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
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
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 ;;
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 )
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 ;