evaluator: add if and primitives and tests

This commit is contained in:
2018-04-30 17:47:15 +02:00
parent 92a2ecbd8e
commit 013c0844c7
28 changed files with 110 additions and 4 deletions

View File

@@ -0,0 +1,3 @@
as yet unclassified
carBinding
^ #car -> [ :l | l first ]

View File

@@ -0,0 +1,3 @@
as yet unclassified
cdrBinding
^ #cdr -> [ :l | l allButFirst ]

View File

@@ -0,0 +1,3 @@
as yet unclassified
consBinding
^ #cons -> [ :e :l | {e} , l ]

View File

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

View File

@@ -4,6 +4,12 @@ eval: expr in: environ
expr isSymbol ifTrue: [ ^ environ at: expr ]. "returns the variable value"
expr isArray ifFalse: [ ^ expr ] "returns literals boolean, string, number"
ifTrue: [
expr first = #define
ifTrue: [ ^ self evalDefine: expr in: environ ]
| fst |
fst := expr first.
(prims includes: fst) ifTrue: [
^ self evalPrim: 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 = #quote ifTrue: [ ^ expr second ]. "returns the value unevaluated"
]

View File

@@ -0,0 +1,5 @@
as yet unclassified
evalIf: expr in: environ
^ (self eval: expr second in: environ)
ifTrue: [ self eval: expr third in: environ ]
ifFalse: [ self eval: expr fourth in: environ ]

View File

@@ -0,0 +1,5 @@
as yet unclassified
evalPrim: expr in: environ
| method |
method := (environ at: expr first).
^ method valueWithArguments: (expr allButFirst collect: [ :x | self eval: x in: environ])

View File

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

View File

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

View File

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

View File

@@ -0,0 +1,9 @@
as yet unclassified
initializeEnvBindings
(self class selectors select: [ :each | each endsWithSubCollection: 'Binding' ])
do: [ :s |
| binding |
binding := self perform: s.
prims add: binding key.
env at: binding key put: binding value
]

View File

@@ -0,0 +1,3 @@
as yet unclassified
isEqualBinding
^ #equal -> [ :e :v | e = v ]

View File

@@ -0,0 +1,3 @@
as yet unclassified
isNotBinding
^ #not -> [ :a | a not ]

View File

@@ -0,0 +1,3 @@
as yet unclassified
isNullBinding
^ #isNull -> [ :l | l = #() ]

View File

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

View File

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

View File

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

View File

@@ -0,0 +1,3 @@
as yet unclassified
smallerOrEqualBinding
^ #<= -> [ :e :v | e <= v ]

View File

@@ -6,7 +6,8 @@
],
"commentStamp" : "VeitHeller 4/30/2018 16:32",
"instvars" : [
"env" ],
"env",
"prims" ],
"name" : "Phsyche",
"pools" : [
],

View File

@@ -0,0 +1,5 @@
tests
testEvalCarExpressionEvaluatesItsArgument
self
assert: (ph parseAndEval: '(car (cons (quote a) (cons (quote b) ())))')
equals: #a

View File

@@ -0,0 +1,3 @@
tests
testEvalCdrExpressionEvaluatesItsArgument
self assert: (ph parseAndEval: '(cdr (quote (quote a)))') equals: #(a)

View File

@@ -0,0 +1,4 @@
tests
testEvalExpressionArith
self assert: (ph parseAndEval: '(* (+ 2 3) 8)') equals: 40.
self assert: (ph parseAndEval: '(* 8 (+ 2 3))') equals: 40

View File

@@ -0,0 +1,3 @@
tests
testEvalExpressionMult
self assert: (ph parseAndEval: '(* 3 8)') equals: 24

View File

@@ -0,0 +1,4 @@
tests
testEvalIf
self assert: (ph parseAndEval: '(if true 4 5)') equals: 4.
self assert: (ph parseAndEval: '(if false 4 5)') equals: 5

View File

@@ -0,0 +1,3 @@
tests
testEvalListExpression
self assert: (ph parseAndEval: '(cons (quote a) ())') equals: #(a)

View File

@@ -0,0 +1,8 @@
tests
testEvalQuote
self
assert: (ph parseAndEval: '(quote (* x x))')
equals: #(#* #x #x).
self
assert: (ph parseAndEval: '(quote (quote (* x x)))')
equals: #(quote #(#* #x #x))

View File

@@ -0,0 +1,5 @@
tests
testIsNull
self assert: (ph parseAndEval: '(isNull #())').
self assert: (ph parseAndEval: '(isNull (quote ()))').
self deny: (ph parseAndEval: '(isNull (cons (quote a) #()))')

View File

@@ -0,0 +1,4 @@
tests
testNot
self assert: (ph parseAndEval: '(not false)').
self deny: (ph parseAndEval: '(not true)')