1 ! Copyright (C) 2007, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs classes classes.tuple
4 classes.tuple.private combinators hash-sets hashtables kernel
5 math sequences sets slots slots.private summary ;
8 TUPLE: mirror { object read-only } ;
12 : object-slots ( mirror -- slots ) object>> class-of all-slots ; inline
15 [ nip object>> ] [ object-slots slot-named ] 2bi
16 [ offset>> slot t ] [ drop f f ] if* ;
18 ERROR: no-such-slot slot ;
19 ERROR: read-only-slot slot ;
21 : check-set-slot ( val slot -- val offset )
23 { [ dup not ] [ no-such-slot ] }
24 { [ dup read-only>> ] [ read-only-slot ] }
25 { [ 2dup class>> instance? not ] [ class>> bad-slot-value ] }
30 [ object-slots slot-named check-set-slot ] [ object>> ] bi
33 ERROR: mirror-slot-removal slots mirror method ;
36 \ delete-at mirror-slot-removal ;
39 [ object-slots ] keep \ clear-assoc mirror-slot-removal ;
41 M: mirror-slot-removal summary
42 drop "Slots cannot be removed from a tuple or a mirror of it" ;
45 [ object-slots ] [ object>> ] bi '[
46 [ name>> ] [ offset>> _ swap slot ] bi
50 object-slots [ name>> ] map ;
53 [ object-slots ] [ object>> ] bi
54 '[ offset>> _ swap slot ] map ;
57 object>> class-of class-size ;
59 INSTANCE: mirror assoc
61 GENERIC: make-mirror ( obj -- assoc )
62 M: hashtable make-mirror ;
63 M: hash-set make-mirror members make-mirror ;
64 M: integer make-mirror drop f ;
65 M: sequence make-mirror <enumerated> ;
66 M: object make-mirror <mirror> ;