steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Changed alien constructor behavior, new-style string mode parsing for C enums and unions (C-ENUM: and C-UNION: words)

slava 2006-03-27 00:47:51 +00:00
parent 6662637374
commit ca0ec4afaf
9 changed files with 143 additions and 191 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
TODO.FACTOR.txt
View File

@ -66,7 +66,7 @@
- FIELD: char key_vector[32]; - FIELD: char key_vector[32];
- FIELD: union { char b[20]; short s[10]; long l[5]; } data; - FIELD: union { char b[20]; short s[10]; long l[5]; } data;
- MEMBER: long pad[24]; - MEMBER: long pad[24];
- C structs, enums, unions: use new-style string mode parsing - C structs: use new-style string mode parsing
- [ [ dup call ] dup call ] infer hangs - [ [ dup call ] dup call ] infer hangs
- the invalid recursion form case needs to be fixed, for inlines too - the invalid recursion form case needs to be fixed, for inlines too
- code gc - code gc

162
contrib/cairo/cairo.factor
View File

@ -28,68 +28,68 @@ USE: syntax
USE: sequences USE: sequences
! cairo_status_t ! cairo_status_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_STATUS_SUCCESS CAIRO_STATUS_SUCCESS
ENUM: CAIRO_STATUS_NO_MEMORY CAIRO_STATUS_NO_MEMORY
ENUM: CAIRO_STATUS_INVALID_RESTORE CAIRO_STATUS_INVALID_RESTORE
ENUM: CAIRO_STATUS_INVALID_POP_GROUP CAIRO_STATUS_INVALID_POP_GROUP
ENUM: CAIRO_STATUS_NO_CURRENT_POINT CAIRO_STATUS_NO_CURRENT_POINT
ENUM: CAIRO_STATUS_INVALID_MATRIX CAIRO_STATUS_INVALID_MATRIX
ENUM: CAIRO_STATUS_NO_TARGET_SURFACE CAIRO_STATUS_NO_TARGET_SURFACE
ENUM: CAIRO_STATUS_NULL_POINTER CAIRO_STATUS_NULL_POINTER
ENUM: CAIRO_STATUS_INVALID_STRING CAIRO_STATUS_INVALID_STRING
END-ENUM ;
! cairo_operator_t ! cairo_operator_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_OPERATOR_CLEAR CAIRO_OPERATOR_CLEAR
ENUM: CAIRO_OPERATOR_SRC CAIRO_OPERATOR_SRC
ENUM: CAIRO_OPERATOR_DST CAIRO_OPERATOR_DST
ENUM: CAIRO_OPERATOR_OVER CAIRO_OPERATOR_OVER
ENUM: CAIRO_OPERATOR_OVER_REVERSE CAIRO_OPERATOR_OVER_REVERSE
ENUM: CAIRO_OPERATOR_IN CAIRO_OPERATOR_IN
ENUM: CAIRO_OPERATOR_IN_REVERSE CAIRO_OPERATOR_IN_REVERSE
ENUM: CAIRO_OPERATOR_OUT CAIRO_OPERATOR_OUT
ENUM: CAIRO_OPERATOR_OUT_REVERSE CAIRO_OPERATOR_OUT_REVERSE
ENUM: CAIRO_OPERATOR_ATOP CAIRO_OPERATOR_ATOP
ENUM: CAIRO_OPERATOR_ATOP_REVERSE CAIRO_OPERATOR_ATOP_REVERSE
ENUM: CAIRO_OPERATOR_XOR CAIRO_OPERATOR_XOR
ENUM: CAIRO_OPERATOR_ADD CAIRO_OPERATOR_ADD
ENUM: CAIRO_OPERATOR_SATURATE CAIRO_OPERATOR_SATURATE
END-ENUM ;
! cairo_line_cap_t ! cairo_line_cap_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_LINE_CAP_BUTT CAIRO_LINE_CAP_BUTT
ENUM: CAIRO_LINE_CAP_ROUND CAIRO_LINE_CAP_ROUND
ENUM: CAIRO_LINE_CAP_SQUARE CAIRO_LINE_CAP_SQUARE
END-ENUM ;
! cair_line_join_t ! cair_line_join_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_LINE_JOIN_MITER CAIRO_LINE_JOIN_MITER
ENUM: CAIRO_LINE_JOIN_ROUND CAIRO_LINE_JOIN_ROUND
ENUM: CAIRO_LINE_JOIN_BEVEL CAIRO_LINE_JOIN_BEVEL
END-ENUM ;
! cairo_fill_rule_t ! cairo_fill_rule_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_FILL_RULE_WINDING CAIRO_FILL_RULE_WINDING
ENUM: CAIRO_FILL_RULE_EVEN_ODD CAIRO_FILL_RULE_EVEN_ODD
END-ENUM ;
! cairo_font_slant_t ! cairo_font_slant_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_SLANT_NORMAL
ENUM: CAIRO_FONT_SLANT_ITALIC CAIRO_FONT_SLANT_ITALIC
ENUM: CAIRO_FONT_SLANT_OBLIQUE CAIRO_FONT_SLANT_OBLIQUE
END-ENUM ;
! cairo_font_weight_t ! cairo_font_weight_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_FONT_WEIGHT_NORMAL CAIRO_FONT_WEIGHT_NORMAL
ENUM: CAIRO_FONT_WEIGHT_BOLD CAIRO_FONT_WEIGHT_BOLD
END-ENUM ;
BEGIN-STRUCT: cairo_font_t BEGIN-STRUCT: cairo_font_t
FIELD: int refcount FIELD: int refcount
@ -149,45 +149,45 @@ BEGIN-STRUCT: cairo_t
END-STRUCT END-STRUCT
! cairo_format_t ! cairo_format_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_FORMAT_ARGB32 CAIRO_FORMAT_ARGB32
ENUM: CAIRO_FORMAT_RGB24 CAIRO_FORMAT_RGB24
ENUM: CAIRO_FORMAT_A8 CAIRO_FORMAT_A8
ENUM: CAIRO_FORMAT_A1 CAIRO_FORMAT_A1
END-ENUM ;
! cairo_antialias_t ! cairo_antialias_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_ANTIALIAS_DEFAULT CAIRO_ANTIALIAS_DEFAULT
ENUM: CAIRO_ANTIALIAS_NONE CAIRO_ANTIALIAS_NONE
ENUM: CAIRO_ANTIALIAS_GRAY CAIRO_ANTIALIAS_GRAY
ENUM: CAIRO_ANTIALIAS_SUBPIXEL CAIRO_ANTIALIAS_SUBPIXEL
END-ENUM ;
! cairo_subpixel_order_t ! cairo_subpixel_order_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_SUBPIXEL_ORDER_DEFAULT CAIRO_SUBPIXEL_ORDER_DEFAULT
ENUM: CAIRO_SUBPIXEL_ORDER_RGB CAIRO_SUBPIXEL_ORDER_RGB
ENUM: CAIRO_SUBPIXEL_ORDER_BGR CAIRO_SUBPIXEL_ORDER_BGR
ENUM: CAIRO_SUBPIXEL_ORDER_VRGB CAIRO_SUBPIXEL_ORDER_VRGB
ENUM: CAIRO_SUBPIXEL_ORDER_VBGR CAIRO_SUBPIXEL_ORDER_VBGR
END-ENUM ;
! cairo_hint_style_t ! cairo_hint_style_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_HINT_STYLE_DEFAULT CAIRO_HINT_STYLE_DEFAULT
ENUM: CAIRO_HINT_STYLE_NONE CAIRO_HINT_STYLE_NONE
ENUM: CAIRO_HINT_STYLE_SLIGHT CAIRO_HINT_STYLE_SLIGHT
ENUM: CAIRO_HINT_STYLE_MEDIUM CAIRO_HINT_STYLE_MEDIUM
ENUM: CAIRO_HINT_STYLE_FULL CAIRO_HINT_STYLE_FULL
END-ENUM ;
! cairo_hint_metrics_t ! cairo_hint_metrics_t
BEGIN-ENUM: 0 C-ENUM:
ENUM: CAIRO_HINT_METRICS_DEFAULT CAIRO_HINT_METRICS_DEFAULT
ENUM: CAIRO_HINT_METRICS_OFF CAIRO_HINT_METRICS_OFF
ENUM: CAIRO_HINT_METRICS_ON CAIRO_HINT_METRICS_ON
END-ENUM ;
: cairo_create ( cairo_surface_t -- cairo_t ) : cairo_create ( cairo_surface_t -- cairo_t )
"cairo_t*" "cairo" "cairo_create" [ "void*" ] alien-invoke ; compiled "cairo_t*" "cairo" "cairo_create" [ "void*" ] alien-invoke ; compiled

3
library/alien/aliens.factor
View File

@ -4,8 +4,7 @@ IN: alien
USING: arrays hashtables io kernel lists math namespaces parser USING: arrays hashtables io kernel lists math namespaces parser
sequences ; sequences ;
: <alien> ( address -- alien ) : <alien> ( address -- alien ) f <displaced-alien> ; inline
dup zero? [ drop f ] [ f <displaced-alien> ] if ; inline
UNION: c-ptr byte-array alien ; UNION: c-ptr byte-array alien ;

38
library/alien/syntax.factor
View File

@ -43,30 +43,16 @@ sequences syntax words ;
: END-STRUCT ( length -- ) : END-STRUCT ( length -- )
define-struct-type ; parsing define-struct-type ; parsing
: BEGIN-UNION: ( -- max ) : C-UNION: ( -- max )
scan "struct-name" set 0 ; parsing scan "struct-name" set
string-mode on [
string-mode off
0 [ define-member ] reduce define-struct-type
] [ ] ; parsing
: MEMBER: ( max -- max ) : C-ENUM:
scan define-member ; parsing string-mode on [
string-mode off 0 [
: END-UNION ( max -- ) create-in swap [ unit define-compound ] keep 1+
define-struct-type ; parsing ] reduce drop
] [ ] ; parsing
: BEGIN-ENUM:
#! C-style enumerations. Their use is not encouraged unless
#! it is for C library interfaces. Used like this:
#!
#! BEGIN-ENUM 0
#! ENUM: x
#! ENUM: y
#! ENUM: z
#! END-ENUM
#!
#! This is the same as : x 0 ; : y 1 ; : z 2 ;.
scan string>number ; parsing
: ENUM:
dup CREATE swap unit define-compound 1+ ; parsing
: END-ENUM
drop ; parsing

14
library/freetype/freetype.factor
View File

@ -162,13 +162,13 @@ FUNCTION: FT_Error FT_Set_Char_Size ( face* face, FT_F26Dot6 char_width, FT_F26D
FUNCTION: FT_Error FT_Load_Char ( face* face, FT_ULong charcode, FT_Int32 load_flags ) ; FUNCTION: FT_Error FT_Load_Char ( face* face, FT_ULong charcode, FT_Int32 load_flags ) ;
BEGIN-ENUM: 0 C-ENUM:
ENUM: FT_RENDER_MODE_NORMAL FT_RENDER_MODE_NORMAL
ENUM: FT_RENDER_MODE_LIGHT FT_RENDER_MODE_LIGHT
ENUM: FT_RENDER_MODE_MONO FT_RENDER_MODE_MONO
ENUM: FT_RENDER_MODE_LCD FT_RENDER_MODE_LCD
ENUM: FT_RENDER_MODE_LCD_V FT_RENDER_MODE_LCD_V
END-ENUM ;
FUNCTION: int FT_Render_Glyph ( glyph* slot, int render_mode ) ; FUNCTION: int FT_Render_Glyph ( glyph* slot, int render_mode ) ;

1
library/syntax/parse-syntax.factor
View File

@ -46,6 +46,7 @@ SYMBOL: t
: flushable word t "flushable" set-word-prop ; parsing : flushable word t "flushable" set-word-prop ; parsing
: foldable word t "foldable" set-word-prop ; parsing : foldable word t "foldable" set-word-prop ; parsing
: SYMBOL: CREATE dup reset-generic define-symbol ; parsing : SYMBOL: CREATE dup reset-generic define-symbol ; parsing
DEFER: PRIMITIVE: parsing DEFER: PRIMITIVE: parsing
: DEFER: CREATE dup reset-generic drop ; parsing : DEFER: CREATE dup reset-generic drop ; parsing
: : CREATE dup reset-generic [ define-compound ] [ ] ; parsing : : CREATE dup reset-generic [ define-compound ] [ ] ; parsing

2
library/test/alien.factor
View File

@ -4,6 +4,8 @@ USING: alien arrays kernel kernel-internals namespaces test ;
[ t ] [ 0 <alien> 0 <alien> = ] unit-test [ t ] [ 0 <alien> 0 <alien> = ] unit-test
[ f ] [ 0 <alien> 1024 <alien> = ] unit-test [ f ] [ 0 <alien> 1024 <alien> = ] unit-test
[ f ] [ "hello" 1024 <alien> = ] unit-test [ f ] [ "hello" 1024 <alien> = ] unit-test
[ f ] [ 0 <alien> ] unit-test
[ f ] [ 0 f <displaced-alien> ] unit-test
! Testing the various bignum accessor ! Testing the various bignum accessor
10 <byte-array> "dump" set 10 <byte-array> "dump" set

107
library/x11/xlib.factor
View File

@ -999,79 +999,40 @@ BEGIN-STRUCT: XKeymapEvent
FIELD: int pad FIELD: int pad
END-STRUCT END-STRUCT
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! C-UNION: XEvent
int
! BEGIN-UNION: XEvent XAnyEvent
! int type; XKeyEvent
! XAnyEvent xany; XButtonEvent
! XKeyEvent xkey; XMotionEvent
! XButtonEvent xbutton; XCrossingEvent
! XMotionEvent xmotion; XFocusChangeEvent
! XCrossingEvent xcrossing; XExposeEvent
! XFocusChangeEvent xfocus; XGraphicsExposeEvent
! XExposeEvent xexpose; XNoExposeEvent
! XGraphicsExposeEvent xgraphicsexpose; XVisibilityEvent
! XNoExposeEvent xnoexpose; XCreateWindowEvent
! XVisibilityEvent xvisibility; XDestroyWindowEvent
! XCreateWindowEvent xcreatewindow; XUnmapEvent
! XDestroyWindowEvent xdestroywindow; XMapEvent
! XUnmapEvent xunmap; XMapRequestEvent
! XMapEvent xmap; XReparentEvent
! XMapRequestEvent xmaprequest; XConfigureEvent
! XReparentEvent xreparent; XGravityEvent
! XConfigureEvent xconfigure; XResizeRequestEvent
! XGravityEvent xgravity; XConfigureRequestEvent
! XResizeRequestEvent xresizerequest; XCirculateEvent
! XConfigureRequestEvent xconfigurerequest; XCirculateRequestEvent
! XCirculateEvent xcirculate; XPropertyEvent
! XCirculateRequestEvent xcirculaterequest; XSelectionClearEvent
! XPropertyEvent xproperty; XSelectionRequestEvent
! XSelectionClearEvent xselectionclear; XSelectionEvent
! XSelectionRequestEvent xselectionrequest; XColormapEvent
! XSelectionEvent xselection; XClientMessageEvent
! XColormapEvent xcolormap; XMappingEvent
! XClientMessageEvent xclient; XErrorEvent
! XMappingEvent xmapping; XKeymapEvent
! XErrorEvent xerror; ;
! XKeymapEvent xkeymap;
! long pad[24];
! END-UNION
BEGIN-UNION: XEvent
MEMBER: int
MEMBER: XAnyEvent
! MEMBER: XKeyEvent
MEMBER: XButtonEvent
! MEMBER: XMotionEvent
! MEMBER: XCrossingEvent
! MEMBER: XFocusChangeEvent
! MEMBER: XExposeEvent
! MEMBER: XGraphicsExposeEvent
! MEMBER: XNoExposeEvent
! MEMBER: XVisibilityEvent
! MEMBER: XCreateWindowEvent
! MEMBER: XDestroyWindowEvent
! MEMBER: XUnmapEvent
! MEMBER: XMapEvent
! MEMBER: XMapRequestEvent
! MEMBER: XReparentEvent
! MEMBER: XConfigureEvent
! MEMBER: XGravityEvent
! MEMBER: XResizeRequestEvent
! MEMBER: XConfigureRequestEvent
! MEMBER: XCirculateEvent
! MEMBER: XCirculateRequestEvent
! MEMBER: XPropertyEvent
! MEMBER: XSelectionClearEvent
! MEMBER: XSelectionRequestEvent
! MEMBER: XSelectionEvent
! MEMBER: XColormapEvent
! MEMBER: XClientMessageEvent
! MEMBER: XMappingEvent
! MEMBER: XErrorEvent
! MEMBER: XKeymapEvent
! long pad[24];
END-UNION
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 11 - Event Handling Functions ! 11 - Event Handling Functions

3
native/alien.c
View File

@ -80,6 +80,9 @@ void primitive_displaced_alien(void)
maybe_gc(sizeof(ALIEN)); maybe_gc(sizeof(ALIEN));
alien = dpop(); alien = dpop();
displacement = unbox_unsigned_cell(); displacement = unbox_unsigned_cell();
if(alien == F && displacement == 0)
dpush(F);
else
dpush(tag_object(make_alien(alien,displacement))); dpush(tag_object(make_alien(alien,displacement)));
} }