compiler.tree.propagation.known-words: don't want a type function on clone, all the...

diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index 606d1a0edfbb6dba92ff1d20e77e2f0a3527012a..0d08c592a961235ea9ca1ddd712f1ef8b9ea003b 100644 (file)
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -5,7 +5,7 @@ quotations classes classes.algebra classes.tuple.private
 continuations growable namespaces hints alien.accessors
 compiler.tree.builder compiler.tree.optimizer sequences.deep
 compiler.test definitions generic.single shuffle math.order
-compiler.cfg.debugger ;
+compiler.cfg.debugger classes.struct alien.syntax alien.data ;
 IN: compiler.tests.optimizer
 
 GENERIC: xyz ( obj -- obj )
@@ -447,3 +447,14 @@ TUPLE: grid-mesh-tuple { length read-only } { step read-only } ;
 GENERIC: bad-push-test-case ( a -- b )
 M: object bad-push-test-case "foo" throw ; inline
 [ { 1 } "bar" ] [ { 1 } [ [ [ [ bad-push-test-case ] [ "bar" throw ] recover ] attempt-all f ] [ ] recover ] compile-call ] unit-test
+
+STRUCT: BitmapData { Scan0 void* } ;
+
+[ ALIEN: 123 ] [
+    [
+        { BitmapData }
+        [ BitmapData memory>struct ALIEN: 123 >>Scan0 drop ]
+        [ clone ]
+        with-out-parameters Scan0>>
+    ] compile-call
+] unit-test

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index 6d2dec1c0d3d89d0c1e0a5dec03c136d44a46f26..09750d9d3f129389d88fa9042c6d72b9d0a21ed7 100644 (file)
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -288,14 +288,12 @@ generic-comparison-ops [
     literal>> dup tuple-class? [ drop tuple ] unless <class-info>
 ] "outputs" set-word-prop
 
-! the output of clone has the same type as the input
+! the output of (clone) has the same type as the input
 : cloned-value-info ( value-info -- value-info' )
     clone f >>literal f >>literal?
     [ [ dup [ cloned-value-info ] when ] map ] change-slots ;
 
-{ clone (clone) } [
-    [ cloned-value-info ] "outputs" set-word-prop
-] each
+\ (clone) [ cloned-value-info ] "outputs" set-word-prop
 
 \ slot [
     dup literal?>>