case stuff

one of the tests is broken. i'm not entirely sure what the issue is yet

2 files changed, 63 insertions, 14 deletions

diff --git a/sanctuary.fs b/sanctuary.fs
index 7d2c88d..ac71042 100644
--- a/sanctuary.fs
+++ b/sanctuary.fs
@@ -51,6 +51,12 @@
 	else >body [compile] literal ['] compile, compile, then ; immediate compile-only
 
 \ todo doc
+: case  0 ; immediate
+: of  postpone over postpone = postpone if postpone drop ; immediate
+: endof  postpone else ; immediate
+: endcase  postpone drop  begin ?dup while postpone then repeat ; immediate
+
+\ todo doc
 : recurse latest @ >body compile, ; immediate
 
 : cells  8 * ;
@@ -594,6 +600,16 @@ decimal
 : words  get-order 0 ?do vlist loop ;
 \ }}}
 
+\ TERMINAL CONTROL {{{
+vocabulary terminal
+also terminal definitions
+
+60 constant termios#
+create termios termios# allot
+
+previous definitions
+\ }}}
+
 \ todo doc
 0 constant version
 : welcome  ." sanctuary: a 64 bit forth for linux, version " version u. cr ;
diff --git a/test.fs b/test.fs
index 7eb09f0..aea5f5f 100644
--- a/test.fs
+++ b/test.fs
@@ -374,6 +374,36 @@ t{ -1 gi1 -> 123 }t
 t{ <false> melse -> 2 4 }t
 t{ <true>  melse -> 1 3 5 }t
 
+: CS1 case 1 of 111 endof
+   2 of 222 endof
+   3 of 333 endof
+   >r 999 r>
+   endcase
+;
+t{ 1 CS1 -> 111 }t
+t{ 2 CS1 -> 222 }t
+t{ 3 CS1 -> 333 }t
+t{ 4 CS1 -> 999 }t
+: CS2 >r case
+   -1 of case r@ 1 of 100 endof
+                2 of 200 endof
+                >r -300 r>
+        endcase
+     endof
+   -2 of case r@ 1 of -99 endof
+                >r -199 r>
+        endcase
+     endof
+     >r 299 r>
+   endcase r> drop ;
+
+t{ -1 1 CS2 ->  100 }t
+t{ -1 2 CS2 ->  200 }t
+t{ -1 3 CS2 -> -300 }t
+t{ -2 1 CS2 ->  -99 }t
+t{ -2 2 CS2 -> -199 }t
+t{  0 2 CS2 ->  299 }t
+
 t{ : gi3 begin dup 5 < while dup 1+ repeat ; -> }t
 t{ 0 gi3 -> 0 1 2 3 4 5 }t
 t{ 4 gi3 -> 4 5 }t
@@ -400,20 +430,23 @@ t{ :noname ( N -- 0, 1, .., N )
 t{ 0 RN1 execute -> 0 }t
 t{ 4 RN1 execute -> 0 1 2 3 4 }t
 
-\ :noname ( N -- N1 )
-\    1- dup
-\    case 0 of exit endof
-\      1 of 11 swap recurse endof
-\      2 of 22 swap recurse endof
-\      3 of 33 swap recurse endof
-\      drop abs recurse exit
-\    endcase
-\ ; constant RN2
-\
-\ t{  1 RN2 execute -> 0 }t
-\ t{  2 RN2 execute -> 11 0 }t
-\ t{  4 RN2 execute -> 33 22 11 0 }t
-\ t{ 25 RN2 execute -> 33 22 11 0 }t
+\ todo broken
+\ i think the case is splunging up the recurse
+\ i dont know why, because recurse takes no arguments
+:noname ( N -- N1 )
+   1- dup
+   case 0 of exit endof
+     1 of 11 swap recurse endof
+     2 of 22 swap recurse endof
+     3 of 33 swap recurse endof
+     drop abs recurse exit
+   endcase
+; constant RN2
+
+t{  1 RN2 execute -> 0 }t
+t{  2 RN2 execute -> 11 0 }t
+t{  4 RN2 execute -> 33 22 11 0 }t
+t{ 25 RN2 execute -> 33 22 11 0 }t
 hex
 
 t{ : gd1 do i loop ; -> }t