diff --git a/chapter1/astToList.coffee b/chapter1/astToList.coffee index c7dbfd2..6694f6d 100644 --- a/chapter1/astToList.coffee +++ b/chapter1/astToList.coffee @@ -26,7 +26,7 @@ normalizeForm = (form) -> 'record': (atom) -> listToRecord1(atom) # Basic native types. Meh. - 'symbol': (id) -> new Symbol(id) + 'symbol': (id) -> new Symbol(id.name) 'number': id 'string': id 'nil': (atom) -> nil diff --git a/chapter4/interpreter.coffee b/chapter4/interpreter.coffee index c4d4d17..5a1477b 100644 --- a/chapter4/interpreter.coffee +++ b/chapter4/interpreter.coffee @@ -50,7 +50,7 @@ sBoolify = new Symbol 'boolify' sFunction = new Symbol 'function' sSymbol = new Symbol 'symbol' sString = new Symbol 'string' -sChars = new Symbol 'chars' +sValue = new Symbol 'chars' sName = new Symbol 'name' sNumber = new Symbol 'number' sNull = new Symbol 'null' @@ -69,7 +69,7 @@ prox = "begin": (body, env, mem, kont) -> evaluateBegin (cdr body), env, mem, kont "set!": (body, env, mem, kont) -> evaluateSet (intnvalu cadr body), (caddr body), env, mem, kont "lambda": (body, env, mem, kont) -> evaluateLambda (intmksymbols cadr body), (cddr body), env, mem, kont - "or": (body, env, mem, kont) -> evaluateOr (car body), (cdr body), env, mem, kont + "or": (body, env, mem, kont) -> evaluateOr (cadr body), (caddr body), env, mem, kont # ___ _ _ # | __|_ ____ _| |_ _ __ _| |_ ___ _ _ @@ -83,6 +83,7 @@ transcode = (value, mem, qont) -> [((v) -> intsymbolp(v) and v in ['#t', '#f']), (-> qont (createBoolean value), mem)] [intsymbolp, (-> qont (createSymbol value), mem)] [intnumberp, (-> qont (createNumber value), mem)] + [intstringp, (-> qont (createString value), mem)] [intlistp, (-> transcode (car intnvalu value), mem, (addr, mem2) -> (transcode (cdr intvalu value), mem2, (d, mem3) -> (allocatePair addr, d, mem3, qont)))] @@ -92,11 +93,28 @@ transcode = (value, mem, qont) -> throw new LispInterpreterError "Bad transcode match for #{value}" found[0]() +transcode2 = (value, mem, qont) -> + forms = [ + [((v) -> v instanceof Symbol and v.name == 'null'), (-> qont theEmptyList, mem)], + [((v) -> v instanceof Symbol and v.name in ['#t', '#f']), (-> qont (createBoolean value), mem)] + [((v) -> v instanceof Symbol), (-> qont (createSymbol value), mem)] + [((v) -> typeof v == 'string'), (-> qont (createString value), mem)] + [((v) -> typeof v == 'number'), (-> qont (createNumber value), mem)] + [((v) -> v.__type == 'list'), (-> transcode (car value), mem, (addr, mem2) -> + (transcode (cdr value), mem2, (d, mem3) -> + (allocatePair addr, d, mem3, qont)))] + ] + found = (form[1] for form in forms when form[0](value)) + if found.length < 1 + throw new LispInterpreterError "Bad transcode match for #{value}" + found[0]() + + transcodeBack = (value, mem) -> forms = [ [sBoolean, ((v) -> ((v sBoolify) true, false))] [sSymbol, ((v) -> (v sName))] - [sString, ((v) -> (v sChars))] + [sString, ((v) -> (v sValue))] [sNumber, ((v) -> (v sValue))] [sPair, ((v) -> cons (transcodeBack (mem (v sCar)), mem), (transcodeBack (mem (v sCdr)), mem))] @@ -116,12 +134,14 @@ evaluate = (exp, env, mem, kont) -> else body = intnvalu exp head = car body - if prox[(intnvalu head)]? - prox[(intnvalu head)](body, env, mem, kont) + pname = (intnvalu head) + if pname instanceof Symbol and prox[pname.name]? + prox[pname.name](body, env, mem, kont) else evaluateApplication head, (cdr body), env, mem, kont -env_init = (id) -> throw new LispInterpreterError "No binding for " + id.toString() +env_init = (id) -> + throw new LispInterpreterError "No binding for " + id # This is basically the core definition of 'mem': it returns a # function enclosing the address (a monotomically increasing number as @@ -200,14 +220,14 @@ evaluateIf = (expc, expt, expf, env, mem, kont) -> evaluate ((env sBoolify) expt, expf), env, mems, kont evaluateQuote = (c, env, mem, kont) -> - transcode (normalizeForm c), mem, kont + transcode2 (normalizeForm c), mem, kont # By starting over "from here," we undo all side-effect assignments # that were effected by expression 1 evaluateOr = (exp1, exp2, env, mem, kont) -> evaluate exp1, env, mem, (value, mem2) -> - (value sBoolify) (-> kont value, mem2), (-> evaluate exp2, env, mem, kont) + ((value sBoolify) (-> kont value, mem2), (-> evaluate exp2, env, mem, kont))() # I like how, in this version, we explicitly throw away the meaning of # all but the last statement in evaluateBegin. @@ -244,6 +264,13 @@ createNumber = (value) -> when sValue then value when sBoolify then (x, y) -> x +createString = (value) -> + (msg) -> + switch msg + when sType then sString + when sValue then value + when sBoolify then (x, y) -> x + createFunction = (tag, behavior) -> (msg) -> switch msg @@ -326,8 +353,8 @@ defPrimitive = (name, arity, value) -> # -defInitial "true", createBoolean true -defInitial "false", createBoolean false +defInitial "#t", createBoolean true +defInitial "#f", createBoolean false defInitial "nil", null defPrimitive "<=", 2, (values, mem, kont) -> @@ -355,7 +382,7 @@ defPrimitive ">", 2, (values, mem, kont) -> throw new LispInterpreterError "Comparison requires numbers" defPrimitive "=", 2, (values, mem, kont) -> - if (eq ((car values) sType), sNumber) and (eq ((cadr values) sName), sNumber) + if (eq ((car values) sType), sNumber) and (eq ((cadr values) sType), sNumber) kont (createBoolean (((car values) sValue) == ((cadr values) sValue))), mem else throw new LispInterpreterError "Comparison requires numbers" @@ -367,7 +394,7 @@ defPrimitive "*", 2, (values, mem, kont) -> throw new LispInterpreterError "Multiplication requires numbers" defPrimitive "+", 2, (values, mem, kont) -> - if (eq ((car values) sType), sNumber) and (eq ((cadr values) sName), sNumber) + if (eq ((car values) sType), sNumber) and (eq ((cadr values) sType), sNumber) kont (createNumber (((car values) sValue) + ((cadr values) sValue))), mem else throw new LispInterpreterError "Addition requires numbers" @@ -413,24 +440,6 @@ defPrimitive "setcar", 2, (values, mem, kont) -> else throw new LispInterpreterError "Not a pair" -defPrimitive "eqv?", 2, (values, mem, kont) -> - kont createBoolean ( - if (eq ((car values) sType) ((cadr values) sType)) - switch ((car values) sType) - when sBoolean - ((car values) sBoolify) (((cadr values) sBoolify) true, false), (((cadr values) sBoolify) false, true) - when sSymbol - eq ((car values) sName), ((cadr values) sName) - when sNumber - ((car values) sName) == ((cadr values) sName) - when sPair - (((car values) sCar) == ((cadr values) sCar) and - ((car values) sCdr) == ((cadr values) sCdr)) - when sFunction - ((car value) sTag) == ((cadr value) sTag) - else false - else false) - defPrimitive "eq?", 2, (values, mem, kont) -> kont createBoolean ( if (eq ((car values) sType), ((cadr values) sType)) @@ -443,7 +452,25 @@ defPrimitive "eq?", 2, (values, mem, kont) -> (((car values) sCar) == ((cadr values) sCar) and ((car values) sCdr) == ((cadr values) sCdr)) when sFunction - ((car value) sTag) == ((cadr value) sTag) + ((car values) sTag) == ((cadr values) sTag) + else false + else false) + +defPrimitive "eqv?", 2, (values, mem, kont) -> + kont createBoolean ( + if (eq ((car values) sType), ((cadr values) sType)) + switch ((car values) sType) + when sBoolean + ((car values) sBoolify) (((cadr values) sBoolify) true, false), (((cadr values) sBoolify) false, true) + when sSymbol + eq ((car values) sName), ((cadr values) sName) + when sNumber + ((car values) sValue) == ((cadr values) sValue) + when sPair + (((car values) sCar) == ((cadr values) sCar) and + ((car values) sCdr) == ((cadr values) sCdr)) + when sFunction + ((car values) sTag) == ((cadr values) sTag) else false else false) diff --git a/chapter4/reader.coffee b/chapter4/reader.coffee index 0334669..9ce3e27 100644 --- a/chapter4/reader.coffee +++ b/chapter4/reader.coffee @@ -126,7 +126,7 @@ prefixReader = (type) -> [line1, column1] = inStream.position() obj = read inStream, true, null, true return obj if obj.type == 'error' - new Node "list", cons((new Node("symbol", type, line1, column1)), cons(obj)), line, column + new Node "list", cons((new Node("symbol", (new Symbol type), line1, column1)), cons(obj)), line, column # I really wanted to make anything more complex than a list (like an # object or a vector) something handled by a read macro. Maybe in a diff --git a/test/test_chapter4.coffee b/test/test_chapter4.coffee index eacab40..bbd4c6d 100644 --- a/test/test_chapter4.coffee +++ b/test/test_chapter4.coffee @@ -14,12 +14,15 @@ lisp = (ast) -> return ret describe "Core interpreter #4: Pure Lambda Memory", -> - it "Understands equality", -> + it "Understands symbol equality", -> expect(lisp read "(eq? 'a 'b)").to.equal(false) expect(lisp read "(eq? 'a 'a)").to.equal(true) + it "Understands separate allocation inequality", -> expect(lisp read "(eq? (cons 1 2) (cons 1 2))").to.equal(false) + it "Understands address equality", -> expect(lisp read "((lambda (a) (eq? a a)) (cons 1 2))").to.equal(true) expect(lisp read "((lambda (a) (eq? a a)) (lambda (x) x))").to.equal(true) + it "Understands function inequality", -> expect(lisp read "(eq? (lambda (x) 1) (lambda (x y) 2))").to.equal(false) it "Understands equivalence", ->