diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index 69785c8c0a..0ea811c710 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/basis/compiler/tree/propagation/known-words/known-words.factor @@ -16,7 +16,8 @@ compiler.tree.propagation.slots compiler.tree.propagation.simple compiler.tree.propagation.constraints compiler.tree.propagation.call-effect -compiler.tree.propagation.transforms ; +compiler.tree.propagation.transforms +compiler.tree.propagation.simd ; IN: compiler.tree.propagation.known-words { + - * / } @@ -275,9 +276,12 @@ generic-comparison-ops [ ] "outputs" set-word-prop ! 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) } [ - [ clone f >>literal f >>literal? ] - "outputs" set-word-prop + [ cloned-value-info ] "outputs" set-word-prop ] each \ slot [ diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 879ab82c4b..fa5ce55136 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -799,3 +799,13 @@ SYMBOL: not-an-assoc [ t ] [ [ (( a b c -- c b a )) shuffle ] { shuffle } inlined? ] unit-test [ f ] [ [ { 1 2 3 } swap shuffle ] { shuffle } inlined? ] unit-test + +! Type function for 'clone' had a subtle issue +TUPLE: tuple-with-read-only-slot { x read-only } ; + +M: tuple-with-read-only-slot clone + x>> clone tuple-with-read-only-slot boa ; inline + +[ V{ object } ] [ + [ { 1 2 3 } dup tuple-with-read-only-slot boa clone x>> eq? ] final-classes +] unit-test