--- /dev/null
+! 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"
--- /dev/null
+! 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
-! (c)2010 Joe Groff bsd license
-USING: accessors alien.c-types arrays combinators delegate fry
-kernel quotations sequences words.symbol words ;
+! (c)2010 Joe Groff, Erik Charlebois bsd license
+USING: accessors alien.c-types arrays classes.singleton combinators
+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 )
- [ first2 '[ _ ] 2array ] map-to-case '[ _ case ] ;
+GENERIC: enum>number ( enum -- number )
+M: integer enum>number ;
+: number>enum ( number enum-c-type -- enum )
+ c-type-boxer-quot call( x -- y ) ; inline
+
+<PRIVATE
: enum-boxer ( members -- quot )
- [ first2 swap '[ _ ] 2array ] map-to-case '[ _ case ] ;
+ [ 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 members>> enum-unboxer ;
+M: enum-c-type c-type-unboxer-quot drop [ enum>number ] ;
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
+ [ 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? ;
IN: alien.syntax
-USING: alien alien.c-types alien.parser alien.libraries
-classes.struct help.markup help.syntax see ;
+USING: alien alien.c-types alien.enums alien.libraries classes.struct
+help.markup help.syntax see ;
HELP: DLL"
{ $syntax "DLL\" path\"" }
{ $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." }
-{ $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." }
+{ $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." }
{ $examples
"Here is an example enumeration definition:"
{ $code "ENUM: color_t red { green 3 } blue ;" }
- "It is equivalent to the following series of definitions:"
- { $code "CONSTANT: red 0" "CONSTANT: green 3" "CONSTANT: blue 4" }
+ "The following expression returns true:"
+ { $code "3 <color_t> [ green = ] [ enum>number 3 = ] bi and" }
} ;
HELP: C-TYPE:
projects / factor.git / commitdiff