factor: add newlines to .factor files

[factor.git] / basis / alien / enums / enums.factor

diff --git a/basis/alien/enums/enums.factor b/basis/alien/enums/enums.factor
index 4ac7c24cb5c3c301985992f9b1657d3c4f8915ce..e9f9d44ec645648a0afa140db5090494874390b8 100644 (file)
--- a/basis/alien/enums/enums.factor
+++ b/basis/alien/enums/enums.factor
@@ -1,6 +1,7 @@
-! (c)2010 Joe Groff, Erik Charlebois bsd license
-USING: accessors alien.c-types arrays combinators delegate fry
-generic.parser kernel macros math parser sequences words words.symbol ;
+! Copyright (C) 2010 Joe Groff, Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types arrays assocs classes.singleton
+combinators delegate kernel math parser sequences words ;
 IN: alien.enums
 
 <PRIVATE
@@ -20,8 +21,8 @@ M: word enum>number "enum-value" word-prop ;
     { } map-as [ ] suffix '[ _ case ] ;
 PRIVATE>
 
-MACRO: number>enum ( enum-c-type -- )
-    c-type members>> enum-boxer ;
+MACRO: number>enum ( enum-c-type -- quot )
+    lookup-c-type members>> enum-boxer ;
 
 M: enum-c-type c-type-boxed-class drop object ;
 M: enum-c-type c-type-boxer-quot members>> enum-boxer ;
@@ -29,24 +30,38 @@ M: enum-c-type c-type-unboxer-quot drop [ enum>number ] ;
 M: enum-c-type c-type-setter
    [ enum>number ] swap base-type>> c-type-setter '[ _ 2dip @ ] ;
 
-<PRIVATE
-
 : define-enum-value ( class value -- )
     enum>number "enum-value" set-word-prop ;
 
-: define-enum-members ( member-names -- )
-    [ first define-symbol ] each ;
+<PRIVATE
+
+: define-enum-members ( members -- )
+    [ first define-singleton-class ] each ;
 
 : define-enum-constructor ( word -- )
-    [ name>> "<" ">" surround create-in ] keep
-    [ number>enum ] curry (( number -- enum )) define-inline ;
+    [ name>> "<" ">" surround create-word-in ] keep
+    [ number>enum ] curry ( number -- enum ) define-declared ;
 
 PRIVATE>
 
-: define-enum ( word base-type members -- )
+: (define-enum) ( word base-type members -- )
     [ dup define-enum-constructor ] 2dip
-    dup define-enum-members
-    <enum-c-type> swap typedef ;
-    
+    [ define-enum-members ]
+    [ <enum-c-type> swap typedef ] bi ;
+
+: define-enum ( word base-type members -- )
+    [ (define-enum) ]
+    [ [ define-enum-value ] assoc-each ] bi ;
+
 PREDICATE: enum-c-type-word < c-type-word
     "c-type" word-prop enum-c-type? ;
+
+: enum>values ( enum -- seq )
+    "c-type" word-prop members>> values ;
+
+: enum>keys ( enum -- seq )
+    "c-type" word-prop members>> keys [ name>> ] map ;
+
+: values>enum ( values enum -- seq )
+    '[ _ number>enum ] map ; inline
+