use radix literals

[factor.git] / basis / compiler / tree / cleanup / cleanup-tests.factor

diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor
old mode 100755 (executable)
new mode 100644 (file)
index 228a4e3..a383b34
--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/basis/compiler/tree/cleanup/cleanup-tests.factor
@@ -1,12 +1,11 @@
-IN: compiler.tree.cleanup.tests
 USING: tools.test kernel.private kernel arrays sequences
 math.private math generic words quotations alien alien.c-types
-strings sbufs sequences.private slots.private combinators
-definitions system layouts vectors math.partial-dispatch
-math.order math.functions accessors hashtables classes assocs
-io.encodings.utf8 io.encodings.ascii io.encodings fry slots
-sorting.private combinators.short-circuit grouping prettyprint
-generalizations
+alien.data strings sbufs sequences.private slots.private
+combinators definitions system layouts vectors
+math.partial-dispatch math.order math.functions accessors
+hashtables classes assocs io.encodings.utf8 io.encodings.ascii
+io.encodings fry slots sorting.private combinators.short-circuit
+grouping prettyprint generalizations
 compiler.tree
 compiler.tree.combinators
 compiler.tree.cleanup
@@ -17,6 +16,9 @@ compiler.tree.propagation
 compiler.tree.propagation.info
 compiler.tree.checker
 compiler.tree.debugger ;
+FROM: math => float ;
+QUALIFIED-WITH: alien.c-types c
+IN: compiler.tree.cleanup.tests
 
 [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
 
@@ -41,13 +43,13 @@ compiler.tree.debugger ;
 
 GENERIC: mynot ( x -- y )
 
-M: f mynot drop t ;
+M: f mynot drop t ; inline
 
-M: object mynot drop f ;
+M: object mynot drop f ; inline
 
 GENERIC: detect-f ( x -- y )
 
-M: f detect-f ;
+M: f detect-f ; inline
 
 [ t ] [
     [ dup [ mynot ] [ ] if detect-f ] \ detect-f inlined?
@@ -55,9 +57,9 @@ M: f detect-f ;
 
 GENERIC: xyz ( n -- n )
 
-M: integer xyz ;
+M: integer xyz ; inline
 
-M: object xyz ;
+M: object xyz ; inline
 
 [ t ] [
     [ { integer } declare xyz ] \ xyz inlined?
@@ -88,7 +90,7 @@ M: object xyz ;
     2over dup xyz drop >= [
         3drop
     ] [
-        [ swap [ call 1+ ] dip ] keep (i-repeat)
+        [ swap [ call 1 + ] dip ] keep (i-repeat)
     ] if ; inline recursive
 
 : i-repeat ( n quot -- ) [ { integer } declare ] dip 0 -rot (i-repeat) ; inline
@@ -115,10 +117,6 @@ M: object xyz ;
     [ { fixnum } declare [ ] times ] \ >= inlined?
 ] unit-test
 
-[ t ] [
-    [ { fixnum } declare [ ] times ] \ 1+ inlined?
-] unit-test
-
 [ t ] [
     [ { fixnum } declare [ ] times ] \ + inlined?
 ] unit-test
@@ -172,19 +170,6 @@ M: object xyz ;
     [ { array-capacity } declare 1 fixnum- ] \ fixnum- inlined?
 ] unit-test
 
-[ t ] [
-    [ 5000 [ 5000 [ ] times ] times ] \ 1+ inlined?
-] unit-test
-
-[ t ] [
-    [ 5000 [ [ ] times ] each ] \ 1+ inlined?
-] unit-test
-
-[ t ] [
-    [ 5000 0 [ dup 2 - swap [ 2drop ] curry each ] reduce ]
-    \ 1+ inlined?
-] unit-test
-
 GENERIC: annotate-entry-test-1 ( x -- )
 
 M: fixnum annotate-entry-test-1 drop ;
@@ -193,7 +178,7 @@ M: fixnum annotate-entry-test-1 drop ;
     2dup >= [
         2drop
     ] [
-        [ dup annotate-entry-test-1 1+ ] dip (annotate-entry-test-2)
+        [ dup annotate-entry-test-1 1 + ] dip (annotate-entry-test-2)
     ] if ; inline recursive
 
 : annotate-entry-test-2 ( from to -- obj ) 0 -rot (annotate-entry-test-2) ; inline
@@ -260,32 +245,32 @@ cell-bits 32 = [
 ] when
 
 [ t ] [
-    [ B{ 1 0 } *short 0 number= ]
+    [ B{ 1 0 } c:short deref 0 number= ]
     \ number= inlined?
 ] unit-test
 
 [ t ] [
-    [ B{ 1 0 } *short 0 { number number } declare number= ]
+    [ B{ 1 0 } c:short deref 0 { number number } declare number= ]
     \ number= inlined?
 ] unit-test
 
 [ t ] [
-    [ B{ 1 0 } *short 0 = ]
+    [ B{ 1 0 } c:short deref 0 = ]
     \ number= inlined?
 ] unit-test
 
 [ t ] [
-    [ B{ 1 0 } *short dup number? [ 0 number= ] [ drop f ] if ]
+    [ B{ 1 0 } c:short deref dup number? [ 0 number= ] [ drop f ] if ]
     \ number= inlined?
 ] unit-test
 
 [ t ] [
-    [ HEX: ff bitand 0 HEX: ff between? ]
+    [ 0xff bitand 0 0xff between? ]
     \ >= inlined?
 ] unit-test
 
 [ t ] [
-    [ HEX: ff swap HEX: ff bitand >= ]
+    [ 0xff swap 0xff bitand >= ]
     \ >= inlined?
 ] unit-test
 
@@ -305,10 +290,6 @@ cell-bits 32 = [
     ] \ + inlined?
 ] unit-test
 
-[ t ] [
-    [ 1000 iota [ 1+ ] map ] { 1+ fixnum+ } inlined?
-] unit-test
-
 : rec ( a -- b )
     dup 0 > [ 1 - rec ] when ; inline recursive
 
@@ -359,28 +340,23 @@ cell-bits 32 = [
 ] unit-test
 
 [ t ] [
-    [ { fixnum } declare length [ drop ] each-integer ]
-    { < <-integer-fixnum +-integer-fixnum + } inlined?
-] unit-test
-
-[ t ] [
-    [ { fixnum } declare [ drop ] each ]
+    [ { fixnum } declare iota [ drop ] each ]
     { < <-integer-fixnum +-integer-fixnum + } inlined?
 ] unit-test
 
 [ t ] [
-    [ { fixnum } declare 0 [ + ] reduce ]
+    [ { fixnum } declare iota 0 [ + ] reduce ]
     { < <-integer-fixnum nth-unsafe } inlined?
 ] unit-test
 
 [ f ] [
-    [ { fixnum } declare 0 [ + ] reduce ]
+    [ { fixnum } declare iota 0 [ + ] reduce ]
     \ +-integer-fixnum inlined?
 ] unit-test
 
 [ f ] [
     [
-        { integer } declare [ ] map
+        { integer } declare iota [ ] map
     ] \ >fixnum inlined?
 ] unit-test
 
@@ -423,7 +399,7 @@ cell-bits 32 = [
 
 [ t ] [
     [
-        { integer } declare [ 0 >= ] map
+        { integer } declare iota [ 0 >= ] map
     ] { >= fixnum>= } inlined?
 ] unit-test
 
@@ -467,7 +443,7 @@ cell-bits 32 = [
 : buffalo-wings ( i seq -- )
     2dup < [
         2dup chicken-fingers
-        [ 1+ ] dip buffalo-wings
+        [ 1 + ] dip buffalo-wings
     ] [
         2drop
     ] if ; inline recursive
@@ -486,7 +462,7 @@ cell-bits 32 = [
 : ribs ( i seq -- )
     2dup < [
         steak
-        [ 1+ ] dip ribs
+        [ 1 + ] dip ribs
     ] [
         2drop
     ] if ; inline recursive
@@ -511,7 +487,7 @@ cell-bits 32 = [
 ] unit-test
 
 [ t ] [
-    [ { array } declare 2 <groups> [ . . ] assoc-each ]
+    [ { array } declare 2 <sliced-groups> [ . . ] assoc-each ]
     \ nth-unsafe inlined?
 ] unit-test
 
@@ -543,4 +519,29 @@ cell-bits 32 = [
         [ 12 swap nth ] keep
         14 ndrop
     ] cleaned-up-tree nodes>quot
-] unit-test
\ No newline at end of file
+] unit-test
+
+[ t ] [
+    [ int { } cdecl [ 2 2 + ] alien-callback ]
+    { + } inlined?
+] unit-test
+
+[ t ] [
+    [ double { double double } cdecl [ + ] alien-callback ]
+    \ + inlined?
+] unit-test
+
+[ f ] [
+    [ double { double double } cdecl [ + ] alien-callback ]
+    \ float+ inlined?
+] unit-test
+
+[ f ] [
+    [ char { char char } cdecl [ + ] alien-callback ]
+    \ fixnum+fast inlined?
+] unit-test
+
+[ t ] [
+    [ void { } cdecl [ ] alien-callback void { } cdecl alien-indirect ]
+    \ >c-ptr inlined?
+] unit-test