Merge alien/parser/parser.factor
commit
833372cd08
|
@ -69,14 +69,6 @@ M: array resolve-pointer-type
|
||||||
dup void? [ no-c-type ] when
|
dup void? [ no-c-type ] when
|
||||||
dup c-type-name? [ c-type ] when ;
|
dup c-type-name? [ c-type ] when ;
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
: parse-array-type ( name -- dims c-type )
|
|
||||||
"[" split unclip
|
|
||||||
[ [ "]" ?tail drop string>number ] map ] dip ;
|
|
||||||
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
M: word c-type
|
M: word c-type
|
||||||
dup "c-type" word-prop resolve-typedef
|
dup "c-type" word-prop resolve-typedef
|
||||||
[ ] [ no-c-type ] ?if ;
|
[ ] [ no-c-type ] ?if ;
|
||||||
|
|
|
@ -1 +1,2 @@
|
||||||
Slava Pestov
|
Slava Pestov
|
||||||
|
Joe Groff
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien alien.strings assocs io.backend
|
USING: accessors alien alien.strings assocs io.backend
|
||||||
kernel namespaces destructors sequences system io.pathnames ;
|
kernel namespaces destructors sequences system io.pathnames ;
|
||||||
|
@ -9,10 +9,8 @@ IN: alien.libraries
|
||||||
: dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
|
: dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
|
||||||
|
|
||||||
SYMBOL: libraries
|
SYMBOL: libraries
|
||||||
SYMBOL: deploy-libraries
|
|
||||||
|
|
||||||
libraries [ H{ } clone ] initialize
|
libraries [ H{ } clone ] initialize
|
||||||
deploy-libraries [ V{ } clone ] initialize
|
|
||||||
|
|
||||||
TUPLE: library path abi dll ;
|
TUPLE: library path abi dll ;
|
||||||
|
|
||||||
|
@ -37,18 +35,29 @@ M: library dispose dll>> [ dispose ] when* ;
|
||||||
[ 2drop remove-library ]
|
[ 2drop remove-library ]
|
||||||
[ <library> swap libraries get set-at ] 3bi ;
|
[ <library> swap libraries get set-at ] 3bi ;
|
||||||
|
|
||||||
|
: library-abi ( library -- abi )
|
||||||
|
library [ abi>> ] [ "cdecl" ] if* ;
|
||||||
|
|
||||||
|
SYMBOL: deploy-libraries
|
||||||
|
|
||||||
|
deploy-libraries [ V{ } clone ] initialize
|
||||||
|
|
||||||
: deploy-library ( name -- )
|
: deploy-library ( name -- )
|
||||||
dup libraries get key?
|
dup libraries get key?
|
||||||
[ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ]
|
[ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ]
|
||||||
[ no-library ] if ;
|
[ no-library ] if ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
HOOK: >deployed-library-path os ( path -- path' )
|
HOOK: >deployed-library-path os ( path -- path' )
|
||||||
|
|
||||||
M: windows >deployed-library-path
|
M: windows >deployed-library-path
|
||||||
file-name ;
|
file-name ;
|
||||||
|
|
||||||
M: unix >deployed-library-path
|
M: unix >deployed-library-path
|
||||||
file-name "$ORIGIN" prepend-path ;
|
file-name "$ORIGIN" prepend-path ;
|
||||||
|
|
||||||
M: macosx >deployed-library-path
|
M: macosx >deployed-library-path
|
||||||
file-name "@executable_path/../Frameworks" prepend-path ;
|
file-name "@executable_path/../Frameworks" prepend-path ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
|
@ -66,16 +66,16 @@ IN: alien.parser
|
||||||
2 group [ first2 normalize-c-arg 2array ] map
|
2 group [ first2 normalize-c-arg 2array ] map
|
||||||
unzip [ "," ?tail drop ] map
|
unzip [ "," ?tail drop ] map
|
||||||
]
|
]
|
||||||
[ dup "void" = [ drop { } ] [ 1array ] if ]
|
[ [ { } ] [ name>> 1array ] if-void ]
|
||||||
bi* <effect> ;
|
bi* <effect> ;
|
||||||
|
|
||||||
: function-quot ( return library function types -- quot )
|
: function-quot ( return library function types -- quot )
|
||||||
'[ _ _ _ _ alien-invoke ] ;
|
'[ _ _ _ _ alien-invoke ] ;
|
||||||
|
|
||||||
:: make-function ( return library function parameters -- word quot effect )
|
:: make-function ( return library function parameters -- word quot effect )
|
||||||
return function normalize-c-arg :> ( return-c-type function )
|
return function normalize-c-arg :> ( return function )
|
||||||
function create-in dup reset-generic
|
function create-in dup reset-generic
|
||||||
return-c-type library function
|
return library function
|
||||||
parameters return parse-arglist [ function-quot ] dip ;
|
parameters return parse-arglist [ function-quot ] dip ;
|
||||||
|
|
||||||
: parse-arg-tokens ( -- tokens )
|
: parse-arg-tokens ( -- tokens )
|
||||||
|
@ -88,10 +88,7 @@ IN: alien.parser
|
||||||
make-function define-declared ;
|
make-function define-declared ;
|
||||||
|
|
||||||
: callback-quot ( return types abi -- quot )
|
: callback-quot ( return types abi -- quot )
|
||||||
[ [ ] 3curry dip alien-callback ] 3curry ;
|
'[ [ _ _ _ ] dip alien-callback ] ;
|
||||||
|
|
||||||
: library-abi ( lib -- abi )
|
|
||||||
library [ abi>> ] [ "cdecl" ] if* ;
|
|
||||||
|
|
||||||
:: make-callback-type ( lib return type-name parameters -- word quot effect )
|
:: make-callback-type ( lib return type-name parameters -- word quot effect )
|
||||||
return type-name normalize-c-arg :> ( return-c-type type-name )
|
return type-name normalize-c-arg :> ( return-c-type type-name )
|
||||||
|
@ -115,4 +112,3 @@ PREDICATE: alien-function-word < word
|
||||||
|
|
||||||
PREDICATE: alien-callback-type-word < typedef-word
|
PREDICATE: alien-callback-type-word < typedef-word
|
||||||
"callback-effect" word-prop ;
|
"callback-effect" word-prop ;
|
||||||
|
|
||||||
|
|
|
@ -59,7 +59,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
|
||||||
pop-library
|
pop-library
|
||||||
pop-return
|
pop-return
|
||||||
! Set ABI
|
! Set ABI
|
||||||
dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi
|
dup library>> library-abi >>abi
|
||||||
! Quotation which coerces parameters to required types
|
! Quotation which coerces parameters to required types
|
||||||
dup infer-params
|
dup infer-params
|
||||||
! Magic #: consume exactly the number of inputs
|
! Magic #: consume exactly the number of inputs
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
winnt
|
Loading…
Reference in New Issue