aboutsummaryrefslogtreecommitdiff
path: root/forth/step2_eval.fs
diff options
context:
space:
mode:
Diffstat (limited to 'forth/step2_eval.fs')
-rw-r--r--forth/step2_eval.fs117
1 files changed, 117 insertions, 0 deletions
diff --git a/forth/step2_eval.fs b/forth/step2_eval.fs
new file mode 100644
index 0000000..2b55ce0
--- /dev/null
+++ b/forth/step2_eval.fs
@@ -0,0 +1,117 @@
+require reader.fs
+require printer.fs
+
+: args-as-native { argv argc -- entry*argc... }
+ argc 0 ?do
+ argv i cells + @ as-native
+ loop ;
+
+MalMap/Empty
+ s" +" MalSymbol. :noname args-as-native + MalInt. ; MalNativeFn. rot assoc
+ s" -" MalSymbol. :noname args-as-native - MalInt. ; MalNativeFn. rot assoc
+ s" *" MalSymbol. :noname args-as-native * MalInt. ; MalNativeFn. rot assoc
+ s" /" MalSymbol. :noname args-as-native / MalInt. ; MalNativeFn. rot assoc
+value repl-env
+
+: read read-str ;
+: eval ( env obj ) mal-eval ;
+: print
+ \ ." Type: " dup mal-type @ type-name safe-type cr
+ pr-str ;
+
+MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself
+
+MalKeyword
+ extend eval-invoke { env list kw -- val }
+ 0 kw env list MalList/start @ cell+ @ eval get
+ ?dup 0= if
+ \ compute not-found value
+ list MalList/count @ 1 > if
+ env list MalList/start @ 2 cells + @ eval
+ else
+ mal-nil
+ endif
+ endif ;;
+drop
+
+\ eval all but the first item of list
+: eval-rest { env list -- argv argc }
+ list MalList/start @ cell+ { expr-start }
+ list MalList/count @ 1- { argc }
+ argc cells allocate throw { target }
+ argc 0 ?do
+ env expr-start i cells + @ eval
+ target i cells + !
+ loop
+ target argc ;
+
+MalNativeFn
+ extend eval-invoke ( env list this -- list )
+ MalNativeFn/xt @ { xt }
+ eval-rest ( argv argc )
+ xt execute ( return-val ) ;;
+drop
+
+MalSymbol
+ extend mal-eval { env sym -- val }
+ 0 sym env get
+ dup 0= if
+ drop
+ ." Symbol '"
+ sym as-native safe-type
+ ." ' not found." cr
+ 1 throw
+ endif ;;
+drop
+
+: eval-ast { env list -- list }
+ here
+ list MalList/start @ { expr-start }
+ list MalList/count @ 0 ?do
+ env expr-start i cells + @ eval ,
+ loop
+ here>MalList ;
+
+MalList
+ extend mal-eval { env list -- val }
+ env list MalList/start @ @ eval
+ env list rot eval-invoke ;;
+drop
+
+MalVector
+ extend mal-eval ( env vector -- vector )
+ MalVector/list @ eval-ast
+ MalVector new swap over MalVector/list ! ;;
+drop
+
+MalMap
+ extend mal-eval ( env map -- map )
+ MalMap/list @ eval-ast
+ MalMap new swap over MalMap/list ! ;;
+drop
+
+: rep ( str-addr str-len -- str-addr str-len )
+ read
+ repl-env swap eval
+ print ;
+
+create buff 128 allot
+77777777777 constant stack-leak-detect
+
+: read-lines
+ begin
+ ." user> "
+ stack-leak-detect
+ buff 128 stdin read-line throw
+ while ( num-bytes-read )
+ buff swap ( str-addr str-len )
+ ['] rep
+ \ execute safe-type
+ catch ?dup 0= if safe-type else ." Caught error " . endif
+ cr
+ stack-leak-detect <> if ." --stack leak--" cr endif
+ repeat ;
+
+read-lines
+cr
+bye