From d387947033189141696897ae37ad2b45c12b7ae3 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Fri, 16 Apr 2010 13:41:16 -0700 Subject: [PATCH 01/10] FUEL: Syntax highlight CONSULT: and PROTOCOL: --- misc/fuel/fuel-syntax.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 026a7738e0..c6638915b7 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -1,3 +1,4 @@ + ;;; fuel-syntax.el --- auxiliar definitions for factor code navigation. ;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz @@ -46,7 +47,7 @@ '(":" "::" ";" "&:" "<<" ">" "ABOUT:" "AFTER:" "ALIAS:" "ALIEN:" "ARTICLE:" "B" "BEFORE:" "BIN:" - "C:" "CALLBACK:" "C-ENUM:" "C-STRUCT:" "C-TYPE:" "C-UNION:" "CHAR:" "COM-INTERFACE:" "CONSTANT:" "call-next-method" + "C:" "CALLBACK:" "C-ENUM:" "C-TYPE:" "CHAR:" "COM-INTERFACE:" "CONSTANT:" "CONSULT:" "call-next-method" "DEFER:" "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:" "f" "FORGET:" "FROM:" "FUNCTION:" @@ -59,7 +60,7 @@ "MEMO:" "MEMO:" "METHOD:" "MIXIN:" "NAN:" "OCT:" - "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:" + "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROTOCOL:" "PROVIDE:" "QUALIFIED-WITH:" "QUALIFIED:" "read-only" "RENAME:" "REQUIRE:" "REQUIRES:" "SINGLETON:" "SINGLETONS:" "SLOT:" "SPECIALIZED-ARRAY:" "SPECIALIZED-ARRAYS:" "STRING:" "STRUCT:" "SYMBOL:" "SYMBOLS:" "SYNTAX:" @@ -164,13 +165,13 @@ (defconst fuel-syntax--indent-def-starts '("" ":" "AFTER" "BEFORE" - "C-ENUM" "C-STRUCT" "C-UNION" "COM-INTERFACE" + "C-ENUM" "COM-INTERFACE" "CONSULT" "FROM" "FUNCTION:" "INTERSECTION:" "M" "M:" "MACRO" "MACRO:" "MEMO" "MEMO:" "METHOD" "SYNTAX" - "PREDICATE" "PRIMITIVE" + "PREDICATE" "PRIMITIVE" "PROTOCOL" "SINGLETONS" "STRUCT" "SYMBOLS" "TAG" "TUPLE" "TYPED" "TYPED:" From 4bc915d526f86fe6757315e99679e3a6cd17ae2b Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 12 Apr 2010 21:02:55 -0700 Subject: [PATCH 02/10] C-ENUM: -> ENUM: --- basis/alien/data/data-docs.factor | 2 +- basis/alien/syntax/syntax-docs.factor | 6 +-- basis/alien/syntax/syntax.factor | 2 +- basis/cairo/ffi/ffi.factor | 36 ++++++++-------- basis/cocoa/application/application.factor | 2 +- basis/compiler/constants/constants.factor | 4 +- basis/core-graphics/core-graphics.factor | 2 +- basis/pango/fonts/fonts.factor | 2 +- basis/unicode/breaks/breaks.factor | 4 +- basis/vm/vm.factor | 2 +- basis/windows/advapi32/advapi32.factor | 10 ++--- basis/windows/ddk/hid/hid.factor | 4 +- basis/windows/ddk/setupapi/setupapi.factor | 2 +- basis/windows/ddk/winusb/winusb.factor | 2 +- .../directx/d3d11shader/d3d11shader.factor | 2 +- .../directx/d3d9types/d3d9types.factor | 2 +- basis/windows/directx/d3dcsx/d3dcsx.factor | 2 +- .../directx/d3dx9shader/d3dx9shader.factor | 8 ++-- basis/windows/directx/dcommon/dcommon.factor | 2 +- basis/windows/directx/dwrite/dwrite.factor | 42 +++++++++---------- .../windows/directx/dxgitype/dxgitype.factor | 6 +-- basis/windows/directx/xapo/xapo.factor | 2 +- basis/windows/directx/xaudio2/xaudio2.factor | 2 +- basis/windows/kernel32/kernel32.factor | 2 +- basis/windows/usp10/usp10.factor | 2 +- basis/x11/constants/constants.factor | 2 +- extra/chipmunk/ffi/ffi.factor | 4 +- extra/cuda/ffi/ffi.factor | 34 +++++++-------- extra/freetype/freetype.factor | 4 +- extra/libusb/libusb.factor | 24 +++++------ extra/llvm/core/core.factor | 14 +++---- extra/macho/macho.factor | 6 +-- extra/tokyo/alien/tcadb/tcadb.factor | 2 +- extra/tokyo/alien/tcbdb/tcbdb.factor | 2 +- extra/tokyo/alien/tcrdb/tcrdb.factor | 2 +- extra/tokyo/alien/tctdb/tctdb.factor | 6 +-- extra/tokyo/alien/tcutil/tcutil.factor | 2 +- 37 files changed, 127 insertions(+), 127 deletions(-) diff --git a/basis/alien/data/data-docs.factor b/basis/alien/data/data-docs.factor index d36a4d5fd2..c5130001d9 100644 --- a/basis/alien/data/data-docs.factor +++ b/basis/alien/data/data-docs.factor @@ -105,7 +105,7 @@ $nl "Important guidelines for passing data in byte arrays:" { $subsections "byte-arrays-gc" } "C-style enumerated types are supported:" -{ $subsections POSTPONE: C-ENUM: } +{ $subsections POSTPONE: ENUM: } "C types can be aliased for convenience and consistency with native library documentation:" { $subsections POSTPONE: TYPEDEF: } "A utility for defining " { $link "destructors" } " for deallocating memory:" diff --git a/basis/alien/syntax/syntax-docs.factor b/basis/alien/syntax/syntax-docs.factor index b71d0bd533..b7c77dd154 100644 --- a/basis/alien/syntax/syntax-docs.factor +++ b/basis/alien/syntax/syntax-docs.factor @@ -69,14 +69,14 @@ HELP: TYPEDEF: { $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } "." } { $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: C-ENUM: -{ $syntax "C-ENUM: type/f words... ;" } +HELP: ENUM: +{ $syntax "ENUM: type/f 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." } { $examples "Here is an example enumeration definition:" - { $code "C-ENUM: color_t red { green 3 } blue ;" } + { $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" } } ; diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index 41aed99446..b6cb4af8f6 100755 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -28,7 +28,7 @@ SYNTAX: CALLBACK: SYNTAX: TYPEDEF: scan-c-type CREATE-C-TYPE dup save-location typedef ; -SYNTAX: C-ENUM: +SYNTAX: ENUM: scan dup "f" = [ drop ] [ (CREATE-C-TYPE) dup save-location int swap typedef ] if diff --git a/basis/cairo/ffi/ffi.factor b/basis/cairo/ffi/ffi.factor index fafc41af26..026fa621f8 100644 --- a/basis/cairo/ffi/ffi.factor +++ b/basis/cairo/ffi/ffi.factor @@ -46,7 +46,7 @@ TYPEDEF: void* cairo_destroy_func_t STRUCT: cairo_user_data_key_t { unused int } ; -C-ENUM: cairo_status_t +ENUM: cairo_status_t CAIRO_STATUS_SUCCESS CAIRO_STATUS_NO_MEMORY CAIRO_STATUS_INVALID_RESTORE @@ -126,7 +126,7 @@ FUNCTION: void cairo_pop_group_to_source ( cairo_t* cr ) ; ! Modify state -C-ENUM: cairo_operator_t +ENUM: cairo_operator_t CAIRO_OPERATOR_CLEAR CAIRO_OPERATOR_SOURCE @@ -163,7 +163,7 @@ cairo_set_source_surface ( cairo_t* cr, cairo_surface_t* surface, double x, doub FUNCTION: void cairo_set_tolerance ( cairo_t* cr, double tolerance ) ; -C-ENUM: cairo_antialias_t +ENUM: cairo_antialias_t CAIRO_ANTIALIAS_DEFAULT CAIRO_ANTIALIAS_NONE CAIRO_ANTIALIAS_GRAY @@ -172,7 +172,7 @@ C-ENUM: cairo_antialias_t FUNCTION: void cairo_set_antialias ( cairo_t* cr, cairo_antialias_t antialias ) ; -C-ENUM: cairo_fill_rule_t +ENUM: cairo_fill_rule_t CAIRO_FILL_RULE_WINDING CAIRO_FILL_RULE_EVEN_ODD ; @@ -182,7 +182,7 @@ cairo_set_fill_rule ( cairo_t* cr, cairo_fill_rule_t fill_rule ) ; FUNCTION: void cairo_set_line_width ( cairo_t* cr, double width ) ; -C-ENUM: cairo_line_cap_t +ENUM: cairo_line_cap_t CAIRO_LINE_CAP_BUTT CAIRO_LINE_CAP_ROUND CAIRO_LINE_CAP_SQUARE ; @@ -190,7 +190,7 @@ C-ENUM: cairo_line_cap_t FUNCTION: void cairo_set_line_cap ( cairo_t* cr, cairo_line_cap_t line_cap ) ; -C-ENUM: cairo_line_join_t +ENUM: cairo_line_join_t CAIRO_LINE_JOIN_MITER CAIRO_LINE_JOIN_ROUND CAIRO_LINE_JOIN_BEVEL ; @@ -375,30 +375,30 @@ STRUCT: cairo_font_extents_t { max_x_advance double } { max_y_advance double } ; -C-ENUM: cairo_font_slant_t +ENUM: cairo_font_slant_t CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_SLANT_ITALIC CAIRO_FONT_SLANT_OBLIQUE ; -C-ENUM: cairo_font_weight_t +ENUM: cairo_font_weight_t CAIRO_FONT_WEIGHT_NORMAL CAIRO_FONT_WEIGHT_BOLD ; -C-ENUM: cairo_subpixel_order_t +ENUM: cairo_subpixel_order_t CAIRO_SUBPIXEL_ORDER_DEFAULT CAIRO_SUBPIXEL_ORDER_RGB CAIRO_SUBPIXEL_ORDER_BGR CAIRO_SUBPIXEL_ORDER_VRGB CAIRO_SUBPIXEL_ORDER_VBGR ; -C-ENUM: cairo_hint_style_t +ENUM: cairo_hint_style_t CAIRO_HINT_STYLE_DEFAULT CAIRO_HINT_STYLE_NONE CAIRO_HINT_STYLE_SLIGHT CAIRO_HINT_STYLE_MEDIUM CAIRO_HINT_STYLE_FULL ; -C-ENUM: cairo_hint_metrics_t +ENUM: cairo_hint_metrics_t CAIRO_HINT_METRICS_DEFAULT CAIRO_HINT_METRICS_OFF CAIRO_HINT_METRICS_ON ; @@ -518,7 +518,7 @@ cairo_font_face_get_reference_count ( cairo_font_face_t* font_face ) ; FUNCTION: cairo_status_t cairo_font_face_status ( cairo_font_face_t* font_face ) ; -C-ENUM: cairo_font_type_t +ENUM: cairo_font_type_t CAIRO_FONT_TYPE_TOY CAIRO_FONT_TYPE_FT CAIRO_FONT_TYPE_WIN32 @@ -630,7 +630,7 @@ cairo_get_target ( cairo_t* cr ) ; FUNCTION: cairo_surface_t* cairo_get_group_target ( cairo_t* cr ) ; -C-ENUM: cairo_path_data_type_t +ENUM: cairo_path_data_type_t CAIRO_PATH_MOVE_TO CAIRO_PATH_LINE_TO CAIRO_PATH_CURVE_TO @@ -696,7 +696,7 @@ cairo_surface_get_reference_count ( cairo_surface_t* surface ) ; FUNCTION: cairo_status_t cairo_surface_status ( cairo_surface_t* surface ) ; -C-ENUM: cairo_surface_type_t +ENUM: cairo_surface_type_t CAIRO_SURFACE_TYPE_IMAGE CAIRO_SURFACE_TYPE_PDF CAIRO_SURFACE_TYPE_PS @@ -759,7 +759,7 @@ cairo_surface_show_page ( cairo_surface_t* surface ) ; ! Image-surface functions -C-ENUM: cairo_format_t +ENUM: cairo_format_t CAIRO_FORMAT_ARGB32 CAIRO_FORMAT_RGB24 CAIRO_FORMAT_A8 @@ -831,7 +831,7 @@ cairo_pattern_get_user_data ( cairo_pattern_t* pattern, cairo_user_data_key_t* k FUNCTION: cairo_status_t cairo_pattern_set_user_data ( cairo_pattern_t* pattern, cairo_user_data_key_t* key, void* user_data, cairo_destroy_func_t destroy ) ; -C-ENUM: cairo_pattern_type_t +ENUM: cairo_pattern_type_t CAIRO_PATTERN_TYPE_SOLID CAIRO_PATTERN_TYPE_SURFACE CAIRO_PATTERN_TYPE_LINEAR @@ -852,7 +852,7 @@ cairo_pattern_set_matrix ( cairo_pattern_t* pattern, cairo_matrix_t* matrix ) ; FUNCTION: void cairo_pattern_get_matrix ( cairo_pattern_t* pattern, cairo_matrix_t* matrix ) ; -C-ENUM: cairo_extend_t +ENUM: cairo_extend_t CAIRO_EXTEND_NONE CAIRO_EXTEND_REPEAT CAIRO_EXTEND_REFLECT @@ -864,7 +864,7 @@ cairo_pattern_set_extend ( cairo_pattern_t* pattern, cairo_extend_t extend ) ; FUNCTION: cairo_extend_t cairo_pattern_get_extend ( cairo_pattern_t* pattern ) ; -C-ENUM: cairo_filter_t +ENUM: cairo_filter_t CAIRO_FILTER_FAST CAIRO_FILTER_GOOD CAIRO_FILTER_BEST diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor index 6768e1471d..fc5d2baccc 100644 --- a/basis/cocoa/application/application.factor +++ b/basis/cocoa/application/application.factor @@ -8,7 +8,7 @@ IN: cocoa.application : ( str -- alien ) -> autorelease ; -C-ENUM: f +ENUM: f NSApplicationDelegateReplySuccess NSApplicationDelegateReplyCancel NSApplicationDelegateReplyFailure ; diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index 0e2fc3041b..7d8ef4791b 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -40,7 +40,7 @@ CONSTANT: deck-bits 18 : segment-end-offset ( -- n ) 2 bootstrap-cells ; inline ! Relocation classes -C-ENUM: f +ENUM: f rc-absolute-cell rc-absolute rc-relative @@ -55,7 +55,7 @@ C-ENUM: f rc-absolute-1 ; ! Relocation types -C-ENUM: f +ENUM: f rt-dlsym rt-entry-point rt-entry-point-pic diff --git a/basis/core-graphics/core-graphics.factor b/basis/core-graphics/core-graphics.factor index 92925f5d64..1e797a3329 100644 --- a/basis/core-graphics/core-graphics.factor +++ b/basis/core-graphics/core-graphics.factor @@ -6,7 +6,7 @@ images images.memory core-graphics.types core-foundation.utilities opengl.gl literals ; IN: core-graphics -C-ENUM: CGImageAlphaInfo +ENUM: CGImageAlphaInfo kCGImageAlphaNone kCGImageAlphaPremultipliedLast kCGImageAlphaPremultipliedFirst diff --git a/basis/pango/fonts/fonts.factor b/basis/pango/fonts/fonts.factor index 7ea4e0a0c2..979e40947c 100644 --- a/basis/pango/fonts/fonts.factor +++ b/basis/pango/fonts/fonts.factor @@ -8,7 +8,7 @@ IN: pango.fonts LIBRARY: pango -C-ENUM: PangoStyle +ENUM: PangoStyle PANGO_STYLE_NORMAL PANGO_STYLE_OBLIQUE PANGO_STYLE_ITALIC ; diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index 2ab8b27cc7..f330cdb85c 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -12,7 +12,7 @@ IN: unicode.breaks Date: Mon, 12 Apr 2010 21:42:48 -0700 Subject: [PATCH 03/10] alien.parser, alien.syntax: refactor ENUM: to separate parsing from definition --- basis/alien/parser/parser.factor | 27 ++++++++++++++++++--------- basis/alien/syntax/syntax.factor | 6 +++--- 2 files changed, 21 insertions(+), 12 deletions(-) diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 1db4ca5cd8..63f5043eeb 100755 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -75,19 +75,28 @@ M: pointer return-type-name to>> return-type-name CHAR: * suffix ; "*" ?head [ [ ] dip parse-pointers ] when ; +: next-enum-member ( members name value -- members value' ) + [ 2array suffix! ] [ 1 + ] bi ; + PRIVATE> -: define-enum-member ( word-string value -- next-value ) - [ create-in ] dip [ define-constant ] keep 1 + ; +: define-enum-member ( name value -- ) + [ create-in ] [ define-constant ] bi* ; -: parse-enum-member ( word-string value -- next-value ) - over "{" = - [ 2drop scan scan-object define-enum-member "}" expect ] - [ define-enum-member ] if ; +: define-enum-members ( members -- ) + [ first2 define-enum-member ] each ; -: parse-enum-members ( counter -- ) - scan dup ";" = not - [ swap parse-enum-member parse-enum-members ] [ 2drop ] if ; +: parse-enum-member ( members name value -- members value' ) + over "{" = + [ 2drop scan scan-object next-enum-member "}" expect ] + [ next-enum-member ] if ; + +: parse-enum-members ( members counter -- members ) + scan dup ";" = not + [ swap parse-enum-member parse-enum-members ] [ 2drop ] if ; + +: define-enum ( word members -- ) + [ int swap typedef ] [ define-enum-members ] bi* ; : scan-function-name ( -- return function ) scan-c-type scan parse-pointers ; diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index b6cb4af8f6..c69a9b8ebe 100755 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -30,9 +30,9 @@ SYNTAX: TYPEDEF: SYNTAX: ENUM: scan dup "f" = - [ drop ] - [ (CREATE-C-TYPE) dup save-location int swap typedef ] if - 0 parse-enum-members ; + [ drop f ] + [ (CREATE-C-TYPE) dup save-location ] if + V{ } clone 0 parse-enum-members define-enum ; SYNTAX: C-TYPE: void CREATE-C-TYPE typedef ; From f394cb4fdca8044c8da8d2f79bdd5a69c1c4ad54 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 12 Apr 2010 21:54:41 -0700 Subject: [PATCH 04/10] alien.parser: have define-enum handle the case when the enum name is f --- basis/alien/parser/parser.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 63f5043eeb..952f7b64d9 100755 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -96,7 +96,7 @@ PRIVATE> [ swap parse-enum-member parse-enum-members ] [ 2drop ] if ; : define-enum ( word members -- ) - [ int swap typedef ] [ define-enum-members ] bi* ; + [ [ int swap typedef ] when ] [ define-enum-members ] bi* ; : scan-function-name ( -- return function ) scan-c-type scan parse-pointers ; From 6e55a3b8f5b1f6c707e2c85269f7996ac349b838 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 12 Apr 2010 21:58:08 -0700 Subject: [PATCH 05/10] alien.parser, alien.syntax: send ENUM: body to parse-enum --- basis/alien/parser/parser.factor | 24 +++++++++++++++--------- basis/alien/syntax/syntax.factor | 5 +---- 2 files changed, 16 insertions(+), 13 deletions(-) diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 952f7b64d9..731cc4d6b5 100755 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -78,14 +78,6 @@ M: pointer return-type-name to>> return-type-name CHAR: * suffix ; : next-enum-member ( members name value -- members value' ) [ 2array suffix! ] [ 1 + ] bi ; -PRIVATE> - -: define-enum-member ( name value -- ) - [ create-in ] [ define-constant ] bi* ; - -: define-enum-members ( members -- ) - [ first2 define-enum-member ] each ; - : parse-enum-member ( members name value -- members value' ) over "{" = [ 2drop scan scan-object next-enum-member "}" expect ] @@ -95,8 +87,22 @@ PRIVATE> scan dup ";" = not [ swap parse-enum-member parse-enum-members ] [ 2drop ] if ; +: define-enum-member ( name value -- ) + [ create-in ] [ define-constant ] bi* ; + +: define-enum-members ( members -- ) + [ first2 define-enum-member ] each ; + +PRIVATE> + +: parse-enum ( -- name members ) + scan dup "f" = + [ drop f ] + [ (CREATE-C-TYPE) dup save-location ] if + V{ } clone 0 parse-enum-members ; + : define-enum ( word members -- ) - [ [ int swap typedef ] when ] [ define-enum-members ] bi* ; + [ [ int swap typedef ] when* ] [ define-enum-members ] bi* ; : scan-function-name ( -- return function ) scan-c-type scan parse-pointers ; diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index c69a9b8ebe..be137b1da8 100755 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -29,10 +29,7 @@ SYNTAX: TYPEDEF: scan-c-type CREATE-C-TYPE dup save-location typedef ; SYNTAX: ENUM: - scan dup "f" = - [ drop f ] - [ (CREATE-C-TYPE) dup save-location ] if - V{ } clone 0 parse-enum-members define-enum ; + parse-enum define-enum ; SYNTAX: C-TYPE: void CREATE-C-TYPE typedef ; From e730d3b6d566bf19b93a1d77f92919a0e6d5dd1a Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 12 Apr 2010 23:04:29 -0700 Subject: [PATCH 06/10] alien.c-types: use CONSULT: to define c-type-protocol methods on c-type-name --- basis/alien/c-types/c-types.factor | 61 ++++++++++++------------------ 1 file changed, 24 insertions(+), 37 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 17bf4765b8..ff3c9b8dde 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: byte-arrays arrays assocs kernel kernel.private math +USING: byte-arrays arrays assocs delegate kernel kernel.private math math.order math.parser namespaces make parser sequences strings words splitting cpu.architecture alien alien.accessors alien.strings quotations layouts system compiler.units io @@ -79,74 +79,50 @@ GENERIC: c-type-class ( name -- class ) M: abstract-c-type c-type-class class>> ; -M: c-type-name c-type-class c-type c-type-class ; - GENERIC: c-type-boxed-class ( name -- class ) M: abstract-c-type c-type-boxed-class boxed-class>> ; -M: c-type-name c-type-boxed-class c-type c-type-boxed-class ; - GENERIC: c-type-boxer ( name -- boxer ) M: c-type c-type-boxer boxer>> ; -M: c-type-name c-type-boxer c-type c-type-boxer ; - GENERIC: c-type-boxer-quot ( name -- quot ) M: abstract-c-type c-type-boxer-quot boxer-quot>> ; -M: c-type-name c-type-boxer-quot c-type c-type-boxer-quot ; - GENERIC: c-type-unboxer ( name -- boxer ) M: c-type c-type-unboxer unboxer>> ; -M: c-type-name c-type-unboxer c-type c-type-unboxer ; - GENERIC: c-type-unboxer-quot ( name -- quot ) M: abstract-c-type c-type-unboxer-quot unboxer-quot>> ; -M: c-type-name c-type-unboxer-quot c-type c-type-unboxer-quot ; - GENERIC: c-type-rep ( name -- rep ) M: c-type c-type-rep rep>> ; -M: c-type-name c-type-rep c-type c-type-rep ; - GENERIC: c-type-getter ( name -- quot ) M: c-type c-type-getter getter>> ; -M: c-type-name c-type-getter c-type c-type-getter ; - GENERIC: c-type-setter ( name -- quot ) M: c-type c-type-setter setter>> ; -M: c-type-name c-type-setter c-type c-type-setter ; - GENERIC: c-type-align ( name -- n ) M: abstract-c-type c-type-align align>> ; -M: c-type-name c-type-align c-type c-type-align ; - GENERIC: c-type-align-first ( name -- n ) -M: c-type-name c-type-align-first c-type c-type-align-first ; - M: abstract-c-type c-type-align-first align-first>> ; GENERIC: c-type-stack-align? ( name -- ? ) M: c-type c-type-stack-align? stack-align?>> ; -M: c-type-name c-type-stack-align? c-type c-type-stack-align? ; - : c-type-box ( n c-type -- ) [ c-type-rep ] [ c-type-boxer [ "No boxer" throw ] unless* ] bi %box ; @@ -159,38 +135,26 @@ GENERIC: box-parameter ( n c-type -- ) M: c-type box-parameter c-type-box ; -M: c-type-name box-parameter c-type box-parameter ; - GENERIC: box-return ( c-type -- ) M: c-type box-return f swap c-type-box ; -M: c-type-name box-return c-type box-return ; - GENERIC: unbox-parameter ( n c-type -- ) M: c-type unbox-parameter c-type-unbox ; -M: c-type-name unbox-parameter c-type unbox-parameter ; - GENERIC: unbox-return ( c-type -- ) M: c-type unbox-return f swap c-type-unbox ; -M: c-type-name unbox-return c-type unbox-return ; - : little-endian? ( -- ? ) 1 *char 1 = ; foldable GENERIC: heap-size ( name -- size ) -M: c-type-name heap-size c-type heap-size ; - M: abstract-c-type heap-size size>> ; GENERIC: stack-size ( name -- size ) -M: c-type-name stack-size c-type stack-size ; - M: c-type stack-size size>> cell align ; : >c-bool ( ? -- int ) 1 0 ? ; inline @@ -217,6 +181,29 @@ MIXIN: value-type \ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi* ] [ ] make ; +PROTOCOL: c-type-protocol + c-type-class + c-type-boxed-class + c-type-boxer + c-type-boxer-quot + c-type-unboxer + c-type-unboxer-quot + c-type-rep + c-type-getter + c-type-setter + c-type-align + c-type-align-first + c-type-stack-align? + box-parameter + box-return + unbox-parameter + unbox-return + heap-size + stack-size ; + +CONSULT: c-type-protocol c-type-name + c-type ; + PREDICATE: typedef-word < c-type-word "c-type" word-prop c-type-name? ; From d3f770d54533b480b4189618b6ee3cfa1aff39df Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 12 Apr 2010 23:58:58 -0700 Subject: [PATCH 07/10] add alien.enums vocab with enum-c-types that convert between symbols and integer values in the FFI. update ENUM: to define symbolic enums, and take an optional base type --- basis/alien/enums/enums.factor | 38 ++++++++++++++++++++++++++++++++ basis/alien/parser/parser.factor | 38 ++++++++++++++++---------------- basis/alien/syntax/syntax.factor | 2 +- 3 files changed, 58 insertions(+), 20 deletions(-) create mode 100644 basis/alien/enums/enums.factor diff --git a/basis/alien/enums/enums.factor b/basis/alien/enums/enums.factor new file mode 100644 index 0000000000..7cef34369d --- /dev/null +++ b/basis/alien/enums/enums.factor @@ -0,0 +1,38 @@ +! (c)2010 Joe Groff bsd license +USING: accessors alien.c-types arrays combinators delegate fry +kernel quotations sequences words.symbol ; +IN: alien.enums + +TUPLE: enum-c-type base-type members ; + +CONSULT: c-type-protocol enum-c-type + base-type>> ; + +: map-to-case ( quot: ( x -- y ) -- case ) + { } map-as [ ] suffix ; inline + +: enum-unboxer ( members -- quot ) + [ first2 '[ _ ] 2array ] map-to-case '[ _ case ] ; + +: 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 + + + +: define-enum ( word base-type members -- ) + [ define-enum-members ] [ swap typedef ] bi ; + diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 731cc4d6b5..07f0d49f2f 100755 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -78,31 +78,31 @@ M: pointer return-type-name to>> return-type-name CHAR: * suffix ; : next-enum-member ( members name value -- members value' ) [ 2array suffix! ] [ 1 + ] bi ; +: parse-enum-name ( -- name ) + scan dup "f" = + [ drop f ] + [ (CREATE-C-TYPE) dup save-location ] if ; + +: parse-enum-base-type ( -- base-type token ) + scan dup "<" = + [ drop scan-object scan ] + [ [ int ] dip ] if ; + : parse-enum-member ( members name value -- members value' ) over "{" = - [ 2drop scan scan-object next-enum-member "}" expect ] - [ next-enum-member ] if ; + [ 2drop scan create-in scan-object next-enum-member "}" expect ] + [ [ create-in ] dip next-enum-member ] if ; -: parse-enum-members ( members counter -- members ) - scan dup ";" = not - [ swap parse-enum-member parse-enum-members ] [ 2drop ] if ; - -: define-enum-member ( name value -- ) - [ create-in ] [ define-constant ] bi* ; - -: define-enum-members ( members -- ) - [ first2 define-enum-member ] each ; +: parse-enum-members ( members counter token -- members ) + dup ";" = not + [ swap parse-enum-member scan parse-enum-members ] [ 2drop ] if ; PRIVATE> -: parse-enum ( -- name members ) - scan dup "f" = - [ drop f ] - [ (CREATE-C-TYPE) dup save-location ] if - V{ } clone 0 parse-enum-members ; - -: define-enum ( word members -- ) - [ [ int swap typedef ] when* ] [ define-enum-members ] bi* ; +: parse-enum ( -- name base-type members ) + parse-enum-name + parse-enum-base-type + [ V{ } clone 0 ] dip parse-enum-members ; : scan-function-name ( -- return function ) scan-c-type scan parse-pointers ; diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index be137b1da8..570ebf60a5 100755 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2010 Slava Pestov, Alex Chapman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays alien alien.c-types alien.arrays +USING: accessors arrays alien alien.c-types alien.enums alien.arrays alien.strings kernel math namespaces parser sequences words quotations math.parser splitting grouping effects assocs combinators lexer strings.parser alien.parser fry vocabs.parser From 52903ee59787c0a35d0ff34bdd3b223dcc46bed8 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 13 Apr 2010 00:13:18 -0700 Subject: [PATCH 08/10] prettyprint ENUM: definitions --- basis/alien/enums/enums.factor | 4 ++++ basis/alien/prettyprint/prettyprint.factor | 21 +++++++++++++++++---- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/basis/alien/enums/enums.factor b/basis/alien/enums/enums.factor index 7cef34369d..bd508df075 100644 --- a/basis/alien/enums/enums.factor +++ b/basis/alien/enums/enums.factor @@ -8,8 +8,10 @@ TUPLE: enum-c-type base-type members ; CONSULT: c-type-protocol enum-c-type base-type>> ; + : enum-unboxer ( members -- quot ) [ first2 '[ _ ] 2array ] map-to-case '[ _ case ] ; @@ -36,3 +38,5 @@ PRIVATE> : define-enum ( word base-type members -- ) [ define-enum-members ] [ swap typedef ] bi ; +PREDICATE: enum-c-type-word < c-type-word + "c-type" word-prop enum-c-type? ; diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor index c47dafbfce..8ba1328dcd 100644 --- a/basis/alien/prettyprint/prettyprint.factor +++ b/basis/alien/prettyprint/prettyprint.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel combinators alien alien.strings alien.c-types -alien.parser alien.syntax arrays assocs effects math.parser -prettyprint.backend prettyprint.custom prettyprint.sections -definitions see see.private sequences strings words ; +USING: accessors kernel combinators alien alien.enums +alien.strings alien.c-types alien.parser alien.syntax arrays +assocs effects math.parser prettyprint.backend prettyprint.custom +prettyprint.sections definitions see see.private sequences +strings words ; IN: alien.prettyprint M: alien pprint* @@ -110,3 +111,15 @@ M: alien-callback-type-word synopsis* ")" text block> ] } cleave ; + +M: enum-c-type-word definer + drop \ ENUM: \ ; ; +M: enum-c-type-word synopsis* + { + [ seeing-word ] + [ definer. ] + [ pprint-word ] + [ c-type base-type>> dup int eq? [ drop ] [ "<" text pprint-word ] if ] + } cleave ; +M: enum-c-type-word definition + c-type members>> ; From baab8c060d1eeff8e7683e6132c604d2c0bda15f Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Sun, 18 Apr 2010 13:34:18 -0700 Subject: [PATCH 09/10] Remove ENUM: f and replace uses with CONSTANTs. Fix bootstrap and load-all errors from enum classes. --- basis/alien/enums/enums.factor | 8 ++- basis/alien/parser/parser.factor | 4 +- basis/cocoa/application/application.factor | 7 +-- basis/compiler/constants/constants.factor | 66 +++++++++++----------- basis/core-graphics/core-graphics.factor | 16 +++--- basis/unicode/breaks/breaks.factor | 31 ++++++++-- basis/vm/vm.factor | 13 ++--- basis/windows/usp10/usp10.factor | 33 ++++++----- basis/x11/constants/constants.factor | 4 +- extra/freetype/freetype.factor | 26 ++++----- extra/tokyo/alien/tcadb/tcadb.factor | 17 +++--- extra/tokyo/alien/tcbdb/tcbdb.factor | 7 +-- extra/tokyo/alien/tcrdb/tcrdb.factor | 19 +++---- extra/tokyo/alien/tctdb/tctdb.factor | 45 +++++++-------- extra/tokyo/alien/tcutil/tcutil.factor | 9 ++- misc/fuel/fuel-syntax.el | 6 +- unmaintained/cryptlib/libcl/libcl.factor | 12 ++-- unmaintained/pdf/libhpdf/libhpdf.factor | 12 ++-- 18 files changed, 173 insertions(+), 162 deletions(-) diff --git a/basis/alien/enums/enums.factor b/basis/alien/enums/enums.factor index bd508df075..97b694f890 100644 --- a/basis/alien/enums/enums.factor +++ b/basis/alien/enums/enums.factor @@ -1,6 +1,6 @@ ! (c)2010 Joe Groff bsd license USING: accessors alien.c-types arrays combinators delegate fry -kernel quotations sequences words.symbol ; +kernel quotations sequences words.symbol words ; IN: alien.enums TUPLE: enum-c-type base-type members ; @@ -28,6 +28,12 @@ M: enum-c-type c-type-setter 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 ) + c-type-boxer-quot call( x -- y ) ; inline + > return-type-name CHAR: * suffix ; [ 2array suffix! ] [ 1 + ] bi ; : parse-enum-name ( -- name ) - scan dup "f" = - [ drop f ] - [ (CREATE-C-TYPE) dup save-location ] if ; + scan (CREATE-C-TYPE) dup save-location ; : parse-enum-base-type ( -- base-type token ) scan dup "<" = diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor index fc5d2baccc..db1eefca14 100644 --- a/basis/cocoa/application/application.factor +++ b/basis/cocoa/application/application.factor @@ -8,10 +8,9 @@ IN: cocoa.application : ( str -- alien ) -> autorelease ; -ENUM: f -NSApplicationDelegateReplySuccess -NSApplicationDelegateReplyCancel -NSApplicationDelegateReplyFailure ; +CONSTANT: NSApplicationDelegateReplySuccess 0 +CONSTANT: NSApplicationDelegateReplyCancel 1 +CONSTANT: NSApplicationDelegateReplyFailure 2 : with-autorelease-pool ( quot -- ) NSAutoreleasePool -> new [ call ] [ -> release ] bi* ; inline diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index 7d8ef4791b..2fdf814521 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: math kernel layouts system strings words quotations byte-arrays -alien alien.syntax arrays literals sequences ; +alien arrays literals sequences ; IN: compiler.constants ! These constants must match vm/memory.h @@ -40,42 +40,40 @@ CONSTANT: deck-bits 18 : segment-end-offset ( -- n ) 2 bootstrap-cells ; inline ! Relocation classes -ENUM: f - rc-absolute-cell - rc-absolute - rc-relative - rc-absolute-ppc-2/2 - rc-absolute-ppc-2 - rc-relative-ppc-2 - rc-relative-ppc-3 - rc-relative-arm-3 - rc-indirect-arm - rc-indirect-arm-pc - rc-absolute-2 - rc-absolute-1 ; +CONSTANT: rc-absolute-cell 0 +CONSTANT: rc-absolute 1 +CONSTANT: rc-relative 2 +CONSTANT: rc-absolute-ppc-2/2 3 +CONSTANT: rc-absolute-ppc-2 4 +CONSTANT: rc-relative-ppc-2 5 +CONSTANT: rc-relative-ppc-3 6 +CONSTANT: rc-relative-arm-3 7 +CONSTANT: rc-indirect-arm 8 +CONSTANT: rc-indirect-arm-pc 9 +CONSTANT: rc-absolute-2 10 +CONSTANT: rc-absolute-1 11 ! Relocation types -ENUM: f - rt-dlsym - rt-entry-point - rt-entry-point-pic - rt-entry-point-pic-tail - rt-here - rt-this - rt-literal - rt-untagged - rt-megamorphic-cache-hits - rt-vm - rt-cards-offset - rt-decks-offset - rt-exception-handler - rt-float ; +CONSTANT: rt-dlsym 0 +CONSTANT: rt-entry-point 1 +CONSTANT: rt-entry-point-pic 2 +CONSTANT: rt-entry-point-pic-tail 3 +CONSTANT: rt-here 4 +CONSTANT: rt-this 5 +CONSTANT: rt-literal 6 +CONSTANT: rt-untagged 7 +CONSTANT: rt-megamorphic-cache-hits 8 +CONSTANT: rt-vm 9 +CONSTANT: rt-cards-offset 10 +CONSTANT: rt-decks-offset 11 +CONSTANT: rt-exception-handler 12 +CONSTANT: rt-float 13 : rc-absolute? ( n -- ? ) ${ - rc-absolute-ppc-2/2 - rc-absolute-cell - rc-absolute - rc-absolute-2 - rc-absolute-1 + $ rc-absolute-ppc-2/2 + $ rc-absolute-cell + $ rc-absolute + $ rc-absolute-2 + $ rc-absolute-1 } member? ; diff --git a/basis/core-graphics/core-graphics.factor b/basis/core-graphics/core-graphics.factor index 1e797a3329..d921789cb0 100644 --- a/basis/core-graphics/core-graphics.factor +++ b/basis/core-graphics/core-graphics.factor @@ -6,14 +6,14 @@ images images.memory core-graphics.types core-foundation.utilities opengl.gl literals ; IN: core-graphics -ENUM: CGImageAlphaInfo -kCGImageAlphaNone -kCGImageAlphaPremultipliedLast -kCGImageAlphaPremultipliedFirst -kCGImageAlphaLast -kCGImageAlphaFirst -kCGImageAlphaNoneSkipLast -kCGImageAlphaNoneSkipFirst ; +TYPEDEF: int CGImageAlphaInfo +CONSTANT: kCGImageAlphaNone 0 +CONSTANT: kCGImageAlphaPremultipliedLast 1 +CONSTANT: kCGImageAlphaPremultipliedFirst 2 +CONSTANT: kCGImageAlphaLast 3 +CONSTANT: kCGImageAlphaFirst 4 +CONSTANT: kCGImageAlphaNoneSkipLast 5 +CONSTANT: kCGImageAlphaNoneSkipFirst 6 CONSTANT: kCGBitmapAlphaInfoMask HEX: 1f CONSTANT: kCGBitmapFloatComponents 256 diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index f330cdb85c..13c7d1ac79 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -12,8 +12,19 @@ IN: unicode.breaks >" "ABOUT:" "AFTER:" "ALIAS:" "ALIEN:" "ARTICLE:" "B" "BEFORE:" "BIN:" - "C:" "CALLBACK:" "C-ENUM:" "C-TYPE:" "CHAR:" "COM-INTERFACE:" "CONSTANT:" "CONSULT:" "call-next-method" + "C:" "CALLBACK:" "ENUM:" "C-TYPE:" "CHAR:" "COM-INTERFACE:" "CONSTANT:" "CONSULT:" "call-next-method" "DEFER:" "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:" "f" "FORGET:" "FROM:" "FUNCTION:" @@ -165,7 +165,7 @@ (defconst fuel-syntax--indent-def-starts '("" ":" "AFTER" "BEFORE" - "C-ENUM" "COM-INTERFACE" "CONSULT" + "ENUM" "COM-INTERFACE" "CONSULT" "FROM" "FUNCTION:" "INTERSECTION:" "M" "M:" "MACRO" "MACRO:" @@ -280,7 +280,7 @@ ("\\_<\\(U\\)SING: \\(;\\)" (1 "b")) ("\\_b")) - ("\\_\\)" (1 "\\)" diff --git a/unmaintained/cryptlib/libcl/libcl.factor b/unmaintained/cryptlib/libcl/libcl.factor index 02bd38d045..e2b13e8cb1 100644 --- a/unmaintained/cryptlib/libcl/libcl.factor +++ b/unmaintained/cryptlib/libcl/libcl.factor @@ -878,13 +878,11 @@ TYPEDEF: int CRYPT_KEYID_TYPE ! Internal keyset options ! (As _NONE but open for exclusive access, _CRYPT_DEFINED ! Last possible key option type, _CRYPT_DEFINED Last external keyset option) -C-ENUM: f - CRYPT_KEYOPT_NONE - CRYPT_KEYOPT_READONLY - CRYPT_KEYOPT_CREATE - CRYPT_IKEYOPT_EXCLUSIVEACCESS - CRYPT_KEYOPT_LAST -; +CONSTANT: CRYPT_KEYOPT_NONE 0 +CONSTANT: CRYPT_KEYOPT_READONLY 1 +CONSTANT: CRYPT_KEYOPT_CREATE 2 +CONSTANT: CRYPT_IKEYOPT_EXCLUSIVEACCESS 3 +CONSTANT: CRYPT_KEYOPT_LAST 4 : CRYPT_KEYOPT_LAST_EXTERNAL 3 ; inline ! = CRYPT_KEYOPT_CREATE + 1 diff --git a/unmaintained/pdf/libhpdf/libhpdf.factor b/unmaintained/pdf/libhpdf/libhpdf.factor index f01feb494d..49e02d4f8f 100644 --- a/unmaintained/pdf/libhpdf/libhpdf.factor +++ b/unmaintained/pdf/libhpdf/libhpdf.factor @@ -24,13 +24,11 @@ IN: pdf.libhpdf : HPDF_COMP_MASK HEX: FF ; inline ! page mode -C-ENUM: f - HPDF_PAGE_MODE_USE_NONE - HPDF_PAGE_MODE_USE_OUTLINE - HPDF_PAGE_MODE_USE_THUMBS - HPDF_PAGE_MODE_FULL_SCREEN - HPDF_PAGE_MODE_EOF -; +CONSTANT: HPDF_PAGE_MODE_USE_NONE 0 +CONSTANT: HPDF_PAGE_MODE_USE_OUTLINE 1 +CONSTANT: HPDF_PAGE_MODE_USE_THUMBS 2 +CONSTANT: HPDF_PAGE_MODE_FULL_SCREEN 3 +CONSTANT: HPDF_PAGE_MODE_EOF 4 : error-code ( -- seq ) { { HEX: 1001 "HPDF_ARRAY_COUNT_ERR\nInternal error. The consistency of the data was lost." } From fdeb305a3ccc04fc84890bbeaddb76f6863d8cc3 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Mon, 19 Apr 2010 15:53:59 -0700 Subject: [PATCH 10/10] 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: