forth: Back-propogate fixes from stepA through step1

1 files changed, 45 insertions, 48 deletions

diff --git a/forth/step3_env.fs b/forth/step3_env.fs
index 7dc9d7e..676bfcc 100644
--- a/forth/step3_env.fs
+++ b/forth/step3_env.fs
@@ -13,44 +13,47 @@ s" -" MalSymbol.  :noname args-as-native - MalInt. ; MalNativeFn.  repl-env env/
 s" *" MalSymbol.  :noname args-as-native * MalInt. ; MalNativeFn.  repl-env env/set
 s" /" MalSymbol.  :noname args-as-native / MalInt. ; MalNativeFn.  repl-env env/set
 
-\ Fully evalutate any Mal object:
-def-protocol-method mal-eval ( env ast -- val )
-
-\ Invoke an object, given whole env and unevaluated argument forms:
-def-protocol-method invoke ( argv argc mal-fn -- ... )
+: 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
+MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself
 
 MalKeyword
-  extend invoke { env list kw -- val }
-    0   kw   env list MalList/start @ cell+ @ mal-eval   get
+  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 + @  mal-eval
+            env  list MalList/start @ 2 cells + @  eval
         else
             mal-nil
         endif
     endif ;;
 drop
 
-MalNativeFn
-  extend invoke { env list this -- list }
-    \ Pass args on dictionary stack (!)
-    \ TODO: consider allocate and free of a real MalList instead
-    \ Normal list, evaluate and invoke
-    here { val-start }
-    list MalList/start @ { expr-start }
-    list MalList/count @ 1 ?do
-        env expr-start i cells + @ mal-eval ,
+\ 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
-    val-start  here val-start - cell /  this  ( argv argc MalNativeFn )
-    MalNativeFn/xt @ execute
-    val-start here - allot ;;
+    target argc ;
+
+MalNativeFn
+  extend eval-invoke ( env list this -- list )
+    MalNativeFn/xt @ { xt }
+    eval-rest ( argv argc )
+    xt execute ( return-val ) ;;
 drop
 
 SpecialOp
-  extend invoke ( env list this -- list )
+  extend eval-invoke ( env list this -- list )
     SpecialOp/xt @ execute ;;
 drop
 
@@ -66,24 +69,23 @@ drop
 defspecial quote ( env list -- form )
     nip MalList/start @ cell+ @ ;;
 
-defspecial def! { env list -- }
+defspecial def! { env list -- val }
     list MalList/start @ cell+ { arg0 }
     arg0 @ ( key )
-    env arg0 cell+ @ mal-eval dup { val } ( key val )
-    env env/set
-    val ;;
+    env arg0 cell+ @ eval dup { val } ( key val )
+    env env/set val ;;
 
-defspecial let* { old-env list -- }
+defspecial let* { old-env list -- val }
     old-env MalEnv. { env }
     list MalList/start @ cell+ dup { arg0 }
     @ to-list
     dup MalList/start @ { bindings-start } ( list )
     MalList/count @ 0 +do
         bindings-start i cells + dup @ swap cell+ @ ( sym expr )
-        env swap mal-eval
+        env swap eval
         env env/set
     2 +loop
-    env arg0 cell+ @ mal-eval
+    env arg0 cell+ @ eval
     \ TODO: dec refcount of env
     ;;
 
@@ -99,57 +101,52 @@ MalSymbol
     endif ;;
 drop
 
-: mal-eval-ast { env list -- list }
+: eval-ast { env list -- list }
     here
     list MalList/start @ { expr-start }
     list MalList/count @ 0 ?do
-        env expr-start i cells + @ mal-eval ,
+        env expr-start i cells + @ eval ,
     loop
     here>MalList ;
 
 MalList
   extend mal-eval { env list -- val }
-    env list MalList/start @ @ mal-eval
-    env list rot invoke ;;
+    env list MalList/start @ @ eval
+    env list rot eval-invoke ;;
 drop
 
 MalVector
   extend mal-eval ( env vector -- vector )
-    MalVector/list @ mal-eval-ast
+    MalVector/list @ eval-ast
     MalVector new swap over MalVector/list ! ;;
 drop
 
 MalMap
   extend mal-eval ( env map -- map )
-    MalMap/list @ mal-eval-ast
+    MalMap/list @ eval-ast
     MalMap new swap over MalMap/list ! ;;
 drop
 
-: read read-str ;
-: eval ( env obj ) mal-eval ;
-: print
-    \ ." Type: " dup mal-type @ type-name safe-type cr
-    pr-str ;
-
-: rep ( str -- val )
+: 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> "
-      42042042042
+      stack-leak-detect
       buff 128 stdin read-line throw
-    while
-      buff swap
+    while ( num-bytes-read )
+      buff swap ( str-addr str-len )
       ['] rep
-      execute safe-type
-      \ catch 0= if safe-type else ." Caught error" endif
+      \ execute safe-type
+      catch ?dup 0= if safe-type else ." Caught error " . endif
       cr
-      42042042042 <> if ." --stack leak--" cr endif
+      stack-leak-detect <> if ." --stack leak--" cr endif
     repeat ;
 
 read-lines