Cleanups
parent
a75c6ebb22
commit
3995a5c824
|
@ -1,25 +1,28 @@
|
|||
IN: temporary
|
||||
USING: compiler tools.test namespaces sequences
|
||||
kernel.private kernel math continuations continuations.private
|
||||
words ;
|
||||
words splitting ;
|
||||
|
||||
: symbolic-stack-trace ( -- newseq )
|
||||
error-continuation get continuation-call callstack>array ;
|
||||
error-continuation get continuation-call callstack>array
|
||||
2 group flip first ;
|
||||
|
||||
: foo 3 throw 7 ;
|
||||
: bar foo 4 ;
|
||||
: baz bar 5 ;
|
||||
\ baz compile
|
||||
[ 3 ] [ [ baz ] catch ] unit-test
|
||||
[ { baz bar foo throw } ] [
|
||||
symbolic-stack-trace [ word? ] subset
|
||||
[ t ] [
|
||||
symbolic-stack-trace
|
||||
[ word? ] subset
|
||||
{ baz bar foo throw } tail?
|
||||
] unit-test
|
||||
|
||||
: bleh [ 3 + ] map [ 0 > ] subset ;
|
||||
\ bleh compile
|
||||
|
||||
: stack-trace-contains? symbolic-stack-trace memq? ;
|
||||
|
||||
|
||||
[ t ] [
|
||||
[ { 1 "hi" } bleh ] catch drop \ + stack-trace-contains?
|
||||
] unit-test
|
||||
|
|
|
@ -365,17 +365,17 @@ M: object minimal-ds-loc* drop ;
|
|||
2dup [ length ] 2apply <=
|
||||
[ drop { } swap ] [ length swap cut* ] if ;
|
||||
|
||||
: substitute-vregs ( alist -- )
|
||||
>hashtable
|
||||
{ phantom-d phantom-r }
|
||||
[ get substitute ] curry* each ;
|
||||
: vreg-substitution ( value vreg -- pair )
|
||||
dupd <cached> 2array ;
|
||||
|
||||
: substitute-vregs ( values vregs -- )
|
||||
[ vreg-substitution ] 2map [ first loc? ] subset >hashtable
|
||||
[ swap substitute ] curry each-phantom ;
|
||||
|
||||
: lazy-load ( values template -- )
|
||||
#! Set operand vars here.
|
||||
flip first2
|
||||
>r dupd [ (lazy-load) ] 2map dup r>
|
||||
[ >r dup value? [ value-literal ] when r> set ] 2each
|
||||
dupd [ <cached> ] 2map 2array flip [ first loc? ] subset
|
||||
2dup [ first (lazy-load) ] 2map dup rot
|
||||
[ >r dup value? [ value-literal ] when r> second set ] 2each
|
||||
substitute-vregs ;
|
||||
|
||||
: fast-input ( template -- )
|
||||
|
|
Loading…
Reference in New Issue