smolforth/case.fth at main · fstiewitz/smolforth · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
: CASE 2 0 0 0 ; IMMEDIATE
: OF
    POSTPONE OVER
    POSTPONE =
    POSTPONE IF
    POSTPONE DROP
; IMMEDIATE
: ENDOF
    POSTPONE AHEAD
    1 CS-ROLL
    POSTPONE THEN
; IMMEDIATE
: ENDCASE
    POSTPONE DROP
    BEGIN
        2OVER DROP 2 = INVERT
    WHILE
        POSTPONE THEN
    REPEAT
    2DROP 2DROP
; IMMEDIATE

: DO
    POSTPONE >R
    POSTPONE >R
    2 0 0 0
    POSTPONE BEGIN
; IMMEDIATE

: ?DO
    POSTPONE 2DUP
    POSTPONE <>
    POSTPONE IF
    POSTPONE >R
    POSTPONE >R
    3 0 0 0
    POSTPONE BEGIN
; IMMEDIATE

: +LOOP
    POSTPONE SYS:+LOOP
    POSTPONE UNTIL

    BEGIN
        3 PICK 2 = INVERT IF [ 1 CS-ROLL ]
        3 PICK 3 = INVERT IF [ 1 CS-ROLL ]
        POSTPONE THEN
    AGAIN
    THEN \ ?DO
        2DROP 2DROP
        POSTPONE ELSE
        POSTPONE 2DROP
        POSTPONE THEN
        EXIT
    THEN \ DO
        2DROP 2DROP
; IMMEDIATE

: LOOP
    POSTPONE SYS:LOOP
    POSTPONE UNTIL

    BEGIN
        3 PICK 2 = INVERT IF [ 1 CS-ROLL ]
        3 PICK 3 = INVERT IF [ 1 CS-ROLL ]
        POSTPONE THEN
    AGAIN
    THEN \ ?DO
        2DROP 2DROP
        POSTPONE ELSE
        POSTPONE 2DROP
        POSTPONE THEN
        EXIT
    THEN \ DO
        2DROP 2DROP
; IMMEDIATE