Getting compiler unit tests to pass
Slava Pestov
parent
bbb89af5a6
commit
28d6fec557
|
|
@ -38,7 +38,6 @@ $nl
|
|||
{ $unchecked-example
|
||||
"LIBRARY: foo\nFUNCTION: void the_answer ( char* question, int value ) ;"
|
||||
"USE: compiler"
|
||||
"\\ the_answer compile"
|
||||
"\"the question\" 42 the_answer"
|
||||
"The answer to the question is 42."
|
||||
} }
|
||||
|
|
|
|||
|
|
@ -3,7 +3,8 @@ namespaces parser kernel kernel.private classes classes.private
|
|||
arrays hashtables vectors tuples sbufs inference.dataflow
|
||||
hashtables.private sequences.private math tuples.private
|
||||
growable namespaces.private alien.remote-control assocs words
|
||||
generator command-line vocabs io prettyprint libc ;
|
||||
generator command-line vocabs io prettyprint libc definitions ;
|
||||
IN: bootstrap.compiler
|
||||
|
||||
"cpu." cpu append require
|
||||
|
||||
|
|
@ -12,6 +13,8 @@ generator command-line vocabs io prettyprint libc ;
|
|||
0 profiler-prologue set-global
|
||||
] when
|
||||
|
||||
: compile* [ compiled? not ] subset compile ;
|
||||
|
||||
! Compile a set of words ahead of our general
|
||||
! compile-all. This set of words was determined
|
||||
! semi-empirically using the profiler. It improves
|
||||
|
|
@ -36,22 +39,24 @@ generator command-line vocabs io prettyprint libc ;
|
|||
find-pair-next namestack*
|
||||
|
||||
bitand bitor bitxor bitnot
|
||||
} compile
|
||||
} compile*
|
||||
|
||||
{
|
||||
+ 1+ 1- 2/ < <= > >= shift min
|
||||
} compile
|
||||
} compile*
|
||||
|
||||
{
|
||||
new nth push pop peek hashcode* = get set
|
||||
} compile
|
||||
} compile*
|
||||
|
||||
{
|
||||
. lines
|
||||
} compile
|
||||
} compile*
|
||||
|
||||
{
|
||||
malloc free memcpy
|
||||
} compile
|
||||
} compile*
|
||||
|
||||
[ compile ] recompile-hook set-global
|
||||
|
||||
FORGET: compile*
|
||||
|
|
|
|||
|
|
@ -46,15 +46,13 @@ IN: bootstrap.stage2
|
|||
init-io
|
||||
init-stdio
|
||||
|
||||
"compile-errors" "generator" lookup [
|
||||
f swap set-global
|
||||
] when*
|
||||
|
||||
run-bootstrap-init
|
||||
|
||||
f error set-global
|
||||
f error-continuation set-global
|
||||
|
||||
all-words [ compiled? not ] subset recompile-hook get call
|
||||
|
||||
"deploy-vocab" get [
|
||||
"tools.deploy.shaker" run
|
||||
] [
|
||||
|
|
|
|||
|
|
@ -92,7 +92,7 @@ HELP: compile-quot
|
|||
{ $description "Creates a new uninterned word having the given quotation as its definition, and compiles it. The returned word can be passed to " { $link execute } "." }
|
||||
{ $errors "Throws an error if the stack effect of the quotation cannot be inferred." } ;
|
||||
|
||||
HELP: compile-1
|
||||
HELP: compile-call
|
||||
{ $values { "quot" "a quotation" } }
|
||||
{ $description "Compiles and runs a quotation." }
|
||||
{ $errors "Throws an error if the stack effect of the quotation cannot be inferred." } ;
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ SYMBOL: compiler-hook
|
|||
dup compile-begins
|
||||
dup word-dataflow optimize >r over dup r> generate
|
||||
] [
|
||||
print-error f
|
||||
print-error f over compiled get set-at f
|
||||
] recover
|
||||
2dup ripple-up save-effect ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,43 +2,43 @@ USING: tools.test compiler quotations math kernel sequences
|
|||
assocs namespaces ;
|
||||
IN: temporary
|
||||
|
||||
[ 3 ] [ 5 [ [ 2 - ] curry call ] compile-1 ] unit-test
|
||||
[ 3 ] [ [ 5 [ 2 - ] curry call ] compile-1 ] unit-test
|
||||
[ 3 ] [ [ 5 2 [ - ] 2curry call ] compile-1 ] unit-test
|
||||
[ 3 ] [ 5 [ 2 [ - ] 2curry call ] compile-1 ] unit-test
|
||||
[ 3 ] [ 5 2 [ [ - ] 2curry call ] compile-1 ] unit-test
|
||||
[ 3 ] [ 5 2 [ [ - ] 2curry 9 swap call /i ] compile-1 ] unit-test
|
||||
[ 3 ] [ 5 2 [ [ - ] 2curry >r 9 r> call /i ] compile-1 ] unit-test
|
||||
[ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test
|
||||
[ 3 ] [ [ 5 [ 2 - ] curry call ] compile-call ] unit-test
|
||||
[ 3 ] [ [ 5 2 [ - ] 2curry call ] compile-call ] unit-test
|
||||
[ 3 ] [ 5 [ 2 [ - ] 2curry call ] compile-call ] unit-test
|
||||
[ 3 ] [ 5 2 [ [ - ] 2curry call ] compile-call ] unit-test
|
||||
[ 3 ] [ 5 2 [ [ - ] 2curry 9 swap call /i ] compile-call ] unit-test
|
||||
[ 3 ] [ 5 2 [ [ - ] 2curry >r 9 r> call /i ] compile-call ] unit-test
|
||||
|
||||
[ -10 -20 ] [ 10 20 -1 [ [ * ] curry 2apply ] compile-1 ] unit-test
|
||||
[ -10 -20 ] [ 10 20 -1 [ [ * ] curry 2apply ] compile-call ] unit-test
|
||||
|
||||
[ [ 5 2 - ] ] [ 5 [ [ 2 - ] curry ] compile-1 >quotation ] unit-test
|
||||
[ [ 5 2 - ] ] [ [ 5 [ 2 - ] curry ] compile-1 >quotation ] unit-test
|
||||
[ [ 5 2 - ] ] [ [ 5 2 [ - ] 2curry ] compile-1 >quotation ] unit-test
|
||||
[ [ 5 2 - ] ] [ 5 [ 2 [ - ] 2curry ] compile-1 >quotation ] unit-test
|
||||
[ [ 5 2 - ] ] [ 5 2 [ [ - ] 2curry ] compile-1 >quotation ] unit-test
|
||||
[ [ 5 2 - ] ] [ 5 [ [ 2 - ] curry ] compile-call >quotation ] unit-test
|
||||
[ [ 5 2 - ] ] [ [ 5 [ 2 - ] curry ] compile-call >quotation ] unit-test
|
||||
[ [ 5 2 - ] ] [ [ 5 2 [ - ] 2curry ] compile-call >quotation ] unit-test
|
||||
[ [ 5 2 - ] ] [ 5 [ 2 [ - ] 2curry ] compile-call >quotation ] unit-test
|
||||
[ [ 5 2 - ] ] [ 5 2 [ [ - ] 2curry ] compile-call >quotation ] unit-test
|
||||
|
||||
[ [ 6 2 + ] ]
|
||||
[
|
||||
2 5
|
||||
[ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry ]
|
||||
compile-1 >quotation
|
||||
compile-call >quotation
|
||||
] unit-test
|
||||
|
||||
[ 8 ]
|
||||
[
|
||||
2 5
|
||||
[ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry call ]
|
||||
compile-1
|
||||
compile-call
|
||||
] unit-test
|
||||
|
||||
: foobar ( quot -- )
|
||||
dup slip swap [ foobar ] [ drop ] if ; inline
|
||||
|
||||
[ ] [ [ [ f ] foobar ] compile-1 ] unit-test
|
||||
[ ] [ [ [ f ] foobar ] compile-call ] unit-test
|
||||
|
||||
[ { 6 7 8 } ] [ { 1 2 3 } 5 [ [ + ] curry map ] compile-1 ] unit-test
|
||||
[ { 6 7 8 } ] [ { 1 2 3 } [ 5 [ + ] curry map ] compile-1 ] unit-test
|
||||
[ { 6 7 8 } ] [ { 1 2 3 } 5 [ [ + ] curry map ] compile-call ] unit-test
|
||||
[ { 6 7 8 } ] [ { 1 2 3 } [ 5 [ + ] curry map ] compile-call ] unit-test
|
||||
|
||||
: funky-assoc>map
|
||||
[
|
||||
|
|
@ -46,16 +46,16 @@ IN: temporary
|
|||
] { } make ; inline
|
||||
|
||||
[ t ] [
|
||||
global [ [ drop , ] funky-assoc>map ] compile-1
|
||||
global [ [ drop , ] funky-assoc>map ] compile-call
|
||||
global keys =
|
||||
] unit-test
|
||||
|
||||
[ 3 ] [ 1 [ 2 ] [ curry [ 3 ] [ 4 ] if ] compile-1 ] unit-test
|
||||
[ 3 ] [ 1 [ 2 ] [ curry [ 3 ] [ 4 ] if ] compile-call ] unit-test
|
||||
|
||||
[ 3 ] [ t [ 3 [ ] curry 4 [ ] curry if ] compile-1 ] unit-test
|
||||
[ 3 ] [ t [ 3 [ ] curry 4 [ ] curry if ] compile-call ] unit-test
|
||||
|
||||
[ 3 ] [ t [ 3 [ ] curry [ 4 ] if ] compile-1 ] unit-test
|
||||
[ 3 ] [ t [ 3 [ ] curry [ 4 ] if ] compile-call ] unit-test
|
||||
|
||||
[ 4 ] [ f [ 3 [ ] curry 4 [ ] curry if ] compile-1 ] unit-test
|
||||
[ 4 ] [ f [ 3 [ ] curry 4 [ ] curry if ] compile-call ] unit-test
|
||||
|
||||
[ 4 ] [ f [ [ 3 ] 4 [ ] curry if ] compile-1 ] unit-test
|
||||
[ 4 ] [ f [ [ 3 ] 4 [ ] curry if ] compile-call ] unit-test
|
||||
|
|
|
|||
|
|
@ -2,84 +2,84 @@ IN: temporary
|
|||
USING: compiler kernel kernel.private memory math
|
||||
math.private tools.test math.floats.private ;
|
||||
|
||||
[ 5.0 ] [ [ 5.0 ] compile-1 data-gc data-gc data-gc ] unit-test
|
||||
[ 2.0 3.0 ] [ 3.0 [ 2.0 swap ] compile-1 ] unit-test
|
||||
[ 5.0 ] [ [ 5.0 ] compile-call data-gc data-gc data-gc ] unit-test
|
||||
[ 2.0 3.0 ] [ 3.0 [ 2.0 swap ] compile-call ] unit-test
|
||||
|
||||
[ 1 2 3 4.0 ] [ [ 1 2 3 4.0 ] compile-1 ] unit-test
|
||||
[ 1 2 3 4.0 ] [ [ 1 2 3 4.0 ] compile-call ] unit-test
|
||||
|
||||
[ 3.0 1 2 3 ] [ 1.0 2.0 [ float+ 1 2 3 ] compile-1 ] unit-test
|
||||
[ 3.0 1 2 3 ] [ 1.0 2.0 [ float+ 1 2 3 ] compile-call ] unit-test
|
||||
|
||||
[ 5 ] [ 1.0 [ 2.0 float+ tag ] compile-1 ] unit-test
|
||||
[ 5 ] [ 1.0 [ 2.0 float+ tag ] compile-call ] unit-test
|
||||
|
||||
[ 3.0 ] [ 1.0 [ 2.0 float+ ] compile-1 ] unit-test
|
||||
[ 3.0 ] [ 1.0 [ 2.0 swap float+ ] compile-1 ] unit-test
|
||||
[ 3.0 ] [ 1.0 2.0 [ float+ ] compile-1 ] unit-test
|
||||
[ 3.0 ] [ 1.0 2.0 [ swap float+ ] compile-1 ] unit-test
|
||||
[ 3.0 ] [ 1.0 [ 2.0 float+ ] compile-call ] unit-test
|
||||
[ 3.0 ] [ 1.0 [ 2.0 swap float+ ] compile-call ] unit-test
|
||||
[ 3.0 ] [ 1.0 2.0 [ float+ ] compile-call ] unit-test
|
||||
[ 3.0 ] [ 1.0 2.0 [ swap float+ ] compile-call ] unit-test
|
||||
|
||||
[ -1.0 ] [ 1.0 [ 2.0 float- ] compile-1 ] unit-test
|
||||
[ 1.0 ] [ 1.0 [ 2.0 swap float- ] compile-1 ] unit-test
|
||||
[ -1.0 ] [ 1.0 2.0 [ float- ] compile-1 ] unit-test
|
||||
[ 1.0 ] [ 1.0 2.0 [ swap float- ] compile-1 ] unit-test
|
||||
[ -1.0 ] [ 1.0 [ 2.0 float- ] compile-call ] unit-test
|
||||
[ 1.0 ] [ 1.0 [ 2.0 swap float- ] compile-call ] unit-test
|
||||
[ -1.0 ] [ 1.0 2.0 [ float- ] compile-call ] unit-test
|
||||
[ 1.0 ] [ 1.0 2.0 [ swap float- ] compile-call ] unit-test
|
||||
|
||||
[ 6.0 ] [ 3.0 [ 2.0 float* ] compile-1 ] unit-test
|
||||
[ 6.0 ] [ 3.0 [ 2.0 swap float* ] compile-1 ] unit-test
|
||||
[ 6.0 ] [ 3.0 2.0 [ float* ] compile-1 ] unit-test
|
||||
[ 6.0 ] [ 3.0 2.0 [ swap float* ] compile-1 ] unit-test
|
||||
[ 6.0 ] [ 3.0 [ 2.0 float* ] compile-call ] unit-test
|
||||
[ 6.0 ] [ 3.0 [ 2.0 swap float* ] compile-call ] unit-test
|
||||
[ 6.0 ] [ 3.0 2.0 [ float* ] compile-call ] unit-test
|
||||
[ 6.0 ] [ 3.0 2.0 [ swap float* ] compile-call ] unit-test
|
||||
|
||||
[ 0.5 ] [ 1.0 [ 2.0 float/f ] compile-1 ] unit-test
|
||||
[ 2.0 ] [ 1.0 [ 2.0 swap float/f ] compile-1 ] unit-test
|
||||
[ 0.5 ] [ 1.0 2.0 [ float/f ] compile-1 ] unit-test
|
||||
[ 2.0 ] [ 1.0 2.0 [ swap float/f ] compile-1 ] unit-test
|
||||
[ 0.5 ] [ 1.0 [ 2.0 float/f ] compile-call ] unit-test
|
||||
[ 2.0 ] [ 1.0 [ 2.0 swap float/f ] compile-call ] unit-test
|
||||
[ 0.5 ] [ 1.0 2.0 [ float/f ] compile-call ] unit-test
|
||||
[ 2.0 ] [ 1.0 2.0 [ swap float/f ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 1.0 2.0 [ float< ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 [ 2.0 float< ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 swap float< ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 1.0 [ float< ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 [ 1.0 float< ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 [ 1.0 swap float< ] compile-1 ] unit-test
|
||||
[ f ] [ 3.0 1.0 [ float< ] compile-1 ] unit-test
|
||||
[ f ] [ 3.0 [ 1.0 float< ] compile-1 ] unit-test
|
||||
[ t ] [ 3.0 [ 1.0 swap float< ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 2.0 [ float< ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 [ 2.0 float< ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 swap float< ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 1.0 [ float< ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 [ 1.0 float< ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 [ 1.0 swap float< ] compile-call ] unit-test
|
||||
[ f ] [ 3.0 1.0 [ float< ] compile-call ] unit-test
|
||||
[ f ] [ 3.0 [ 1.0 float< ] compile-call ] unit-test
|
||||
[ t ] [ 3.0 [ 1.0 swap float< ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 1.0 2.0 [ float<= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 [ 2.0 float<= ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 swap float<= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 1.0 [ float<= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 float<= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 swap float<= ] compile-1 ] unit-test
|
||||
[ f ] [ 3.0 1.0 [ float<= ] compile-1 ] unit-test
|
||||
[ f ] [ 3.0 [ 1.0 float<= ] compile-1 ] unit-test
|
||||
[ t ] [ 3.0 [ 1.0 swap float<= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 2.0 [ float<= ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 [ 2.0 float<= ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 swap float<= ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 1.0 [ float<= ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 float<= ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 swap float<= ] compile-call ] unit-test
|
||||
[ f ] [ 3.0 1.0 [ float<= ] compile-call ] unit-test
|
||||
[ f ] [ 3.0 [ 1.0 float<= ] compile-call ] unit-test
|
||||
[ t ] [ 3.0 [ 1.0 swap float<= ] compile-call ] unit-test
|
||||
|
||||
[ f ] [ 1.0 2.0 [ float> ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 float> ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 [ 2.0 swap float> ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 1.0 [ float> ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 [ 1.0 float> ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 [ 1.0 swap float> ] compile-1 ] unit-test
|
||||
[ t ] [ 3.0 1.0 [ float> ] compile-1 ] unit-test
|
||||
[ t ] [ 3.0 [ 1.0 float> ] compile-1 ] unit-test
|
||||
[ f ] [ 3.0 [ 1.0 swap float> ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 2.0 [ float> ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 float> ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 [ 2.0 swap float> ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 1.0 [ float> ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 [ 1.0 float> ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 [ 1.0 swap float> ] compile-call ] unit-test
|
||||
[ t ] [ 3.0 1.0 [ float> ] compile-call ] unit-test
|
||||
[ t ] [ 3.0 [ 1.0 float> ] compile-call ] unit-test
|
||||
[ f ] [ 3.0 [ 1.0 swap float> ] compile-call ] unit-test
|
||||
|
||||
[ f ] [ 1.0 2.0 [ float>= ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 float>= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 [ 2.0 swap float>= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 1.0 [ float>= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 float>= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 swap float>= ] compile-1 ] unit-test
|
||||
[ t ] [ 3.0 1.0 [ float>= ] compile-1 ] unit-test
|
||||
[ t ] [ 3.0 [ 1.0 float>= ] compile-1 ] unit-test
|
||||
[ f ] [ 3.0 [ 1.0 swap float>= ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 2.0 [ float>= ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 float>= ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 [ 2.0 swap float>= ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 1.0 [ float>= ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 float>= ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 swap float>= ] compile-call ] unit-test
|
||||
[ t ] [ 3.0 1.0 [ float>= ] compile-call ] unit-test
|
||||
[ t ] [ 3.0 [ 1.0 float>= ] compile-call ] unit-test
|
||||
[ f ] [ 3.0 [ 1.0 swap float>= ] compile-call ] unit-test
|
||||
|
||||
[ f ] [ 1.0 2.0 [ float= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 1.0 [ float= ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 float= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 float= ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 swap float= ] compile-1 ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 swap float= ] compile-1 ] unit-test
|
||||
[ f ] [ 1.0 2.0 [ float= ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 1.0 [ float= ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 float= ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 float= ] compile-call ] unit-test
|
||||
[ f ] [ 1.0 [ 2.0 swap float= ] compile-call ] unit-test
|
||||
[ t ] [ 1.0 [ 1.0 swap float= ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test
|
||||
[ t ] [ -0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test
|
||||
[ f ] [ 3.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test
|
||||
[ t ] [ 0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-call ] unit-test
|
||||
[ t ] [ -0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-call ] unit-test
|
||||
[ f ] [ 3.0 [ dup 0.0 float= swap -0.0 float= or ] compile-call ] unit-test
|
||||
|
||||
[ 315 315.0 ] [ 313 [ 2 fixnum+fast dup fixnum>float ] compile-1 ] unit-test
|
||||
[ 315 315.0 ] [ 313 [ 2 fixnum+fast dup fixnum>float ] compile-call ] unit-test
|
||||
|
|
|
|||
|
|
@ -98,7 +98,7 @@ DEFER: countdown-b
|
|||
{ [ dup 2 mod 0 = ] [ drop "even" ] }
|
||||
{ [ dup 2 mod 1 = ] [ drop "odd" ] }
|
||||
} cond
|
||||
] compile-1
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
||||
[ "odd" ] [
|
||||
|
|
@ -107,7 +107,7 @@ DEFER: countdown-b
|
|||
{ [ dup 2 mod 0 = ] [ drop "even" ] }
|
||||
{ [ dup 2 mod 1 = ] [ drop "odd" ] }
|
||||
} cond
|
||||
] compile-1
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
||||
[ "neither" ] [
|
||||
|
|
@ -118,7 +118,7 @@ DEFER: countdown-b
|
|||
{ [ dup alien? ] [ drop "alien" ] }
|
||||
{ [ t ] [ drop "neither" ] }
|
||||
} cond
|
||||
] compile-1
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 3 ] [
|
||||
|
|
@ -127,5 +127,5 @@ DEFER: countdown-b
|
|||
{ [ dup fixnum? ] [ ] }
|
||||
{ [ t ] [ drop t ] }
|
||||
} cond
|
||||
] compile-1
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -7,258 +7,257 @@ sbufs.private strings.private slots.private alien alien.c-types
|
|||
alien.syntax namespaces libc combinators.private ;
|
||||
|
||||
! Make sure that intrinsic ops compile to correct code.
|
||||
[ ] [ 1 [ drop ] compile-1 ] unit-test
|
||||
[ ] [ 1 2 [ 2drop ] compile-1 ] unit-test
|
||||
[ ] [ 1 2 3 [ 3drop ] compile-1 ] unit-test
|
||||
[ 1 1 ] [ 1 [ dup ] compile-1 ] unit-test
|
||||
[ 1 2 1 2 ] [ 1 2 [ 2dup ] compile-1 ] unit-test
|
||||
[ 1 2 3 1 2 3 ] [ 1 2 3 [ 3dup ] compile-1 ] unit-test
|
||||
[ 2 3 1 ] [ 1 2 3 [ rot ] compile-1 ] unit-test
|
||||
[ 3 1 2 ] [ 1 2 3 [ -rot ] compile-1 ] unit-test
|
||||
[ 1 1 2 ] [ 1 2 [ dupd ] compile-1 ] unit-test
|
||||
[ 2 1 3 ] [ 1 2 3 [ swapd ] compile-1 ] unit-test
|
||||
[ 2 ] [ 1 2 [ nip ] compile-1 ] unit-test
|
||||
[ 3 ] [ 1 2 3 [ 2nip ] compile-1 ] unit-test
|
||||
[ 2 1 2 ] [ 1 2 [ tuck ] compile-1 ] unit-test
|
||||
[ 1 2 1 ] [ 1 2 [ over ] compile-1 ] unit-test
|
||||
[ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-1 ] unit-test
|
||||
[ 2 1 ] [ 1 2 [ swap ] compile-1 ] unit-test
|
||||
[ ] [ 1 [ drop ] compile-call ] unit-test
|
||||
[ ] [ 1 2 [ 2drop ] compile-call ] unit-test
|
||||
[ ] [ 1 2 3 [ 3drop ] compile-call ] unit-test
|
||||
[ 1 1 ] [ 1 [ dup ] compile-call ] unit-test
|
||||
[ 1 2 1 2 ] [ 1 2 [ 2dup ] compile-call ] unit-test
|
||||
[ 1 2 3 1 2 3 ] [ 1 2 3 [ 3dup ] compile-call ] unit-test
|
||||
[ 2 3 1 ] [ 1 2 3 [ rot ] compile-call ] unit-test
|
||||
[ 3 1 2 ] [ 1 2 3 [ -rot ] compile-call ] unit-test
|
||||
[ 1 1 2 ] [ 1 2 [ dupd ] compile-call ] unit-test
|
||||
[ 2 1 3 ] [ 1 2 3 [ swapd ] compile-call ] unit-test
|
||||
[ 2 ] [ 1 2 [ nip ] compile-call ] unit-test
|
||||
[ 3 ] [ 1 2 3 [ 2nip ] compile-call ] unit-test
|
||||
[ 2 1 2 ] [ 1 2 [ tuck ] compile-call ] unit-test
|
||||
[ 1 2 1 ] [ 1 2 [ over ] compile-call ] unit-test
|
||||
[ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-call ] unit-test
|
||||
[ 2 1 ] [ 1 2 [ swap ] compile-call ] unit-test
|
||||
|
||||
[ 1 ] [ { 1 2 } [ 2 slot ] compile-1 ] unit-test
|
||||
[ 1 ] [ [ { 1 2 } 2 slot ] compile-1 ] unit-test
|
||||
[ 3 ] [ 3 1 2 2array [ [ 2 set-slot ] keep ] compile-1 first ] unit-test
|
||||
[ 3 ] [ 3 1 2 [ 2array [ 2 set-slot ] keep ] compile-1 first ] unit-test
|
||||
[ 3 ] [ [ 3 1 2 2array [ 2 set-slot ] keep ] compile-1 first ] unit-test
|
||||
[ 3 ] [ 3 1 2 2array [ [ 3 set-slot ] keep ] compile-1 second ] unit-test
|
||||
[ 3 ] [ 3 1 2 [ 2array [ 3 set-slot ] keep ] compile-1 second ] unit-test
|
||||
[ 3 ] [ [ 3 1 2 2array [ 3 set-slot ] keep ] compile-1 second ] unit-test
|
||||
[ 1 ] [ { 1 2 } [ 2 slot ] compile-call ] unit-test
|
||||
[ 1 ] [ [ { 1 2 } 2 slot ] compile-call ] unit-test
|
||||
[ 3 ] [ 3 1 2 2array [ [ 2 set-slot ] keep ] compile-call first ] unit-test
|
||||
[ 3 ] [ 3 1 2 [ 2array [ 2 set-slot ] keep ] compile-call first ] unit-test
|
||||
[ 3 ] [ [ 3 1 2 2array [ 2 set-slot ] keep ] compile-call first ] unit-test
|
||||
[ 3 ] [ 3 1 2 2array [ [ 3 set-slot ] keep ] compile-call second ] unit-test
|
||||
[ 3 ] [ 3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
|
||||
[ 3 ] [ [ 3 1 2 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
|
||||
|
||||
! Write barrier hits on the wrong value were causing segfaults
|
||||
[ -3 ] [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-1 second ] unit-test
|
||||
[ -3 ] [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
|
||||
|
||||
[ CHAR: b ] [ 1 "abc" [ char-slot ] compile-1 ] unit-test
|
||||
[ CHAR: b ] [ 1 [ "abc" char-slot ] compile-1 ] unit-test
|
||||
[ CHAR: b ] [ [ 1 "abc" char-slot ] compile-1 ] unit-test
|
||||
[ CHAR: b ] [ 1 "abc" [ char-slot ] compile-call ] unit-test
|
||||
[ CHAR: b ] [ 1 [ "abc" char-slot ] compile-call ] unit-test
|
||||
[ CHAR: b ] [ [ 1 "abc" char-slot ] compile-call ] unit-test
|
||||
|
||||
[ "axc" ] [ CHAR: x 1 "abc" [ [ set-char-slot ] keep { string } declare dup rehash-string ] compile-1 ] unit-test
|
||||
[ "axc" ] [ CHAR: x 1 [ "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-1 ] unit-test
|
||||
[ "axc" ] [ CHAR: x [ 1 "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-1 ] unit-test
|
||||
[ "axc" ] [ CHAR: x 1 "abc" [ [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
|
||||
[ "axc" ] [ CHAR: x 1 [ "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
|
||||
[ "axc" ] [ CHAR: x [ 1 "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-call ] unit-test
|
||||
|
||||
[ ] [ [ 0 getenv ] compile-1 drop ] unit-test
|
||||
[ ] [ 1 getenv [ 1 setenv ] compile-1 ] unit-test
|
||||
[ ] [ [ 0 getenv ] compile-call drop ] unit-test
|
||||
[ ] [ 1 getenv [ 1 setenv ] compile-call ] unit-test
|
||||
|
||||
[ ] [ 1 [ drop ] compile-1 ] unit-test
|
||||
[ ] [ [ 1 drop ] compile-1 ] unit-test
|
||||
[ ] [ [ 1 2 2drop ] compile-1 ] unit-test
|
||||
[ ] [ 1 [ 2 2drop ] compile-1 ] unit-test
|
||||
[ ] [ 1 2 [ 2drop ] compile-1 ] unit-test
|
||||
[ 2 1 ] [ [ 1 2 swap ] compile-1 ] unit-test
|
||||
[ 2 1 ] [ 1 [ 2 swap ] compile-1 ] unit-test
|
||||
[ 2 1 ] [ 1 2 [ swap ] compile-1 ] unit-test
|
||||
[ 1 1 ] [ 1 [ dup ] compile-1 ] unit-test
|
||||
[ 1 1 ] [ [ 1 dup ] compile-1 ] unit-test
|
||||
[ 1 2 1 ] [ [ 1 2 over ] compile-1 ] unit-test
|
||||
[ 1 2 1 ] [ 1 [ 2 over ] compile-1 ] unit-test
|
||||
[ 1 2 1 ] [ 1 2 [ over ] compile-1 ] unit-test
|
||||
[ 1 2 3 1 ] [ [ 1 2 3 pick ] compile-1 ] unit-test
|
||||
[ 1 2 3 1 ] [ 1 [ 2 3 pick ] compile-1 ] unit-test
|
||||
[ 1 2 3 1 ] [ 1 2 [ 3 pick ] compile-1 ] unit-test
|
||||
[ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-1 ] unit-test
|
||||
[ 1 1 2 ] [ [ 1 2 dupd ] compile-1 ] unit-test
|
||||
[ 1 1 2 ] [ 1 [ 2 dupd ] compile-1 ] unit-test
|
||||
[ 1 1 2 ] [ 1 2 [ dupd ] compile-1 ] unit-test
|
||||
[ 2 ] [ [ 1 2 nip ] compile-1 ] unit-test
|
||||
[ 2 ] [ 1 [ 2 nip ] compile-1 ] unit-test
|
||||
[ 2 ] [ 1 2 [ nip ] compile-1 ] unit-test
|
||||
[ ] [ 1 [ drop ] compile-call ] unit-test
|
||||
[ ] [ [ 1 drop ] compile-call ] unit-test
|
||||
[ ] [ [ 1 2 2drop ] compile-call ] unit-test
|
||||
[ ] [ 1 [ 2 2drop ] compile-call ] unit-test
|
||||
[ ] [ 1 2 [ 2drop ] compile-call ] unit-test
|
||||
[ 2 1 ] [ [ 1 2 swap ] compile-call ] unit-test
|
||||
[ 2 1 ] [ 1 [ 2 swap ] compile-call ] unit-test
|
||||
[ 2 1 ] [ 1 2 [ swap ] compile-call ] unit-test
|
||||
[ 1 1 ] [ 1 [ dup ] compile-call ] unit-test
|
||||
[ 1 1 ] [ [ 1 dup ] compile-call ] unit-test
|
||||
[ 1 2 1 ] [ [ 1 2 over ] compile-call ] unit-test
|
||||
[ 1 2 1 ] [ 1 [ 2 over ] compile-call ] unit-test
|
||||
[ 1 2 1 ] [ 1 2 [ over ] compile-call ] unit-test
|
||||
[ 1 2 3 1 ] [ [ 1 2 3 pick ] compile-call ] unit-test
|
||||
[ 1 2 3 1 ] [ 1 [ 2 3 pick ] compile-call ] unit-test
|
||||
[ 1 2 3 1 ] [ 1 2 [ 3 pick ] compile-call ] unit-test
|
||||
[ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-call ] unit-test
|
||||
[ 1 1 2 ] [ [ 1 2 dupd ] compile-call ] unit-test
|
||||
[ 1 1 2 ] [ 1 [ 2 dupd ] compile-call ] unit-test
|
||||
[ 1 1 2 ] [ 1 2 [ dupd ] compile-call ] unit-test
|
||||
[ 2 ] [ [ 1 2 nip ] compile-call ] unit-test
|
||||
[ 2 ] [ 1 [ 2 nip ] compile-call ] unit-test
|
||||
[ 2 ] [ 1 2 [ nip ] compile-call ] unit-test
|
||||
|
||||
[ 2 1 "hi" ] [ 1 2 [ swap "hi" ] compile-1 ] unit-test
|
||||
[ 2 1 "hi" ] [ 1 2 [ swap "hi" ] compile-call ] unit-test
|
||||
|
||||
[ 4 ] [ 12 7 [ fixnum-bitand ] compile-1 ] unit-test
|
||||
[ 4 ] [ 12 [ 7 fixnum-bitand ] compile-1 ] unit-test
|
||||
[ 4 ] [ [ 12 7 fixnum-bitand ] compile-1 ] unit-test
|
||||
[ 4 ] [ 12 7 [ fixnum-bitand ] compile-call ] unit-test
|
||||
[ 4 ] [ 12 [ 7 fixnum-bitand ] compile-call ] unit-test
|
||||
[ 4 ] [ [ 12 7 fixnum-bitand ] compile-call ] unit-test
|
||||
|
||||
[ 15 ] [ 12 7 [ fixnum-bitor ] compile-1 ] unit-test
|
||||
[ 15 ] [ 12 [ 7 fixnum-bitor ] compile-1 ] unit-test
|
||||
[ 15 ] [ [ 12 7 fixnum-bitor ] compile-1 ] unit-test
|
||||
[ 15 ] [ 12 7 [ fixnum-bitor ] compile-call ] unit-test
|
||||
[ 15 ] [ 12 [ 7 fixnum-bitor ] compile-call ] unit-test
|
||||
[ 15 ] [ [ 12 7 fixnum-bitor ] compile-call ] unit-test
|
||||
|
||||
[ 11 ] [ 12 7 [ fixnum-bitxor ] compile-1 ] unit-test
|
||||
[ 11 ] [ 12 [ 7 fixnum-bitxor ] compile-1 ] unit-test
|
||||
[ 11 ] [ [ 12 7 fixnum-bitxor ] compile-1 ] unit-test
|
||||
[ 11 ] [ 12 7 [ fixnum-bitxor ] compile-call ] unit-test
|
||||
[ 11 ] [ 12 [ 7 fixnum-bitxor ] compile-call ] unit-test
|
||||
[ 11 ] [ [ 12 7 fixnum-bitxor ] compile-call ] unit-test
|
||||
|
||||
[ f ] [ 12 7 [ fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 12 [ 7 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ [ 12 7 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ [ 12 12 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 12 12 [ fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 12 7 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ 12 [ 7 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ [ 12 7 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ [ 12 12 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ 12 12 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 12 70 [ fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 12 [ 70 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ [ 12 70 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 12 70 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ 12 [ 70 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ [ 12 70 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
|
||||
|
||||
[ f ] [ 12 7 [ fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 12 [ 7 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ [ 12 7 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 12 12 [ fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 12 7 [ fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ 12 [ 7 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ [ 12 7 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ 12 12 [ fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 12 70 [ fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 12 [ 70 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ [ 12 70 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 12 70 [ fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ 12 [ 70 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ [ 12 70 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 12 7 [ fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 12 [ 7 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ [ 12 7 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 12 12 [ fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 12 7 [ fixnum> [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ 12 [ 7 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ [ 12 7 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ 12 12 [ fixnum> [ t ] [ f ] if ] compile-call ] unit-test
|
||||
|
||||
[ f ] [ 12 70 [ fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 12 [ 70 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ [ 12 70 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 12 70 [ fixnum> [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ 12 [ 70 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ [ 12 70 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 12 7 [ fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 12 [ 7 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ [ 12 7 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ [ 12 12 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 12 12 [ fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 12 7 [ fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ 12 [ 7 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ [ 12 7 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ [ 12 12 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ 12 12 [ fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
|
||||
[ f ] [ 12 70 [ fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 12 [ 70 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ [ 12 70 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 12 70 [ fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ 12 [ 70 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ [ 12 70 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
|
||||
|
||||
[ f ] [ 1 2 [ eq? [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 1 [ 2 eq? [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ [ 1 2 eq? [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 3 3 [ eq? [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ 3 [ 3 eq? [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ t ] [ [ 3 3 eq? [ t ] [ f ] if ] compile-1 ] unit-test
|
||||
[ f ] [ 1 2 [ eq? [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ 1 [ 2 eq? [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ f ] [ [ 1 2 eq? [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ 3 3 [ eq? [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ 3 [ 3 eq? [ t ] [ f ] if ] compile-call ] unit-test
|
||||
[ t ] [ [ 3 3 eq? [ t ] [ f ] if ] compile-call ] unit-test
|
||||
|
||||
[ -1 ] [ 0 [ fixnum-bitnot ] compile-1 ] unit-test
|
||||
[ -1 ] [ [ 0 fixnum-bitnot ] compile-1 ] unit-test
|
||||
[ -1 ] [ 0 [ fixnum-bitnot ] compile-call ] unit-test
|
||||
[ -1 ] [ [ 0 fixnum-bitnot ] compile-call ] unit-test
|
||||
|
||||
[ 3 ] [ 13 10 [ fixnum-mod ] compile-1 ] unit-test
|
||||
[ 3 ] [ 13 [ 10 fixnum-mod ] compile-1 ] unit-test
|
||||
[ 3 ] [ [ 13 10 fixnum-mod ] compile-1 ] unit-test
|
||||
[ -3 ] [ -13 10 [ fixnum-mod ] compile-1 ] unit-test
|
||||
[ -3 ] [ -13 [ 10 fixnum-mod ] compile-1 ] unit-test
|
||||
[ -3 ] [ [ -13 10 fixnum-mod ] compile-1 ] unit-test
|
||||
[ 3 ] [ 13 10 [ fixnum-mod ] compile-call ] unit-test
|
||||
[ 3 ] [ 13 [ 10 fixnum-mod ] compile-call ] unit-test
|
||||
[ 3 ] [ [ 13 10 fixnum-mod ] compile-call ] unit-test
|
||||
[ -3 ] [ -13 10 [ fixnum-mod ] compile-call ] unit-test
|
||||
[ -3 ] [ -13 [ 10 fixnum-mod ] compile-call ] unit-test
|
||||
[ -3 ] [ [ -13 10 fixnum-mod ] compile-call ] unit-test
|
||||
|
||||
[ 2 ] [ 4 2 [ fixnum/i ] compile-1 ] unit-test
|
||||
[ 2 ] [ 4 [ 2 fixnum/i ] compile-1 ] unit-test
|
||||
[ -2 ] [ 4 [ -2 fixnum/i ] compile-1 ] unit-test
|
||||
[ 3 1 ] [ 10 3 [ fixnum/mod ] compile-1 ] unit-test
|
||||
[ 2 ] [ 4 2 [ fixnum/i ] compile-call ] unit-test
|
||||
[ 2 ] [ 4 [ 2 fixnum/i ] compile-call ] unit-test
|
||||
[ -2 ] [ 4 [ -2 fixnum/i ] compile-call ] unit-test
|
||||
[ 3 1 ] [ 10 3 [ fixnum/mod ] compile-call ] unit-test
|
||||
|
||||
[ 4 ] [ 1 3 [ fixnum+ ] compile-1 ] unit-test
|
||||
[ 4 ] [ 1 [ 3 fixnum+ ] compile-1 ] unit-test
|
||||
[ 4 ] [ [ 1 3 fixnum+ ] compile-1 ] unit-test
|
||||
[ 4 ] [ 1 3 [ fixnum+ ] compile-call ] unit-test
|
||||
[ 4 ] [ 1 [ 3 fixnum+ ] compile-call ] unit-test
|
||||
[ 4 ] [ [ 1 3 fixnum+ ] compile-call ] unit-test
|
||||
|
||||
[ 4 ] [ 1 3 [ fixnum+fast ] compile-1 ] unit-test
|
||||
[ 4 ] [ 1 [ 3 fixnum+fast ] compile-1 ] unit-test
|
||||
[ 4 ] [ [ 1 3 fixnum+fast ] compile-1 ] unit-test
|
||||
[ 4 ] [ 1 3 [ fixnum+fast ] compile-call ] unit-test
|
||||
[ 4 ] [ 1 [ 3 fixnum+fast ] compile-call ] unit-test
|
||||
[ 4 ] [ [ 1 3 fixnum+fast ] compile-call ] unit-test
|
||||
|
||||
[ 30001 ] [ 1 [ 30000 fixnum+fast ] compile-1 ] unit-test
|
||||
[ 30001 ] [ 1 [ 30000 fixnum+fast ] compile-call ] unit-test
|
||||
|
||||
[ 6 ] [ 2 3 [ fixnum*fast ] compile-1 ] unit-test
|
||||
[ 6 ] [ 2 [ 3 fixnum*fast ] compile-1 ] unit-test
|
||||
[ 6 ] [ [ 2 3 fixnum*fast ] compile-1 ] unit-test
|
||||
[ -6 ] [ 2 -3 [ fixnum*fast ] compile-1 ] unit-test
|
||||
[ -6 ] [ 2 [ -3 fixnum*fast ] compile-1 ] unit-test
|
||||
[ -6 ] [ [ 2 -3 fixnum*fast ] compile-1 ] unit-test
|
||||
[ 6 ] [ 2 3 [ fixnum*fast ] compile-call ] unit-test
|
||||
[ 6 ] [ 2 [ 3 fixnum*fast ] compile-call ] unit-test
|
||||
[ 6 ] [ [ 2 3 fixnum*fast ] compile-call ] unit-test
|
||||
[ -6 ] [ 2 -3 [ fixnum*fast ] compile-call ] unit-test
|
||||
[ -6 ] [ 2 [ -3 fixnum*fast ] compile-call ] unit-test
|
||||
[ -6 ] [ [ 2 -3 fixnum*fast ] compile-call ] unit-test
|
||||
|
||||
[ 6 ] [ 2 3 [ fixnum* ] compile-1 ] unit-test
|
||||
[ 6 ] [ 2 [ 3 fixnum* ] compile-1 ] unit-test
|
||||
[ 6 ] [ [ 2 3 fixnum* ] compile-1 ] unit-test
|
||||
[ -6 ] [ 2 -3 [ fixnum* ] compile-1 ] unit-test
|
||||
[ -6 ] [ 2 [ -3 fixnum* ] compile-1 ] unit-test
|
||||
[ -6 ] [ [ 2 -3 fixnum* ] compile-1 ] unit-test
|
||||
[ 6 ] [ 2 3 [ fixnum* ] compile-call ] unit-test
|
||||
[ 6 ] [ 2 [ 3 fixnum* ] compile-call ] unit-test
|
||||
[ 6 ] [ [ 2 3 fixnum* ] compile-call ] unit-test
|
||||
[ -6 ] [ 2 -3 [ fixnum* ] compile-call ] unit-test
|
||||
[ -6 ] [ 2 [ -3 fixnum* ] compile-call ] unit-test
|
||||
[ -6 ] [ [ 2 -3 fixnum* ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 3 type 3 [ type ] compile-1 eq? ] unit-test
|
||||
[ t ] [ 3 >bignum type 3 >bignum [ type ] compile-1 eq? ] unit-test
|
||||
[ t ] [ "hey" type "hey" [ type ] compile-1 eq? ] unit-test
|
||||
[ t ] [ f type f [ type ] compile-1 eq? ] unit-test
|
||||
[ t ] [ 3 type 3 [ type ] compile-call eq? ] unit-test
|
||||
[ t ] [ 3 >bignum type 3 >bignum [ type ] compile-call eq? ] unit-test
|
||||
[ t ] [ "hey" type "hey" [ type ] compile-call eq? ] unit-test
|
||||
[ t ] [ f type f [ type ] compile-call eq? ] unit-test
|
||||
|
||||
[ 5 ] [ 1 2 [ eq? [ 3 ] [ 5 ] if ] compile-1 ] unit-test
|
||||
[ 3 ] [ 2 2 [ eq? [ 3 ] [ 5 ] if ] compile-1 ] unit-test
|
||||
[ 3 ] [ 1 2 [ fixnum< [ 3 ] [ 5 ] if ] compile-1 ] unit-test
|
||||
[ 5 ] [ 2 2 [ fixnum< [ 3 ] [ 5 ] if ] compile-1 ] unit-test
|
||||
[ 5 ] [ 1 2 [ eq? [ 3 ] [ 5 ] if ] compile-call ] unit-test
|
||||
[ 3 ] [ 2 2 [ eq? [ 3 ] [ 5 ] if ] compile-call ] unit-test
|
||||
[ 3 ] [ 1 2 [ fixnum< [ 3 ] [ 5 ] if ] compile-call ] unit-test
|
||||
[ 5 ] [ 2 2 [ fixnum< [ 3 ] [ 5 ] if ] compile-call ] unit-test
|
||||
|
||||
[ 8 ] [ 1 3 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ 8 ] [ 1 [ 3 fixnum-shift ] compile-1 ] unit-test
|
||||
[ 8 ] [ [ 1 3 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -8 ] [ -1 3 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ -8 ] [ -1 [ 3 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -8 ] [ [ -1 3 fixnum-shift ] compile-1 ] unit-test
|
||||
[ 8 ] [ 1 3 [ fixnum-shift ] compile-call ] unit-test
|
||||
[ 8 ] [ 1 [ 3 fixnum-shift ] compile-call ] unit-test
|
||||
[ 8 ] [ [ 1 3 fixnum-shift ] compile-call ] unit-test
|
||||
[ -8 ] [ -1 3 [ fixnum-shift ] compile-call ] unit-test
|
||||
[ -8 ] [ -1 [ 3 fixnum-shift ] compile-call ] unit-test
|
||||
[ -8 ] [ [ -1 3 fixnum-shift ] compile-call ] unit-test
|
||||
|
||||
[ 2 ] [ 8 -2 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ 2 ] [ 8 [ -2 fixnum-shift ] compile-1 ] unit-test
|
||||
[ 2 ] [ 8 -2 [ fixnum-shift ] compile-call ] unit-test
|
||||
[ 2 ] [ 8 [ -2 fixnum-shift ] compile-call ] unit-test
|
||||
|
||||
[ 0 ] [ [ 123 -64 fixnum-shift ] compile-1 ] unit-test
|
||||
[ 0 ] [ 123 -64 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ -1 ] [ [ -123 -64 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -1 ] [ -123 -64 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ 0 ] [ [ 123 -64 fixnum-shift ] compile-call ] unit-test
|
||||
[ 0 ] [ 123 -64 [ fixnum-shift ] compile-call ] unit-test
|
||||
[ -1 ] [ [ -123 -64 fixnum-shift ] compile-call ] unit-test
|
||||
[ -1 ] [ -123 -64 [ fixnum-shift ] compile-call ] unit-test
|
||||
|
||||
[ HEX: 10000000 ] [ HEX: -10000000 >fixnum [ 0 swap fixnum- ] compile-1 ] unit-test
|
||||
[ HEX: 10000000 ] [ HEX: -fffffff >fixnum [ 1 swap fixnum- ] compile-1 ] unit-test
|
||||
[ HEX: 10000000 ] [ HEX: -10000000 >fixnum [ 0 swap fixnum- ] compile-call ] unit-test
|
||||
[ HEX: 10000000 ] [ HEX: -fffffff >fixnum [ 1 swap fixnum- ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 1 27 fixnum-shift dup [ fixnum+ ] compile-1 1 28 fixnum-shift = ] unit-test
|
||||
[ -268435457 ] [ 1 28 shift neg >fixnum [ -1 fixnum+ ] compile-1 ] unit-test
|
||||
[ t ] [ 1 27 fixnum-shift dup [ fixnum+ ] compile-call 1 28 fixnum-shift = ] unit-test
|
||||
[ -268435457 ] [ 1 28 shift neg >fixnum [ -1 fixnum+ ] compile-call ] unit-test
|
||||
|
||||
[ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-1 ] unit-test
|
||||
[ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -4294967296 ] [ -1 32 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
|
||||
[ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-call ] unit-test
|
||||
[ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-call ] unit-test
|
||||
[ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
|
||||
[ -4294967296 ] [ -1 32 [ fixnum-shift ] compile-call ] unit-test
|
||||
[ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-call ] unit-test
|
||||
[ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 1 20 shift 1 20 shift [ fixnum* ] compile-1 1 40 shift = ] unit-test
|
||||
[ t ] [ 1 20 shift neg 1 20 shift [ fixnum* ] compile-1 1 40 shift neg = ] unit-test
|
||||
[ t ] [ 1 20 shift neg 1 20 shift neg [ fixnum* ] compile-1 1 40 shift = ] unit-test
|
||||
[ -351382792 ] [ -43922849 [ 3 fixnum-shift ] compile-1 ] unit-test
|
||||
[ t ] [ 1 20 shift 1 20 shift [ fixnum* ] compile-call 1 40 shift = ] unit-test
|
||||
[ t ] [ 1 20 shift neg 1 20 shift [ fixnum* ] compile-call 1 40 shift neg = ] unit-test
|
||||
[ t ] [ 1 20 shift neg 1 20 shift neg [ fixnum* ] compile-call 1 40 shift = ] unit-test
|
||||
[ -351382792 ] [ -43922849 [ 3 fixnum-shift ] compile-call ] unit-test
|
||||
|
||||
[ 268435456 ] [ -268435456 >fixnum -1 [ fixnum/i ] compile-1 ] unit-test
|
||||
[ 268435456 ] [ -268435456 >fixnum -1 [ fixnum/i ] compile-call ] unit-test
|
||||
|
||||
[ 268435456 0 ] [ -268435456 >fixnum -1 [ fixnum/mod ] compile-1 ] unit-test
|
||||
[ 268435456 0 ] [ -268435456 >fixnum -1 [ fixnum/mod ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ f [ f eq? ] compile-1 ] unit-test
|
||||
[ t ] [ f [ f eq? ] compile-call ] unit-test
|
||||
|
||||
! regression
|
||||
[ t ] [ { 1 2 3 } { 1 2 3 } [ over type over type eq? ] compile-1 2nip ] unit-test
|
||||
[ t ] [ { 1 2 3 } { 1 2 3 } [ over type over type eq? ] compile-call 2nip ] unit-test
|
||||
|
||||
! regression
|
||||
[ 3 ] [
|
||||
100001 f <array> 3 100000 pick set-nth
|
||||
[ 100000 swap array-nth ] compile-1
|
||||
[ 100000 swap array-nth ] compile-call
|
||||
] unit-test
|
||||
|
||||
! 64-bit overflow
|
||||
cell 8 = [
|
||||
[ t ] [ 1 59 fixnum-shift dup [ fixnum+ ] compile-1 1 60 fixnum-shift = ] unit-test
|
||||
[ -1152921504606846977 ] [ 1 60 shift neg >fixnum [ -1 fixnum+ ] compile-1 ] unit-test
|
||||
[ t ] [ 1 59 fixnum-shift dup [ fixnum+ ] compile-call 1 60 fixnum-shift = ] unit-test
|
||||
[ -1152921504606846977 ] [ 1 60 shift neg >fixnum [ -1 fixnum+ ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 1 40 shift 1 40 shift [ fixnum* ] compile-1 1 80 shift = ] unit-test
|
||||
[ t ] [ 1 40 shift neg 1 40 shift [ fixnum* ] compile-1 1 80 shift neg = ] unit-test
|
||||
[ t ] [ 1 40 shift neg 1 40 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
|
||||
[ t ] [ 1 30 shift neg 1 50 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
|
||||
[ t ] [ 1 50 shift neg 1 30 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
|
||||
[ t ] [ 1 40 shift 1 40 shift [ fixnum* ] compile-call 1 80 shift = ] unit-test
|
||||
[ t ] [ 1 40 shift neg 1 40 shift [ fixnum* ] compile-call 1 80 shift neg = ] unit-test
|
||||
[ t ] [ 1 40 shift neg 1 40 shift neg [ fixnum* ] compile-call 1 80 shift = ] unit-test
|
||||
[ t ] [ 1 30 shift neg 1 50 shift neg [ fixnum* ] compile-call 1 80 shift = ] unit-test
|
||||
[ t ] [ 1 50 shift neg 1 30 shift neg [ fixnum* ] compile-call 1 80 shift = ] unit-test
|
||||
|
||||
[ 18446744073709551616 ] [ 1 64 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ 18446744073709551616 ] [ 1 [ 64 fixnum-shift ] compile-1 ] unit-test
|
||||
[ 18446744073709551616 ] [ 1 [ 32 fixnum-shift 32 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -18446744073709551616 ] [ -1 64 [ fixnum-shift ] compile-1 ] unit-test
|
||||
[ -18446744073709551616 ] [ -1 [ 64 fixnum-shift ] compile-1 ] unit-test
|
||||
[ -18446744073709551616 ] [ -1 [ 32 fixnum-shift 32 fixnum-shift ] compile-1 ] unit-test
|
||||
[ 18446744073709551616 ] [ 1 64 [ fixnum-shift ] compile-call ] unit-test
|
||||
[ 18446744073709551616 ] [ 1 [ 64 fixnum-shift ] compile-call ] unit-test
|
||||
[ 18446744073709551616 ] [ 1 [ 32 fixnum-shift 32 fixnum-shift ] compile-call ] unit-test
|
||||
[ -18446744073709551616 ] [ -1 64 [ fixnum-shift ] compile-call ] unit-test
|
||||
[ -18446744073709551616 ] [ -1 [ 64 fixnum-shift ] compile-call ] unit-test
|
||||
[ -18446744073709551616 ] [ -1 [ 32 fixnum-shift 32 fixnum-shift ] compile-call ] unit-test
|
||||
|
||||
[ 1152921504606846976 ] [ -1152921504606846976 >fixnum -1 [ fixnum/i ] compile-1 ] unit-test
|
||||
[ 1152921504606846976 ] [ -1152921504606846976 >fixnum -1 [ fixnum/i ] compile-call ] unit-test
|
||||
|
||||
[ 1152921504606846976 0 ] [ -1152921504606846976 >fixnum -1 [ fixnum/mod ] compile-1 ] unit-test
|
||||
[ 1152921504606846976 0 ] [ -1152921504606846976 >fixnum -1 [ fixnum/mod ] compile-call ] unit-test
|
||||
|
||||
[ -268435457 ] [ 28 2^ [ fixnum-bitnot ] compile-1 ] unit-test
|
||||
[ -268435457 ] [ 28 2^ [ fixnum-bitnot ] compile-call ] unit-test
|
||||
] when
|
||||
|
||||
! Some randomized tests
|
||||
: compiled-fixnum* fixnum* ;
|
||||
\ compiled-fixnum* compile
|
||||
|
||||
: test-fixnum*
|
||||
(random) >fixnum (random) >fixnum
|
||||
|
|
@ -269,7 +268,6 @@ cell 8 = [
|
|||
[ ] [ 10000 [ test-fixnum* ] times ] unit-test
|
||||
|
||||
: compiled-fixnum>bignum fixnum>bignum ;
|
||||
\ compiled-fixnum>bignum compile
|
||||
|
||||
: test-fixnum>bignum
|
||||
(random) >fixnum
|
||||
|
|
@ -279,7 +277,6 @@ cell 8 = [
|
|||
[ ] [ 10000 [ test-fixnum>bignum ] times ] unit-test
|
||||
|
||||
: compiled-bignum>fixnum bignum>fixnum ;
|
||||
\ compiled-bignum>fixnum compile
|
||||
|
||||
: test-bignum>fixnum
|
||||
5 random [ drop (random) ] map product >bignum
|
||||
|
|
@ -292,84 +289,84 @@ cell 8 = [
|
|||
[ t ] [
|
||||
most-positive-fixnum 100 - >fixnum
|
||||
200
|
||||
[ [ fixnum+ ] compile-1 [ bignum>fixnum ] compile-1 ] 2keep
|
||||
[ fixnum+ >fixnum ] compile-1
|
||||
[ [ fixnum+ ] compile-call [ bignum>fixnum ] compile-call ] 2keep
|
||||
[ fixnum+ >fixnum ] compile-call
|
||||
=
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
most-negative-fixnum 100 + >fixnum
|
||||
-200
|
||||
[ [ fixnum+ ] compile-1 [ bignum>fixnum ] compile-1 ] 2keep
|
||||
[ fixnum+ >fixnum ] compile-1
|
||||
[ [ fixnum+ ] compile-call [ bignum>fixnum ] compile-call ] 2keep
|
||||
[ fixnum+ >fixnum ] compile-call
|
||||
=
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
most-negative-fixnum 100 + >fixnum
|
||||
200
|
||||
[ [ fixnum- ] compile-1 [ bignum>fixnum ] compile-1 ] 2keep
|
||||
[ fixnum- >fixnum ] compile-1
|
||||
[ [ fixnum- ] compile-call [ bignum>fixnum ] compile-call ] 2keep
|
||||
[ fixnum- >fixnum ] compile-call
|
||||
=
|
||||
] unit-test
|
||||
|
||||
! Test inline allocators
|
||||
[ { 1 1 1 } ] [
|
||||
[ 3 1 <array> ] compile-1
|
||||
[ 3 1 <array> ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ B{ 0 0 0 } ] [
|
||||
[ 3 <byte-array> ] compile-1
|
||||
[ 3 <byte-array> ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 500 ] [
|
||||
[ 500 <byte-array> length ] compile-1
|
||||
[ 500 <byte-array> length ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 1 2 ] [
|
||||
1 2 [ <complex> ] compile-1 dup real swap imaginary
|
||||
1 2 [ <complex> ] compile-call dup real swap imaginary
|
||||
] unit-test
|
||||
|
||||
[ 1 2 ] [
|
||||
1 2 [ <ratio> ] compile-1 dup numerator swap denominator
|
||||
1 2 [ <ratio> ] compile-call dup numerator swap denominator
|
||||
] unit-test
|
||||
|
||||
[ \ + ] [ \ + [ <wrapper> ] compile-1 ] unit-test
|
||||
[ \ + ] [ \ + [ <wrapper> ] compile-call ] unit-test
|
||||
|
||||
[ H{ } ] [
|
||||
100 [ (hashtable) ] compile-1 [ reset-hash ] keep
|
||||
100 [ (hashtable) ] compile-call [ reset-hash ] keep
|
||||
] unit-test
|
||||
|
||||
[ B{ 0 0 0 0 0 } ] [
|
||||
[ 5 <byte-array> ] compile-1
|
||||
[ 5 <byte-array> ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ V{ 1 2 } ] [
|
||||
{ 1 2 3 } 2 [ array>vector ] compile-1
|
||||
{ 1 2 3 } 2 [ array>vector ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ SBUF" hello" ] [
|
||||
"hello world" 5 [ string>sbuf ] compile-1
|
||||
"hello world" 5 [ string>sbuf ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ [ 3 + ] ] [
|
||||
3 [ + ] [ curry ] compile-1
|
||||
3 [ + ] [ curry ] compile-call
|
||||
] unit-test
|
||||
|
||||
! Alien intrinsics
|
||||
[ 3 ] [ B{ 1 2 3 4 5 } 2 [ alien-unsigned-1 ] compile-1 ] unit-test
|
||||
[ 3 ] [ [ B{ 1 2 3 4 5 } 2 alien-unsigned-1 ] compile-1 ] unit-test
|
||||
[ 3 ] [ B{ 1 2 3 4 5 } 2 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test
|
||||
[ 3 ] [ B{ 1 2 3 4 5 } 2 [ { c-ptr fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test
|
||||
[ 3 ] [ B{ 1 2 3 4 5 } 2 [ alien-unsigned-1 ] compile-call ] unit-test
|
||||
[ 3 ] [ [ B{ 1 2 3 4 5 } 2 alien-unsigned-1 ] compile-call ] unit-test
|
||||
[ 3 ] [ B{ 1 2 3 4 5 } 2 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
|
||||
[ 3 ] [ B{ 1 2 3 4 5 } 2 [ { c-ptr fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
|
||||
|
||||
[ ] [ B{ 1 2 3 4 5 } malloc-byte-array "b" set ] unit-test
|
||||
[ t ] [ "b" get >boolean ] unit-test
|
||||
|
||||
"b" get [
|
||||
[ 3 ] [ "b" get 2 [ alien-unsigned-1 ] compile-1 ] unit-test
|
||||
[ 3 ] [ "b" get [ { alien } declare 2 alien-unsigned-1 ] compile-1 ] unit-test
|
||||
[ 3 ] [ "b" get 2 [ { simple-alien fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test
|
||||
[ 3 ] [ "b" get 2 [ { c-ptr fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test
|
||||
[ 3 ] [ "b" get 2 [ alien-unsigned-1 ] compile-call ] unit-test
|
||||
[ 3 ] [ "b" get [ { alien } declare 2 alien-unsigned-1 ] compile-call ] unit-test
|
||||
[ 3 ] [ "b" get 2 [ { simple-alien fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
|
||||
[ 3 ] [ "b" get 2 [ { c-ptr fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
|
||||
|
||||
[ ] [ "b" get free ] unit-test
|
||||
] when
|
||||
|
|
@ -377,61 +374,61 @@ cell 8 = [
|
|||
[ ] [ "hello world" malloc-char-string "s" set ] unit-test
|
||||
|
||||
"s" get [
|
||||
[ "hello world" ] [ "s" get <void*> [ { byte-array } declare *void* ] compile-1 alien>char-string ] unit-test
|
||||
[ "hello world" ] [ "s" get <void*> [ { c-ptr } declare *void* ] compile-1 alien>char-string ] unit-test
|
||||
[ "hello world" ] [ "s" get <void*> [ { byte-array } declare *void* ] compile-call alien>char-string ] unit-test
|
||||
[ "hello world" ] [ "s" get <void*> [ { c-ptr } declare *void* ] compile-call alien>char-string ] unit-test
|
||||
|
||||
[ ] [ "s" get free ] unit-test
|
||||
] when
|
||||
|
||||
[ ALIEN: 1234 ] [ ALIEN: 1234 [ { alien } declare <void*> ] compile-1 *void* ] unit-test
|
||||
[ ALIEN: 1234 ] [ ALIEN: 1234 [ { c-ptr } declare <void*> ] compile-1 *void* ] unit-test
|
||||
[ f ] [ f [ { POSTPONE: f } declare <void*> ] compile-1 *void* ] unit-test
|
||||
[ ALIEN: 1234 ] [ ALIEN: 1234 [ { alien } declare <void*> ] compile-call *void* ] unit-test
|
||||
[ ALIEN: 1234 ] [ ALIEN: 1234 [ { c-ptr } declare <void*> ] compile-call *void* ] unit-test
|
||||
[ f ] [ f [ { POSTPONE: f } declare <void*> ] compile-call *void* ] unit-test
|
||||
|
||||
[ 252 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test
|
||||
[ -4 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-1 ] unit-test
|
||||
[ 252 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
|
||||
[ -4 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-call ] unit-test
|
||||
|
||||
: xword-def word-def [ { fixnum } declare ] swap append ;
|
||||
|
||||
[ -100 ] [ -100 <char> [ { byte-array } declare *char ] compile-1 ] unit-test
|
||||
[ 156 ] [ -100 <uchar> [ { byte-array } declare *uchar ] compile-1 ] unit-test
|
||||
[ -100 ] [ -100 <char> [ { byte-array } declare *char ] compile-call ] unit-test
|
||||
[ 156 ] [ -100 <uchar> [ { byte-array } declare *uchar ] compile-call ] unit-test
|
||||
|
||||
[ -100 ] [ -100 \ <char> xword-def compile-1 *char ] unit-test
|
||||
[ 156 ] [ -100 \ <uchar> xword-def compile-1 *uchar ] unit-test
|
||||
[ -100 ] [ -100 \ <char> xword-def compile-call *char ] unit-test
|
||||
[ 156 ] [ -100 \ <uchar> xword-def compile-call *uchar ] unit-test
|
||||
|
||||
[ -1000 ] [ -1000 <short> [ { byte-array } declare *short ] compile-1 ] unit-test
|
||||
[ 64536 ] [ -1000 <ushort> [ { byte-array } declare *ushort ] compile-1 ] unit-test
|
||||
[ -1000 ] [ -1000 <short> [ { byte-array } declare *short ] compile-call ] unit-test
|
||||
[ 64536 ] [ -1000 <ushort> [ { byte-array } declare *ushort ] compile-call ] unit-test
|
||||
|
||||
[ -1000 ] [ -1000 \ <short> xword-def compile-1 *short ] unit-test
|
||||
[ 64536 ] [ -1000 \ <ushort> xword-def compile-1 *ushort ] unit-test
|
||||
[ -1000 ] [ -1000 \ <short> xword-def compile-call *short ] unit-test
|
||||
[ 64536 ] [ -1000 \ <ushort> xword-def compile-call *ushort ] unit-test
|
||||
|
||||
[ -100000 ] [ -100000 <int> [ { byte-array } declare *int ] compile-1 ] unit-test
|
||||
[ 4294867296 ] [ -100000 <uint> [ { byte-array } declare *uint ] compile-1 ] unit-test
|
||||
[ -100000 ] [ -100000 <int> [ { byte-array } declare *int ] compile-call ] unit-test
|
||||
[ 4294867296 ] [ -100000 <uint> [ { byte-array } declare *uint ] compile-call ] unit-test
|
||||
|
||||
[ -100000 ] [ -100000 \ <int> xword-def compile-1 *int ] unit-test
|
||||
[ 4294867296 ] [ -100000 \ <uint> xword-def compile-1 *uint ] unit-test
|
||||
[ -100000 ] [ -100000 \ <int> xword-def compile-call *int ] unit-test
|
||||
[ 4294867296 ] [ -100000 \ <uint> xword-def compile-call *uint ] unit-test
|
||||
|
||||
[ t ] [ pi pi <double> *double = ] unit-test
|
||||
|
||||
[ t ] [ pi <double> [ { byte-array } declare *double ] compile-1 pi = ] unit-test
|
||||
[ t ] [ pi <double> [ { byte-array } declare *double ] compile-call pi = ] unit-test
|
||||
|
||||
! Silly
|
||||
[ t ] [ pi 4 <byte-array> [ [ { float byte-array } declare 0 set-alien-float ] compile-1 ] keep *float pi - -0.001 0.001 between? ] unit-test
|
||||
[ t ] [ pi <float> [ { byte-array } declare *float ] compile-1 pi - -0.001 0.001 between? ] unit-test
|
||||
[ t ] [ pi 4 <byte-array> [ [ { float byte-array } declare 0 set-alien-float ] compile-call ] keep *float pi - -0.001 0.001 between? ] unit-test
|
||||
[ t ] [ pi <float> [ { byte-array } declare *float ] compile-call pi - -0.001 0.001 between? ] unit-test
|
||||
|
||||
[ t ] [ pi 8 <byte-array> [ [ { float byte-array } declare 0 set-alien-double ] compile-1 ] keep *double pi = ] unit-test
|
||||
[ t ] [ pi 8 <byte-array> [ [ { float byte-array } declare 0 set-alien-double ] compile-call ] keep *double pi = ] unit-test
|
||||
|
||||
[ 4 ] [
|
||||
2 B{ 1 2 3 4 5 6 } <displaced-alien> [
|
||||
{ alien } declare 1 alien-unsigned-1
|
||||
] compile-1
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
||||
[
|
||||
B{ 0 0 0 0 } [ { byte-array } declare <void*> ] compile-1
|
||||
B{ 0 0 0 0 } [ { byte-array } declare <void*> ] compile-call
|
||||
] unit-test-fails
|
||||
|
||||
[
|
||||
B{ 0 0 0 0 } [ { c-ptr } declare <void*> ] compile-1
|
||||
B{ 0 0 0 0 } [ { c-ptr } declare <void*> ] compile-call
|
||||
] unit-test-fails
|
||||
|
||||
[
|
||||
|
|
@ -441,5 +438,5 @@ cell 8 = [
|
|||
[
|
||||
{ [ 4444 ] [ 444 ] [ 44 ] [ 4 ] } dispatch
|
||||
] keep 2 fixnum+fast
|
||||
] compile-1
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -50,7 +50,7 @@ FORGET: xyz
|
|||
GENERIC: xyz ( obj -- obj )
|
||||
M: array xyz xyz ;
|
||||
|
||||
[ ] [ \ xyz compile ] unit-test
|
||||
[ t ] [ \ xyz compiled? ] unit-test
|
||||
|
||||
! Test predicate inlining
|
||||
: pred-test-1
|
||||
|
|
@ -135,7 +135,7 @@ TUPLE: pred-test ;
|
|||
! regression
|
||||
GENERIC: void-generic ( obj -- * )
|
||||
: breakage "hi" void-generic ;
|
||||
[ ] [ \ breakage compile ] unit-test
|
||||
[ t ] [ \ breakage compiled? ] unit-test
|
||||
[ breakage ] unit-test-fails
|
||||
|
||||
! regression
|
||||
|
|
@ -156,7 +156,7 @@ GENERIC: void-generic ( obj -- * )
|
|||
! another regression
|
||||
: constant-branch-fold-0 "hey" ; foldable
|
||||
: constant-branch-fold-1 constant-branch-fold-0 "hey" = ; inline
|
||||
[ 1 ] [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-1 ] unit-test
|
||||
[ 1 ] [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-call ] unit-test
|
||||
|
||||
! another regression
|
||||
: foo f ;
|
||||
|
|
@ -184,71 +184,71 @@ M: slice foozul ;
|
|||
: constant-fold-3 4 ; foldable
|
||||
|
||||
[ f t ] [
|
||||
[ constant-fold-2 constant-fold-3 4 = ] compile-1
|
||||
[ constant-fold-2 constant-fold-3 4 = ] compile-call
|
||||
] unit-test
|
||||
|
||||
: constant-fold-4 f ; foldable
|
||||
: constant-fold-5 f ; foldable
|
||||
|
||||
[ f ] [
|
||||
[ constant-fold-4 constant-fold-5 or ] compile-1
|
||||
[ constant-fold-4 constant-fold-5 or ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 5 ] [ 5 [ 0 + ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ 0 swap + ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ 0 + ] compile-call ] unit-test
|
||||
[ 5 ] [ 5 [ 0 swap + ] compile-call ] unit-test
|
||||
|
||||
[ 5 ] [ 5 [ 0 - ] compile-1 ] unit-test
|
||||
[ -5 ] [ 5 [ 0 swap - ] compile-1 ] unit-test
|
||||
[ 0 ] [ 5 [ dup - ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ 0 - ] compile-call ] unit-test
|
||||
[ -5 ] [ 5 [ 0 swap - ] compile-call ] unit-test
|
||||
[ 0 ] [ 5 [ dup - ] compile-call ] unit-test
|
||||
|
||||
[ 5 ] [ 5 [ 1 * ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ 1 swap * ] compile-1 ] unit-test
|
||||
[ 0 ] [ 5 [ 0 * ] compile-1 ] unit-test
|
||||
[ 0 ] [ 5 [ 0 swap * ] compile-1 ] unit-test
|
||||
[ -5 ] [ 5 [ -1 * ] compile-1 ] unit-test
|
||||
[ -5 ] [ 5 [ -1 swap * ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ 1 * ] compile-call ] unit-test
|
||||
[ 5 ] [ 5 [ 1 swap * ] compile-call ] unit-test
|
||||
[ 0 ] [ 5 [ 0 * ] compile-call ] unit-test
|
||||
[ 0 ] [ 5 [ 0 swap * ] compile-call ] unit-test
|
||||
[ -5 ] [ 5 [ -1 * ] compile-call ] unit-test
|
||||
[ -5 ] [ 5 [ -1 swap * ] compile-call ] unit-test
|
||||
|
||||
[ 0 ] [ 5 [ 1 mod ] compile-1 ] unit-test
|
||||
[ 0 ] [ 5 [ 1 rem ] compile-1 ] unit-test
|
||||
[ 0 ] [ 5 [ 1 mod ] compile-call ] unit-test
|
||||
[ 0 ] [ 5 [ 1 rem ] compile-call ] unit-test
|
||||
|
||||
[ 5 ] [ 5 [ -1 bitand ] compile-1 ] unit-test
|
||||
[ 0 ] [ 5 [ 0 bitand ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ -1 swap bitand ] compile-1 ] unit-test
|
||||
[ 0 ] [ 5 [ 0 swap bitand ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ dup bitand ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ -1 bitand ] compile-call ] unit-test
|
||||
[ 0 ] [ 5 [ 0 bitand ] compile-call ] unit-test
|
||||
[ 5 ] [ 5 [ -1 swap bitand ] compile-call ] unit-test
|
||||
[ 0 ] [ 5 [ 0 swap bitand ] compile-call ] unit-test
|
||||
[ 5 ] [ 5 [ dup bitand ] compile-call ] unit-test
|
||||
|
||||
[ 5 ] [ 5 [ 0 bitor ] compile-1 ] unit-test
|
||||
[ -1 ] [ 5 [ -1 bitor ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ 0 swap bitor ] compile-1 ] unit-test
|
||||
[ -1 ] [ 5 [ -1 swap bitor ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ dup bitor ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ 0 bitor ] compile-call ] unit-test
|
||||
[ -1 ] [ 5 [ -1 bitor ] compile-call ] unit-test
|
||||
[ 5 ] [ 5 [ 0 swap bitor ] compile-call ] unit-test
|
||||
[ -1 ] [ 5 [ -1 swap bitor ] compile-call ] unit-test
|
||||
[ 5 ] [ 5 [ dup bitor ] compile-call ] unit-test
|
||||
|
||||
[ 5 ] [ 5 [ 0 bitxor ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ 0 swap bitxor ] compile-1 ] unit-test
|
||||
[ -6 ] [ 5 [ -1 bitxor ] compile-1 ] unit-test
|
||||
[ -6 ] [ 5 [ -1 swap bitxor ] compile-1 ] unit-test
|
||||
[ 0 ] [ 5 [ dup bitxor ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ 0 bitxor ] compile-call ] unit-test
|
||||
[ 5 ] [ 5 [ 0 swap bitxor ] compile-call ] unit-test
|
||||
[ -6 ] [ 5 [ -1 bitxor ] compile-call ] unit-test
|
||||
[ -6 ] [ 5 [ -1 swap bitxor ] compile-call ] unit-test
|
||||
[ 0 ] [ 5 [ dup bitxor ] compile-call ] unit-test
|
||||
|
||||
[ 0 ] [ 5 [ 0 swap shift ] compile-1 ] unit-test
|
||||
[ 5 ] [ 5 [ 0 shift ] compile-1 ] unit-test
|
||||
[ 0 ] [ 5 [ 0 swap shift ] compile-call ] unit-test
|
||||
[ 5 ] [ 5 [ 0 shift ] compile-call ] unit-test
|
||||
|
||||
[ f ] [ 5 [ dup < ] compile-1 ] unit-test
|
||||
[ t ] [ 5 [ dup <= ] compile-1 ] unit-test
|
||||
[ f ] [ 5 [ dup > ] compile-1 ] unit-test
|
||||
[ t ] [ 5 [ dup >= ] compile-1 ] unit-test
|
||||
[ f ] [ 5 [ dup < ] compile-call ] unit-test
|
||||
[ t ] [ 5 [ dup <= ] compile-call ] unit-test
|
||||
[ f ] [ 5 [ dup > ] compile-call ] unit-test
|
||||
[ t ] [ 5 [ dup >= ] compile-call ] unit-test
|
||||
|
||||
[ t ] [ 5 [ dup eq? ] compile-1 ] unit-test
|
||||
[ t ] [ 5 [ dup = ] compile-1 ] unit-test
|
||||
[ t ] [ 5 [ dup number= ] compile-1 ] unit-test
|
||||
[ t ] [ \ vector [ \ vector = ] compile-1 ] unit-test
|
||||
[ t ] [ 5 [ dup eq? ] compile-call ] unit-test
|
||||
[ t ] [ 5 [ dup = ] compile-call ] unit-test
|
||||
[ t ] [ 5 [ dup number= ] compile-call ] unit-test
|
||||
[ t ] [ \ vector [ \ vector = ] compile-call ] unit-test
|
||||
|
||||
GENERIC: detect-number ( obj -- obj )
|
||||
M: number detect-number ;
|
||||
|
||||
[ 10 f [ <array> 0 + detect-number ] compile-1 ] unit-test-fails
|
||||
[ 10 f [ <array> 0 + detect-number ] compile-call ] unit-test-fails
|
||||
|
||||
! Regression
|
||||
[ 4 [ + ] ] [ 2 2 [ [ + ] [ call ] keep ] compile-1 ] unit-test
|
||||
[ 4 [ + ] ] [ 2 2 [ [ + ] [ call ] keep ] compile-call ] unit-test
|
||||
|
||||
! Regression
|
||||
USE: sorting
|
||||
|
|
@ -265,7 +265,7 @@ USE: sorting.private
|
|||
|
||||
[ 10 ] [
|
||||
10 20 >vector <flat-slice>
|
||||
[ [ - ] swap old-binsearch ] compile-1 2nip
|
||||
[ [ - ] swap old-binsearch ] compile-call 2nip
|
||||
] unit-test
|
||||
|
||||
! Regression
|
||||
|
|
@ -275,5 +275,5 @@ TUPLE: silly-tuple a b ;
|
|||
T{ silly-tuple f 1 2 }
|
||||
[
|
||||
{ silly-tuple-a silly-tuple-b } [ get-slots ] keep
|
||||
] compile-1
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -10,7 +10,6 @@ words splitting ;
|
|||
: foo 3 throw 7 ;
|
||||
: bar foo 4 ;
|
||||
: baz bar 5 ;
|
||||
\ baz compile
|
||||
[ 3 ] [ [ baz ] catch ] unit-test
|
||||
[ t ] [
|
||||
symbolic-stack-trace
|
||||
|
|
@ -19,7 +18,6 @@ words splitting ;
|
|||
] unit-test
|
||||
|
||||
: bleh [ 3 + ] map [ 0 > ] subset ;
|
||||
\ bleh compile
|
||||
|
||||
: stack-trace-contains? symbolic-stack-trace memq? ;
|
||||
|
||||
|
|
@ -34,7 +32,6 @@ words splitting ;
|
|||
] unit-test
|
||||
|
||||
: quux [ t [ "hi" throw ] when ] times ;
|
||||
\ quux compile
|
||||
|
||||
[ t ] [
|
||||
[ 10 quux ] catch drop
|
||||
|
|
|
|||
|
|
@ -7,48 +7,48 @@ combinators.private byte-arrays alien layouts ;
|
|||
IN: temporary
|
||||
|
||||
! Oops!
|
||||
[ 5000 ] [ [ 5000 ] compile-1 ] unit-test
|
||||
[ "hi" ] [ [ "hi" ] compile-1 ] unit-test
|
||||
[ 5000 ] [ [ 5000 ] compile-call ] unit-test
|
||||
[ "hi" ] [ [ "hi" ] compile-call ] unit-test
|
||||
|
||||
[ 1 2 3 4 ] [ [ 1 2 3 4 ] compile-1 ] unit-test
|
||||
[ 1 2 3 4 ] [ [ 1 2 3 4 ] compile-call ] unit-test
|
||||
|
||||
[ 1 1 ] [ 1 [ dup ] compile-1 ] unit-test
|
||||
[ 0 ] [ 3 [ tag ] compile-1 ] unit-test
|
||||
[ 0 3 ] [ 3 [ [ tag ] keep ] compile-1 ] unit-test
|
||||
[ 1 1 ] [ 1 [ dup ] compile-call ] unit-test
|
||||
[ 0 ] [ 3 [ tag ] compile-call ] unit-test
|
||||
[ 0 3 ] [ 3 [ [ tag ] keep ] compile-call ] unit-test
|
||||
|
||||
[ 2 3 ] [ 3 [ 2 swap ] compile-1 ] unit-test
|
||||
[ 2 3 ] [ 3 [ 2 swap ] compile-call ] unit-test
|
||||
|
||||
[ 2 1 3 4 ] [ 1 2 [ swap 3 4 ] compile-1 ] unit-test
|
||||
[ 2 1 3 4 ] [ 1 2 [ swap 3 4 ] compile-call ] unit-test
|
||||
|
||||
[ 2 3 4 ] [ 3 [ 2 swap 4 ] compile-1 ] unit-test
|
||||
[ 2 3 4 ] [ 3 [ 2 swap 4 ] compile-call ] unit-test
|
||||
|
||||
[ { 1 2 3 } { 1 4 3 } 3 3 ]
|
||||
[ { 1 2 3 } { 1 4 3 } [ over tag over tag ] compile-1 ]
|
||||
[ { 1 2 3 } { 1 4 3 } [ over tag over tag ] compile-call ]
|
||||
unit-test
|
||||
|
||||
[ { 1 2 3 } { 1 4 3 } 8 8 ]
|
||||
[ { 1 2 3 } { 1 4 3 } [ over type over type ] compile-1 ]
|
||||
[ { 1 2 3 } { 1 4 3 } [ over type over type ] compile-call ]
|
||||
unit-test
|
||||
|
||||
! Test literals in either side of a shuffle
|
||||
[ 4 1 ] [ 1 [ [ 3 fixnum+ ] keep ] compile-1 ] unit-test
|
||||
[ 4 1 ] [ 1 [ [ 3 fixnum+ ] keep ] compile-call ] unit-test
|
||||
|
||||
[ 2 ] [ 1 2 [ swap fixnum/i ] compile-1 ] unit-test
|
||||
[ 2 ] [ 1 2 [ swap fixnum/i ] compile-call ] unit-test
|
||||
|
||||
: foo ;
|
||||
|
||||
[ 5 5 ]
|
||||
[ 1.2 [ tag [ foo ] keep ] compile-1 ]
|
||||
[ 1.2 [ tag [ foo ] keep ] compile-call ]
|
||||
unit-test
|
||||
|
||||
[ 1 2 2 ]
|
||||
[ { 1 2 } [ dup 2 slot swap 3 slot [ foo ] keep ] compile-1 ]
|
||||
[ { 1 2 } [ dup 2 slot swap 3 slot [ foo ] keep ] compile-call ]
|
||||
unit-test
|
||||
|
||||
[ 3 ]
|
||||
[
|
||||
global [ 3 \ foo set ] bind
|
||||
\ foo [ global >n get ndrop ] compile-1
|
||||
\ foo [ global >n get ndrop ] compile-call
|
||||
] unit-test
|
||||
|
||||
: blech drop ;
|
||||
|
|
@ -56,48 +56,48 @@ unit-test
|
|||
[ 3 ]
|
||||
[
|
||||
global [ 3 \ foo set ] bind
|
||||
\ foo [ global [ get ] swap blech call ] compile-1
|
||||
\ foo [ global [ get ] swap blech call ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 3 ]
|
||||
[
|
||||
global [ 3 \ foo set ] bind
|
||||
\ foo [ global [ get ] swap >n call ndrop ] compile-1
|
||||
\ foo [ global [ get ] swap >n call ndrop ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 3 ]
|
||||
[
|
||||
global [ 3 \ foo set ] bind
|
||||
\ foo [ global [ get ] bind ] compile-1
|
||||
\ foo [ global [ get ] bind ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 12 13 ] [
|
||||
-12 -13 [ [ 0 swap fixnum-fast ] 2apply ] compile-1
|
||||
-12 -13 [ [ 0 swap fixnum-fast ] 2apply ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ -1 2 ] [ 1 2 [ >r 0 swap fixnum- r> ] compile-1 ] unit-test
|
||||
[ -1 2 ] [ 1 2 [ >r 0 swap fixnum- r> ] compile-call ] unit-test
|
||||
|
||||
[ 12 13 ] [
|
||||
-12 -13 [ [ 0 swap fixnum- ] 2apply ] compile-1
|
||||
-12 -13 [ [ 0 swap fixnum- ] 2apply ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 2 ] [
|
||||
SBUF" " [ 2 slot 2 [ slot ] keep ] compile-1 nip
|
||||
SBUF" " [ 2 slot 2 [ slot ] keep ] compile-call nip
|
||||
] unit-test
|
||||
|
||||
! Test slow shuffles
|
||||
[ 3 1 2 3 4 5 6 7 8 9 ] [
|
||||
1 2 3 4 5 6 7 8 9
|
||||
[ >r >r >r >r >r >r >r >r >r 3 r> r> r> r> r> r> r> r> r> ]
|
||||
compile-1
|
||||
compile-call
|
||||
] unit-test
|
||||
|
||||
[ 2 2 2 2 2 2 2 2 2 2 1 ] [
|
||||
1 2
|
||||
[ swap >r dup dup dup dup dup dup dup dup dup r> ] compile-1
|
||||
[ swap >r dup dup dup dup dup dup dup dup dup r> ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ ] [ [ 9 [ ] times ] compile-1 ] unit-test
|
||||
[ ] [ [ 9 [ ] times ] compile-call ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
|
|
@ -122,7 +122,7 @@ unit-test
|
|||
|
||||
[ 2.0 { 2.0 0.0 } ] [
|
||||
2.0 1.0
|
||||
[ float/f 0.0 [ drop (broken) ] 2keep 2array ] compile-1
|
||||
[ float/f 0.0 [ drop (broken) ] 2keep 2array ] compile-call
|
||||
] unit-test
|
||||
|
||||
! Regression
|
||||
|
|
@ -143,7 +143,7 @@ unit-test
|
|||
|
||||
[ ] [
|
||||
H{ { 1 2 } { 3 4 } } dup hash-array
|
||||
[ 0 swap hellish-bug-2 drop ] compile-1
|
||||
[ 0 swap hellish-bug-2 drop ] compile-call
|
||||
] unit-test
|
||||
|
||||
! Regression
|
||||
|
|
@ -160,34 +160,34 @@ TUPLE: my-tuple ;
|
|||
[ 5 ] [ "hi" foox ] unit-test
|
||||
|
||||
! Making sure we don't needlessly unbox/rebox
|
||||
[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ >r eq? r> ] compile-1 ] unit-test
|
||||
[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ >r eq? r> ] compile-call ] unit-test
|
||||
|
||||
[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-1 >r eq? r> ] unit-test
|
||||
[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call >r eq? r> ] unit-test
|
||||
|
||||
[ t ] [ 1.0 dup [ [ 2.0 float+ ] keep ] compile-1 nip eq? ] unit-test
|
||||
[ t ] [ 1.0 dup [ [ 2.0 float+ ] keep ] compile-call nip eq? ] unit-test
|
||||
|
||||
[ 1 B{ 1 2 3 4 } ] [
|
||||
B{ 1 2 3 4 } [
|
||||
{ byte-array } declare
|
||||
[ 0 alien-unsigned-1 ] keep
|
||||
] compile-1
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
||||
[ 1 t ] [
|
||||
B{ 1 2 3 4 } [
|
||||
{ c-ptr } declare
|
||||
[ 0 alien-unsigned-1 ] keep type
|
||||
] compile-1 byte-array type-number =
|
||||
] compile-call byte-array type-number =
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
B{ 1 2 3 4 } [
|
||||
{ c-ptr } declare
|
||||
0 alien-cell type
|
||||
] compile-1 alien type-number =
|
||||
] compile-call alien type-number =
|
||||
] unit-test
|
||||
|
||||
[ 2 1 ] [
|
||||
2 1
|
||||
[ 2dup fixnum< [ >r die r> ] when ] compile-1
|
||||
[ 2dup fixnum< [ >r die r> ] when ] compile-call
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -4,11 +4,11 @@ USING: kernel tools.test compiler ;
|
|||
TUPLE: color red green blue ;
|
||||
|
||||
[ T{ color f 1 2 3 } ]
|
||||
[ 1 2 3 [ color construct-boa ] compile-1 ] unit-test
|
||||
[ 1 2 3 [ color construct-boa ] compile-call ] unit-test
|
||||
|
||||
[ 1 3 ] [
|
||||
1 2 3 color construct-boa
|
||||
[ { color-red color-blue } get-slots ] compile-1
|
||||
[ { color-red color-blue } get-slots ] compile-call
|
||||
] unit-test
|
||||
|
||||
[ T{ color f 10 2 20 } ] [
|
||||
|
|
@ -16,17 +16,17 @@ TUPLE: color red green blue ;
|
|||
1 2 3 color construct-boa [
|
||||
[
|
||||
{ set-color-red set-color-blue } set-slots
|
||||
] compile-1
|
||||
] compile-call
|
||||
] keep
|
||||
] unit-test
|
||||
|
||||
[ T{ color f f f f } ]
|
||||
[ [ color construct-empty ] compile-1 ] unit-test
|
||||
[ [ color construct-empty ] compile-call ] unit-test
|
||||
|
||||
[ T{ color "a" f "b" f } ] [
|
||||
"a" "b"
|
||||
[ { set-delegate set-color-green } color construct ]
|
||||
compile-1
|
||||
compile-call
|
||||
] unit-test
|
||||
|
||||
[ T{ color f f f f } ] [ [ { } color construct ] compile-1 ] unit-test
|
||||
[ T{ color f f f f } ] [ [ { } color construct ] compile-call ] unit-test
|
||||
|
|
|
|||
|
|
@ -15,13 +15,13 @@ SYMBOL: compiled
|
|||
: begin-compiling ( word -- )
|
||||
f swap compiled get set-at ;
|
||||
|
||||
: finish-compiling ( word literals words rel labels code -- )
|
||||
: finish-compiling ( word literals words rel labels code profiler-prologue -- )
|
||||
6array swap compiled get set-at ;
|
||||
|
||||
: queue-compile ( word -- )
|
||||
{
|
||||
{ [ dup compound? not ] [ drop ] }
|
||||
{ [ dup compiled get key? ] [ drop ] }
|
||||
{ [ dup compound? not ] [ f swap compiled get set-at ] }
|
||||
{ [ t ] [ dup compile-queue get set-at ] }
|
||||
} cond ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue