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 ; [ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ;
SYNTAX: SUBROUTINE: SYNTAX: SUBROUTINE:
f "c-library" get scan ";" parse-tokens f current-library get scan ";" parse-tokens
[ "()" subseq? not ] filter define-fortran-function ; [ "()" subseq? not ] filter define-fortran-function ;
SYNTAX: FUNCTION: SYNTAX: FUNCTION:
scan "c-library" get scan ";" parse-tokens scan current-library get scan ";" parse-tokens
[ "()" subseq? not ] filter define-fortran-function ; [ "()" subseq? not ] filter define-fortran-function ;
SYNTAX: LIBRARY: SYNTAX: LIBRARY:
scan scan
[ "c-library" set ] [ current-library set ]
[ set-fortran-abi ] bi ; [ 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 ( library -- abi )
library [ abi>> ] [ cdecl ] if* ; 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 SYMBOL: deploy-libraries
deploy-libraries [ V{ } clone ] initialize 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 ; vocabs.parser words.constant ;
IN: alien.parser IN: alien.parser
SYMBOL: current-library
: parse-c-type-name ( name -- word ) : parse-c-type-name ( name -- word )
dup search [ ] [ no-word ] ?if ; dup search [ ] [ no-word ] ?if ;
@ -117,7 +119,7 @@ PRIVATE>
names return function-effect ; names return function-effect ;
: (FUNCTION:) ( -- word quot 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 ) : callback-quot ( return types abi -- quot )
'[ [ _ _ _ ] dip alien-callback ] ; '[ [ _ _ _ ] dip alien-callback ] ;
@ -131,7 +133,7 @@ PRIVATE>
type-word return types lib library-abi callback-quot (( quot -- alien )) ; type-word return types lib library-abi callback-quot (( quot -- alien )) ;
: (CALLBACK:) ( -- word quot effect ) : (CALLBACK:) ( -- word quot effect )
"c-library" get current-library get
scan-function-name ";" scan-c-args make-callback-type ; scan-function-name ";" scan-c-args make-callback-type ;
PREDICATE: alien-function-word < word PREDICATE: alien-function-word < word
@ -142,3 +144,10 @@ 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 ;
: 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. ! Copyright (C) 2005, 2010 Slava Pestov, Alex Chapman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays alien alien.c-types USING: accessors arrays alien alien.c-types alien.arrays
alien.arrays alien.strings kernel math namespaces parser alien.strings kernel math namespaces parser sequences words
sequences words quotations math.parser splitting grouping quotations math.parser splitting grouping effects assocs
effects assocs combinators lexer strings.parser alien.parser combinators lexer strings.parser alien.parser fry vocabs.parser
fry vocabs.parser words.constant alien.libraries ; words.constant alien.libraries ;
IN: alien.syntax IN: alien.syntax
SYNTAX: DLL" lexer get skip-blank parse-string dlopen suffix! ; 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: BAD-ALIEN <bad-alien> suffix! ;
SYNTAX: LIBRARY: scan "c-library" set ; SYNTAX: LIBRARY: scan current-library set ;
SYNTAX: FUNCTION: SYNTAX: FUNCTION:
(FUNCTION:) define-declared ; (FUNCTION:) define-declared ;
@ -33,20 +33,8 @@ SYNTAX: C-ENUM:
SYNTAX: C-TYPE: SYNTAX: C-TYPE:
void CREATE-C-TYPE typedef ; 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: &: SYNTAX: &:
scan "c-library" get '[ _ _ address-of ] append! ; scan current-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 ;
SYNTAX: C-GLOBAL: scan-c-type CREATE-WORD define-global ; SYNTAX: C-GLOBAL: scan-c-type CREATE-WORD define-global ;