remove >r r> from alien

db4
Doug Coleman 2008-11-29 13:37:38 -06:00
parent 347087fab8
commit 57e34e9d6c
5 changed files with 30 additions and 28 deletions

View File

@ -52,7 +52,7 @@ GENERIC: c-type ( name -- type ) foldable
: parse-array-type ( name -- array )
"[" split unclip
>r [ "]" ?tail drop string>number ] map r> prefix ;
[ [ "]" ?tail drop string>number ] map ] dip prefix ;
M: string c-type ( name -- type )
CHAR: ] over member? [
@ -215,13 +215,13 @@ M: byte-array byte-length length ;
] [ ] make define-inline ;
: nth-word ( name vocab -- word )
>r "-nth" append r> create ;
[ "-nth" append ] dip create ;
: define-nth ( name vocab -- )
dupd nth-word swap dup c-getter (define-nth) ;
: set-nth-word ( name vocab -- word )
>r "set-" swap "-nth" 3append r> create ;
[ "set-" swap "-nth" 3append ] dip create ;
: define-set-nth ( name vocab -- )
dupd set-nth-word swap dup c-setter (define-nth) ;
@ -229,7 +229,7 @@ M: byte-array byte-length length ;
: typedef ( old new -- ) c-types get set-at ;
: define-c-type ( type name vocab -- )
>r tuck typedef r> [ define-nth ] 2keep define-set-nth ;
[ tuck typedef ] dip [ define-nth ] 2keep define-set-nth ;
TUPLE: long-long-type < c-type ;
@ -249,12 +249,12 @@ M: long-long-type box-return ( type -- )
f swap box-parameter ;
: define-deref ( name vocab -- )
>r dup CHAR: * prefix r> create
[ dup CHAR: * prefix ] dip create
swap c-getter 0 prefix define-inline ;
: define-out ( name vocab -- )
over [ <c-object> tuck 0 ] over c-setter append swap
>r >r constructor-word r> r> prefix define-inline ;
[ constructor-word ] 2dip prefix define-inline ;
: c-bool> ( int -- ? )
zero? not ;
@ -267,7 +267,7 @@ M: long-long-type box-return ( type -- )
dupd set-nth-word [ >c-array ] 2curry ;
: to-array-word ( name vocab -- word )
>r ">c-" swap "-array" 3append r> create ;
[ ">c-" swap "-array" 3append ] dip create ;
: define-to-array ( type vocab -- )
[ to-array-word ] 2keep >c-array-quot
@ -281,7 +281,7 @@ M: long-long-type box-return ( type -- )
] [ ] make ;
: from-array-word ( name vocab -- word )
>r "c-" swap "-array>" 3append r> create ;
[ "c-" swap "-array>" 3append ] dip create ;
: define-from-array ( type vocab -- )
[ from-array-word ] 2keep c-array>quot
@ -299,11 +299,13 @@ M: long-long-type box-return ( type -- )
: expand-constants ( c-type -- c-type' )
dup array? [
unclip >r [
dup word? [
def>> { } swap with-datastack first
] when
] map r> prefix
unclip [
[
dup word? [
def>> { } swap with-datastack first
] when
] map
] dip prefix
] when ;
: malloc-file-contents ( path -- alien len )

View File

@ -9,7 +9,7 @@ IN: alien.strings
GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
M: c-ptr alien>string
>r <memory-stream> r> <decoder>
[ <memory-stream> ] [ <decoder> ] bi*
"\0" swap stream-read-until drop ;
M: f alien>string

View File

@ -29,10 +29,10 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
writer>> swap "writing" set-word-prop ;
: reader-word ( class name vocab -- word )
>r >r "-" r> 3append r> create ;
[ "-" swap 3append ] dip create ;
: writer-word ( class name vocab -- word )
>r [ swap "set-" % % "-" % % ] "" make r> create ;
[ [ swap "set-" % % "-" % % ] "" make ] dip create ;
: <field-spec> ( struct-name vocab type field-name -- spec )
field-spec new

View File

@ -39,7 +39,7 @@ M: struct-type stack-size
: c-struct? ( type -- ? ) (c-type) struct-type? ;
: (define-struct) ( name vocab size align fields -- )
>r [ align ] keep r>
[ [ align ] keep ] dip
struct-type boa
-rot define-c-type ;
@ -50,11 +50,11 @@ M: struct-type stack-size
[ c-type-align ] map supremum ;
: define-struct ( name vocab fields -- )
pick >r
[ struct-offsets ] keep
[ [ type>> ] map compute-struct-align ] keep
[ (define-struct) ] keep
r> [ swap define-field ] curry each ;
pick [
[ struct-offsets ] keep
[ [ type>> ] map compute-struct-align ] keep
[ (define-struct) ] keep
] dip [ swap define-field ] curry each ;
: define-union ( name vocab members -- )
[ expand-constants ] map

View File

@ -17,9 +17,9 @@ IN: alien.syntax
[ alien-invoke ] 2curry 2curry ;
: define-function ( return library function parameters -- )
>r pick r> parse-arglist
[ pick ] dip parse-arglist
pick create-in dup reset-generic
>r >r function-quot r> r>
[ function-quot ] 2dip
-rot define-declared ;
PRIVATE>
@ -28,9 +28,9 @@ PRIVATE>
[ alien-indirect ] 3curry compose ;
: define-indirect ( abi return function-ptr-quot function-name parameters -- )
>r pick r> parse-arglist
[ pick ] dip parse-arglist
rot create-in dup reset-generic
>r >r swapd roll indirect-quot r> r>
[ swapd roll indirect-quot ] dip
-rot define-declared ;
: DLL" lexer get skip-blank parse-string dlopen parsed ; parsing
@ -55,7 +55,7 @@ PRIVATE>
: C-STRUCT:
scan in get
parse-definition
>r 2dup r> define-struct-early
[ 2dup ] dip define-struct-early
define-struct ; parsing
: C-UNION:
@ -64,7 +64,7 @@ PRIVATE>
: C-ENUM:
";" parse-tokens
dup length
[ >r create-in r> 1quotation define ] 2each ;
[ [ create-in ] dip 1quotation define ] 2each ;
parsing
M: alien pprint*