diff options
Diffstat (limited to 'forth/step2_eval.fs')
| -rw-r--r-- | forth/step2_eval.fs | 117 |
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 |
