From 3a17cb968281f7e833088fdb22cf793861810912 Mon Sep 17 00:00:00 2001
From: Chouser <chouser@n01se.net>
Date: Sat, 21 Feb 2015 18:50:50 -0500
Subject: [PATCH] forth: Clean up symbol eval for better perf

---
 forth/env.fs           | 17 +++++------------
 forth/step9_try.fs     |  4 +++-
 forth/stepA_interop.fs |  4 +++-
 forth/types.fs         | 36 +++++++++++++++---------------------
 4 files changed, 26 insertions(+), 35 deletions(-)

diff --git a/forth/env.fs b/forth/env.fs
index 1b5a3626..9469bf2b 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 e11c6912..4d4050ba 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 9a398890..4d48ae7b 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 f5d067a9..8d0e6193 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 ;
 
 
-- 
2.20.1