vocab stuff, compare

1 files changed, 60 insertions, 9 deletions

diff --git a/sanctuary.fs b/sanctuary.fs
index 7dd455c..b5234a0 100644
--- a/sanctuary.fs
+++ b/sanctuary.fs
@@ -373,10 +373,14 @@ privatise
 		>resolve
 	then ; immediate compile-only
 : i  rp cell+ @ ;
+\ todo leave
+\ todo unloop
 \ }}}
 
+\ todo doc
 \ VOCABULARY {{{
 \ todo doc
+\ based on the forth standard word list reference implementations
 \ words in asm that use latest directly:
 \ find (header) : ; smudge immediate compile-only
 \ the easiest (altho kind of ugly) way i'll probably do this
@@ -385,19 +389,65 @@ privatise
 32 constant #vocs \ #context better name ?
 variable #order
 create context #vocs cells allot
+variable current
 
 : wordlist  here 0 , ;
-: vocabulary  wordlist create , does> ( todo ) ;
+wordlist constant forth-wordlist
+
+defer default-wordlist
+:noname  forth-wordlist 1 ; is default-wordlist
+
+\ the most recent is stored toward high memory
+: get-order ( -- widn ... wid1 n )
+	#order @ 0 ?do
+		#order @ i -
+		1- cells
+		context + @
+	loop
+	#order @ ;
+: set-order ( widn ... wid1 n -- )
+	dup 1 < if
+		drop default-wordlist
+	then
+	dup #order !
+	0 ?do
+		i cells context + !
+	loop ;
+
+: (vocabulary)  create , does>
+	>r get-order swap drop r> swap set-order ;
+: vocabulary  wordlist (vocabulary) ;
+
+: get-current ( -- wid )  current @ ;
+: set-current ( wid -- )  current ! ;
+
+: discard ( x1 xn u -- )  0 ?do drop loop ;
+: definitions  get-order swap set-current discard ;
+: previous  get-order nip 1- set-order ;
+: only  -1 set-order ;
+: also  get-order over swap 1+ set-order ;
+
+forth-wordlist (vocabulary) forth
+-1 set-order
 
-: get-order ( -- widn ... wid1 n ) ;
-: set-order ( widn ... wid1 n -- ) ;
+private{
+}private
+: search-wordlist ( a u wid -- 0 | ht -1 )
+	( wid ) @  begin ( a u ht )
+		dup >r
+		r>
+	until
+	;
+privatise
 
-\ private{
-\ }private
-\ \ the actual setup is in a compiled word to prevent
-\ \ the system from shitfucking itself when its only halfway done setting up
-\ :noname  ; execute
-\ privatise
+private{
+: (find) ( a u -- a u 0 | ht -1 )  ;
+: (latest) ( -- a )  ;
+}private
+\ the actual setup is in a compiled word to prevent
+\ the system from shitfucking itself when its only halfway done setting up
+\ :noname  ['] (find) is find ; execute
+privatise
 \ }}}
 
 \ PROGRAMMING TOOLS {{{
@@ -411,5 +461,6 @@ create context #vocs cells allot
 0 constant version
 : welcome  ." sanctuary: a 64 bit forth for linux, version " version u. cr ;
 
+:noname  quit ; handler !
 welcome quit bye
 bye