add OF? for logical tests in CASE structures
This commit is contained in:
parent
0ee566ea39
commit
50fe63b104
|
|
@ -915,12 +915,15 @@ DEFER QUIT
|
|||
\ a forward reference to the ENDOF (as with IF ... THEN) above the ENDCASE counter.
|
||||
\
|
||||
\ Begin by creating a placeholder for the unresolved ENDOF forward references
|
||||
: CASE ( C: -- NULL ) IMMEDIATE
|
||||
: CASE ( C: -- null-orig ) IMMEDIATE
|
||||
POSTPONE (ALWAYS) ;
|
||||
\ At runtime test the flag on top of the stack; branch to ENDOF if false
|
||||
: OF? ( C: orig-case -- orig-case orig-of ; x flag -- x ) IMMEDIATE
|
||||
POSTPONE (ALWAYS) POSTPONE (ONWARD-IF) POSTPONE DROP ;
|
||||
\ At runtime compare the values on the top of the stack; branch to ENDOF if unequal
|
||||
\ Keep the first value for the next OF if unequal, otherwise consume both
|
||||
: OF ( C: orign ... orig1 n -- orign ... orig1 n orig-of ) IMMEDIATE
|
||||
POSTPONE OVER POSTPONE = POSTPONE (ALWAYS) POSTPONE (ONWARD-IF) POSTPONE DROP ;
|
||||
POSTPONE OVER POSTPONE = POSTPONE OF? ;
|
||||
\ Create a forward branch to ENDCASE and resolve the one from OF
|
||||
: ENDOF ( C: orig-case1 orig-of -- orig-case2 ) IMMEDIATE
|
||||
SWAP POSTPONE (ONWARD-AHEAD) SWAP POSTPONE (THEN) ;
|
||||
|
|
@ -2000,7 +2003,7 @@ NULL 0 TIB-LEFTOVER 2!
|
|||
[[ CHAR " ]] OF [[ CHAR " ]] ENDOF
|
||||
[[ CHAR ' ]] OF [[ CHAR ' ]] ENDOF
|
||||
[[ CHAR \ ]] OF [[ CHAR \ ]] ENDOF
|
||||
TO-LOWER [[ CHAR x ]] OF
|
||||
DUP TO-LOWER [[ CHAR x ]] = OF?
|
||||
NEXT-CHAR 16 >DIGIT-BASE 0= "Invalid \\x… escape sequence" ?FAIL
|
||||
16 1 ESCAPED-DIGITS
|
||||
ENDOF
|
||||
|
|
|
|||
Loading…
Reference in New Issue