forth: Get rid of car/cdr style lists

Rename MalArray to MalList

7 files changed, 89 insertions, 178 deletions

diff --git a/forth/env.fs b/forth/env.fs
index c1dc278..1b5a362 100644
--- a/forth/env.fs
+++ b/forth/env.fs
@@ -42,4 +42,4 @@ MalEnv
     else
         pr-buf
     endif ;;
-drop
\ No newline at end of file
+drop
diff --git a/forth/misc-tests.fs b/forth/misc-tests.fs
index ede5119..2526067 100644
--- a/forth/misc-tests.fs
+++ b/forth/misc-tests.fs
@@ -36,13 +36,6 @@ dup 4 cells + @  15 test=
 dup 5 cells + @  20 test=
 
 
-\ MalType tests
-
-MalList new   MalList new   = 0 test=
-
-MalList new dup MalList/car 5 swap ! MalList/car @   5 test=
-
-
 \ Protocol tests
 
 mal-nil
@@ -52,9 +45,11 @@ mal-nil
 23 MalInt. mal-nil conj conj conj
 pr-str s" (nil (20 (42) 10) 23)" str= -1 test=
 
-\ MalArray tests
+1500 MalInt. 1500 MalInt. test=
+
+\ MalList tests
 
-here 1 MalInt. , 2 MalInt. , 3 MalInt. , here>MalArray
+here 1 MalInt. , 2 MalInt. , 3 MalInt. , here>MalList
 4 MalInt. swap conj
 5 MalInt. swap conj
 pr-str s" (5 4 1 2 3)" str= -1 test=
diff --git a/forth/printer.fs b/forth/printer.fs
index cc376e6..78ac197 100644
--- a/forth/printer.fs
+++ b/forth/printer.fs
@@ -72,50 +72,22 @@ MalNil
     drop s" nil" str-append ;;
 drop
 
-: pr-buf-list-item ( list str-addr str-len -- list str-addr str-len)
-    rot dup MalList/cdr @ swap MalList/car @ 2swap rot pr-buf ;
-
 MalList
   extend pr-buf
     -rot s" (" str-append ( list str-addr str-len )
     rot pr-seq-buf
     s" )" str-append ;;
-  extend pr-seq-buf
-    \ currently assumes list chain through to the end
-    -rot pr-buf-list-item
-    begin ( list str-addr str-len )
-      2 pick mal-nil <>
-    while
-      a-space pr-buf-list-item
-    repeat
-    rot drop ;;
-  extend pr-pairs-buf
-    -rot pr-buf-list-item a-space pr-buf-list-item
-    begin ( list str-addr str-len )
-      2 pick mal-nil <>
-    while
-      s" , " str-append
-      pr-buf-list-item a-space pr-buf-list-item
-    repeat
-    rot drop ;;
-drop
-
-MalArray
-  extend pr-buf
-    -rot s" (" str-append ( list str-addr str-len )
-    rot pr-seq-buf
-    s" )" str-append ;;
-  extend pr-seq-buf { ary }
-    ary MalArray/start @ { start }
+  extend pr-seq-buf { list }
+    list MalList/start @ { start }
     start @ pr-buf
-    ary MalArray/count @ 1 ?do
+    list MalList/count @ 1 ?do
         a-space
         start i cells + @ pr-buf
     loop ;;
-  extend pr-pairs-buf { ary }
-    ary MalArray/start @ { start }
+  extend pr-pairs-buf { list }
+    list MalList/start @ { start }
     start @ pr-buf a-space start cell+ @ pr-buf
-    ary MalArray/count @ 2 / 1 ?do
+    list MalList/count @ 2 / 1 ?do
         s" , " str-append
         a-space
         start i 2 * cells + @ pr-buf a-space
diff --git a/forth/reader.fs b/forth/reader.fs
index 8f7e3e3..f65db2c 100644
--- a/forth/reader.fs
+++ b/forth/reader.fs
@@ -91,32 +91,7 @@ defer read-form ( str-addr str-len -- str-addr str-len mal-obj )
     out-addr out-len MalString. ;
 
 : read-list ( str-addr str-len open-paren-char close-paren-char
-              -- str-addr str-len non-paren-char mal-list )
-    \ push objects onto "dictionary" -- maybe not the best stack for this?
-    0 { close-char len }
-    drop adv-str
-    begin ( str-addr str-len char )
-        skip-spaces ( str-addr str-len non-space-char )
-        over 0= if
-            drop 2drop
-            s\" expected '" close-char str-append-char
-            s\" ', got EOF" str-append safe-type 1 throw
-        endif
-        dup close-char <>
-    while ( str-addr str-len non-space-non-paren-char )
-        read-form , len 1+ to len
-    repeat
-    drop adv-str
-
-    \ pop objects out of "dictionary" into MalList
-    mal-nil
-    len 0 ?do
-        0 cell - allot
-        here @ swap conj
-    loop ;
-
-: read-array ( str-addr str-len open-paren-char close-paren-char
-                 -- str-addr str-len non-paren-char mal-array )
+                  -- str-addr str-len non-paren-char mal-list )
     here { close-char old-here }
     drop adv-str
     begin ( str-addr str-len char )
@@ -131,22 +106,22 @@ defer read-form ( str-addr str-len -- str-addr str-len mal-obj )
             read-form ,
     repeat
     drop adv-str
-    old-here here>MalArray
+    old-here here>MalList
     ;
 
 : read-wrapped ( buf-addr buf-len quote-char sym-addr sym-len -- buf-addr buf-len char mal-list )
     here { old-here }
     MalSymbol. , ( buf-addr buf-len char )
     read-form , ( buf-addr buf-len char )
-    old-here here>MalArray ;
+    old-here here>MalList ;
 
 : read-form2 ( str-addr str-len char -- str-addr str-len char mal-obj )
     begin
         skip-spaces
         dup mal-digit? if read-int else
-        dup [char] ( = if [char] ) read-array else
-        dup [char] [ = if [char] ] read-array MalVector new tuck MalVector/list ! else
-        dup [char] { = if [char] } read-array MalMap new tuck MalMap/list ! else
+        dup [char] ( = if [char] ) read-list else
+        dup [char] [ = if [char] ] read-list MalVector new tuck MalVector/list ! else
+        dup [char] { = if [char] } read-list MalMap new tuck MalMap/list ! else
         dup [char] " = if read-string-literal else
         dup [char] ; = if read-comment else
         dup [char] : = if drop adv-str read-symbol-str MalKeyword. else
diff --git a/forth/step2_eval.fs b/forth/step2_eval.fs
index 33ceb4e..6a9af72 100644
--- a/forth/step2_eval.fs
+++ b/forth/step2_eval.fs
@@ -44,38 +44,25 @@ MalSymbol
     endif ;;
 drop
 
-MalArray
-  extend mal-eval { env ary -- val }
+MalList
+  extend mal-eval { env list -- val }
     \ Pass args on dictionary stack (!)
-    \ TODO: consider allocate and free of a real MalArray instead
+    \ TODO: consider allocate and free of a real MalList instead
     here { val-start }
-    ary MalArray/start @ { expr-start }
-    ary MalArray/count @ 0 ?do
+    list MalList/start @ { expr-start }
+    list MalList/count @ 0 ?do
         env expr-start i cells + @ mal-eval ,
     loop
     val-start cell+  here val-start - cell / 1-  val-start @  ( argv argc MalFn )
     invoke
     val-start here - allot ;;
-  extend mal-eval-ast { env ary -- ary }
+  extend mal-eval-ast { env list -- list }
     here
-    ary MalArray/start @ { expr-start }
-    ary MalArray/count @ 0 ?do
+    list MalList/start @ { expr-start }
+    list MalList/count @ 0 ?do
         env expr-start i cells + @ mal-eval ,
     loop
-    here>MalArray ;;
-drop
-
-MalList
-  extend mal-eval-ast { env list -- ary }
-    here
-    list
-    begin ( list )
-        dup mal-nil <>
-    while
-        env over MalList/car @ mal-eval ,
-        MalList/cdr @
-    repeat
-    drop here>MalArray ;;
+    here>MalList ;;
 drop
 
 MalVector
diff --git a/forth/step3_env.fs b/forth/step3_env.fs
index 4b76c4d..269964d 100644
--- a/forth/step3_env.fs
+++ b/forth/step3_env.fs
@@ -32,13 +32,13 @@ MalFn
   extend invoke ( ... mal-fn -- ... )
     MalFn/xt @ execute ;;
 
-  extend invoke+ { env ary this -- ary }
+  extend invoke+ { env list this -- list }
     \ Pass args on dictionary stack (!)
-    \ TODO: consider allocate and free of a real MalArray instead
+    \ TODO: consider allocate and free of a real MalList instead
     \ Normal list, evaluate and invoke
     here { val-start }
-    ary MalArray/start @ { expr-start }
-    ary MalArray/count @ 1 ?do
+    list MalList/start @ { expr-start }
+    list MalList/count @ 1 ?do
         env expr-start i cells + @ mal-eval ,
     loop
     val-start  here val-start - cell /  this  ( argv argc MalFn )
@@ -47,28 +47,28 @@ MalFn
 drop
 
 SpecialOp
-  extend invoke+ ( env ary this -- ary )
+  extend invoke+ ( env list this -- list )
     SpecialOp/xt @ execute ;;
 drop
 
-s" quote" MalSymbol. :noname ( env ary -- form )
-    nip MalArray/start @ cell+ @
+s" quote" MalSymbol. :noname ( env list -- form )
+    nip MalList/start @ cell+ @
 ; SpecialOp. repl-env env/set
 
-s" def!" MalSymbol. :noname { env ary -- }
-    ary MalArray/start @ cell+ { arg0 }
+s" def!" MalSymbol. :noname { env list -- }
+    list MalList/start @ cell+ { arg0 }
     arg0 @ ( key )
     env arg0 cell+ @ mal-eval dup { val } ( key val )
     env env/set
     val
 ; SpecialOp. repl-env env/set
 
-s" let*" MalSymbol. :noname { old-env ary -- }
+s" let*" MalSymbol. :noname { old-env list -- }
     old-env MalEnv. { env }
-    ary MalArray/start @ cell+ dup { arg0 }
-    @ to-array
-    dup MalArray/start @ { bindings-start } ( ary )
-    MalArray/count @ 0 +do
+    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 env/set
@@ -89,31 +89,18 @@ MalSymbol
     endif ;;
 drop
 
-MalArray
-  extend mal-eval { env ary -- val }
-    env ary MalArray/start @ @ mal-eval
-    env ary rot invoke+ ;;
+MalList
+  extend mal-eval { env list -- val }
+    env list MalList/start @ @ mal-eval
+    env list rot invoke+ ;;
 
-  extend mal-eval-ast { env ary -- ary }
+  extend mal-eval-ast { env list -- list }
     here
-    ary MalArray/start @ { expr-start }
-    ary MalArray/count @ 0 ?do
+    list MalList/start @ { expr-start }
+    list MalList/count @ 0 ?do
         env expr-start i cells + @ mal-eval ,
     loop
-    here>MalArray ;;
-drop
-
-MalList
-  extend mal-eval-ast { env list -- ary }
-    here
-    list
-    begin ( list )
-        dup mal-nil <>
-    while
-        env over MalList/car @ mal-eval ,
-        MalList/cdr @
-    repeat
-    drop here>MalArray ;;
+    here>MalList ;;
 drop
 
 MalVector
diff --git a/forth/types.fs b/forth/types.fs
index a8268a3..305ff31 100644
--- a/forth/types.fs
+++ b/forth/types.fs
@@ -108,21 +108,32 @@ MalType% deftype MalDefault
 MalType% deftype MalNil
 MalNil new constant mal-nil
 
+: not-object? ( obj -- bool )
+    dup 7 and 0 <> if
+        drop -1
+    else
+        1000000 <
+    endif ;
+
 \ === protocol methods === /
 
 \ Used by protocol methods to find the appropriate implementation of
 \ themselves for the given object, and then execute that implementation.
 : execute-method { obj pxt -- }
+  obj not-object? if
+      ." Refusing to invoke protocol fn '"
+      pxt >name name>string type
+      ." ' on non-object: " obj .
+      1 throw
+  endif
   obj mal-type @ dup MalTypeType-methods 2@ swap ( type methods method-keys )
   dup 0= if \ No protocols extended to this type; check for a default
     2drop drop MalDefault MalTypeType-methods 2@ swap
   endif
-  dup 0= if ." No protocols extended to this type or MalDefault" 1 throw endif
 
   pxt array-find ( type idx found? )
   dup 0= if \ No implementation found for this method; check for a default
     2drop drop MalDefault dup MalTypeType-methods 2@ swap
-    dup 0= if ." No implementation found for this method, and no protocols extended to MalDefault" 1 throw endif
     pxt array-find ( type idx found? )
   endif
   0= if ( type idx )
@@ -157,10 +168,8 @@ MalNil new constant mal-nil
       type MalTypeType-methods dup @ 1+ dup rot ! ( new-count )
       1- dup type MalTypeType-method-keys @ idx pxt array-insert ( old-count new-array )
         type MalTypeType-method-keys ! ( old-count )
-      \ cr ." before: " MalList MalTypeType-method-vals @ @ . cr
       type MalTypeType-method-vals @ idx ixt array-insert ( new-array )
         type MalTypeType-method-vals !
-      \ cr ." after: " MalList MalTypeType-method-vals @ @ . cr
     endif
   endif
   type
@@ -205,7 +214,7 @@ def-protocol-method assoc ( k v this -- this )
 def-protocol-method get ( not-found k this -- value )
 def-protocol-method mal= ( a b -- bool )
 def-protocol-method as-native ( obj --  )
-def-protocol-method to-array ( obj -- mal-array )
+def-protocol-method to-list ( obj -- mal-list )
 
 : m= ( a b -- bool )
     2dup = if
@@ -215,78 +224,67 @@ def-protocol-method to-array ( obj -- mal-array )
     endif ;
 
 MalType%
-  cell% field MalList/car
-  cell% field MalList/cdr
+  cell% field MalList/count
+  cell% field MalList/start
 deftype MalList
 
-: MalList/conj { val coll -- list }
-    MalList new ( list )
-    val over MalList/car ! ( list )
-    coll over MalList/cdr ! ( list )
-    ;
-
-MalType%
-  cell% field MalArray/count
-  cell% field MalArray/start
-deftype MalArray
-
-: here>MalArray ( old-here -- mal-array )
+: here>MalList ( old-here -- mal-list )
     here over - { bytes } ( old-here )
-    MalArray new bytes ( old-here mal-array bytes )
-    allocate throw dup { target } over MalArray/start ! ( old-here mal-array )
-    bytes cell / over MalArray/count ! ( old-here mal-array )
-    swap target bytes cmove ( mal-array )
-    0 bytes - allot \ pop array contents from dictionary stack
+    MalList new bytes ( old-here mal-list bytes )
+    allocate throw dup { target } over MalList/start ! ( old-here mal-list )
+    bytes cell / over MalList/count ! ( old-here mal-list )
+    swap target bytes cmove ( mal-list )
+    0 bytes - allot \ pop list contents from dictionary stack
     ;
 
-MalArray
-  extend to-array ;;
-  extend conj { elem old-ary -- ary }
-    old-ary MalArray/count @ 1+ { new-count }
+MalList
+  extend to-list ;;
+  extend conj { elem old-list -- list }
+    old-list MalList/count @ 1+ { new-count }
     new-count cells allocate throw { new-start }
     elem new-start !
     new-count 1 > if
-      old-ary MalArray/start @   new-start cell+   new-count 1- cells  cmove
+      old-list MalList/start @   new-start cell+   new-count 1- cells  cmove
     endif
 
-    MalArray new
-    new-count over MalArray/count !
-    new-start over MalArray/start ! ;;
+    MalList new
+    new-count over MalList/count !
+    new-start over MalList/start ! ;;
 drop
 
-MalArray new 0 over MalArray/count ! constant MalArray/Empty
+MalList new 0 over MalList/count ! constant MalList/Empty
 
 MalType%
   cell% field MalVector/list
 deftype MalVector
 
 MalVector
-  extend to-array
-    MalVector/list @ to-array ;;
+  extend to-list
+    MalVector/list @ to-list ;;
 drop
 
 MalType%
   cell% field MalMap/list
 deftype MalMap
 
-MalMap new MalArray/Empty over MalMap/list ! constant MalMap/Empty
+MalMap new MalList/Empty over MalMap/list ! constant MalMap/Empty
 
 MalMap
   extend conj ( kv map -- map )
     MalMap/list @ \ get list
-    over MalArray/start @ cell+ @ swap conj \ add value
-    swap MalArray/start @ @ swap conj \ add key
+    over MalList/start @ cell+ @ swap conj \ add value
+    swap MalList/start @ @ swap conj \ add key
     MalMap new dup -rot MalMap/list ! \ put back in map
     ;;
   extend assoc ( k v map -- map )
     MalMap/list @ \ get list
-    conj conj 
+    conj conj
     MalMap new dup -rot MalMap/list ! \ put back in map
     ;;
   extend get { not-found k map -- value }
     map MalMap/list @
-    dup MalArray/start @ { start }
-    MalArray/count @ { count }
+    dup MalList/start @ { start }
+    MalList/count @ { count }
     0
     begin
         dup count >= if
@@ -309,14 +307,11 @@ MalDefault
 drop
 
 MalNil
-  ' conj ' MalList/conj extend-method*
+  extend conj ( item nil -- mal-list )
+    drop MalList/Empty conj ;;
   extend as-native drop 0 ;;
 drop
 
-MalList
-  ' conj ' MalList/conj extend-method*
-drop
-
 
 MalType%
   cell% field MalInt/int