remove >r r> from alien
parent
347087fab8
commit
57e34e9d6c
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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*
|
||||
|
|
Loading…
Reference in New Issue