138 lines
3.0 KiB
Plaintext
138 lines
3.0 KiB
Plaintext
|
# Optional control-structure overrides for L2 parser defaults.
|
||
|
|
# Import this file when you want custom compile-time implementations of
|
||
|
|
# if/else/for/while/do instead of the built-in Python parser behavior.
|
||
|
|
|
||
|
|
word ct-if-open
|
||
|
|
"if_false" ct-new-label
|
||
|
|
dup "branch_zero" swap ct-emit-op
|
||
|
|
"if" ct-control-frame-new
|
||
|
|
swap "false" swap ct-control-set
|
||
|
|
nil "end" swap ct-control-set
|
||
|
|
dup "false" ct-control-get "label" swap ct-control-add-close-op
|
||
|
|
ct-control-push
|
||
|
|
end
|
||
|
|
compile-only
|
||
|
|
|
||
|
|
word ct-if-open-with-end
|
||
|
|
"if_false" ct-new-label
|
||
|
|
dup "branch_zero" swap ct-emit-op
|
||
|
|
"if" ct-control-frame-new
|
||
|
|
swap "false" swap ct-control-set
|
||
|
|
swap "end" swap ct-control-set
|
||
|
|
dup "false" ct-control-get "label" swap ct-control-add-close-op
|
||
|
|
dup "end" ct-control-get "label" swap ct-control-add-close-op
|
||
|
|
ct-control-push
|
||
|
|
end
|
||
|
|
compile-only
|
||
|
|
|
||
|
|
word if-base ct-if-open end
|
||
|
|
immediate
|
||
|
|
compile-only
|
||
|
|
|
||
|
|
word if
|
||
|
|
ct-control-depth 0 > if-base
|
||
|
|
ct-control-peek
|
||
|
|
dup "type" ct-control-get "else" string= if-base
|
||
|
|
dup "line" ct-control-get ct-last-token-line == if-base
|
||
|
|
drop
|
||
|
|
ct-control-pop >r
|
||
|
|
r@ "end" ct-control-get dup nil? if-base
|
||
|
|
drop "if_end" ct-new-label
|
||
|
|
end
|
||
|
|
ct-if-open-with-end
|
||
|
|
r> drop
|
||
|
|
exit
|
||
|
|
end
|
||
|
|
end
|
||
|
|
drop
|
||
|
|
end
|
||
|
|
ct-if-open
|
||
|
|
end
|
||
|
|
immediate
|
||
|
|
compile-only
|
||
|
|
|
||
|
|
word else
|
||
|
|
ct-control-pop >r
|
||
|
|
r@ "end" ct-control-get dup nil? if-base
|
||
|
|
drop "if_end" ct-new-label
|
||
|
|
end
|
||
|
|
dup "jump" swap ct-emit-op
|
||
|
|
r@ "false" ct-control-get "label" swap ct-emit-op
|
||
|
|
"else" ct-control-frame-new
|
||
|
|
swap "end" swap ct-control-set
|
||
|
|
dup "end" ct-control-get "label" swap ct-control-add-close-op
|
||
|
|
ct-control-push
|
||
|
|
r> drop
|
||
|
|
end
|
||
|
|
immediate
|
||
|
|
compile-only
|
||
|
|
|
||
|
|
word for
|
||
|
|
"for_loop" ct-new-label
|
||
|
|
"for_end" ct-new-label
|
||
|
|
map-new
|
||
|
|
"loop" 3 pick map-set
|
||
|
|
"end" 2 pick map-set
|
||
|
|
"for_begin" swap ct-emit-op
|
||
|
|
"for" ct-control-frame-new
|
||
|
|
swap "end" swap ct-control-set
|
||
|
|
swap "loop" swap ct-control-set
|
||
|
|
dup "end" ct-control-get >r
|
||
|
|
dup "loop" ct-control-get >r
|
||
|
|
map-new
|
||
|
|
"loop" r> map-set
|
||
|
|
"end" r> map-set
|
||
|
|
"for_end" swap ct-control-add-close-op
|
||
|
|
ct-control-push
|
||
|
|
end
|
||
|
|
immediate
|
||
|
|
compile-only
|
||
|
|
|
||
|
|
word while
|
||
|
|
"begin" ct-new-label
|
||
|
|
"end" ct-new-label
|
||
|
|
over "label" swap ct-emit-op
|
||
|
|
"while_open" ct-control-frame-new
|
||
|
|
swap "end" swap ct-control-set
|
||
|
|
swap "begin" swap ct-control-set
|
||
|
|
ct-control-push
|
||
|
|
end
|
||
|
|
immediate
|
||
|
|
compile-only
|
||
|
|
|
||
|
|
word do
|
||
|
|
ct-control-pop >r
|
||
|
|
r@ "end" ct-control-get "branch_zero" swap ct-emit-op
|
||
|
|
"while" ct-control-frame-new
|
||
|
|
r@ "begin" ct-control-get "begin" swap ct-control-set
|
||
|
|
r@ "end" ct-control-get "end" swap ct-control-set
|
||
|
|
dup "begin" ct-control-get "jump" swap ct-control-add-close-op
|
||
|
|
dup "end" ct-control-get "label" swap ct-control-add-close-op
|
||
|
|
r> drop
|
||
|
|
ct-control-push
|
||
|
|
end
|
||
|
|
immediate
|
||
|
|
compile-only
|
||
|
|
|
||
|
|
word block-opener
|
||
|
|
next-token token-lexeme ct-register-block-opener
|
||
|
|
end
|
||
|
|
immediate
|
||
|
|
compile-only
|
||
|
|
|
||
|
|
word control-override
|
||
|
|
next-token token-lexeme ct-register-control-override
|
||
|
|
end
|
||
|
|
immediate
|
||
|
|
compile-only
|
||
|
|
|
||
|
|
block-opener if
|
||
|
|
block-opener for
|
||
|
|
block-opener while
|
||
|
|
|
||
|
|
control-override if
|
||
|
|
control-override else
|
||
|
|
control-override for
|
||
|
|
control-override while
|
||
|
|
control-override do
|