From a631063f3fa2eaed473369b376a5499df92209bd Mon Sep 17 00:00:00 2001 From: Chouser Date: Sun, 22 Feb 2015 13:20:31 -0500 Subject: [PATCH] forth: Add map-hint to symbols for better perf --- forth/step2_eval.fs | 2 +- forth/step3_env.fs | 8 ++++---- forth/step4_if_fn_do.fs | 8 ++++---- forth/step5_tco.fs | 8 ++++---- forth/step6_file.fs | 8 ++++---- forth/step7_quote.fs | 8 ++++---- forth/step8_macros.fs | 8 ++++---- forth/step9_try.fs | 2 +- forth/stepA_interop.fs | 2 +- forth/types.fs | 35 +++++++++++++++++++++++++++++------ 10 files changed, 56 insertions(+), 33 deletions(-) diff --git a/forth/step2_eval.fs b/forth/step2_eval.fs index 10e1e77f..724de447 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 676bfcc8..a8a625e6 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 4fd277e1..a3d64aca 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 f7372dbc..421a2fc3 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 b3945ad2..60b38171 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 0c6b909a..1e4043d0 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 f01f3a96..7260567d 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 4d4050ba..681e608b 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 4d48ae7b..af5f5d83 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 8d0e6193..2fceccfa 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 -- 2.20.1