elf
/
LispInSmallPieces
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

[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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
chapter5/interpreter5a.coffee
View File

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

2
chapter5/reader.coffee
View File

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

37
test/test_chapter5_benchmark.coffee
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)

27
test/test_chapter5a.coffee Normal file
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)