further code cleanups, unit test fixes
parent
f65aa407e9
commit
3366640fb1
|
@ -28,4 +28,4 @@ TUPLE: interp data call name catch ;
|
||||||
|
|
||||||
: callcc1 ( quot ++ obj | quot: cont -- | cont: obj ++ obj )
|
: callcc1 ( quot ++ obj | quot: cont -- | cont: obj ++ obj )
|
||||||
continuation
|
continuation
|
||||||
[ swap literalize set-interp ] cons swap call ;
|
[ swap literalize unit set-interp ] cons swap call ;
|
||||||
|
|
|
@ -83,7 +83,8 @@ M: 2generic dispatching-values drop node-in-d 2 swap tail* ;
|
||||||
|
|
||||||
: subst-literal ( successor literal -- #push )
|
: subst-literal ( successor literal -- #push )
|
||||||
#! Make #push -> #return -> successor
|
#! Make #push -> #return -> successor
|
||||||
literalize dataflow [ last-node set-node-successor ] keep ;
|
literalize unit dataflow
|
||||||
|
[ last-node set-node-successor ] keep ;
|
||||||
|
|
||||||
: inline-literal ( node literal -- node )
|
: inline-literal ( node literal -- node )
|
||||||
over drop-inputs
|
over drop-inputs
|
||||||
|
|
|
@ -30,7 +30,7 @@ M: comment prettyprint* ( ann -- )
|
||||||
] make-string ;
|
] make-string ;
|
||||||
|
|
||||||
M: #push node>quot ( ? node -- )
|
M: #push node>quot ( ? node -- )
|
||||||
node-out-d [ literal-value literalize ] map concat % drop ;
|
node-out-d [ literal-value literalize ] map % drop ;
|
||||||
|
|
||||||
M: #drop node>quot ( ? node -- )
|
M: #drop node>quot ( ? node -- )
|
||||||
node-in-d length dup 3 > [
|
node-in-d length dup 3 > [
|
||||||
|
|
|
@ -1,8 +1,4 @@
|
||||||
|
IN: temporary
|
||||||
GENERIC: xyz
|
|
||||||
M: cons xyz xyz ;
|
|
||||||
|
|
||||||
[ ] [ \ xyz compile ] unit-testIN: temporary
|
|
||||||
USING: generic kernel-internals strings vectors ;
|
USING: generic kernel-internals strings vectors ;
|
||||||
USE: test
|
USE: test
|
||||||
USE: assembler
|
USE: assembler
|
||||||
|
@ -79,11 +75,11 @@ USE: sequences
|
||||||
|
|
||||||
[ 4 ] [ 2 2 literal-kill-test-7 ] unit-test
|
[ 4 ] [ 2 2 literal-kill-test-7 ] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ string ] [
|
||||||
\ string
|
\ string
|
||||||
[ range repeated integer string mirror array reversed sbuf
|
[ range repeated integer string mirror array reversed sbuf
|
||||||
slice vector diagonal general-list ]
|
slice vector diagonal general-list ]
|
||||||
min-class?
|
min-class
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ f ] [
|
[ f ] [
|
||||||
|
@ -144,7 +140,7 @@ TUPLE: pred-test ;
|
||||||
"not a tuple"
|
"not a tuple"
|
||||||
] ifte ; compiled
|
] ifte ; compiled
|
||||||
|
|
||||||
[ 1 "pred-test" ] [ << pred-test >> pred-test-3 ] unit-test
|
[ << pred-test >> "pred-test" ] [ << pred-test >> pred-test-3 ] unit-test
|
||||||
|
|
||||||
: pred-test-4
|
: pred-test-4
|
||||||
dup pred-test? [
|
dup pred-test? [
|
||||||
|
|
|
@ -27,7 +27,7 @@ global [ 100 <vector> commands set ] bind
|
||||||
dup presented paint-prop dup [
|
dup presented paint-prop dup [
|
||||||
[
|
[
|
||||||
\ drop ,
|
\ drop ,
|
||||||
literal,
|
literalize ,
|
||||||
[ command-menu show-menu ] %
|
[ command-menu show-menu ] %
|
||||||
] make-list
|
] make-list
|
||||||
button-gestures
|
button-gestures
|
||||||
|
|
Loading…
Reference in New Issue