Better optimizers for new, boa

core/classes/tuple/tuple-tests.factor

@@ -477,7 +477,9 @@ USE: vocabs
     ] with-compilation-unit
 ] unit-test
 
-[ "USE: words T{ word }" eval ] [ error>> T{ no-method f word new } = ] must-fail-with
+[ "USE: words T{ word }" eval ]
+[ error>> T{ no-method f word slots>tuple } = ]
+must-fail-with
 
 ! Accessors not being forgotten...
 [ [ ] ] [
@@ -621,3 +623,11 @@ must-fail-with
 [ 0 { } foo ]
 [ T{ bad-slot-value f { } string } = ]
 must-fail-with
+
+[ T{ declared-types f 0 "" } ] [ declared-types new ] unit-test
+
+: blah ( -- vec ) vector new ;
+
+\ blah must-infer
+
+[ V{ } ] [ blah ] unit-test

core/classes/tuple/tuple.factor

@@ -16,6 +16,18 @@ ERROR: not-a-tuple object ;
 
 <PRIVATE
 
+: (tuple) ( layout -- tuple )
+    #! In non-optimized code, this word simply calls the
+    #! <tuple> primitive. In optimized code, an intrinsic
+    #! is generated which allocates a tuple but does not set
+    #! any of its slots. This means that any code that uses
+    #! (tuple) must fill in the slots before the next
+    #! call to GC.
+    #!
+    #! This word is only used in the expansion of <tuple-boa>,
+    #! where this invariant is guaranteed to hold.
+    <tuple> ;
+
 : tuple-layout ( class -- layout )
     "layout" word-prop ;
 
@@ -52,9 +64,11 @@ PRIVATE>
         ] 2each
     ] if-bootstrapping ; inline
 
-: slots>tuple ( seq class -- tuple )
+GENERIC: slots>tuple ( seq class -- tuple )
+
+M: tuple-class slots>tuple
     check-slots
-    new [
+    tuple-layout <tuple> [
         [ tuple-size ]
         [ [ set-array-nth ] curry ]
         bi 2each
@@ -119,6 +133,12 @@ ERROR: bad-superclass class ;
 : define-boa-check ( class -- )
     dup boa-check-quot "boa-check" set-word-prop ;
 
+: tuple-prototype ( class -- prototype )
+    [ all-slots [ initial>> ] map ] keep slots>tuple ;
+
+: define-tuple-prototype ( class -- )
+    dup tuple-prototype "prototype" set-word-prop ;
+
 : generate-tuple-slots ( class slots -- slot-specs )
     over superclass-size 2 + make-slots deprecated-slots ;
 
@@ -172,6 +192,7 @@ M: tuple-class update-class
         [ define-tuple-layout ]
         [ define-tuple-slots ]
         [ define-tuple-predicate ]
+        [ define-tuple-prototype ]
         [ define-boa-check ]
     } cleave ;
 
@@ -235,8 +256,11 @@ M: tuple-class reset-class
         ] with each
     ] [
         [ call-next-method ]
-        [ { "layout" "slots" "slot-names" } reset-props ]
-        bi
+        [
+            {
+                "layout" "slots" "slot-names" "boa-check" "prototype"
+            } reset-props
+        ] bi
     ] bi ;
 
 M: tuple-class rank-class drop 0 ;
@@ -258,7 +282,8 @@ M: tuple hashcode*
         ] 2curry each
     ] recursive-hashcode ;
 
-M: tuple-class new tuple-layout <tuple> ;
+M: tuple-class new
+    "prototype" word-prop (clone) ;
 
 M: tuple-class boa
     [ "boa-check" word-prop call ]

core/cpu/ppc/intrinsics/intrinsics.factor

@@ -437,14 +437,11 @@ IN: cpu.ppc.intrinsics
     { +clobber+ { "n" } }
 } define-intrinsic
 
-\ <tuple> [
+\ (tuple) [
     tuple "layout" get size>> 2 + cells %allot
     ! Store layout
     "layout" get 12 load-indirect
     12 11 cell STW
-    ! Zero out the rest of the tuple
-    f v>operand 12 LI
-    "layout" get size>> [ 12 11 rot 2 + cells STW ] each
     ! Store tagged ptr in reg
     "tuple" get tuple %store-tagged
 ] H{

core/cpu/x86/intrinsics/intrinsics.factor

@@ -291,15 +291,11 @@ IN: cpu.x86.intrinsics
     { +clobber+ { "n" } }
 } define-intrinsic
 
-\ <tuple> [
+\ (tuple) [
     tuple "layout" get size>> 2 + cells [
         ! Store layout
         "layout" get "scratch" get load-literal
         1 object@ "scratch" operand MOV
-        ! Zero out the rest of the tuple
-        "layout" get size>> [
-            2 + object@ f v>operand MOV
-        ] each
         ! Store tagged ptr in reg
         "tuple" get tuple %store-tagged
     ] %allot

core/inference/known-words/known-words.factor

@@ -550,6 +550,9 @@ set-primitive-effect
 \ <tuple> { tuple-layout } { tuple } <effect> set-primitive-effect
 \ <tuple> make-flushable
 
+\ (tuple) { tuple-layout } { tuple } <effect> set-primitive-effect
+\ (tuple) make-flushable
+
 \ <tuple-layout> { word fixnum array fixnum } { tuple-layout } <effect> set-primitive-effect
 \ <tuple-layout> make-foldable
 

core/inference/transforms/transforms.factor

@@ -95,12 +95,13 @@ M: duplicated-slots-error summary
 ] 1 define-transform
 
 : [tuple-boa] ( layout -- quot )
-    [ [ <tuple> ] curry ]
+    [ [ (tuple) ] curry ]
     [
         size>> 1 - [ 3 + ] map <reversed>
         [ [ set-slot ] curry [ keep ] curry ] map concat
-    ]
-    bi append ;
+    ] bi
+    [ f over 2 set-slot ]
+    3append ;
 
 \ <tuple-boa> [ [tuple-boa] ] 1 define-transform
 

core/mirrors/mirrors-docs.factor

@@ -13,10 +13,6 @@ $nl
 
 ABOUT: "mirrors"
 
-HELP: object-slots
-{ $values { "obj" object } { "seq" "a sequence of " { $link slot-spec } " instances" } }
-{ $description "Outputs a sequence of slot specifiers for the object." } ;
-
 HELP: mirror
 { $class-description "An associative structure which wraps an object and presents itself as a mapping from slot names to the object's slot values. Mirrors are used to build reflective developer tools."
 $nl

core/optimizer/known-words/known-words.factor

@@ -12,7 +12,7 @@ optimizer.backend optimizer.pattern-match optimizer.inlining
 float-arrays sequences.private combinators byte-arrays
 byte-vectors ;
 
-{ <tuple> <tuple-boa> } [
+{ <tuple> <tuple-boa> (tuple) } [
     [
         dup node-in-d peek node-literal
         dup tuple-layout? [ class>> ] [ drop tuple ] if
@@ -25,6 +25,23 @@ byte-vectors ;
     dup class? [ drop tuple ] unless 1array f
 ] "output-classes" set-word-prop
 
+! if the input to new is a literal tuple class, we can expand it
+: literal-new? ( #call -- ? )
+    dup in-d>> first node-literal tuple-class? ;
+
+: new-quot ( class -- quot )
+    dup all-slots 1 tail ! delegate slot
+    [ [ initial>> literalize , ] each literalize , \ boa , ] [ ] make ;
+
+: expand-new ( #call -- node )
+    dup dup in-d>> first node-literal
+    [ +inlined+ depends-on ] [ new-quot ] bi
+    f splice-quot ;
+
+\ new {
+    { [ dup literal-new? ] [ expand-new ] }
+} define-optimizers
+
 ! the output of clone has the same type as the input
 { clone (clone) } [
     [
@@ -128,19 +145,6 @@ byte-vectors ;
     ] if
 ] "constraints" set-word-prop
 
-! if the input to new is a literal tuple class, we can expand it
-: literal-new? ( #call -- ? )
-    dup in-d>> first node-literal tuple-class? ;
-
-: expand-new ( #call -- node )
-    dup dup in-d>> first node-literal
-    [ +inlined+ depends-on ] [ tuple-layout [ nip <tuple> ] curry ] bi
-    f splice-quot ;
-
-\ new {
-    { [ dup literal-new? ] [ expand-new ] }
-} define-optimizers
-
 ! open-code instance? checks on predicate classes
 : literal-predicate-class? ( #call -- ? )
     dup in-d>> second node-literal predicate-class? ;