further code cleanups, unit test fixes

cvs
Slava Pestov 2005-08-04 04:48:07 +00:00
parent f65aa407e9
commit 3366640fb1
5 changed files with 9 additions and 12 deletions

View File

@ -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 ;

View File

@ -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

View File

@ -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 > [

View File

@ -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? [

View File

@ -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