diff options
| -rw-r--r-- | forth/step2_eval.fs | 2 | ||||
| -rw-r--r-- | forth/step3_env.fs | 8 | ||||
| -rw-r--r-- | forth/step4_if_fn_do.fs | 8 | ||||
| -rw-r--r-- | forth/step5_tco.fs | 8 | ||||
| -rw-r--r-- | forth/step6_file.fs | 8 | ||||
| -rw-r--r-- | forth/step7_quote.fs | 8 | ||||
| -rw-r--r-- | forth/step8_macros.fs | 8 | ||||
| -rw-r--r-- | forth/step9_try.fs | 2 | ||||
| -rw-r--r-- | forth/stepA_interop.fs | 2 | ||||
| -rw-r--r-- | forth/types.fs | 35 |
10 files changed, 56 insertions, 33 deletions
diff --git a/forth/step2_eval.fs b/forth/step2_eval.fs index 10e1e77..724de44 100644 --- a/forth/step2_eval.fs +++ b/forth/step2_eval.fs @@ -61,7 +61,7 @@ MalSymbol dup 0= if drop ." Symbol '" - sym as-native safe-type + sym pr-str safe-type ." ' not found." cr 1 throw endif ;; diff --git a/forth/step3_env.fs b/forth/step3_env.fs index 676bfcc..a8a625e 100644 --- a/forth/step3_env.fs +++ b/forth/step3_env.fs @@ -91,13 +91,13 @@ defspecial let* { old-env list -- val } MalSymbol extend mal-eval { env sym -- val } - 0 sym env get + sym env env/get-addr dup 0= if drop - ." Symbol '" - sym as-native safe-type - ." ' not found." cr + ." Symbol '" sym pr-str safe-type ." ' not found." cr 1 throw + else + @ endif ;; drop diff --git a/forth/step4_if_fn_do.fs b/forth/step4_if_fn_do.fs index 4fd277e..a3d64ac 100644 --- a/forth/step4_if_fn_do.fs +++ b/forth/step4_if_fn_do.fs @@ -151,13 +151,13 @@ defspecial fn* { env list -- val } MalSymbol extend mal-eval { env sym -- val } - 0 sym env get + sym env env/get-addr dup 0= if drop - ." Symbol '" - sym as-native safe-type - ." ' not found." cr + ." Symbol '" sym pr-str safe-type ." ' not found." cr 1 throw + else + @ endif ;; drop diff --git a/forth/step5_tco.fs b/forth/step5_tco.fs index f7372db..421a2fc 100644 --- a/forth/step5_tco.fs +++ b/forth/step5_tco.fs @@ -162,13 +162,13 @@ defspecial fn* { env list -- val } MalSymbol extend mal-eval { env sym -- val } - 0 sym env get + sym env env/get-addr dup 0= if drop - ." Symbol '" - sym as-native safe-type - ." ' not found." cr + ." Symbol '" sym pr-str safe-type ." ' not found." cr 1 throw + else + @ endif ;; drop diff --git a/forth/step6_file.fs b/forth/step6_file.fs index b3945ad..60b3817 100644 --- a/forth/step6_file.fs +++ b/forth/step6_file.fs @@ -162,13 +162,13 @@ defspecial fn* { env list -- val } MalSymbol extend mal-eval { env sym -- val } - 0 sym env get + sym env env/get-addr dup 0= if drop - ." Symbol '" - sym as-native safe-type - ." ' not found." cr + ." Symbol '" sym pr-str safe-type ." ' not found." cr 1 throw + else + @ endif ;; drop diff --git a/forth/step7_quote.fs b/forth/step7_quote.fs index 0c6b909..1e4043d 100644 --- a/forth/step7_quote.fs +++ b/forth/step7_quote.fs @@ -204,13 +204,13 @@ defspecial fn* { env list -- val } MalSymbol extend mal-eval { env sym -- val } - 0 sym env get + sym env env/get-addr dup 0= if drop - ." Symbol '" - sym as-native safe-type - ." ' not found." cr + ." Symbol '" sym pr-str safe-type ." ' not found." cr 1 throw + else + @ endif ;; drop diff --git a/forth/step8_macros.fs b/forth/step8_macros.fs index f01f3a9..7260567 100644 --- a/forth/step8_macros.fs +++ b/forth/step8_macros.fs @@ -232,13 +232,13 @@ defspecial macroexpand ( env list[_,form] -- form ) MalSymbol extend mal-eval { env sym -- val } - 0 sym env get + sym env env/get-addr dup 0= if drop - ." Symbol '" - sym as-native safe-type - ." ' not found." cr + ." Symbol '" sym pr-str safe-type ." ' not found." cr 1 throw + else + @ endif ;; drop diff --git a/forth/step9_try.fs b/forth/step9_try.fs index 4d4050b..681e608 100644 --- a/forth/step9_try.fs +++ b/forth/step9_try.fs @@ -266,7 +266,7 @@ MalSymbol sym env env/get-addr dup 0= if drop - 0 0 s" ' not found" sym as-native s" '" ...throw-str + 0 0 s" ' not found" sym pr-str s" '" ...throw-str else @ endif ;; diff --git a/forth/stepA_interop.fs b/forth/stepA_interop.fs index 4d48ae7..af5f5d8 100644 --- a/forth/stepA_interop.fs +++ b/forth/stepA_interop.fs @@ -273,7 +273,7 @@ MalSymbol sym env env/get-addr dup 0= if drop - 0 0 s" ' not found" sym as-native s" '" ...throw-str + 0 0 s" ' not found" sym pr-str s" '" ...throw-str else @ endif ;; diff --git a/forth/types.fs b/forth/types.fs index 8d0e619..2fceccf 100644 --- a/forth/types.fs +++ b/forth/types.fs @@ -272,6 +272,8 @@ def-protocol-method to-list ( obj -- mal-list ) def-protocol-method empty? ( obj -- mal-bool ) def-protocol-method mal-count ( obj -- mal-int ) def-protocol-method sequential? ( obj -- mal-bool ) +def-protocol-method get-map-hint ( obj -- hint ) +def-protocol-method set-map-hint! ( hint obj -- ) \ Fully evalutate any Mal object: @@ -426,12 +428,27 @@ MalMap new MalList/Empty over MalMap/list ! constant MalMap/Empty MalMap/list @ dup MalList/start @ swap MalList/count @ { k start count } - nil ( addr ) - count cells start + start +do - i @ k m= if - drop i cell+ leave + true \ need to search? + k get-map-hint { hint-idx } + hint-idx -1 <> if + hint-idx count < if + hint-idx cells start + { key-addr } + key-addr @ k m= if + key-addr cell+ + nip false + endif endif - [ 2 cells ] literal +loop ; + endif + if \ search + nil ( addr ) + count cells start + start +do + i @ k m= if + drop i + dup start - cell / k set-map-hint! + cell+ leave + endif + [ 2 cells ] literal +loop + endif ; MalMap extend conj ( kv map -- map ) @@ -443,7 +460,7 @@ MalMap extend assoc ( k v map -- map ) MalMap/list @ \ get list conj conj - MalMap new dup -rot MalMap/list ! \ put back in map + MalMap new tuck MalMap/list ! \ put back in map ;; extend dissoc { k map -- map } map MalMap/list @ @@ -477,6 +494,8 @@ MalDefault extend empty? drop mal-true ;; extend sequential? drop mal-false ;; extend mal= = ;; + extend get-map-hint drop -1 ;; + extend set-map-hint! 2drop ;; drop MalNil @@ -493,12 +512,14 @@ drop MalType% cell% field MalSymbol/sym-addr cell% field MalSymbol/sym-len + cell% field MalSymbol/map-hint deftype MalSymbol : MalSymbol. { str-addr str-len -- mal-sym } MalSymbol new { sym } str-addr sym MalSymbol/sym-addr ! str-len sym MalSymbol/sym-len ! + -1 sym MalSymbol/map-hint ! sym ; : unpack-sym ( mal-string -- addr len ) @@ -512,6 +533,8 @@ MalSymbol else 2drop 0 endif ;; + extend get-map-hint MalSymbol/map-hint @ ;; + extend set-map-hint! MalSymbol/map-hint ! ;; extend as-native ( this ) unpack-sym evaluate ;; drop |