Add CASE..OF words

blk/042

@@ -5,12 +5,12 @@ definitions. In the INTERPRET loop, they don't have the desired
 effect because each word from the input stream is executed
 immediately. In this context, branching doesn't work.
 
-(br)  --   Branches by the number specified in the 2 following
+f IF A ELSE B THEN: if f is true, execute A, if false, execute
-           bytes. Can be negative.
+B. ELSE is optional.
-(?br) f -- Branch if f is false.
+BEGIN .. f UNTIL: if f is false, branch to BEGIN.
-(     --   *I* Comment. Ignore rest of line until ")" is read.
+BEGIN .. AGAIN: Always branch to BEGIN.
-[     --   Begin interpretative mode. In a definition, words
+x y DO .. LOOP: LOOP increments y. if y != x, branch to DO.
-           between here and "]" will be executed instead of
+x CASE y OF A ENDOF z OF B ENDOF C ENDCASE: If x == y, execute
-           compiled.
+A, if x == z, execute B. Otherwise, execute C.
-]     --   End interpretative mode.
+
-ABORT --   Resets PS and RS and returns to interpreter. (cont.)
+                                                        (cont.)

blk/043

@@ -1,16 +1,15 @@
 (cont.)
+(br)      --   Branches by the number specified in the 2
+               following bytes. Can be negative.
+(?br)     f -- Branch if f is false.
+(         --   *I* Comment. Ignore input until ")" is read.
+[         --   Begin interpretative mode. In a definition,
+               execute words instead of compiling them.
+]         --   End interpretative mode.
+ABORT     --   Resets PS and RS and returns to interpreter.
 ABORT" x" --   *I* Compiles a ." followed by a ABORT.
-AGAIN     I:a --       *I* Jump backwards to preceeding BEGIN.
-BEGIN     -- I:a       *I* Marker for backward branching with
-                       AGAIN.
-ELSE      I:a --       *I* Compiles a (fbr) and set branching
-                       cell at a.
 EXECUTE   a -- Execute wordref at addr a
-IF        -- I:a       *I* Compiles a (fbr?) and pushes its
+INTERPRET --   Get a line from stdin, compile it in tmp memory,
-                       cell's addr
+               then execute the compiled contents.
-INTERPRET --           Get a line from stdin, compile it in tmp
+QUIT      --   Return to interpreter prompt immediately
-                       memory, then execute the compiled
+EXIT!     --   Exit current INTERPRET loop.
-                       contents.
-QUIT      R:drop --    Return to interpreter prompt immediately
-RECURSE   R:I -- R:I-2 Run the current word again.
-THEN      I:a --       *I* Set branching cell at a.     (cont.)

blk/044

@@ -1,4 +0,0 @@
-(cont.)
-UNTIL     f --         *I* Jump backwards to BEGIN if f is
-                       false.
-EXIT!     --           Exit current INTERPRET loop.

forth/core.fs

@@ -55,6 +55,27 @@
     H@ 2-          ( push a. -2 for allot offset )
 ; IMMEDIATE
 
+( During a CASE, the stack grows by 1 at each ENDOF so that
+  we can fill all those ENDOF branching addrs. So that we
+  know when to stop, we put a 0 on PSP. That's our stopgap. )
+: CASE 0 ; IMMEDIATE
+: OF
+    COMPILE OVER COMPILE =
+    [COMPILE] IF
+; IMMEDIATE
+: ENDOF [COMPILE] ELSE ; IMMEDIATE
+
+( At this point, we have something like "0 e1 e2 e3 val". We
+  want top drop val, and then call THEN as long as we don't
+  hit 0. )
+: ENDCASE
+    BEGIN
+        DUP NOT IF DROP EXIT THEN
+        [COMPILE] THEN
+    AGAIN
+    COMPILE DROP
+; IMMEDIATE
+
 : CREATE
     (entry)            ( empty header with name )
     11                 ( 11 == cellWord )

tests/forth/test_flow.fs

@@ -0,0 +1,13 @@
+: foo
+    CASE
+        'X' OF 42 ENDOF
+        0x12 OF 43 ENDOF
+        255 OF 44 ENDOF
+        45
+    ENDCASE
+;
+
+'X' foo 42 #eq
+0x12 foo 43 #eq
+255 foo 44 #eq
+254 foo 45 #eq