[feat] Chapter 5, first compiler. Not doing the rest...

This commit is contained in:
Elf M. Sternberg 2015-09-01 16:50:04 -07:00
parent 65476fecaf
commit ec9cdfb4a1
4 changed files with 86 additions and 85 deletions

View File

@ -6,10 +6,14 @@
{Node, Comment, Symbol} = require '../chapter5/reader_types' {Node, Comment, Symbol} = require '../chapter5/reader_types'
{inspect} = require 'util' {inspect} = require 'util'
itap = (a) -> return inspect a, true, null, false itap = (a) -> console.log inspect a, true, null, false; a
ftap = (a) -> console.log Function.prototype.toString.call(a); a
class Value class Value
vpos = 0
constructor: (@v) -> constructor: (@v) ->
vpos = vpos + 1
inValue = (f) -> inValue = (f) ->
new Value(f) new Value(f)
@ -27,6 +31,9 @@ eq = (id1, id2) ->
cadddr = metacadr('cadddr') cadddr = metacadr('cadddr')
# Hack
gsym = (x) -> if (x instanceof Symbol) then x.name else x
consp = (e) -> consp = (e) ->
((pairp e) and (typeof (car e) == 'number') and ((pairp e) and (typeof (car e) == 'number') and
((car e) > 0) and (pairp cdr e) and (typeof (cadr e) == 'number') and ((car e) > 0) and (pairp cdr e) and (typeof (cadr e) == 'number') and
@ -147,8 +154,8 @@ ValueToNumber = (e) ->
ValueToPrimitive = (e) -> ValueToPrimitive = (e) ->
return e.v return e.v
store_init = (a) -> throw new LispInterpreterError "No such address" store_init = (a) -> throw new LispInterpreterError "No such address: #{a}"
env_init = (a) -> throw new LispInterpreterError "No such variable" env_init = (a) -> throw new LispInterpreterError "No such variable: #{a}"
class Interpreter class Interpreter
constructor: -> constructor: ->
@ -156,7 +163,7 @@ class Interpreter
(values, kont, store) => (values, kont, store) =>
if not eq (length values), arity if not eq (length values), arity
throw new LispInterpreterError "Incorrect Arity for #{name}" throw new LispInterpreterError "Incorrect Arity for #{name}"
fn.call(@, values, kont, store) fn(values, kont, store)
@definitial "cons", inValue arity_check "cons", 2, (values, kont, store) => @definitial "cons", inValue arity_check "cons", 2, (values, kont, store) =>
allocate store, 2, (store, addrs) => allocate store, 2, (store, addrs) =>
@ -208,20 +215,21 @@ class Interpreter
@definitial '#f', (inValue false) @definitial '#f', (inValue false)
@definitial 'nil', (inValue cons()) @definitial 'nil', (inValue cons())
@definitial "x", null @definitial "x", inValue (new Object(null))
@definitial "y", null @definitial "y", inValue (new Object(null))
@definitial "z", null @definitial "z", inValue (new Object(null))
@definitial "a", null @definitial "a", inValue (new Object(null))
@definitial "b", null @definitial "b", inValue (new Object(null))
@definitial "c", null @definitial "c", inValue (new Object(null))
@definitial "foo", null @definitial "foo", inValue (new Object(null))
@definitial "bar", null @definitial "bar", inValue (new Object(null))
@definitial "hux", null @definitial "hux", inValue (new Object(null))
@definitial "fib", null @definitial "fib", inValue (new Object(null))
@definitial "fact", null @definitial "fact", inValue (new Object(null))
@definitial "visit", null @definitial "visit", inValue (new Object(null))
@definitial "length", null @definitial "length", inValue (new Object(null))
@definitial "primes", null @definitial "filter", inValue (new Object(null))
@definitial "primes", inValue (new Object(null))
meaning: (e) -> meaning: (e) ->
meaningTable = meaningTable =
@ -232,14 +240,35 @@ class Interpreter
'set!': ((e) => @meaningAssignment (cadr e), (caddr e)) 'set!': ((e) => @meaningAssignment (cadr e), (caddr e))
if (atomp e) if (atomp e)
return if (symbolp e) then (@meaningReference e.name) else (@meaningQuotation e) return if (symbolp e) then (@meaningReference gsym(e)) else (@meaningQuotation e)
n = gsym(car e)
n = if symbolp (car e) then (car e).name else (car e)
if meaningTable[n]? if meaningTable[n]?
meaningTable[n](e) meaningTable[n](e)
else else
@meaningApplication (car e), (cdr e) @meaningApplication (car e), (cdr e)
meaningSequence: (exps) =>
(env, kont, store) =>
(@meaningsSequence exps) env, kont, store
meaningsMultipleSequence: (exp, exps) ->
(env, kont, store) =>
hkont = (values, store1) =>
(@meaningsSequence exps) env, kont, store1
(@meaning exp) env, hkont, store
meaningsSingleSequence: (exp) ->
(env, kont, store) =>
(@meaning exp) env, kont, store
meaningsSequence: (exps) ->
if not (pairp exps)
throw new LispInterpreterError("Illegal Syntax")
if pairp cdr exps
@meaningsMultipleSequence (car exps), (cdr exps)
else
@meaningsSingleSequence (car exps)
meaningQuotation: (val) -> meaningQuotation: (val) ->
(env, kont, store) -> (env, kont, store) ->
(translate val, store, kont) (translate val, store, kont)
@ -265,11 +294,12 @@ class Interpreter
# Assignment # Assignment
meaningAssignment: (name, exp) -> meaningAssignment: (name, exp) ->
name = if name instanceof Symbol then name.name else name
console.log(name)
(env, kont, store) => (env, kont, store) =>
hkont = (val, store1) -> hkont = (val, store1) ->
kont value, (extend store1, (env name), val) kont val, (extend store1, (env name), val)
(@meaning exp) env, hkont, store
(@meaning exp)(env, hkont, store)
# Abstraction (keeps a lambda) # Abstraction (keeps a lambda)
@ -278,10 +308,10 @@ class Interpreter
funcrep = (vals, kont1, store1) => funcrep = (vals, kont1, store1) =>
if not (eq (length vals), (length names)) if not (eq (length vals), (length names))
throw new LispInterpreterError("Incorrect Arity.") throw new LispInterpreterError("Incorrect Arity.")
functostore = (store2, addrs) => argnamestostore = (store2, addrs) =>
(@meaningsSequence exps) (lextends env, names, addrs), kont1, (lextends store2, addrs, vals) (@meaningsSequence exps) (lextends env, names, addrs), kont1, (lextends store2, addrs, vals)
allocate store1, (length names), functostore allocate store1, (length names), argnamestostore
kont inValue, funcrep kont (inValue funcrep), store
meaningVariable: (name) -> meaningVariable: (name) ->
(m) -> (m) ->
@ -298,25 +328,6 @@ class Interpreter
(@meanings exps) env, kont2, store1 (@meanings exps) env, kont2, store1
(@meaning exp) env, hkont, store (@meaning exp) env, hkont, store
meaningSequence: (exps) ->
meaningsMultipleSequence = (exp, exps) =>
(env, kont, store) =>
hkont = (values, store1) ->
(meaningsSequence exps) env, kont, store1
(@meaning exp) env, hkont, store
meaningsSingleSequence = (exp) =>
(env, kont, store) =>
(@meaning exp) env, kont, store
(env, kont, store) ->
if not (pairp exps)
throw new LispInterpreterError("Illegal Syntax")
if pairp cdr exps
meaningsMultipleSequence (car exps), (cdr exps)
else
meaningSingleSequence (car exps)
meanings: (exps) => meanings: (exps) =>
meaningSomeArguments = (exp, exps) => meaningSomeArguments = (exp, exps) =>
(env, kont, store) => (env, kont, store) =>

View File

@ -90,7 +90,7 @@ class Reader
inStream.next() inStream.next()
obj = @read inStream, true, null, true obj = @read inStream, true, null, true
return obj if obj instanceof ReadError return obj if obj instanceof ReadError
cons((new Symbol type), obj) list((new Symbol type), obj)
"acc": (obj) -> obj "acc": (obj) -> obj

View File

@ -1,37 +0,0 @@
chai = require 'chai'
chai.should()
expect = chai.expect
olisp = require '../chapter5/interpreter5a'
{read} = require '../chapter5/reader'
lisp = (ast) ->
ret = undefined
olisp ast, (i) -> ret = i
return ret
benchmark = [
"(begin",
" (set! primes",
" (lambda (n f max)",
" ((lambda (filter)",
" (begin",
" (set! filter (lambda (p)",
" (lambda (n) (= 0 (remainder n p))) ))",
" (if (> n max)",
" '()",
" (if (f n)",
" (primes (+ n 1) f max)",
" (cons n",
" ((lambda (ff)",
" (primes (+ n 1)",
" (lambda (p) (if (f p) t (ff p)))",
" max ) )",
" (filter n) ) ) ) ) ) )",
" 'wait ) ) )",
" (primes 2 (lambda (x) f) 50) )"].join('')
describe "Chapter 5: It runs.", ->
it "Runs the primes search example", ->
expect(lisp read benchmark).to.equal(true)

View File

@ -0,0 +1,27 @@
chai = require 'chai'
chai.should()
expect = chai.expect
olisp = require '../chapter5/interpreter5a'
{read} = require '../chapter5/reader'
lisp = (ast) ->
ret = undefined
olisp ast, (i) -> ret = i
return ret
describe "Core interpreter #5: Now with more λ!", ->
it "Understands symbol inequality", ->
expect(lisp read "(eq? 'a 'b)").to.equal(false)
it "Understands symbol equality", ->
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 of values", ->
expect(lisp read "((lambda (a) (eq? a a)) (cons 1 2))").to.equal(true)
it "Understands address equality of functions", ->
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)