alien.enums: allow enum members to be given values based on other enum symbols' values
parent
cd183a24b4
commit
0cb3eff34b
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
Loading…
Reference in New Issue