79 lines
1.9 KiB
Factor
79 lines
1.9 KiB
Factor
IN: scratchpad
|
|
USE: arithmetic
|
|
USE: combinators
|
|
USE: kernel
|
|
USE: stack
|
|
USE: stdio
|
|
USE: test
|
|
USE: words
|
|
|
|
"Check compiler's auxiliary quotation code." print
|
|
|
|
: [call] call ; inline
|
|
: [[call]] [call] ; inline
|
|
|
|
: [nop] [ nop ] call ; word must-compile
|
|
: [[nop]] [ nop ] [call] ; word must-compile
|
|
: [[[nop]]] [ nop ] [[call]] ; word must-compile
|
|
|
|
[ ] [ ] [ [nop] ] test-word
|
|
[ ] [ ] [ [[nop]] ] test-word
|
|
[ ] [ ] [ [[[nop]]] ] test-word
|
|
|
|
: ?call t [ call ] [ drop ] ifte ; inline
|
|
: ?nop [ nop ] ?call ; word must-compile
|
|
|
|
: ??call t [ call ] [ ?call ] ifte ; inline
|
|
: ??nop [ nop ] ??call ; word must-compile
|
|
|
|
: ???call t [ call ] [ ???call ] ifte ; inline
|
|
: ???nop [ nop ] ???call ; word must-compile
|
|
|
|
[ ] [ ] [ ?nop ] test-word
|
|
[ ] [ ] [ ??nop ] test-word
|
|
[ ] [ ] [ ???nop ] test-word
|
|
|
|
: while-test [ f ] [ ] while ; word must-compile
|
|
|
|
[ ] [ ] [ while-test ] test-word
|
|
|
|
: [while]
|
|
[ over call ] [ dup 2dip ] while 2drop ; inline
|
|
|
|
: [while-test] [ f ] [ ] [while] ; word must-compile
|
|
|
|
[ ] [ ] [ [while-test] ] test-word
|
|
|
|
: times-test-1 [ nop ] times ; word must-compile
|
|
: times-test-2 [ succ ] times ; word must-compile
|
|
: times-test-3 0 10 [ succ ] times ; word must-compile
|
|
|
|
[ ] [ 10 ] [ times-test-1 ] test-word
|
|
[ 10 ] [ 0 10 ] [ times-test-2 ] test-word
|
|
[ 10 ] [ ] [ times-test-3 ] test-word
|
|
|
|
: nested-ifte [ [ 1 ] [ 2 ] ifte ] [ [ 3 ] [ 4 ] ifte ] ifte ; word must-compile
|
|
|
|
[ 1 ] [ t t ] [ nested-ifte ] test-word
|
|
[ 2 ] [ f t ] [ nested-ifte ] test-word
|
|
[ 3 ] [ t f ] [ nested-ifte ] test-word
|
|
[ 4 ] [ f f ] [ nested-ifte ] test-word
|
|
|
|
: flow-erasure [ 2 2 + ] [ ] dip call ; inline word must-compile
|
|
|
|
[ 4 ] [ ] [ flow-erasure ] test-word
|
|
|
|
! This got broken when I changed : ifte ? call ; to primitive
|
|
: twice-nested-ifte
|
|
t [
|
|
t [
|
|
|
|
] [
|
|
twice-nested-ifte
|
|
] ifte
|
|
] [
|
|
|
|
] ifte ; word must-compile
|
|
|
|
"Auxiliary quotation checks done." print
|