]> gitweb.factorcode.org Git - factor.git/commitdiff
alien: merge enum improvements from Blei/gtk-image-loader
authorJoe Groff <arcata@gmail.com>
Sat, 27 Aug 2011 20:48:30 +0000 (13:48 -0700)
committerJoe Groff <arcata@gmail.com>
Sat, 27 Aug 2011 20:48:30 +0000 (13:48 -0700)
basis/alien/enums/enums-tests.factor
basis/alien/enums/enums.factor
basis/alien/parser/parser.factor
basis/alien/syntax/syntax.factor

index f0c665830d25296c1c4c8d17f410b87eb47af403..a7fd665e1374b688ab242b5faadfff266166c684 100644 (file)
@@ -33,3 +33,19 @@ ENUM: instrument_t < ushort trombone trumpet ;
 
 { V{ { red 0 } { green 3 } { blue 4 } } }
 [ 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
+
+SYMBOLS: couleurs rouge vert bleu jaune azure ;
+
+<< \ couleurs int {
+    { rouge red }
+    { vert green }
+    { bleu blue }
+    { jaune 14 }
+    { azure bleu }
+} define-enum >>
+
+[ { 0 3 4 14 4 } ] [ { rouge vert bleu jaune azure } [ enum>number ] map ] unit-test
index b0755c130b249076b404c081b6d9a414caff0db5..5634805f5d33e75bbd250b988b85da875c47a3ac 100644 (file)
@@ -30,16 +30,13 @@ 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-value" set-word-prop ;
+    enum>number "enum-value" set-word-prop ;
+
+<PRIVATE
 
 : define-enum-members ( members -- )
-    [
-        [ drop define-singleton-class ]
-        [ define-enum-value ] 2bi
-    ] assoc-each ;
+    [ first define-singleton-class ] each ;
 
 : define-enum-constructor ( word -- )
     [ name>> "<" ">" surround create-in ] keep
@@ -47,10 +44,14 @@ M: enum-c-type c-type-setter
 
 PRIVATE>
 
-: define-enum ( word base-type members -- )
+: (define-enum) ( word base-type members -- )
     [ dup define-enum-constructor ] 2dip
     [ 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? ;
index 6d0cbb79cc7f23d099939e500f3b5fcc638fcfa1..09fedc5e3cca13e8bcb6736b518722ab584f4eb4 100755 (executable)
@@ -4,7 +4,7 @@ USING: accessors alien alien.c-types alien.libraries arrays
 assocs classes combinators combinators.short-circuit
 compiler.units effects grouping kernel parser sequences
 splitting words fry locals lexer namespaces summary math
-vocabs.parser words.constant classes.parser ;
+vocabs.parser words.constant classes.parser alien.enums ;
 IN: alien.parser
 
 SYMBOL: current-library
@@ -84,7 +84,8 @@ M: pointer return-type-name to>> return-type-name CHAR: * suffix ;
     [ [ <pointer> ] dip parse-pointers ] when ;
 
 : 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 )
     scan (CREATE-C-TYPE) dup save-location ;
index 259f99a833ba7faa16d43198fedf727442c002b6..fe5a6dcadc5de992e8d3d58b44e59f496d61aacf 100755 (executable)
@@ -29,7 +29,7 @@ SYNTAX: TYPEDEF:
     scan-c-type CREATE-C-TYPE dup save-location typedef ;
 
 SYNTAX: ENUM:
-    parse-enum define-enum ;
+    parse-enum (define-enum) ;
 
 SYNTAX: C-TYPE:
     void CREATE-C-TYPE typedef ;