From fdeb305a3ccc04fc84890bbeaddb76f6863d8cc3 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Mon, 19 Apr 2010 15:53:59 -0700 Subject: [PATCH] Use generic word for enum>number. Tests and documentations. --- basis/alien/enums/enums-docs.factor | 30 +++++++++++++ basis/alien/enums/enums-tests.factor | 35 +++++++++++++++ basis/alien/enums/enums.factor | 65 +++++++++++++++------------ basis/alien/syntax/syntax-docs.factor | 13 +++--- 4 files changed, 107 insertions(+), 36 deletions(-) create mode 100644 basis/alien/enums/enums-docs.factor create mode 100644 basis/alien/enums/enums-tests.factor diff --git a/basis/alien/enums/enums-docs.factor b/basis/alien/enums/enums-docs.factor new file mode 100644 index 0000000000..86c8503c61 --- /dev/null +++ b/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" diff --git a/basis/alien/enums/enums-tests.factor b/basis/alien/enums/enums-tests.factor new file mode 100644 index 0000000000..f0c665830d --- /dev/null +++ b/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 } [ ] map ] unit-test + +{ { 0 3 4 5 } } +[ { red green blue 5 } [ enum>number ] map ] unit-test + +{ { -1 trombone trumpet } } +[ { -1 0 1 } [ ] 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 diff --git a/basis/alien/enums/enums.factor b/basis/alien/enums/enums.factor index 97b694f890..6920a7742d 100644 --- a/basis/alien/enums/enums.factor +++ b/basis/alien/enums/enums.factor @@ -1,48 +1,55 @@ -! (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 + enum-c-type CONSULT: c-type-protocol enum-c-type base-type>> ; - - -: enum-unboxer ( members -- quot ) - [ first2 '[ _ ] 2array ] map-to-case '[ _ case ] ; +GENERIC: enum>number ( enum -- number ) +M: integer enum>number ; -: enum-boxer ( members -- quot ) - [ 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>int ( enum enum-c-type -- int ) - c-type-unboxer-quot call( x -- y ) ; inline - -: int>enum ( int enum-c-type -- enum ) +: number>enum ( number enum-c-type -- enum ) c-type-boxer-quot call( x -- y ) ; inline + +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 @ ] ; + +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 ] [ swap typedef ] bi ; - + [ dup define-enum-constructor ] 2dip + dup define-enum-members + swap typedef ; + PREDICATE: enum-c-type-word < c-type-word "c-type" word-prop enum-c-type? ; diff --git a/basis/alien/syntax/syntax-docs.factor b/basis/alien/syntax/syntax-docs.factor index b7c77dd154..f93f1fb3b8 100644 --- a/basis/alien/syntax/syntax-docs.factor +++ b/basis/alien/syntax/syntax-docs.factor @@ -1,6 +1,6 @@ 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\"" } @@ -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." } -{ $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 "" } " 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 [ green = ] [ enum>number 3 = ] bi and" } } ; HELP: C-TYPE: