evaluator: add user-defined functions

src/Phsyche.package/PEnv.class/README.md

@@ -0,0 +1 @@
+I’m an interpreter environment.

src/Phsyche.package/PEnv.class/class/newFromKeys.andValues..st

@@ -0,0 +1,6 @@
+dictionary access
+newFromKeys: keys andValues: values
+	| dict |
+	dict := self new.
+	keys with: values do: [ :k :v | dict at: k put: v ].
+	^ dict

src/Phsyche.package/PEnv.class/instance/at..st

@@ -0,0 +1,7 @@
+dictionary access
+at: key
+	| value |
+	value := self at: key ifAbsent: [ nil ].
+	^ value
+		ifNil: [ parent ifNil: [ super at: key ] ifNotNil: [ :arg | parent at: key ] ]
+		ifNotNil: [ :v | v ]

src/Phsyche.package/PEnv.class/instance/parent..st

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

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

@@ -0,0 +1,14 @@
+{
+	"category" : "Phsyche",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		 ],
+	"commentStamp" : "<historical>",
+	"instvars" : [
+		"parent" ],
+	"name" : "PEnv",
+	"pools" : [
+		 ],
+	"super" : "Dictionary",
+	"type" : "normal" }

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

@@ -0,0 +1,5 @@
+tests
+setUp
+	outer := PEnv new.
+	inner := PEnv new.
+	inner parent: outer

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

@@ -0,0 +1,5 @@
+tests
+testLookingOuterFromInner
+	outer at: #dad put: 'donald'.
+	inner at: #son put: 'riri'.
+	self assert: (inner at: #dad) equals: 'donald'

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

@@ -0,0 +1,7 @@
+tests
+testLookupInFails
+	outer at: #dad put: 'donald'.
+	inner at: #son put: 'riri'.
+	self should: [ outer at: #nodad ] raise: KeyNotFound.
+	self should: [ outer at: #noson ] raise: KeyNotFound.
+	self should: [ inner at: #nodad ] raise: KeyNotFound

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

@@ -0,0 +1,15 @@
+{
+	"category" : "Phsyche",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		 ],
+	"commentStamp" : "",
+	"instvars" : [
+		"outer",
+		"inner" ],
+	"name" : "PEnvTest",
+	"pools" : [
+		 ],
+	"super" : "TestCase",
+	"type" : "normal" }

src/Phsyche.package/PProc.class/README.md

@@ -0,0 +1 @@
+I’m a user-defined procedure.

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

@@ -0,0 +1,3 @@
+accessing
+body: b
+	body := b

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

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

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

@@ -0,0 +1,3 @@
+accessing
+params: p
+	params := p

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

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

src/Phsyche.package/PProc.class/instance/setParamEnv.in..st

@@ -0,0 +1,6 @@
+accessing
+setParamEnv: values in: parent
+	| appEnv |
+	appEnv := PEnv newFromKeys: self params andValues: values.
+	appEnv parent: parent.
+	^ appEnv

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

@@ -0,0 +1,15 @@
+{
+	"category" : "Phsyche",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		 ],
+	"commentStamp" : "<historical>",
+	"instvars" : [
+		"params",
+		"body" ],
+	"name" : "PProc",
+	"pools" : [
+		 ],
+	"super" : "Object",
+	"type" : "normal" }

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

@@ -11,5 +11,7 @@ eval: expr in: environ
 						]. "evaluates primitive"
 						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 = #quote ifTrue: [ ^ expr second ]. "returns the value unevaluated"
+						^ self evalApp: expr in: environ
 					]

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

@@ -0,0 +1,7 @@
+as yet unclassified
+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.
+	^ self eval: proc body in: newEnv

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

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

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

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

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

@@ -0,0 +1,7 @@
+as yet unclassified
+testProcedureDefinition
+	| proc |
+	ph parseAndEval: '(define squared (lambda (x) (* x x)))'.
+	proc := ph parseAndEval: #squared.
+	self assert: proc params equals: #(#x).
+	self assert: proc body equals: #(#* #x #x)

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

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