1 ! Copyright (C) 2011 Joe Groff.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: combinators compiler.units generalizations kernel math
4 quotations sequences sequences.generalizations slots vectors ;
7 ! Fundamental accessors
10 : define-slot ( name -- )
11 [ define-protocol-slot ] with-compilation-unit ;
14 MACRO: slot ( name -- quot: ( tuple -- value ) )
15 [ define-slot ] [ reader-word 1quotation ] bi ;
16 MACRO: set-slot ( name -- quot: ( value tuple -- ) )
17 [ define-slot ] [ writer-word 1quotation ] bi ;
20 ! In-place modifiers akin to *-at or *-nth
22 : change-slot ( ..a tuple name quot: ( ..a old -- ..b new ) -- ..b )
23 '[ slot @ ] [ set-slot ] 2bi ; inline
25 : inc-slot ( tuple name -- )
26 [ 0 or 1 + ] change-slot ; inline
28 : slot+ ( value tuple name -- )
29 [ 0 or + ] change-slot ; inline
31 : push-slot ( value tuple name -- )
32 [ ?push ] change-slot ; inline
36 : set-slot* ( tuple value name -- tuple )
37 swapd '[ _ set-slot ] keep ; inline
39 : change-slot* ( tuple name quot: ( ..a old -- ..b new ) -- ..b tuple )
40 '[ _ _ change-slot ] keep ; inline
42 ! Multiple-slot accessors
44 MACRO: slots ( names -- quot: ( tuple -- values... ) )
45 [ '[ _ slot ] ] { } map-as '[ _ cleave ] ;
47 MACRO: slots>array ( names -- quot: ( tuple -- values ) )
48 dup length '[ _ slots _ narray ] ;
50 MACRO: set-slots ( names -- quot: ( values... tuple -- ) )
51 [ [ '[ _ set-slot ] ] [ ] map-as ] [ length dup ] bi
52 '[ @ _ cleave-curry _ spread* ] ;
54 MACRO: array>set-slots ( names -- quot: ( values tuple -- ) )
55 [ length ] keep '[ [ _ firstn ] dip _ set-slots ] ;