evaluator: closures work

src/Phsyche.package/PEnv.class/instance/lookupAt.put..st

@@ -0,0 +1,9 @@
+dictionary access
+lookupAt: key put: val
+	| found |
+	found := self at: key ifAbsent: nil.
+	found
+		ifNil: [ parent
+				ifNotNil: [ :arg | parent lookupAt: key put: val ]
+				ifNil: [ KeyNotFound signal: key , ' not found in the environment' ] ]
+		ifNotNil: [ :arg | self at: key put: val ]

src/Phsyche.package/PEnvTest.class/instance/testSetAtRightLevel.st

@@ -0,0 +1,9 @@
+tests
+testSetAtRightLevel
+	outer at: #dad put: 'donald'.
+	inner at: #son put: 'riri'.
+	self assert: (inner at: #son) = 'riri'.
+	inner lookupAt: #son put: 'fifi'.
+	self assert: (outer at: #dad) = 'donald'.
+	outer lookupAt: #dad put: 'piscou'.
+	self assert: (outer at: #dad) = 'piscou'.

src/Phsyche.package/PEnvTest.class/instance/testSetLookup.st

@@ -0,0 +1,9 @@
+tests
+testSetLookup
+	outer at: #dad put: 'donald'.
+	inner at: #son put: 'riri'.
+	self assert: (inner at: #dad) = 'donald'.
+	inner lookupAt: #dad put: 'picsou'.
+	self assert: (outer at: #dad) = 'picsou'.
+	self assert: (inner at: #dad) = 'picsou'.
+	self deny: (inner keys includes: #dad)

src/Phsyche.package/PProc.class/instance/env..st

@@ -0,0 +1,3 @@
+accessing
+env: e
+	env := e

src/Phsyche.package/PProc.class/instance/env.st

@@ -0,0 +1,3 @@
+accessing
+env
+ ^ env

src/Phsyche.package/PProc.class/properties.json

@@ -7,7 +7,8 @@
 	"commentStamp" : "<historical>",
 	"instvars" : [
 		"params",
-		"body" ],
+		"body",
+		"env" ],
 	"name" : "PProc",
 	"pools" : [
 		 ],

src/Phsyche.package/Phsyche.class/instance/divBinding.st

@@ -1,3 +1,3 @@
 as yet unclassified
 divBinding
-	^ #+ -> [ :e :v | e / v asFloat ]
+	^ #/ -> [ :e :v | e / v asFloat ]

src/Phsyche.package/Phsyche.class/instance/eval.in..st

@@ -12,6 +12,8 @@ eval: expr in: environ
 						fst = #define ifTrue: [ ^ self evalDefine: expr in: environ ]. "defines the value"
 						fst = #if ifTrue: [ ^ self evalIf: expr in: environ]. "evaluates if"
 						fst = #lambda ifTrue: [ ^ self evalLambda: expr in: environ ]. "evaluates lambda"
+						fst = #begin ifTrue: [ ^ self evalBegin: expr in: environ ]. "evaluates begin"
 						fst = #quote ifTrue: [ ^ expr second ]. "returns the value unevaluated"
-						^ self evalApp: expr in: environ
+						fst = #set ifTrue: [ ^ self evalSet: expr in: environ ]. "evaluates set"
+						^ self evalApp: expr in: environ "everything else is treated as fn application"
 					]

src/Phsyche.package/Phsyche.class/instance/evalApp.in..st

@@ -3,5 +3,5 @@ evalApp: expr in: environ
 	| proc newEnv |
 	proc := self eval: expr first in: environ.
 	newEnv := proc setParamEnv: (expr allButFirst collect: [ :e | self eval: e in: environ ])
-						in: environ.
+						in: proc env.
 	^ self eval: proc body in: newEnv

src/Phsyche.package/Phsyche.class/instance/evalBegin.in..st

@@ -0,0 +1,5 @@
+as yet unclassified
+evalBegin: expr in: environ
+	| res |
+	expr allButFirst do: [ :each | res := self eval: each in: environ ].
+	^ res

src/Phsyche.package/Phsyche.class/instance/evalLambda.in..st

@@ -1,3 +1,3 @@
 as yet unclassified
 evalLambda: expr in: environ
-	^ PProc new params: expr second; body: expr third
+	^ PProc new params: expr second; body: expr third; env: environ

src/Phsyche.package/Phsyche.class/instance/evalSet.in..st

@@ -0,0 +1,4 @@
+as yet unclassified
+evalSet: expr in: environ
+	environ lookupAt: expr second put: (self eval: expr third in: environ).
+	^ #undefined

src/Phsyche.package/Phsyche.class/instance/initialize.st

@@ -1,6 +1,6 @@
 initialization
 initialize
 	super initialize.
-	env := Dictionary new.
+	env := PEnv new.
 	prims := OrderedCollection new.
 	self initializeEnvBindings

src/Phsyche.package/Phsyche.class/instance/minusBinding.st

@@ -1,3 +1,3 @@
 as yet unclassified
 minusBinding
-	^ #+ -> [ :e :v | e - v ]
+	^ #- -> [ :e :v | e - v ]

src/Phsyche.package/PhsycheTest.class/instance/testEvalBegin.st

@@ -0,0 +1,3 @@
+tests
+testEvalBegin
+	self assert: (ph parseAndEval: '(begin 1 2 3)') equals: 3

src/Phsyche.package/PhsycheTest.class/instance/testEvalBeginSet.st

@@ -0,0 +1,3 @@
+tests
+testEvalBeginSet
+	self assert: (ph parseAndEval: '(begin (define x 1) (set x 2) x)') equals: 2

src/Phsyche.package/PhsycheTest.class/instance/testEvalSetAtCorrectLevel.st

@@ -0,0 +1,13 @@
+tests
+testEvalSetAtCorrectLevel
+	| proc |
+	ph parseAndEval: '
+		(define fy3
+			((lambda (x)
+				(lambda (y)
+					(begin
+						(set x (+ x 2))
+						(+ x y))))
+			3))'.
+	proc := ph eval: #fy3.
+	self assert: (ph parseAndEval: '(fy3 5)') equals: 10

src/Phsyche.package/PhsycheTest.class/instance/testEvalSimpleSet.st

@@ -0,0 +1,5 @@
+tests
+testEvalSimpleSet
+	self assert: (ph parseAndEval: '(define x2 21') equals: #undefined.
+	self assert: (ph parseAndEval: '(set x2 22)') equals: #undefined.
+	self assert: (ph parseAndEval: 'x2') equals: 22.

src/Phsyche.package/PhsycheTest.class/instance/testLambdaProcedureExecution.st

@@ -1,3 +1,3 @@
-as yet unclassified
+tests
 testLambdaProcedureExecution
 	self assert: (ph parseAndEval: '((lambda (x) (* x x)) 3)') equals: 9.

src/Phsyche.package/PhsycheTest.class/instance/testProcedureDefinition.st

@@ -1,4 +1,4 @@
-as yet unclassified
+tests
 testProcedureDefinition
 	| proc |
 	ph parseAndEval: '(define squared (lambda (x) (* x x)))'.

src/Phsyche.package/PhsycheTest.class/instance/testProcedureExecution.st

@@ -1,4 +1,4 @@
-as yet unclassified
+tests
 testProcedureExecution
 	ph parseAndEval: '(define squared (lambda (x) (* x x)))'.
 	self assert: (ph parseAndEval: '(squared 3)') equals: 9

src/Phsyche.package/PhsycheTest.class/instance/testSimpleClosure.st

@@ -0,0 +1,10 @@
+tests
+testSimpleClosure
+	| res |
+	res := ph eval: (ph parse: '(
+		((lambda (x)
+			(lambda (y)
+				(+ x y)))
+			3)
+		7)').
+	self assert: res equals: 10

src/Phsyche.package/PhsycheTest.class/instance/testSimpleClosureIntrospection.st

@@ -0,0 +1,11 @@
+tests
+testSimpleClosureIntrospection
+	| proc |
+	ph parseAndEval: '(define fy3
+		((lambda (x)
+			(lambda (y)
+			x))
+		3))'.
+	proc := ph parseAndEval: '#fy3'.
+	self assert: proc params equals: #(y).
+	self assert: (proc env at: #x) equals: 3.