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.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.inline.compiler alien.libraries
alien.parser arrays assocs effects fry generalizations grouping
io.files io.files.info io.files.temp kernel lexer math
math.order math.ranges multiline namespaces sequences splitting
strings system vocabs.loader vocabs.parser words ;
USING: accessors alien.inline.compiler alien.inline.types
alien.libraries alien.parser arrays assocs effects fry
generalizations grouping io.files io.files.info io.files.temp
kernel lexer math math.order math.ranges multiline namespaces
sequences splitting strings system vocabs.loader
vocabs.parser words ;
IN: alien.inline
<PRIVATE
@ -13,35 +14,14 @@ SYMBOL: library-is-c++
SYMBOL: compiler-args
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 )
scan scan swap ")" parse-tokens
[ "(" 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 )
CHAR: a swap length CHAR: a + [a,b]
[ 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 )
annotate-effect [ c-library get ] 3dip
[ [ 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> ;