diff options
| -rw-r--r-- | forth/env.fs | 17 | ||||
| -rw-r--r-- | forth/step9_try.fs | 4 | ||||
| -rw-r--r-- | forth/stepA_interop.fs | 4 | ||||
| -rw-r--r-- | forth/types.fs | 36 |
4 files changed, 26 insertions, 35 deletions
diff --git a/forth/env.fs b/forth/env.fs index 1b5a362..9469bf2 100644 --- a/forth/env.fs +++ b/forth/env.fs @@ -15,25 +15,18 @@ deftype MalEnv key val env MalEnv/data @ assoc env MalEnv/data ! ; -: env/find { key env -- env-or-0 } +: env/get-addr { key env -- val-addr } env begin ( env ) - dup 0 key rot MalEnv/data @ get ( env val-or-0 ) - 0= if ( env ) + key over MalEnv/data @ MalMap/get-addr ( env addr-or-0 ) + ?dup 0= if ( env ) MalEnv/outer @ dup 0= ( env-or-0 done-looping? ) - else - -1 \ found it! ( env -1 ) + else ( env addr ) + nip -1 \ found it! ( addr -1 ) endif until ; MalEnv - extend get { not-found key env -- } - key env env/find ( env-or-0 ) - ?dup 0= if - not-found - else ( env ) - not-found key rot MalEnv/data @ get - endif ;; extend pr-buf { env } env MalEnv/data @ pr-buf a-space s" outer: " str-append diff --git a/forth/step9_try.fs b/forth/step9_try.fs index e11c691..4d4050b 100644 --- a/forth/step9_try.fs +++ b/forth/step9_try.fs @@ -263,10 +263,12 @@ defspecial try* { env list -- val } MalSymbol extend mal-eval { env sym -- val } - 0 sym env get + sym env env/get-addr dup 0= if drop 0 0 s" ' not found" sym as-native s" '" ...throw-str + else + @ endif ;; drop diff --git a/forth/stepA_interop.fs b/forth/stepA_interop.fs index 9a39889..4d48ae7 100644 --- a/forth/stepA_interop.fs +++ b/forth/stepA_interop.fs @@ -270,10 +270,12 @@ defspecial . { env coll -- rtn-list } MalSymbol extend mal-eval { env sym -- val } - 0 sym env get + sym env env/get-addr dup 0= if drop 0 0 s" ' not found" sym as-native s" '" ...throw-str + else + @ endif ;; drop diff --git a/forth/types.fs b/forth/types.fs index f5d067a..8d0e619 100644 --- a/forth/types.fs +++ b/forth/types.fs @@ -422,6 +422,17 @@ deftype MalMap MalMap new MalList/Empty over MalMap/list ! constant MalMap/Empty +: MalMap/get-addr ( k map -- addr-or-nil ) + 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 + endif + [ 2 cells ] literal +loop ; + MalMap extend conj ( kv map -- map ) MalMap/list @ \ get list @@ -447,22 +458,9 @@ MalMap MalMap new dup -rot MalMap/list ! \ put back in map endif 2 +loop ;; - extend get { not-found k map -- value } - map MalMap/list @ - dup MalList/start @ { start } - MalList/count @ { count } - 0 - begin - dup count >= if - drop not-found true - else - start over cells + @ k m= if - start swap cells + cell+ @ true \ found it ( value true ) - else - 2 + false - endif - endif - until ;; + extend get ( not-found k map -- value ) + MalMap/get-addr ( not-found addr-or-nil ) + dup 0= if drop else nip @ endif ;; extend empty? MalMap/list @ MalList/count @ 0= mal-bool ;; @@ -495,14 +493,12 @@ drop MalType% cell% field MalSymbol/sym-addr cell% field MalSymbol/sym-len - cell% field MalSymbol/meta deftype MalSymbol : MalSymbol. { str-addr str-len -- mal-sym } MalSymbol new { sym } str-addr sym MalSymbol/sym-addr ! - str-len sym MalSymbol/sym-len ! - MalMap/Empty sym MalSymbol/meta ! + str-len sym MalSymbol/sym-len ! sym ; : unpack-sym ( mal-string -- addr len ) @@ -574,13 +570,11 @@ drop MalType% cell% field MalNativeFn/xt - cell% field MalNativeFn/meta deftype MalNativeFn : MalNativeFn. { xt -- mal-fn } MalNativeFn new { mal-fn } xt mal-fn MalNativeFn/xt ! - MalMap/Empty mal-fn MalNativeFn/meta ! mal-fn ; |