alien.enums: allow enum members to be given values based on other enum symbols' values

db4
Joe Groff 2010-06-28 15:56:44 -07:00
parent cd183a24b4
commit 0cb3eff34b
3 changed files with 13 additions and 8 deletions

View File

@ -33,3 +33,7 @@ ENUM: instrument_t < ushort trombone trumpet ;
{ V{ { red 0 } { green 3 } { blue 4 } } } { V{ { red 0 } { green 3 } { blue 4 } } }
[ color_t "c-type" word-prop members>> ] unit-test [ color_t "c-type" word-prop members>> ] unit-test
ENUM: colores { rojo red } { verde green } { azul blue } { colorado rojo } ;
[ { 0 3 4 0 } ] [ { rojo verde azul colorado } [ enum>number ] map ] unit-test

View File

@ -12,7 +12,7 @@ PRIVATE>
GENERIC: enum>number ( enum -- number ) foldable GENERIC: enum>number ( enum -- number ) foldable
M: integer enum>number ; M: integer enum>number ;
M: symbol enum>number "enum-value" word-prop ; M: word enum>number "enum-value" word-prop ;
<PRIVATE <PRIVATE
: enum-boxer ( members -- quot ) : enum-boxer ( members -- quot )
@ -32,13 +32,10 @@ M: enum-c-type c-type-setter
<PRIVATE <PRIVATE
: define-enum-value ( class value -- ) : define-enum-value ( class value -- )
"enum-value" set-word-prop ; enum>number "enum-value" set-word-prop ;
: define-enum-members ( member-names -- ) : define-enum-members ( member-names -- )
[ [ first define-symbol ] each ;
[ first define-symbol ]
[ first2 define-enum-value ] bi
] each ;
: define-enum-constructor ( word -- ) : define-enum-constructor ( word -- )
[ name>> "<" ">" surround create-in ] keep [ name>> "<" ">" surround create-in ] keep

View File

@ -4,7 +4,7 @@ USING: accessors alien alien.c-types alien.libraries arrays
assocs classes combinators combinators.short-circuit assocs classes combinators combinators.short-circuit
compiler.units effects grouping kernel parser sequences compiler.units effects grouping kernel parser sequences
splitting words fry locals lexer namespaces summary math splitting words fry locals lexer namespaces summary math
vocabs.parser words.constant ; vocabs.parser words.constant alien.enums ;
IN: alien.parser IN: alien.parser
SYMBOL: current-library SYMBOL: current-library
@ -75,8 +75,12 @@ M: pointer return-type-name to>> return-type-name CHAR: * suffix ;
"*" ?head "*" ?head
[ [ <pointer> ] dip parse-pointers ] when ; [ [ <pointer> ] dip parse-pointers ] when ;
: define-enum-value ( class value -- )
enum>number "enum-value" set-word-prop ;
: next-enum-member ( members name value -- members value' ) : next-enum-member ( members name value -- members value' )
[ 2array suffix! ] [ 1 + ] bi ; [ define-enum-value ]
[ [ 2array suffix! ] [ enum>number 1 + ] bi ] 2bi ;
: parse-enum-name ( -- name ) : parse-enum-name ( -- name )
scan (CREATE-C-TYPE) dup save-location ; scan (CREATE-C-TYPE) dup save-location ;