classes.tuple: adding set-slots and from-slots.

core/classes/tuple/tuple-docs.factor

@@ -460,3 +460,11 @@ HELP: get-slot-named
 HELP: set-slot-named
 { $values { "value" object } { "name" string } { "tuple" tuple } }
 { $description "Stores the " { $snippet "value" } " into a tuple slot accessed by " { $snippet "name" } "." } ;
+
+HELP: set-slots
+{ $values { "assoc" assoc } { "tuple" tuple } }
+{ $description "For each " { $snippet "{ key value }" } " pair in " { $snippet "assoc" } ", sets the " { $snippet "key" } " slot in " { $snippet "obj" } " to " { $snippet "value" } "." } ;
+
+HELP: from-slots
+{ $values { "assoc" assoc } { "class" tuple-class } { "tuple" tuple } }
+{ $description "Creates a new instance of " { $snippet "class" } " with slot values specified by " { $snippet "assoc" } "." } ;

core/classes/tuple/tuple-tests.factor

@@ -59,6 +59,12 @@ TUPLE: point x y ;
 [ 200 ] [ "p" get y>> ] unit-test
 [ 300 ] [ "p" get "z>>" "accessors" lookup-word execute ] unit-test
 
+TUPLE: slotty a b c ;
+
+[ T{ slotty } ] [ H{ } slotty from-slots ] unit-test
+[ T{ slotty f 1 2 f } ] [ H{ { "a" 1 } { "b" 2 } } slotty from-slots ] unit-test
+[ H{ { "d" 0 } } slotty new set-slots ] must-fail
+
 TUPLE: predicate-test ;
 
 C: <predicate-test> predicate-test

core/classes/tuple/tuple.factor

@@ -28,6 +28,12 @@ ERROR: no-slot name tuple ;
 : set-slot-named ( value name tuple -- )
     [ nip ] [ offset-of-slot ] 2bi set-slot ;
 
+: set-slots ( assoc tuple -- )
+    [ swapd set-slot-named ] curry assoc-each ; inline
+
+: from-slots ( assoc class -- tuple )
+    new [ set-slots ] keep ; inline
+
 PREDICATE: immutable-tuple-class < tuple-class
     all-slots [ read-only>> ] all? ;