duskos

commit 6cc5b70d228153a592fdc6841fc9612639e65864
parent 9f4db5f346e180552081785e2c7000df59d8c12f
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Fri, 10 Jun 2022 20:24:30 -0400

Add lib/xdict.fs

Diffstat:
M
fs/lib/core.fs
 | 
8
+++++++-
A
fs/lib/xdict.fs
 | 
29
+++++++++++++++++++++++++++++
M
fs/tests/all.fs
 | 
1
+
A
fs/tests/xdict.fs
 | 
12
++++++++++++

4 files changed, 49 insertions(+), 1 deletion(-)
diff --git a/fs/lib/core.fs b/fs/lib/core.fs
@@ -7,6 +7,7 @@
 4 const CELLSZ
 : alias ' code compile (alias) , ;
 : doer code compile (does) CELLSZ allot ;
+: does> r> ( exit current definition ) current 5 + ! ;
 
 \ Memory
 : Ac@+ Ac@ A+ ;
@@ -51,4 +52,9 @@ create _ ," 0123456789abcdef"
 : .S ( -- )
   S" SP " stype scnt .x1 spc> S" RS " stype rcnt .x1 spc>
   S" -- " stype stack? psdump ;
-: does> r> ( exit current definition ) current 5 + ! ;
+: dump ( a -- ) \ dump 8 lines of data after "a"
+  A>r >A 8 >r begin
+    ':' emit A> dup .x spc> ( a )
+    8 >r begin Ac@+ .x1 Ac@+ .x1 spc> next ( a ) >A
+    16 >r begin Ac@+ dup SPC - $5e > if drop '.' then emit next
+  nl> next r>A ;
diff --git a/fs/lib/xdict.fs b/fs/lib/xdict.fs
@@ -0,0 +1,29 @@
+\ Extra dictionaries
+\ Create and use dictionaries besides the system one. Such dictionaries use the
+\ same words as words for the system dictionary. It does so by fiddling with
+\ "current".
+
+\ Usage: You begin by allocating a new dict structure with "newxdict <name>".
+\ Then, you just need to use "x" words like "xentry", "x'" and "xfind". If you
+\ need dict-related words that aren't proxied by "x" words, you can use xdict[
+\ and ]xdict directly, but be careful not to use this in interpret mode because
+\ you'll lock you out of your system dict. Also, you can't nest xdict[ calls.
+\ Example:
+
+\ newxdict mydict
+\ mydict xcreate foo 1 c, 2 c, 3 c,
+\ 42 mydict xvalue bar
+\ mydict x' foo execute 1+ c@ .x1 -> 02
+\ mydict x' bar execute .x1 -> 2a
+
+0 value currentbkp
+: newxdict create 4 allot0 ;
+: xdict[ ( 'dict -- ) current to currentbkp @ to current ;
+: ]xdict ( 'dict -- ) current swap ! currentbkp to current ;
+: xdictproxy ( w -- ) doer , does> ( 'dict 'w -- )
+  over xdict[ swap >r @ execute r> ]xdict ;
+' '      xdictproxy x'
+' find   xdictproxy xfind
+' entry  xdictproxy xentry
+' create xdictproxy xcreate
+' value  xdictproxy xvalue
diff --git a/fs/tests/all.fs b/fs/tests/all.fs
@@ -1,5 +1,6 @@
 \ Run all test suites
 f<< tests/core.fs
 f<< tests/str.fs
+f<< tests/xdict.fs
 f<< tests/asm.fs
 f<< tests/cc/all.fs
diff --git a/fs/tests/xdict.fs b/fs/tests/xdict.fs
@@ -0,0 +1,12 @@
+f<< tests/harness.fs
+f<< lib/xdict.fs
+testbegin
+\ Test xdict
+
+newxdict mydict
+mydict xcreate foo 1 c, 2 c, 3 c,
+42 mydict xvalue bar
+mydict x' foo execute 1+ c@ 2 #eq
+mydict x' bar execute 42 #eq
+word noop mydict xfind not #
+testend