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: union { char b[20]; short s[10]; long l[5]; } data;
- 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
- the invalid recursion form case needs to be fixed, for inlines too
- code gc

162
contrib/cairo/cairo.factor
View File

@ -28,68 +28,68 @@ USE: syntax
USE: sequences
! cairo_status_t
BEGIN-ENUM: 0
ENUM: CAIRO_STATUS_SUCCESS
ENUM: CAIRO_STATUS_NO_MEMORY
ENUM: CAIRO_STATUS_INVALID_RESTORE
ENUM: CAIRO_STATUS_INVALID_POP_GROUP
ENUM: CAIRO_STATUS_NO_CURRENT_POINT
ENUM: CAIRO_STATUS_INVALID_MATRIX
ENUM: CAIRO_STATUS_NO_TARGET_SURFACE
ENUM: CAIRO_STATUS_NULL_POINTER
ENUM: CAIRO_STATUS_INVALID_STRING
END-ENUM
C-ENUM:
CAIRO_STATUS_SUCCESS
CAIRO_STATUS_NO_MEMORY
CAIRO_STATUS_INVALID_RESTORE
CAIRO_STATUS_INVALID_POP_GROUP
CAIRO_STATUS_NO_CURRENT_POINT
CAIRO_STATUS_INVALID_MATRIX
CAIRO_STATUS_NO_TARGET_SURFACE
CAIRO_STATUS_NULL_POINTER
CAIRO_STATUS_INVALID_STRING
;
! cairo_operator_t
BEGIN-ENUM: 0
ENUM: CAIRO_OPERATOR_CLEAR
ENUM: CAIRO_OPERATOR_SRC
ENUM: CAIRO_OPERATOR_DST
ENUM: CAIRO_OPERATOR_OVER
ENUM: CAIRO_OPERATOR_OVER_REVERSE
ENUM: CAIRO_OPERATOR_IN
ENUM: CAIRO_OPERATOR_IN_REVERSE
ENUM: CAIRO_OPERATOR_OUT
ENUM: CAIRO_OPERATOR_OUT_REVERSE
ENUM: CAIRO_OPERATOR_ATOP
ENUM: CAIRO_OPERATOR_ATOP_REVERSE
ENUM: CAIRO_OPERATOR_XOR
ENUM: CAIRO_OPERATOR_ADD
ENUM: CAIRO_OPERATOR_SATURATE
END-ENUM
C-ENUM:
CAIRO_OPERATOR_CLEAR
CAIRO_OPERATOR_SRC
CAIRO_OPERATOR_DST
CAIRO_OPERATOR_OVER
CAIRO_OPERATOR_OVER_REVERSE
CAIRO_OPERATOR_IN
CAIRO_OPERATOR_IN_REVERSE
CAIRO_OPERATOR_OUT
CAIRO_OPERATOR_OUT_REVERSE
CAIRO_OPERATOR_ATOP
CAIRO_OPERATOR_ATOP_REVERSE
CAIRO_OPERATOR_XOR
CAIRO_OPERATOR_ADD
CAIRO_OPERATOR_SATURATE
;
! cairo_line_cap_t
BEGIN-ENUM: 0
ENUM: CAIRO_LINE_CAP_BUTT
ENUM: CAIRO_LINE_CAP_ROUND
ENUM: CAIRO_LINE_CAP_SQUARE
END-ENUM
C-ENUM:
CAIRO_LINE_CAP_BUTT
CAIRO_LINE_CAP_ROUND
CAIRO_LINE_CAP_SQUARE
;
! cair_line_join_t
BEGIN-ENUM: 0
ENUM: CAIRO_LINE_JOIN_MITER
ENUM: CAIRO_LINE_JOIN_ROUND
ENUM: CAIRO_LINE_JOIN_BEVEL
END-ENUM
C-ENUM:
CAIRO_LINE_JOIN_MITER
CAIRO_LINE_JOIN_ROUND
CAIRO_LINE_JOIN_BEVEL
;
! cairo_fill_rule_t
BEGIN-ENUM: 0
ENUM: CAIRO_FILL_RULE_WINDING
ENUM: CAIRO_FILL_RULE_EVEN_ODD
END-ENUM
C-ENUM:
CAIRO_FILL_RULE_WINDING
CAIRO_FILL_RULE_EVEN_ODD
;
! cairo_font_slant_t
BEGIN-ENUM: 0
ENUM: CAIRO_FONT_SLANT_NORMAL
ENUM: CAIRO_FONT_SLANT_ITALIC
ENUM: CAIRO_FONT_SLANT_OBLIQUE
END-ENUM
C-ENUM:
CAIRO_FONT_SLANT_NORMAL
CAIRO_FONT_SLANT_ITALIC
CAIRO_FONT_SLANT_OBLIQUE
;
! cairo_font_weight_t
BEGIN-ENUM: 0
ENUM: CAIRO_FONT_WEIGHT_NORMAL
ENUM: CAIRO_FONT_WEIGHT_BOLD
END-ENUM
C-ENUM:
CAIRO_FONT_WEIGHT_NORMAL
CAIRO_FONT_WEIGHT_BOLD
;
BEGIN-STRUCT: cairo_font_t
FIELD: int refcount
@ -149,45 +149,45 @@ BEGIN-STRUCT: cairo_t
END-STRUCT
! cairo_format_t
BEGIN-ENUM: 0
ENUM: CAIRO_FORMAT_ARGB32
ENUM: CAIRO_FORMAT_RGB24
ENUM: CAIRO_FORMAT_A8
ENUM: CAIRO_FORMAT_A1
END-ENUM
C-ENUM:
CAIRO_FORMAT_ARGB32
CAIRO_FORMAT_RGB24
CAIRO_FORMAT_A8
CAIRO_FORMAT_A1
;
! cairo_antialias_t
BEGIN-ENUM: 0
ENUM: CAIRO_ANTIALIAS_DEFAULT
ENUM: CAIRO_ANTIALIAS_NONE
ENUM: CAIRO_ANTIALIAS_GRAY
ENUM: CAIRO_ANTIALIAS_SUBPIXEL
END-ENUM
C-ENUM:
CAIRO_ANTIALIAS_DEFAULT
CAIRO_ANTIALIAS_NONE
CAIRO_ANTIALIAS_GRAY
CAIRO_ANTIALIAS_SUBPIXEL
;
! cairo_subpixel_order_t
BEGIN-ENUM: 0
ENUM: CAIRO_SUBPIXEL_ORDER_DEFAULT
ENUM: CAIRO_SUBPIXEL_ORDER_RGB
ENUM: CAIRO_SUBPIXEL_ORDER_BGR
ENUM: CAIRO_SUBPIXEL_ORDER_VRGB
ENUM: CAIRO_SUBPIXEL_ORDER_VBGR
END-ENUM
C-ENUM:
CAIRO_SUBPIXEL_ORDER_DEFAULT
CAIRO_SUBPIXEL_ORDER_RGB
CAIRO_SUBPIXEL_ORDER_BGR
CAIRO_SUBPIXEL_ORDER_VRGB
CAIRO_SUBPIXEL_ORDER_VBGR
;
! cairo_hint_style_t
BEGIN-ENUM: 0
ENUM: CAIRO_HINT_STYLE_DEFAULT
ENUM: CAIRO_HINT_STYLE_NONE
ENUM: CAIRO_HINT_STYLE_SLIGHT
ENUM: CAIRO_HINT_STYLE_MEDIUM
ENUM: CAIRO_HINT_STYLE_FULL
END-ENUM
C-ENUM:
CAIRO_HINT_STYLE_DEFAULT
CAIRO_HINT_STYLE_NONE
CAIRO_HINT_STYLE_SLIGHT
CAIRO_HINT_STYLE_MEDIUM
CAIRO_HINT_STYLE_FULL
;
! cairo_hint_metrics_t
BEGIN-ENUM: 0
ENUM: CAIRO_HINT_METRICS_DEFAULT
ENUM: CAIRO_HINT_METRICS_OFF
ENUM: CAIRO_HINT_METRICS_ON
END-ENUM
C-ENUM:
CAIRO_HINT_METRICS_DEFAULT
CAIRO_HINT_METRICS_OFF
CAIRO_HINT_METRICS_ON
;
: cairo_create ( cairo_surface_t -- cairo_t )
"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
sequences ;
: <alien> ( address -- alien )
dup zero? [ drop f ] [ f <displaced-alien> ] if ; inline
: <alien> ( address -- alien ) f <displaced-alien> ; inline
UNION: c-ptr byte-array alien ;

38
library/alien/syntax.factor
View File

@ -43,30 +43,16 @@ sequences syntax words ;
: END-STRUCT ( length -- )
define-struct-type ; parsing
: BEGIN-UNION: ( -- max )
scan "struct-name" set 0 ; parsing
: C-UNION: ( -- max )
scan "struct-name" set
string-mode on [
string-mode off
0 [ define-member ] reduce define-struct-type
] [ ] ; parsing
: MEMBER: ( max -- max )
scan define-member ; parsing
: END-UNION ( max -- )
define-struct-type ; 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
: C-ENUM:
string-mode on [
string-mode off 0 [
create-in swap [ unit define-compound ] keep 1+
] reduce 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 ) ;
BEGIN-ENUM: 0
ENUM: FT_RENDER_MODE_NORMAL
ENUM: FT_RENDER_MODE_LIGHT
ENUM: FT_RENDER_MODE_MONO
ENUM: FT_RENDER_MODE_LCD
ENUM: FT_RENDER_MODE_LCD_V
END-ENUM
C-ENUM:
FT_RENDER_MODE_NORMAL
FT_RENDER_MODE_LIGHT
FT_RENDER_MODE_MONO
FT_RENDER_MODE_LCD
FT_RENDER_MODE_LCD_V
;
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
: foldable word t "foldable" set-word-prop ; parsing
: SYMBOL: CREATE dup reset-generic define-symbol ; parsing
DEFER: PRIMITIVE: parsing
: DEFER: CREATE dup reset-generic drop ; 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
[ f ] [ 0 <alien> 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
10 <byte-array> "dump" set

107
library/x11/xlib.factor
View File

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

5
native/alien.c
View File

@ -80,7 +80,10 @@ void primitive_displaced_alien(void)
maybe_gc(sizeof(ALIEN));
alien = dpop();
displacement = unbox_unsigned_cell();
dpush(tag_object(make_alien(alien,displacement)));
if(alien == F && displacement == 0)
dpush(F);
else
dpush(tag_object(make_alien(alien,displacement)));
}
/* address of an object representing a C pointer */