Fix infinite loop when compiling a word containing a tuple literal with circular structure in it. This was triggered by call( inline caching in core-foundation.fsevents on Mac OS X

basis/compiler/tree/propagation/info/info.factor

@@ -59,21 +59,18 @@ CONSTANT: object-info T{ value-info f object full-interval }
 
 : <value-info> ( -- info ) \ value-info new ;
 
-: read-only-slots ( values class -- slots )
-    all-slots
-    [ read-only>> [ drop f ] unless ] 2map
-    f prefix ;
-
 DEFER: <literal-info>
 
+: tuple-slot-infos ( tuple -- slots )
+    [ tuple-slots ] [ class all-slots ] bi
+    [ read-only>> [ <literal-info> ] [ drop f ] if ] 2map
+    f prefix ;
+
 : init-literal-info ( info -- info )
     dup literal>> class >>class
     dup literal>> dup real? [ [a,a] >>interval ] [
         [ [-inf,inf] >>interval ] dip
-        dup tuple? [
-            [ tuple-slots [ <literal-info> ] map ] [ class ] bi
-            read-only-slots >>slots
-        ] [ drop ] if
+        dup tuple? [ tuple-slot-infos >>slots ] [ drop ] if
     ] if ; inline
 
 : init-value-info ( info -- info )

basis/compiler/tree/propagation/propagation-tests.factor

@@ -9,7 +9,7 @@ compiler.tree.propagation.info compiler.tree.def-use
 compiler.tree.debugger compiler.tree.checker
 slots.private words hashtables classes assocs locals
 specialized-arrays.double system sorting math.libm
-math.intervals ;
+math.intervals quotations ;
 IN: compiler.tree.propagation.tests
 
 [ V{ } ] [ [ ] final-classes ] unit-test
@@ -686,3 +686,8 @@ TUPLE: littledan-2 { from read-only } { to read-only } ;
 [ V{ 0 } ] [ [ { } length ] final-literals ] unit-test
 
 [ V{ 1 } ] [ [ { } length 1+ f <array> length ] final-literals ] unit-test
+
+! Mutable tuples with circularity should not cause problems
+TUPLE: circle me ;
+
+[ ] [ circle new dup >>me 1quotation final-info drop ] unit-test

basis/compiler/tree/propagation/slots/slots.factor

@@ -30,8 +30,13 @@ UNION: fixed-length-sequence array byte-array string ;
     [ [ literal>> ] map ] dip prefix >tuple
     <literal-info> ;
 
+: read-only-slots ( values class -- slots )
+    all-slots
+    [ read-only>> [ value-info ] [ drop f ] if ] 2map
+    f prefix ;
+
 : (propagate-tuple-constructor) ( values class -- info )
-    [ [ value-info ] map ] dip [ read-only-slots ] keep
+    [ read-only-slots ] keep
     over rest-slice [ dup [ literal?>> ] when ] all? [
         [ rest-slice ] dip fold-<tuple-boa>
     ] [