Move non-parsing words out of alien.syntax, and use a symbol instead of a string variable to store the current library in alien.parser

release
Slava Pestov 2010-04-12 18:09:26 -05:00
parent 2712496880
commit becb7c78b7
4 changed files with 26 additions and 24 deletions

6
basis/alien/fortran/fortran.factor Normal file → Executable file
View File

@ -434,15 +434,15 @@ MACRO: fortran-invoke ( return library function parameters -- )
[ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ;
SYNTAX: SUBROUTINE:
f "c-library" get scan ";" parse-tokens
f current-library get scan ";" parse-tokens
[ "()" subseq? not ] filter define-fortran-function ;
SYNTAX: FUNCTION:
scan "c-library" get scan ";" parse-tokens
scan current-library get scan ";" parse-tokens
[ "()" subseq? not ] filter define-fortran-function ;
SYNTAX: LIBRARY:
scan
[ "c-library" set ]
[ current-library set ]
[ set-fortran-abi ] bi ;

5
basis/alien/libraries/libraries.factor Normal file → Executable file
View File

@ -38,6 +38,11 @@ M: library dispose dll>> [ dispose ] when* ;
: library-abi ( library -- abi )
library [ abi>> ] [ cdecl ] if* ;
ERROR: no-such-symbol name library ;
: address-of ( name library -- value )
2dup load-library dlsym [ 2nip ] [ no-such-symbol ] if* ;
SYMBOL: deploy-libraries
deploy-libraries [ V{ } clone ] initialize

13
basis/alien/parser/parser.factor Normal file → Executable file
View File

@ -7,6 +7,8 @@ splitting words fry locals lexer namespaces summary math
vocabs.parser words.constant ;
IN: alien.parser
SYMBOL: current-library
: parse-c-type-name ( name -- word )
dup search [ ] [ no-word ] ?if ;
@ -117,7 +119,7 @@ PRIVATE>
names return function-effect ;
: (FUNCTION:) ( -- word quot effect )
scan-function-name "c-library" get ";" scan-c-args make-function ;
scan-function-name current-library get ";" scan-c-args make-function ;
: callback-quot ( return types abi -- quot )
'[ [ _ _ _ ] dip alien-callback ] ;
@ -131,7 +133,7 @@ PRIVATE>
type-word return types lib library-abi callback-quot (( quot -- alien )) ;
: (CALLBACK:) ( -- word quot effect )
"c-library" get
current-library get
scan-function-name ";" scan-c-args make-callback-type ;
PREDICATE: alien-function-word < word
@ -142,3 +144,10 @@ PREDICATE: alien-function-word < word
PREDICATE: alien-callback-type-word < typedef-word
"callback-effect" word-prop ;
: global-quot ( type word -- quot )
name>> current-library get '[ _ _ address-of 0 ]
swap c-type-getter-boxer append ;
: define-global ( type word -- )
[ nip ] [ global-quot ] 2bi (( -- value )) define-declared ;

26
basis/alien/syntax/syntax.factor Normal file → Executable file
View File

@ -1,10 +1,10 @@
! Copyright (C) 2005, 2010 Slava Pestov, Alex Chapman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays alien alien.c-types
alien.arrays alien.strings kernel math namespaces parser
sequences words quotations math.parser splitting grouping
effects assocs combinators lexer strings.parser alien.parser
fry vocabs.parser words.constant alien.libraries ;
USING: accessors arrays alien alien.c-types alien.arrays
alien.strings kernel math namespaces parser sequences words
quotations math.parser splitting grouping effects assocs
combinators lexer strings.parser alien.parser fry vocabs.parser
words.constant alien.libraries ;
IN: alien.syntax
SYNTAX: DLL" lexer get skip-blank parse-string dlopen suffix! ;
@ -13,7 +13,7 @@ SYNTAX: ALIEN: 16 scan-base <alien> suffix! ;
SYNTAX: BAD-ALIEN <bad-alien> suffix! ;
SYNTAX: LIBRARY: scan "c-library" set ;
SYNTAX: LIBRARY: scan current-library set ;
SYNTAX: FUNCTION:
(FUNCTION:) define-declared ;
@ -33,20 +33,8 @@ SYNTAX: C-ENUM:
SYNTAX: C-TYPE:
void CREATE-C-TYPE typedef ;
ERROR: no-such-symbol name library ;
: address-of ( name library -- value )
2dup load-library dlsym [ 2nip ] [ no-such-symbol ] if* ;
SYNTAX: &:
scan "c-library" get '[ _ _ address-of ] append! ;
: global-quot ( type word -- quot )
name>> "c-library" get '[ _ _ address-of 0 ]
swap c-type-getter-boxer append ;
: define-global ( type word -- )
[ nip ] [ global-quot ] 2bi (( -- value )) define-declared ;
scan current-library get '[ _ _ address-of ] append! ;
SYNTAX: C-GLOBAL: scan-c-type CREATE-WORD define-global ;