forth: Add . interop special operator and tests

3 files changed, 51 insertions, 8 deletions

diff --git a/forth/stepA_interop.fs b/forth/stepA_interop.fs
index 0a4050a..9a39889 100644
--- a/forth/stepA_interop.fs
+++ b/forth/stepA_interop.fs
@@ -261,6 +261,13 @@ defspecial try* { env list -- val }
         catch-env  catch0 cell+ @  TCO-eval
     endif ;;
 
+defspecial . { env coll -- rtn-list }
+    depth { old-depth }
+    coll to-list dup MalList/count @ swap MalList/start @ { count start }
+    count cells start +  start cell+  +do
+        env i @ eval as-native
+    cell +loop ;;
+
 MalSymbol
   extend mal-eval { env sym -- val }
     0 sym env get
diff --git a/forth/tests/stepA_interop.mal b/forth/tests/stepA_interop.mal
new file mode 100644
index 0000000..c4a0e75
--- /dev/null
+++ b/forth/tests/stepA_interop.mal
@@ -0,0 +1,41 @@
+;; Basic interop
+(. 5 'MalInt.)
+;=>5
+(. 11 31 '+ 'MalInt.)
+;=>42
+(. "greetings" 'MalString.)
+;=>"greetings"
+(. "hello" 'type 'cr 'mal-nil)
+; hello
+;=>nil
+
+;; Interop on non-literals
+(. (+ 15 27) 'MalInt.)
+;=>42
+(let* [a 17] (. a 25 '+ 'MalInt.))
+;=>42
+(let* [a "hello"] (. a 1 '- 'MalString.))
+;=>"hell"
+
+;; Use of annoyingly-named forth words
+(. 1 'MalInt. (symbol ",") 'here (symbol "@"))
+;=>1
+(let* (i 'MalInt.) (. 5 i))
+;=>5
+(let* (comma (symbol ",") fetch (symbol "@")) (. 'here 42 'MalInt. comma fetch))
+;=>42
+
+;; Multiple .-forms interacting via heap memory and mal locals
+(def! string-parts (fn* (s) (. s 'MalInt. 'swap 'MalInt. 'here '-rot (symbol ",") (symbol ",") 'here>MalList)))
+(first (rest (string-parts "sketchy")))
+;=>7
+(def! prn-chars (fn* (start count) (if (> count 0) (do (prn (. start 1 'MalString.)) (prn-chars (+ start 1) (- count 1))))))
+(let* (msg (string-parts "sketchy")) (prn-chars (first msg) (first (rest msg))))
+; "s"
+; "k"
+; "e"
+; "t"
+; "c"
+; "h"
+; "y"
+;=>nil
diff --git a/forth/types.fs b/forth/types.fs
index 2c4c8e0..c0144d4 100644
--- a/forth/types.fs
+++ b/forth/types.fs
@@ -437,7 +437,6 @@ drop
 MalDefault
   extend conj   ( obj this -- this )
     nip ;;
-  extend as-native ;; ( obj -- obj )
   extend to-list drop 0 ;;
   extend empty? drop mal-true ;;
   extend sequential? drop mal-false ;;
@@ -447,7 +446,7 @@ drop
 MalNil
   extend conj ( item nil -- mal-list )
     drop MalList/Empty conj ;;
-  extend as-native drop 0 ;;
+  extend as-native drop nil ;;
   extend get 2drop ;;
   extend to-list drop MalList/Empty ;;
   extend empty? drop mal-true ;;
@@ -479,7 +478,8 @@ MalSymbol
     else
         2drop 0
     endif ;;
-  ' as-native ' unpack-sym extend-method*
+  extend as-native ( this )
+    unpack-sym evaluate ;;
 drop
 
 MalType%
@@ -545,11 +545,6 @@ deftype MalNativeFn
     MalMap/Empty mal-fn MalNativeFn/meta  !
     mal-fn ;
 
-MalNativeFn
-  extend as-native
-    MalNativeFn/xt @ ;;
-drop
-
 
 MalType%
   cell% field MalUserFn/is-macro?