Some time ago I posted a CASE construct which had as its aim:
functionality similar to Pascal, efficient run-time, expandable,
small as possible.
It worked but there were deficiencies. The syntax was inconsistent
making it necessary to "learn". RANGE didn't meet the design
objectives.
The construct has since been reworked. It now reads better and
eliminates from RANGE the massaging previously required for
it work with OF: (now replaced by WHEN).
The cost of these changes is the addition of an unconditional
branch at WHEN - something which a smart optimizer may be
able to eliminate.
The new syntax is:
CASE
COND <tests> WHEN ... ELSE
ENDCASE
<tests> may be one or more tests based on IF. Predefined
tests are EQUAL and RANGE. COND compiles nothing,
being simply a marker for WHEN.
There is nothing to preclude having OF ... ENDOF in the
construct for backward compatibility.
Here's the code. For DTC/ITC forths, the run-time should be
replaced by machine-code primitives for best performance.
--
\ Miser's CASE
\ This code is not ****table. It makes assumptions about the
\ control flow stack which may not be applicable to your forth.
0 constant CASE immediate
0 constant COND immediate
: thens
begin ?dup while postpone then repeat ;
: ENDCASE postpone drop thens ; immediate
cr cr .( Are you using SwiftForth or VFX? Y/N )
key dup char Y = swap char y = or
[if]
: WHEN
postpone else >r thens r> postpone drop ; immediate
[else]
: WHEN
postpone else 2>r thens 2r> postpone drop ; immediate
[then]
: EQUAL
postpone over postpone - postpone if ; immediate
\ values are either signed or unsigned. upper limit is umax-1
: (range)
2>r dup 2r> 1+ within 0= ;
: RANGE
postpone (range) postpone if ; immediate
\ A sample run
hex
: TEST ( n ) space
case
cond
0 20 range
7F equal when ." Control char " else
cond
20 2F range
3A 40 range
5B 60 range
7B 7E range when ." Punctuation " else
cond 30 39 range when ." Digit " else
cond 41 5A range when ." Upper case letter " else
cond 61 7A range when ." Lower case letter " else
." Not a character "
endcase ;
decimal
cr char a .( ) dup emit test
cr char , .( ) dup emit test
cr char 8 .( ) dup emit test
cr char ? .( ) dup emit test
cr char K .( ) dup emit test
cr 0 dup 3 .r test
cr 127 dup 3 .r test
cr 128 dup 3 .r test
