Fix &add, etc

db4
Slava Pestov 2008-06-27 00:48:05 -05:00
parent fd4542a41d
commit a25b0a8cb1
3 changed files with 37 additions and 9 deletions

View File

@ -9,3 +9,29 @@ H{ } describe
H{ } describe H{ } describe
[ "fixnum instance\n" ] [ [ 3 describe ] with-string-writer ] unit-test [ "fixnum instance\n" ] [ [ 3 describe ] with-string-writer ] unit-test
[ ] [ inspector-hook get-global inspector-hook set ] unit-test
[ ] [ H{ } clone inspect ] unit-test
[ ] [ "a" "b" &add ] unit-test
[ H{ { "b" "a" } } ] [ me get ] unit-test
[ ] [ "x" 0 &put ] unit-test
[ H{ { "b" "x" } } ] [ me get ] unit-test
[ ] [ 0 &at ] unit-test
[ "x" ] [ me get ] unit-test
[ ] [ &back ] unit-test
[ ] [ "y" 0 &rename ] unit-test
[ H{ { "y" "x" } } ] [ me get ] unit-test
[ ] [ 0 &delete ] unit-test
[ H{ } ] [ me get ] unit-test

View File

@ -3,7 +3,7 @@
USING: arrays generic hashtables io kernel assocs math USING: arrays generic hashtables io kernel assocs math
namespaces prettyprint sequences strings io.styles vectors words namespaces prettyprint sequences strings io.styles vectors words
quotations mirrors splitting math.parser classes vocabs refs quotations mirrors splitting math.parser classes vocabs refs
sets ; sets sorting ;
IN: inspector IN: inspector
GENERIC: summary ( object -- string ) GENERIC: summary ( object -- string )
@ -78,10 +78,17 @@ SYMBOL: +editable+
: summary. ( obj -- ) [ summary ] keep write-object nl ; : summary. ( obj -- ) [ summary ] keep write-object nl ;
: sorted-keys ( assoc -- alist )
dup mirror? [ keys ] [
keys
[ [ unparse-short ] keep ] { } map>assoc
sort-keys values
] if ;
: describe* ( obj flags -- ) : describe* ( obj flags -- )
clone [ clone [
dup summary. dup summary.
make-mirror dup keys dup empty? [ make-mirror dup sorted-keys dup empty? [
2drop 2drop
] [ ] [
dup enum? [ +sequence+ on ] when dup enum? [ +sequence+ on ] when

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs hashtables kernel sequences generic words USING: assocs hashtables kernel sequences generic words
arrays classes slots slots.private classes.tuple math vectors arrays classes slots slots.private classes.tuple math vectors
quotations sorting prettyprint accessors ; quotations accessors ;
IN: mirrors IN: mirrors
: all-slots ( class -- slots ) : all-slots ( class -- slots )
@ -47,13 +47,8 @@ M: mirror assoc-size mirror-slots length ;
INSTANCE: mirror assoc INSTANCE: mirror assoc
: sort-assoc ( assoc -- alist )
>alist
[ [ first unparse-short ] keep ] { } map>assoc
sort-keys values ;
GENERIC: make-mirror ( obj -- assoc ) GENERIC: make-mirror ( obj -- assoc )
M: hashtable make-mirror sort-assoc ; M: hashtable make-mirror ;
M: integer make-mirror drop f ; M: integer make-mirror drop f ;
M: array make-mirror <enum> ; M: array make-mirror <enum> ;
M: vector make-mirror <enum> ; M: vector make-mirror <enum> ;