Use generic word for enum>number. Tests and documentations.

basis/alien/enums/enums-docs.factor

@@ -0,0 +1,30 @@
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types help.markup help.syntax words ;
+IN: alien.enums
+
+HELP: define-enum
+{ $values
+    { "word" word } { "base-type" c-type } { "members" "sequence of word and value pairs" }
+}
+{ $description "Defines an enum. This is the run-time equivalent of ENUM:." } ;
+
+HELP: enum>number
+{ $values
+    { "enum" "an enum word" }
+    { "number" "the corresponding number value" }
+}
+{ $description "Converts an enum to a number." } ;
+
+HELP: number>enum
+{ $values
+    { "number" "an enum number" } { "enum-c-type" "an enum type" }
+    { "enum" "the corresponding enum word" }
+}
+{ $description "Convert a number to an enum." } ;
+
+ARTICLE: "alien.enums" "alien.enums"
+{ $vocab-link "alien.enums" }
+;
+
+ABOUT: "alien.enums"

basis/alien/enums/enums-tests.factor

@@ -0,0 +1,35 @@
+! Copyright (C) 2010 Erik Charlebois.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.enums alien.enums.private
+alien.syntax sequences tools.test words ;
+IN: alien.enums.tests
+
+ENUM: color_t red { green 3 } blue ;
+ENUM: instrument_t < ushort trombone trumpet ;
+
+{ { red green blue 5 } }
+[ { 0 3 4 5 } [ <color_t> ] map ] unit-test
+
+{ { 0 3 4 5 } }
+[ { red green blue 5 } [ enum>number ] map ] unit-test
+
+{ { -1 trombone trumpet } }
+[ { -1 0 1 } [ <instrument_t> ] map ] unit-test
+
+{ { -1 0 1 } }
+[ { -1 trombone trumpet } [ enum>number ] map ] unit-test
+
+{ t }
+[ color_t "c-type" word-prop enum-c-type? ] unit-test
+
+{ f }
+[ ushort "c-type" word-prop enum-c-type? ] unit-test
+
+{ int }
+[ color_t "c-type" word-prop base-type>> ] unit-test
+
+{ ushort }
+[ instrument_t "c-type" word-prop base-type>> ] unit-test
+
+{ V{ { red 0 } { green 3 } { blue 4 } } }
+[ color_t "c-type" word-prop members>> ] unit-test

basis/alien/enums/enums.factor

@@ -1,48 +1,55 @@
-! (c)2010 Joe Groff bsd license
+! (c)2010 Joe Groff, Erik Charlebois bsd license
-USING: accessors alien.c-types arrays combinators delegate fry
+USING: accessors alien.c-types arrays classes.singleton combinators
-kernel quotations sequences words.symbol words ;
+delegate fry generic.parser kernel math parser sequences words ;
 IN: alien.enums
 
+<PRIVATE
 TUPLE: enum-c-type base-type members ;
-
+C: <enum-c-type> enum-c-type
 CONSULT: c-type-protocol enum-c-type
     base-type>> ;
-
-<PRIVATE
-: map-to-case ( quot: ( x -- y ) -- case )
-    { } map-as [ ] suffix ; inline
 PRIVATE>
 
-: enum-unboxer ( members -- quot )
+GENERIC: enum>number ( enum -- number )
-    [ first2 '[ _ ] 2array ] map-to-case '[ _ case ] ;
+M: integer enum>number ;
 
-: enum-boxer ( members -- quot )
+: number>enum ( number enum-c-type -- enum )
-    [ first2 swap '[ _ ] 2array ] map-to-case '[ _ case ] ;
-
-M: enum-c-type c-type-boxed-class drop object ;
-M: enum-c-type c-type-boxer-quot members>> enum-boxer ;
-M: enum-c-type c-type-unboxer-quot members>> enum-unboxer ;
-M: enum-c-type c-type-setter
-    [ members>> enum-unboxer ] [ base-type>> c-type-setter ] bi
-    '[ _ 2dip @ ] ;
-
-C: <enum-c-type> enum-c-type
-
-: enum>int ( enum enum-c-type -- int )
-    c-type-unboxer-quot call( x -- y ) ; inline
-
-: int>enum ( int enum-c-type -- enum )
     c-type-boxer-quot call( x -- y ) ; inline
 
 <PRIVATE
+: enum-boxer ( members -- quot )
+    [ first2 swap '[ _ ] 2array ]
+    { } map-as [ ] suffix '[ _ case ] ;
+PRIVATE>
+
+M: enum-c-type c-type-boxed-class drop object ;
+M: enum-c-type c-type-boxer-quot members>> enum-boxer ;
+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>number ( class value -- )
+    [ \ enum>number create-method-in ]
+    [ '[ drop _ ] ] bi* define ;
 
 : define-enum-members ( member-names -- )
-    [ first define-symbol ] each ;
+    [
+        [ first define-singleton-class ]
+        [ first2 define-enum>number ] bi
+    ] each ;
+
+: define-enum-constructor ( word -- )
+    [ name>> "<" ">" surround create-in ] keep
+    [ number>enum ] curry (( enum -- number )) define-inline ;
 
 PRIVATE>
 
 : define-enum ( word base-type members -- )
-    [ define-enum-members ] [ <enum-c-type> swap typedef ] bi ;
+    [ dup define-enum-constructor ] 2dip
+    dup define-enum-members
+    <enum-c-type> swap typedef ;
     
 PREDICATE: enum-c-type-word < c-type-word
     "c-type" word-prop enum-c-type? ;

basis/alien/syntax/syntax-docs.factor

@@ -1,6 +1,6 @@
 IN: alien.syntax
-USING: alien alien.c-types alien.parser alien.libraries
+USING: alien alien.c-types alien.enums alien.libraries classes.struct
-classes.struct help.markup help.syntax see ;
+help.markup help.syntax see ;
 
 HELP: DLL"
 { $syntax "DLL\" path\"" }
@@ -70,15 +70,14 @@ HELP: TYPEDEF:
 { $notes "This word differs from " { $link typedef } " in that it runs at parse time, to ensure correct ordering of operations when loading source files. Words defined in source files are compiled before top-level forms are run, so if a source file defines C binding words and uses " { $link typedef } ", the type alias won't be available at compile time." } ;
 
 HELP: ENUM:
-{ $syntax "ENUM: type/f words... ;" }
+{ $syntax "ENUM: type words... ;" "ENUM: type < base-type words..." }
 { $values { "type" "a name to typedef to int or f" } { "words" "a sequence of word names" } }
-{ $description "Creates a sequence of word definitions in the current vocabulary. Each word pushes an integer according to the rules of C enums." }
+{ $description "Creates a c-type that boxes and unboxes integer values to singletons. A singleton is defined for each member word. The base c-type can optionally be specified and defaults to " { $snippet "int" } ". A constructor word " { $snippet "<type>" } " is defined for converting from integers to singletons. The generic word " { $link enum>number } " converts from singletons to integers. Enum-typed values are automatically prettyprinted as their singleton words. Unrecognizing enum numbers are kept as numbers." }
-{ $notes "This word emulates a C-style " { $snippet "enum" } " in Factor. While this feature can be used for any purpose, using integer constants is discouraged unless it is for interfacing with C libraries. Factor code should use " { $link "words.symbol" } " or " { $link "singletons" } " instead." }
 { $examples
     "Here is an example enumeration definition:"
     { $code "ENUM: color_t red { green 3 } blue ;" }
-    "It is equivalent to the following series of definitions:"
+    "The following expression returns true:"
-    { $code "CONSTANT: red 0" "CONSTANT: green 3" "CONSTANT: blue 4" }
+    { $code "3 <color_t> [ green = ] [ enum>number 3 = ] bi and" }
 } ;
 
 HELP: C-TYPE: