Added alien.inline.types (forgot to add several commits ago)

db4
Jeremy Hughes 2009-07-06 20:57:51 +12:00
parent dbe19d8173
commit da01ae5cda
3 changed files with 54 additions and 26 deletions

View File

@ -1,10 +1,11 @@
! Copyright (C) 2009 Jeremy Hughes. ! Copyright (C) 2009 Jeremy Hughes.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.inline.compiler alien.libraries USING: accessors alien.inline.compiler alien.inline.types
alien.parser arrays assocs effects fry generalizations grouping alien.libraries alien.parser arrays assocs effects fry
io.files io.files.info io.files.temp kernel lexer math generalizations grouping io.files io.files.info io.files.temp
math.order math.ranges multiline namespaces sequences splitting kernel lexer math math.order math.ranges multiline namespaces
strings system vocabs.loader vocabs.parser words ; sequences splitting strings system vocabs.loader
vocabs.parser words ;
IN: alien.inline IN: alien.inline
<PRIVATE <PRIVATE
@ -13,35 +14,14 @@ SYMBOL: library-is-c++
SYMBOL: compiler-args SYMBOL: compiler-args
SYMBOL: c-strings SYMBOL: c-strings
: annotate-effect ( types effect -- types effect' )
[ in>> ] [ out>> ] bi [
zip
[ over pointer-to-primitive? [ ">" prepend ] when ]
assoc-map unzip
] dip <effect> ;
: function-types-effect ( -- function types effect ) : function-types-effect ( -- function types effect )
scan scan swap ")" parse-tokens scan scan swap ")" parse-tokens
[ "(" subseq? not ] filter swap parse-arglist ; [ "(" subseq? not ] filter swap parse-arglist ;
: types-effect>params-return ( types effect -- params return )
[ in>> zip ]
[ nip out>> dup length 0 > [ first ] [ drop "void" ] if ]
2bi ;
: arg-list ( types -- params ) : arg-list ( types -- params )
CHAR: a swap length CHAR: a + [a,b] CHAR: a swap length CHAR: a + [a,b]
[ 1string ] map ; [ 1string ] map ;
: factorize-type ( str -- str' )
"const-" ?head drop
"unsigned-" ?head [ "u" prepend ] when
"long-" ?head [ "long" prepend ] when ;
: cify-type ( str -- str' )
{ { CHAR: - CHAR: space } } substitute ;
: factor-function ( function types effect -- word quot effect ) : factor-function ( function types effect -- word quot effect )
annotate-effect [ c-library get ] 3dip annotate-effect [ c-library get ] 3dip
[ [ factorize-type ] map ] dip [ [ factorize-type ] map ] dip

View File

@ -0,0 +1 @@
Jeremy Hughes

View File

@ -0,0 +1,47 @@
! Copyright (C) 2009 Jeremy Hughes.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types assocs combinators.short-circuit
continuations effects fry kernel math memoize sequences
splitting ;
IN: alien.inline.types
: factorize-type ( str -- str' )
"const-" ?head drop
"unsigned-" ?head [ "u" prepend ] when
"long-" ?head [ "long" prepend ] when ;
: cify-type ( str -- str' )
{ { CHAR: - CHAR: space } } substitute ;
: const-type? ( str -- ? )
"const-" head? ;
MEMO: resolved-primitives ( -- seq )
primitive-types [ resolve-typedef ] map ;
: primitive-type? ( type -- ? )
[
factorize-type resolve-typedef [ resolved-primitives ] dip
'[ _ = ] any?
] [ 2drop f ] recover ;
: pointer? ( type -- ? )
[ "*" tail? ] [ "&" tail? ] bi or ;
: type-sans-pointer ( type -- type' )
[ '[ _ = ] "*&" swap any? ] trim-tail ;
: pointer-to-primitive? ( type -- ? )
{ [ pointer? ] [ type-sans-pointer primitive-type? ] } 1&& ;
: types-effect>params-return ( types effect -- params return )
[ in>> zip ]
[ nip out>> dup length 0 > [ first ] [ drop "void" ] if ]
2bi ;
: annotate-effect ( types effect -- types effect' )
[ in>> ] [ out>> ] bi [
zip
[ over pointer-to-primitive? [ ">" prepend ] when ]
assoc-map unzip
] dip <effect> ;