steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Mirror keys are now slot names not reader words

db4
Slava Pestov 2008-03-07 02:29:00 -06:00
parent 219a3a4a40
commit 60a4cc48a5
5 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
core/mirrors/mirrors-docs.factor Normal file → Executable file
View File

@ -20,7 +20,7 @@ HELP: object-slots
HELP: mirror 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." { $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 $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 $nl
"Mirrors are created by calling " { $link <mirror> } " or " { $link make-mirror } "." } ; "Mirrors are created by calling " { $link <mirror> } " or " { $link make-mirror } "." } ;
@ -33,7 +33,7 @@ HELP: <mirror>
"TUPLE: circle center radius ;" "TUPLE: circle center radius ;"
"C: <circle> circle" "C: <circle> circle"
"{ 100 50 } 15 <circle> <mirror> >alist ." "{ 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." } ; "Enumerations are mutable; note that deleting a key calls " { $link delete-nth } ", which results in all subsequent elements being shifted down." } ;
HELP: make-mirror 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." } ; { $description "Creates an assoc which reflects the internal structure of the object." } ;

6
core/mirrors/mirrors-tests.factor Normal file → Executable file
View File

@ -5,12 +5,12 @@ TUPLE: foo bar baz ;
C: <foo> foo 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 [ f f ] [ "hi" 1 2 <foo> <mirror> at* ] unit-test
[ 3 ] [ [ 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 ] unit-test

10
core/mirrors/mirrors.factor
View File

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

3
core/slots/slots.factor
View File

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

8
extra/http/server/components/components.factor Normal file → Executable file
View File

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