dup void? [ no-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
dup "c-type" word-prop resolve-typedef
[ ] [ no-c-type ] ?if ;
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.strings assocs io.backend
kernel namespaces destructors sequences system io.pathnames ;
: dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
SYMBOL: libraries
-SYMBOL: deploy-libraries
libraries [ H{ } clone ] initialize
-deploy-libraries [ V{ } clone ] initialize
TUPLE: library path abi dll ;
[ 2drop remove-library ]
[ <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 -- )
dup libraries get key?
[ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ]
[ no-library ] if ;
<PRIVATE
+
HOOK: >deployed-library-path os ( path -- path' )
M: windows >deployed-library-path
file-name ;
+
M: unix >deployed-library-path
file-name "$ORIGIN" prepend-path ;
+
M: macosx >deployed-library-path
file-name "@executable_path/../Frameworks" prepend-path ;
+
PRIVATE>
2 group [ first2 normalize-c-arg 2array ] map
unzip [ "," ?tail drop ] map
]
- [ dup "void" = [ drop { } ] [ 1array ] if ]
+ [ [ { } ] [ name>> 1array ] if-void ]
bi* <effect> ;
: function-quot ( return library function types -- quot )
'[ _ _ _ _ alien-invoke ] ;
:: 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
- return-c-type library function
+ return library function
parameters return parse-arglist [ function-quot ] dip ;
: parse-arg-tokens ( -- tokens )
make-function define-declared ;
: callback-quot ( return types abi -- quot )
- [ [ ] 3curry dip alien-callback ] 3curry ;
-
-: library-abi ( lib -- abi )
- library [ abi>> ] [ "cdecl" ] if* ;
+ '[ [ _ _ _ ] dip alien-callback ] ;
:: make-callback-type ( lib return type-name parameters -- word quot effect )
return type-name normalize-c-arg :> ( return-c-type type-name )
PREDICATE: alien-callback-type-word < typedef-word
"callback-effect" word-prop ;
-
pop-library
pop-return
! Set ABI
- dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi
+ dup library>> library-abi >>abi
! Quotation which coerces parameters to required types
dup infer-params
! Magic #: consume exactly the number of inputs