Mirror keys are now slot names not reader words

core/mirrors/mirrors-docs.factor

@@ -20,7 +20,7 @@ HELP: object-slots
 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
-"Mirrors are mutable, however new keys cannot be inserted and keys cannot be deleted, only values of existing keys can be changed."
+"Mirrors are mutable, however new keys cannot be inserted, only values of existing keys can be changed. Deleting a key has the effect of setting its value to " { $link f } "."
 $nl
 "Mirrors are created by calling " { $link <mirror> } " or " { $link make-mirror } "." } ;
 
@@ -33,7 +33,7 @@ HELP: <mirror>
         "TUPLE: circle center radius ;"
         "C: <circle> circle"
         "{ 100 50 } 15 <circle> <mirror> >alist ."
-        "{ { circle-center { 100 50 } } { circle-radius 15 } }"
+        "{ { \"center\" { 100 50 } } { \"radius\" 15 } }"
     }
 } ;
 
@@ -47,5 +47,5 @@ $nl
 "Enumerations are mutable; note that deleting a key calls " { $link delete-nth } ", which results in all subsequent elements being shifted down." } ;
 
 HELP: make-mirror
-{ $values { "obj" object } { "assoc" "an assoc" } }
+{ $values { "obj" object } { "assoc" assoc } }
 { $description "Creates an assoc which reflects the internal structure of the object." } ;

core/mirrors/mirrors-tests.factor

@@ -5,12 +5,12 @@ TUPLE: foo bar baz ;
 
 C: <foo> foo
 
-[ { foo-bar foo-baz } ] [ 1 2 <foo> <mirror> keys ] unit-test
+[ { "bar" "baz" } ] [ 1 2 <foo> <mirror> keys ] unit-test
 
-[ 1 t ] [ \ foo-bar 1 2 <foo> <mirror> at* ] unit-test
+[ 1 t ] [ "bar" 1 2 <foo> <mirror> at* ] unit-test
 
 [ f f ] [ "hi" 1 2 <foo> <mirror> at* ] unit-test
 
 [ 3 ] [
-    3 \ foo-baz 1 2 <foo> [ <mirror> set-at ] keep foo-baz
+    3 "baz" 1 2 <foo> [ <mirror> set-at ] keep foo-baz
 ] unit-test

core/mirrors/mirrors.factor

@@ -21,12 +21,14 @@ TUPLE: mirror object slots ;
 : >mirror< ( mirror -- obj slots )
     dup mirror-object swap mirror-slots ;
 
+: mirror@ ( slot-name mirror -- obj slot-spec )
+    >mirror< swapd slot-named ;
+
 M: mirror at*
-    >mirror< swapd slot-of-reader
-    dup [ slot-spec-offset slot t ] [ 2drop f f ] if ;
+    mirror@ dup [ slot-spec-offset slot t ] [ 2drop f f ] if ;
 
 M: mirror set-at ( val key mirror -- )
-    >mirror< swapd slot-of-reader dup [
+    mirror@ dup [
         dup slot-spec-writer [
             slot-spec-offset set-slot
         ] [
@@ -42,7 +44,7 @@ M: mirror delete-at ( key mirror -- )
 M: mirror >alist ( mirror -- alist )
     >mirror<
     [ [ slot-spec-offset slot ] with map ] keep
-    [ slot-spec-reader ] map swap 2array flip ;
+    [ slot-spec-name ] map swap 2array flip ;
 
 M: mirror assoc-size mirror-slots length ;
 

core/slots/slots.factor

@@ -110,3 +110,6 @@ PREDICATE: word slot-writer "writing" word-prop >boolean ;
 
 : slot-of-writer ( writer specs -- spec/f )
     [ slot-spec-writer eq? ] with find nip ;
+
+: slot-named ( string specs -- spec/f )
+    [ slot-spec-name = ] with find nip ;

extra/http/server/components/components.factor

@@ -3,7 +3,7 @@
 USING: new-slots html.elements http.server.validators
 accessors namespaces kernel io farkup math.parser assocs
 classes words tuples arrays sequences io.files
-http.server.templating.fhtml splitting ;
+http.server.templating.fhtml splitting mirrors ;
 IN: http.server.components
 
 SYMBOL: components
@@ -94,14 +94,10 @@ M: number render-edit*
 M: number render-error*
     render-input render-error ;
 
-: tuple>slots ( tuple -- alist )
-    dup class "slot-names" word-prop swap tuple-slots
-    2array flip ;
-
 : with-components ( tuple components quot -- )
     [
         >r components set
-        dup tuple>slots values set
+        dup make-mirror values set
         tuple set
         r> call
     ] with-scope ; inline