1 ! Copyright (C) 2007, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: assocs hashtables kernel sequences generic words
4 arrays classes slots slots.private classes.tuple math vectors
8 : all-slots ( class -- slots )
9 superclasses [ "slots" word-prop ] map concat ;
11 : object-slots ( obj -- seq )
14 TUPLE: mirror object slots ;
16 : <mirror> ( object -- mirror )
17 dup object-slots mirror boa ;
19 ERROR: no-such-slot object name ;
21 ERROR: immutable-slot object name ;
24 [ nip object>> ] [ slots>> slot-named ] 2bi
25 dup [ offset>> slot t ] [ 2drop f f ] if ;
27 M: mirror set-at ( val key mirror -- )
28 [ nip object>> ] [ drop ] [ slots>> slot-named ] 2tri dup [
38 M: mirror delete-at ( key mirror -- )
41 M: mirror >alist ( mirror -- alist )
42 [ slots>> [ name>> ] map ]
43 [ [ object>> ] [ slots>> ] bi [ offset>> slot ] with map ] bi
46 M: mirror assoc-size mirror-slots length ;
48 INSTANCE: mirror assoc
50 GENERIC: make-mirror ( obj -- assoc )
51 M: hashtable make-mirror ;
52 M: integer make-mirror drop f ;
53 M: array make-mirror <enum> ;
54 M: vector make-mirror <enum> ;
55 M: quotation make-mirror <enum> ;
56 M: object make-mirror <mirror> ;