1 ! Copyright (C) 2009 Jeremy Hughes.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types assocs combinators.short-circuit
4 continuations effects fry kernel math memoize sequences
5 splitting strings peg.ebnf make words ;
8 : cify-type ( str -- str' )
9 dup word? [ name>> ] when
10 { { CHAR: - CHAR: space } } substitute ;
12 : factorize-type ( str -- str' )
15 "unsigned " ?head [ "u" prepend ] when
16 "long " ?head [ "long" prepend ] when
19 : const-pointer? ( str -- ? )
20 cify-type { [ " const" tail? ] [ "&" tail? ] } 1|| ;
22 : pointer-to-const? ( str -- ? )
23 cify-type "const " head? ;
25 : template-class? ( str -- ? )
28 MEMO: resolved-primitives ( -- seq )
29 primitive-types [ resolve-typedef ] map ;
31 : primitive-type? ( type -- ? )
33 factorize-type resolve-typedef [ resolved-primitives ] dip
35 ] [ 2drop f ] recover ;
37 : pointer? ( type -- ? )
38 factorize-type [ "*" tail? ] [ "&" tail? ] bi or ;
40 : type-sans-pointer ( type -- type' )
41 factorize-type [ '[ _ = ] "*&" swap any? ] trim-tail ;
43 : pointer-to-primitive? ( type -- ? )
45 { [ pointer? ] [ type-sans-pointer primitive-type? ] } 1&& ;
47 : pointer-to-non-const-primitive? ( str -- ? )
49 [ pointer-to-const? not ]
50 [ factorize-type pointer-to-primitive? ]
53 : types-effect>params-return ( types effect -- params return )
55 [ nip out>> dup length 0 > [ first ] [ drop "void" ] if ]
58 : annotate-effect ( types effect -- types effect' )
59 [ in>> ] [ out>> ] bi [
61 [ over pointer-to-primitive? [ ">" prepend ] when ]
65 TUPLE: c++-type name params ptr ;
66 C: <c++-type> c++-type
68 EBNF: (parse-c++-type)
71 alphanum = [1-9a-zA-Z]
72 name = [_a-zA-Z] [_a-zA-Z1-9:]* => [[ first2 swap prefix >string ]]
73 ptr = [*&] => [[ empty? not ]]
75 param = "," " "* type " "* => [[ third ]]
77 params = "<" " "* type " "* param* ">" => [[ [ 4 swap nth ] [ third ] bi prefix ]]
79 type = name " "* params? " "* ptr? => [[ { 0 2 4 } [ swap nth ] with map first3 <c++-type> ]]
82 : parse-c++-type ( str -- c++-type )
83 factorize-type (parse-c++-type) ;
85 DEFER: c++-type>string
87 : params>string ( params -- str )
88 [ "<" % [ c++-type>string ] map "," join % ">" % ] "" make ;
90 : c++-type>string ( c++-type -- str )
93 [ params>> [ params>string % ] when* ]
94 [ ptr>> [ "*" % ] when ]
98 GENERIC: c++-type ( obj -- c++-type/f )
100 M: object c++-type drop f ;