Add a compile time check to set-slots transform

core/inference/inference-docs.factor

@@ -1,5 +1,5 @@
 USING: help.syntax help.markup kernel sequences words io
-effects inference.dataflow inference.backend
+effects inference.dataflow inference.backend classes
 math combinators inference.transforms inference.state ;
 IN: inference
 
@@ -93,8 +93,8 @@ $nl
 ABOUT: "inference"
 
 HELP: inference-error
-{ $values { "msg" "an object" } }
-{ $description "Throws an " { $link inference-error } "." }
+{ $values { "class" class } }
+{ $description "Creates an instance of " { $snippet "class" } ", wraps it in an " { $link inference-error } " and throws the result." }
 { $error-description
     "Thrown by " { $link infer } " and " { $link dataflow } " when the stack effect of a quotation cannot be inferred."
     $nl

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

@@ -475,10 +475,6 @@ t over set-effect-terminated?
 
 \ string>u16-alien { string } { byte-array } <effect> "inferred-effect" set-word-prop
 
-\ string>memory { string c-ptr } { } <effect> "inferred-effect" set-word-prop
-
-\ memory>string { c-ptr integer } { string } <effect> "inferred-effect" set-word-prop
-
 \ alien-address { alien } { integer } <effect> "inferred-effect" set-word-prop
 \ alien-address make-flushable
 

core/inference/transforms/transforms-docs.factor

@@ -1,5 +1,5 @@
-USING: help.markup help.syntax inference.transforms
-combinators words ;
+IN: inference.transforms
+USING: help.markup help.syntax combinators words kernel ;
 
 HELP: define-transform
 { $values { "word" word } { "quot" "a quotation taking " { $snippet "n" } " inputs from the stack and producing another quotation as output" } { "n" "a non-negative integer" } }
@@ -12,3 +12,8 @@ HELP: define-transform
 $nl
 "The " { $link cond } " word compiles to efficient code because it is transformed using " { $link cond>quot } ":"
 { $code "\\ cond [ cond>quot ] 1 define-transform" } } ;
+
+HELP: duplicated-slots-error
+{ $values { "names" "a sequence of setter words" } }
+{ $description "Throws a " { $link duplicated-slots-error } "." }
+{ $error-description "Thrown by stack effect inference if a " { $link set-slots } " form is given an array of slot setters that includes duplicates. Since writing to the same slot multiple times has no useful effect, this is a programmer error, so it is caught at compile time." } ;

core/inference/transforms/transforms-tests.factor

@@ -1,6 +1,6 @@
 IN: temporary
 USING: sequences inference.transforms tools.test math kernel
-quotations tools.test.inference ;
+quotations tools.test.inference inference ;
 
 : compose-n-quot <repetition> >quotation ;
 : compose-n compose-n-quot call ;
@@ -20,3 +20,15 @@ quotations tools.test.inference ;
 [ 512 ] [ 1 { { 1+ 8 } } bitfield-quot call ] unit-test
 
 \ construct-empty must-infer
+
+TUPLE: a-tuple x y z ;
+
+: set-slots-test ( x y z -- )
+    { set-a-tuple-x set-a-tuple-y } set-slots ;
+
+\ set-slots-test must-infer
+
+: set-slots-test-2
+    { set-a-tuple-x set-a-tuple-x } set-slots ;
+
+[ [ set-slots-test-2 ] infer ] unit-test-fails

core/inference/transforms/transforms.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel words sequences generic math namespaces
 quotations assocs combinators math.bitfields inference.backend
-inference.dataflow inference.state tuples.private effects ;
+inference.dataflow inference.state tuples.private effects
+inspector hashtables ;
 IN: inference.transforms
 
 : pop-literals ( n -- rstate seq )
@@ -59,7 +60,18 @@ M: pair (bitfield-quot) ( spec -- quot )
 
 \ get-slots [ [get-slots] ] 1 define-transform
 
-\ set-slots [ <reversed> [get-slots] ] 1 define-transform
+TUPLE: duplicated-slots-error names ;
+
+M: duplicated-slots-error summary
+    drop "Calling set-slots with duplicate slot setters" ;
+
+: duplicated-slots-error ( names -- * )
+    \ duplicated-slots-error construct-boa throw ;
+
+\ set-slots [
+    dup all-unique?
+    [ <reversed> [get-slots] ] [ duplicated-slots-error ] if
+] 1 define-transform
 
 \ construct-boa [
     dup +inlined+ depends-on