commit c0c52f18d65933d54292ef62087770c281ff1158
parent 09415954bb0181cfcc5ec0cebaa19f09d6cd4671
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 15 Jun 2023 11:46:50 -0400
Simplify case..of semantics
See doc/usage.
Diffstat:
17 files changed, 118 insertions(+), 122 deletions(-)
diff --git a/fs/asm/i386.fs b/fs/asm/i386.fs
@@ -96,10 +96,10 @@ alias _remsz 8b)
: addr, realmode if w, else , then ;
: data, realmode _16b or if w, else , then ;
: ?disp, ( opmod -- ) dup mod@ case ( opmod )
- 0 of = dup ismem? if bank@ addr, else drop then endof
- 1 of = bank@ c, endof
- 2 of = bank@ addr, endof
- drop endcase ;
+ 0 = of dup ismem? if bank@ addr, else drop then endof
+ 1 = of bank@ c, endof
+ 2 = of bank@ addr, endof
+ 2drop endcase ;
: ?8b, ( n f -- ) if c, else data, then ;
: ?imm, ( opmod -- ) _imm? if 8b? _imm swap ?8b, else drop then ;
: ?sib, ( opmod -- ) dup sib? if sib@ c, else drop then ;
@@ -247,10 +247,10 @@ $e2 op loop, $e1 op loopz, $e0 op loopnz,
_jmpop@ ( a is8? ) swap here over - ( is8? a rel )
rot if 1- swap c! else realmode if 2 - swap w! else 4 - swap ! then then ;
-: ?movzx, ( dst src -- ) dup case
- of imm? mov, endof
- of 8b? movzx, endof
- of 16b? 32b) movzx, endof
+: ?movzx, ( dst src -- ) case
+ imm? of r@ mov, endof
+ 8b? of r@ movzx, endof
+ 16b? of r@ 32b) movzx, endof
mov, endcase ;
\ High HAL for i386
@@ -299,9 +299,9 @@ op <<, shl, op >>, shr,
: [+n], ( n halop -- )
halop>dstsrc nip swap case ( op )
- 1 of = inc, endof
- -1 of = dec, endof
- r@ i) add, endcase ;
+ 1 = of inc, endof
+ -1 = of dec, endof
+ i) add, endcase ;
: _ ( halop -- dst src )
dup 16b? >r dup 8b? >r 32b)
halop>dstsrc bx swap mov, ( dst )
diff --git a/fs/comp/c/egen.fs b/fs/comp/c/egen.fs
@@ -150,20 +150,20 @@ code _callA branchA,
\ We parse postfix args as long as there are any.
: parsePostfixOp ( eop -- eop )
nextt case ( )
- '[' of isChar?^ \ x[y] is the equivalent of *(x+y)
+ '[' isChar? of \ x[y] is the equivalent of *(x+y)
nextt parseExpression _+,
dup ExprOp cdecl CDecl :structdot? not if ExprOp :* then
nextt ']' expectChar parsePostfixOp endof
- '(' of isChar?^ _funcall parsePostfixOp endof
- S" ->" of s=
+ '(' isChar? of _funcall parsePostfixOp endof
+ S" ->" s= of
dup ExprOp cdecl CDecl :structarrow? _assert
_arrow parsePostfixOp endof
- '.' of isChar?^
+ '.' isChar? of
dup ExprOp cdecl CDecl :structdot? _assert
_arrow parsePostfixOp endof
- S" ++" of s= 1 _incdec, endof
- S" --" of s= -1 _incdec, endof
- r@ to nexttputback
+ S" ++" s= of 1 _incdec, endof
+ S" --" s= of -1 _incdec, endof
+ to nexttputback
endcase ;
\ We need to parse the entire list before we begin writing to _litarena if we
@@ -173,8 +173,8 @@ MAXLITSZ Stack :new structbind Stack _list
: parseList ( -- eop )
_list :empty begin ( )
nextt parseFactor dup ExprOp type case ( eop )
- ExprOp CONST of = ExprOp :const# endof
- ExprOp CDECL of =
+ ExprOp CONST = of ExprOp :const# endof
+ ExprOp CDECL = of
ExprOp cdecl dup CDecl :isglobal? _assert CDecl offset endof
_err endcase ( n ) _list :push
',' readChar? not until ( tok )
@@ -192,31 +192,31 @@ MAXLITSZ Stack :new structbind Stack _list
\ 9. NULL
\ 10. sizeof()
:realias parseFactor ( tok -- eop ) case ( )
- '(' of isChar?^
+ '(' isChar? of
\ can be an expression or a typecast
nextt dup parseType if ( tok type )
nip parseDeclarator read) nextt parseFactor ( type eop )
tuck ExprOp :typecast
else ( tok ) parseExpression read) parsePostfixOp then
endof
- '"' of isChar?^ MAXLITSZ _litarena :[
+ '"' isChar? of MAXLITSZ _litarena :[
here 0 c, ['] ," with-stdin<
ccin dup '0' = if
drop 1+ 0 c, \ null terminated
else ccputback here over - 1- over c! then ( saddr )
_litarena :] drop ( "a ) ExprOp :const endof
- '{' of isChar?^ parseList endof
- S" pspop" of s=
+ '{' isChar? of parseList endof
+ S" pspop" s= of
read( read) ExprOp :?freeCurrentW
0 PSP+) @, PS+ ExprOp :W parsePostfixOp endof
- S" NULL" of s= 0 ExprOp :const endof
- S" sizeof" of s=
+ S" NULL" s= of 0 ExprOp :const endof
+ S" sizeof" s= of
read( nextt parseType _assert typesize ExprOp :const read) endof
- of uopid ( opid )
+ uopid of ( opid )
nextt parseFactor ( opid eop ) uoptbl rot wexec endof
- of isIdent? \ lvalue, FunCall or macro
+ isIdent? of \ lvalue, FunCall or macro
r@ findIdent ?dup _assert ExprOp :cdecl parsePostfixOp endof
- r@ parse if ExprOp :const else _err then
+ parse if ExprOp :const else _err then
endcase ;
: bothconst? ( left right -- f ) ExprOp :isconst? swap ExprOp :isconst? and ;
diff --git a/fs/comp/c/expr.fs b/fs/comp/c/expr.fs
@@ -7,7 +7,7 @@
: _assert ( f -- ) not if _err then ;
: nb) ( halop sz -- halop )
- case 1 of = 8b) endof 2 of = 16b) endof 4 of = 32b) endof abort" nb)" endcase ;
+case 1 = of 8b) endof 2 = of 16b) endof 4 = of 32b) endof abort" nb)" endcase ;
NULLSTR TYPE_UINT CDecl :new const UintCDecl
@@ -74,11 +74,11 @@ struct[ ExprOp
: :nb) ( halop self -- halop ) dup lvl if drop else :basesz nb) then ;
\ Never changes W, never pushes to PS
: :hal# ( self -- halop ) dup type case ( self )
- CONST of = arg i) endof
- CDECL of = dup cdecl CDecl :halop swap :nb) endof
- PS of = arg PSP+) endof
- REF of = target :hal# &) 32b) endof
- DEREF of =
+ CONST = of arg i) endof
+ CDECL = of dup cdecl CDecl :halop swap :nb) endof
+ PS = of arg PSP+) endof
+ REF = of target :hal# &) 32b) endof
+ DEREF = of
dup target dup :isW? if :release W) &) else :hal# then ( self halop )
A>) @, A) swap :nb) endof
abort" :hal# error" endcase ;
@@ -103,9 +103,9 @@ struct[ ExprOp
\ base type), otherwise it's 4 (we deal with pointers).
: :*arisz ( self -- n ) \ pointer arithmetics multiplier
dup lvl case
- 0 of = drop 1 endof
- 1 of = :basesz endof
- drop 4 endcase ;
+ 0 = of drop 1 endof
+ 1 = of :basesz endof
+ 2drop 4 endcase ;
: :toint ( self -- ) UintCDecl over to cdecl 0 swap to lvl ;
create _masks $ff , $ffff ,
: :typecast ( cdecl self -- )
diff --git a/fs/comp/c/fgen.fs b/fs/comp/c/fgen.fs
@@ -135,7 +135,7 @@ MAXSWITCHCASES << Stack :new structbind Stack _cases
\ and we jump to it after we've created the stack frame.
0 value _initcode
-: _, ( sz -- ) case 1 of = c, endof 2 of = 16b , endof , endcase ;
+: _, ( sz -- ) case 1 = of c, endof 2 = of 16b , endof drop , endcase ;
: writeStack ( stack sz -- ) >r \ V1=sz
bi Stack :buf( | Stack :count for ( a ) @+ V1 _, next drop rdrop ;
diff --git a/fs/comp/c/gen.fs b/fs/comp/c/gen.fs
@@ -24,8 +24,8 @@ require /sys/scratch.fs
here over to CDecl offset ( cdecl )
'=' readChar? if ( cdecl )
nextt parseExpression case ( cdecl )
- of ExprOp :isconst? r@ ExprOp arg , endof
- of ExprOp :isarray? r@ ExprOp arg over CDecl :elemsize writeStack endof
+ ExprOp :isconst? of r@ ExprOp arg , endof
+ ExprOp :isarray? of r@ ExprOp arg over CDecl :elemsize writeStack endof
_err endcase
else to nexttputback dup CDecl :size allot then ( cdecl )
',' readChar? if
diff --git a/fs/comp/c/ptype.fs b/fs/comp/c/ptype.fs
@@ -30,17 +30,17 @@ alias _err parseDeclarator ( type -- cdecl ) \ forward declaration
\ parsing after the identifier
: _post ( cdecl -- cdecl )
begin ( cdecl ) nextt case
- '[' of isChar?^
+ '[' isChar? of
nextt parseExpression ExprOp :const#
nextt ']' expectChar ( cdecl nbelem ) over to CDecl nbelem endof
- '(' of isChar?^
+ '(' isChar? of
dup CDecl :funcsig! STORAGE_PS to@! curstorage >r
')' readChar? not if ( cdecl tok )
over swap _arg ( cdecl offset ) drop
\ args in nexttype, we want them in args
0 over to@! CDecl nexttype over to CDecl args then
r> to curstorage endof
- r> to nexttputback exit
+ to nexttputback rdrop exit
endcase again ;
:realias parseDeclarator ( type -- cdecl )
diff --git a/fs/comp/c/tok.fs b/fs/comp/c/tok.fs
@@ -78,7 +78,7 @@ create _ 10 c, ," 09AZaz__$$"
tonws dup not if ( EOF ) exit then ( c )
0 to@! _firstchar over '#' = and if drop handleDirective nextt? exit then
case ( )
- of isSym1? ( )
+ isSym1? of ( )
r@ ccin 2dup isSym2? if ( c1 c2 )
2dup is<<>>? if ( c1 c2 )
ccin dup '=' = if ( c1 c2 '=' )
@@ -88,18 +88,18 @@ create _ 10 c, ," 09AZaz__$$"
else swap 2 ( c2 c1 len ) _writesym then
else ( c1 c2 ) ccputback 1 ( c1 len ) _writesym then ( tok )
dup case
- S" /*" of s= drop begin ( )
+ S" /*" s= of drop begin ( )
ccin ?line+ '*' = dup if drop ccin ?line+ '/' = then until
nextt? endof
- S" //" of s= drop begin ( )
+ S" //" s= of drop begin ( )
ccin dup not if ( EOF! ) rdrop exit then ?line+ LF = until
nextt? endof
- endcase
+ drop endcase
endof
- ''' of = \ the char literal is a special case: anything can go in between ''
+ ''' = of \ the char literal is a special case: anything can go in between ''
ccin ccin ''' = not if _err then ( c ) ''' tuck ( ' c ' ) 3 _writesym
endof
- of ident-or-lit? \ identifier or number literal
+ ident-or-lit? of \ identifier or number literal
[ -4 [rcnt] ! ] \ V1=c
MAXTOKSZ _pad :allot dup >r >r \ V2=tok V3=a
0 8b to!+ V3 ( len placeholder ) V1 begin ( c )
@@ -119,11 +119,10 @@ create _ 10 c, ," 09AZaz__$$"
c@+ identifier? not if drop 0 break then next drop 1 then ;
: expectIdent ( tok -- tok ) dup isIdent? _assert ;
: isChar? ( tok c -- f ) over 1+ c@ = swap c@ 1 = and ;
-: isChar?^ ( c tok -- f ) swap isChar? ; \ for "case..of"
: expectChar ( tok c -- ) isChar? _assert ;
\ Read next token. f=1 and token is *not* present if tok=c. Else, f=0 and tok is
\ present.
-: readChar? ( c -- tok? f ) nextt tuck isChar?^ dup if nip then ;
+: readChar? ( c -- tok? f ) nextt tuck swap isChar? dup if nip then ;
: read; ( -- ) nextt ';' expectChar ;
: read( ( -- ) nextt '(' expectChar ;
: read) ( -- ) nextt ')' expectChar ;
diff --git a/fs/comp/c/type.fs b/fs/comp/c/type.fs
@@ -92,9 +92,9 @@ struct[ CDecl
: :lvl bi lvl | :reference? + ;
: :halop ( self -- operand ) dup bi offset | storage case ( self offset )
- STORAGE_RS of = RSP) swap +) endof
- STORAGE_PS of = PSP+) endof
- STORAGE_MEM of = m) endof
+ STORAGE_RS = of RSP) swap +) endof
+ STORAGE_PS = of PSP+) endof
+ STORAGE_MEM = of m) endof
_err endcase ( self operand )
swap :reference? if &) then ;
@@ -140,9 +140,9 @@ struct[ CDecl
dup type typesize over nbelem * sfield'
else ( cdecl )
dup type typesize case
- 1 of = sfieldb endof
- 2 of = sfieldw endof
- sfield endcase then ( cdecl )
+ 1 = of sfieldb endof
+ 2 = of sfieldw endof
+ drop sfield endcase then ( cdecl )
llnext repeat ]struct ;
: :append ( other self -- ) 2dup :size swap to offset llappend ;
]struct
diff --git a/fs/doc/usage.txt b/fs/doc/usage.txt
@@ -136,30 +136,27 @@ Weird, but sometimes useful.
The "case" structure allows us to "fan out" to many possible branches depending
on a single value. It's the functional equivalent of nested "if..then", but
-more readable. The idea is that "case" pushes a value from PS to RS, and then
-each "of" evaluates that value with a "truth word".
-
-The part before each "of" is executed as-is and then "of" does a "r@" and
-executes the specified word. If the word yields nonzero, then we stay in that
-branch. Otherwise, we branch to "endof".
-
-During the execution of a branch, the value in question is still available
-through "r@". Then, upon reaching "endof", we branch to "endcase" which then
-drops that value from RS.
-
-If no case matches, the part between the last "endof" and the "endcase" is
-executed. The value in question is also available through "r@".
-
-: foo case
- 5 of = ." I am 5!" endof
- of 0< ." I am negative!" endof
- 100 of < ." I am higher than 100" endof \ yeah, order is counter-intuitive...
- r@ .f" This number, %d, is something else" endcase ;
-
-5 foo --> I am 5!
--1 foo --> I am negative!
-101 foo --> I am higher than 100
-42 foo --> This number, 42, is something else
+more readable. Code like this:
+
+case
+ 1 = of ." foo!" endof
+ 2 > of ." bar!" endof
+ drop ." baz!"
+endcase
+
+is the exact equivalent of:
+
+r! 1 = if ." foo!" else
+r@ 2 > if ." bar!" else
+r@ drop ." baz!" then then
+
+As you can see, the "base value" is automatically duplicated to PS before each
+"of". The last part is the final "else", if no condition match. This branch also
+has its base value duplicated, so even if you do nothing on the fallthrough
+condition, you need to "drop" that value to keep PS balance.
+
+During the execution of a "of" branch, the value in question is available
+through "r@".
None of these control structures above can be ran in interpret mode. They only
work when compiled. Sometimes, a little conditional in interpret mode can be
diff --git a/fs/drv/pc/ahci.fs b/fs/drv/pc/ahci.fs
@@ -35,11 +35,11 @@ struct[ HBAPort
: :stopcmd dup cmd $ffffffee ( ~FRE+~ST ) and swap to cmd ;
: :ci! 1 over to ci begin dup ci not until drop ;
: :sigstr ( self -- str ) sig case
- $101 of = S" ATA" endof
- $eb140101 of = S" ATAPI" endof
- $c33c0101 of = S" bridge" endof
- $96690101 of = S" multiplier" endof
- S" unknown" endcase ;
+ $101 = of S" ATA" endof
+ $eb140101 = of S" ATAPI" endof
+ $c33c0101 = of S" bridge" endof
+ $96690101 = of S" multiplier" endof
+ drop S" unknown" endcase ;
]struct
struct[ RsvdFIS \ buffer for receiving FIS from AHCI controller
diff --git a/fs/emul/uxn/gui.fs b/fs/emul/uxn/gui.fs
@@ -34,11 +34,11 @@ create _scrbuf SCRBUFSZ allot
:c void _drawlayer(ushort x, ushort y, uchar pixel, int fg);
: screendei ( dev port -- c ) case
- $2 of = drop screen width 8 rshift endof
- $3 of = drop screen width $ff and endof
- $4 of = drop screen height 8 rshift endof
- $5 of = drop screen height $ff and endof
- Device dat r@ + c@ endcase ;
+ $2 = of drop screen width 8 rshift endof
+ $3 = of drop screen width $ff and endof
+ $4 = of drop screen height 8 rshift endof
+ $5 = of drop screen height $ff and endof
+ Device dat + c@ endcase ;
: _pixel ( dev -- ) >r \ V1=dev
$8 r@ devshort@ ( x ) $a r@ devshort@ ( x y )
@@ -101,9 +101,9 @@ create _scrbuf SCRBUFSZ allot
0 screencolor to screen color 0 0 screen :pos!
screen width screen height screen :fill then
case ( dev ) \ V1=case
- $e of = _pixel endof
- $f of = _sprite endof
- drop endcase ;
+ $e = of _pixel endof
+ $f = of _sprite endof
+ 2drop endcase ;
: _?execvector ( dev -- ) Device dat short@ ?dup if uxn_exec then ;
diff --git a/fs/emul/uxn/varvara.fs b/fs/emul/uxn/varvara.fs
@@ -45,14 +45,14 @@ uxn_ram $10000 MemIO :new structbind MemIO _memio
_memio ptr ;
: filedeo ( dev port -- ) case ( dev ) \ V1=case
- $5 of = >r \ V2=dev
+ $5 = of >r \ V2=dev
r@ _findfn ( path-or-0 ) ?dup if ( path )
$4 V2 devshort@ uxn_ram + ( path a )
tuck _stat!+ ( a a+n ) -^ then ( res )
$2 r> devshort!
endof
- $9 of = 0 swap devfileoff _fpos + ! endof
- $d of = >r \ V2=dev
+ $9 = of 0 swap devfileoff _fpos + ! endof
+ $d = of >r \ V2=dev
r@ _findfn ( path-or-0 ) ?dup if ( path )
Path :open >r \ V3=hdl
V2 devfileoff _fpos + @ V3 File :seek ( )
@@ -66,7 +66,7 @@ uxn_ram $10000 MemIO :new structbind MemIO _memio
else ( ) 0 then ( res )
$2 r> devshort!
endof
- $f of = >r \ V2=dev
+ $f = of >r \ V2=dev
r@ _findfn ( path-or-0 ) ?dup if ( path )
Path :open >r \ V3=hdl
V2 devfileoff _fpos + @ V3 File :seek ( )
@@ -78,7 +78,7 @@ uxn_ram $10000 MemIO :new structbind MemIO _memio
else ( ) 0 then ( res )
$2 r> devshort!
endof
- drop
+ 2drop
endcase ;
: varvara_init
diff --git a/fs/lib/fmt.fs b/fs/lib/fmt.fs
@@ -23,13 +23,13 @@ struct+[ IO
8b to@+ V2 ( len ) for ( nX ... n0 )
8b to@+ V2 dup '%' = if
drop to1- i 8b to@+ V2 case
- 'b' of = V1 :.x1 endof
- 'w' of = V1 :.x2 endof
- 'x' of = V1 :.x endof
- 'd' of = V1 :. endof
- 's' of = V1 :puts endof
- 'z' of = V1 :putz endof
- 'c' of = V1 :putc endof
+ 'b' = of V1 :.x1 endof
+ 'w' = of V1 :.x2 endof
+ 'x' = of V1 :.x endof
+ 'd' = of V1 :. endof
+ 's' = of V1 :puts endof
+ 'z' = of V1 :putz endof
+ 'c' = of V1 :putc endof
abort" unsupported fmt argument"
endcase
else V1 :putc then next 2rdrop ;
diff --git a/fs/sys/grid.fs b/fs/sys/grid.fs
@@ -23,10 +23,10 @@ extends ByteWriter struct[ Grid
\ called in "normal" mode
: _emit ( c self -- ) >r case \ V1=self V2=c
- 8 ( BS ) of = SPC V1 :pcell! V1 pos 1- V1 :pos! endof
- LF of = SPC V1 :pcell! V1 :linefeed endof
- SPC of > endof
- r@ V1 :pcell! V1 pos 1+ dup V1 COLS mod
+ 8 ( BS ) = of SPC V1 :pcell! V1 pos 1- V1 :pos! endof
+ LF = of SPC V1 :pcell! V1 :linefeed endof
+ SPC < of endof
+ V1 :pcell! V1 pos 1+ dup V1 COLS mod
if V1 :pos! else drop V1 :linefeed then
endcase rdrop ;
diff --git a/fs/tests/kernel.fs b/fs/tests/kernel.fs
@@ -66,11 +66,11 @@ foo 55 #eq
\ case
: foo ( n ) case
- 1 of = 111 endof
- 42 of > 222 endof
- 333
+ 1 = of 111 endof
+ 42 < of 222 endof
+ drop 333
endcase ;
-: testrcnt 42 case 42 of = endof endcase [ [rcnt] @ 0 #eq ] ;
+: testrcnt 42 case 42 = of endof endcase [ [rcnt] @ 0 #eq ] ;
here .x
current .x
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -126,11 +126,11 @@ code rcnt pushret, dup, RSP) addr, ] RSTOP -^ >> >> ;
: while [compile] if swap ; immediate
: repeat [compile] again [compile] then ; immediate
-: case ( -- then-stopgap ) 0 [compile] >r ; immediate
-: of ( -- jump-addr ) [compile] r@ word compword [compile] if ; immediate
-: endof [compile] else ; immediate
+: case ( -- then-stopgap ) 0 [compile] r! ; immediate
+: of ( -- jump-addr ) [compile] if ; immediate
+: endof [compile] else [compile] r@ ; immediate
: endcase ( then-stopgap jump1? jump2? ... jumpn? -- )
- ?dup if begin [compile] then ?dup not until then [compile] rdrop ; immediate
+ begin ?dup while [compile] then repeat [compile] rdrop ; immediate
\ Local variables + beginning of compiling words
code (cell) pushret, r> popret, exit,
diff --git a/fs/xcomp/tools.fs b/fs/xcomp/tools.fs
@@ -31,7 +31,7 @@ LF value _last
dup 0< if 1 exit then
_incomment? if LF = if 0 to _incomment? LF 1 else 0 then exit then ( c )
dup case
- '\' of = _last LF = if 1 to _incomment? 0 else 1 then endof
- of ws? _last ws? not endof
- 1 endcase ( c f )
+ '\' = of _last LF = if 1 to _incomment? 0 else 1 then endof
+ ws? of _last ws? not endof
+ drop 1 endcase ( c f )
dup if over to _last else nip then ;
