1 ! (c)2010 Joe Groff, Erik Charlebois bsd license
2 USING: accessors alien.c-types arrays combinators delegate fry
3 generic.parser kernel macros math parser sequences words words.symbol
4 classes.singleton assocs ;
8 TUPLE: enum-c-type base-type members ;
9 C: <enum-c-type> enum-c-type
10 CONSULT: c-type-protocol enum-c-type
14 GENERIC: enum>number ( enum -- number ) foldable
15 M: integer enum>number ;
16 M: word enum>number "enum-value" word-prop ;
19 : enum-boxer ( members -- quot )
20 [ first2 swap '[ _ ] 2array ]
21 { } map-as [ ] suffix '[ _ case ] ;
24 MACRO: number>enum ( enum-c-type -- )
25 c-type members>> enum-boxer ;
27 M: enum-c-type c-type-boxed-class drop object ;
28 M: enum-c-type c-type-boxer-quot members>> enum-boxer ;
29 M: enum-c-type c-type-unboxer-quot drop [ enum>number ] ;
30 M: enum-c-type c-type-setter
31 [ enum>number ] swap base-type>> c-type-setter '[ _ 2dip @ ] ;
35 : define-enum-value ( class value -- )
36 "enum-value" set-word-prop ;
38 : define-enum-members ( members -- )
40 [ drop define-singleton-class ]
41 [ define-enum-value ] 2bi
44 : define-enum-constructor ( word -- )
45 [ name>> "<" ">" surround create-in ] keep
46 [ number>enum ] curry (( number -- enum )) define-inline ;
50 : define-enum ( word base-type members -- )
51 [ dup define-enum-constructor ] 2dip
52 [ define-enum-members ]
53 [ <enum-c-type> swap typedef ] bi ;
55 PREDICATE: enum-c-type-word < c-type-word
56 "c-type" word-prop enum-c-type? ;