alien.*: moving the c-type-string word to the alien.c-types vocab

This way it can be used in alien.parser instead of return-type-name.
char-rename
Björn Lindqvist 2016-08-10 14:26:09 +02:00
parent 13a983783f
commit 907d63c16b
5 changed files with 49 additions and 30 deletions

View File

@ -59,6 +59,23 @@ C-TYPE: opaque
{ t } [ void* lookup-c-type pointer: opaque lookup-c-type = ] unit-test
[ opaque lookup-c-type ] [ no-c-type? ] must-fail-with
! c-type-string
{
"c-string[ascii]"
"foo*"
"int[5]"
"int**"
"MyFunkyString*"
"opaque*"
} [
{ c-string ascii } c-type-string
pointer: foo c-type-string
{ int 5 } c-type-string
pointer: pointer: int c-type-string
pointer: MyFunkyString c-type-string
pointer: opaque c-type-string
] unit-test
[ "
USING: alien.syntax ;
IN: alien.c-types.tests

View File

@ -1,9 +1,9 @@
! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.accessors arrays byte-arrays
classes combinators compiler.units cpu.architecture delegate
fry kernel layouts locals macros math math.order quotations
sequences system words words.symbol summary ;
USING: accessors alien alien.accessors arrays classes combinators
compiler.units cpu.architecture delegate fry kernel layouts macros
math math.order prettyprint quotations sequences summary system words
words.symbol ;
IN: alien.c-types
SYMBOLS:
@ -499,3 +499,19 @@ M: double-2-rep rep-component-type drop double ;
: c-type-clamp ( value c-type -- value' )
dup { float double } member-eq?
[ drop ] [ c-type-interval clamp ] if ; inline
GENERIC: pointer-string ( pointer -- string/f )
M: object pointer-string drop f ;
M: word pointer-string name>> ;
M: pointer pointer-string to>> pointer-string [ CHAR: * suffix ] [ f ] if* ;
GENERIC: c-type-string ( c-type -- string )
M: word c-type-string name>> ;
M: pointer c-type-string pointer-string ;
M: wrapper c-type-string wrapped>> c-type-string ;
M: array c-type-string
unclip
[ [ unparse "[" "]" surround ] map ]
[ c-type-string ] bi*
prefix concat ;

View File

@ -46,11 +46,6 @@ IN: alien.parser.tests
{ "ayae" } [ parse-enum-name new-definitions get first in? ] with-parsing
] unit-test
! return-type-name
{ "void" } [
void return-type-name
] unit-test
>>
TYPEDEF: char char2

View File

@ -71,10 +71,6 @@ ERROR: *-in-c-type-name name ;
scan-token (CREATE-C-TYPE) ;
<PRIVATE
GENERIC: return-type-name ( type -- name )
M: word return-type-name name>> ;
M: pointer return-type-name to>> return-type-name CHAR: * suffix ;
: parse-pointers ( type name -- type' name' )
"*" ?head
@ -122,7 +118,7 @@ PRIVATE>
] until drop types names [ >array ] bi@ ;
: function-effect ( names return -- effect )
[ { } ] [ return-type-name 1array ] if-void <effect> ;
[ { } ] [ c-type-string 1array ] if-void <effect> ;
: create-function ( name -- word )
create-word-in dup reset-generic ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.enums alien.strings
alien.syntax arrays assocs combinators combinators.short-circuit
definitions effects kernel math.parser prettyprint prettyprint.backend
definitions effects kernel math.parser prettyprint.backend
prettyprint.custom prettyprint.sections see see.private sequences
words ;
IN: alien.prettyprint
@ -21,25 +21,20 @@ M: c-type-word definition drop f ;
M: c-type-word declarations. drop ;
<PRIVATE
GENERIC: pointer-string ( pointer -- string/f )
M: object pointer-string drop f ;
M: word pointer-string [ record-vocab ] [ name>> ] bi ;
M: pointer pointer-string to>> pointer-string [ CHAR: * suffix ] [ f ] if* ;
GENERIC: record-pointer ( pointer -- )
M: object record-pointer drop ;
M: word record-pointer record-vocab ;
M: pointer record-pointer to>> record-pointer ;
GENERIC: c-type-string ( c-type -- string )
M: word c-type-string [ record-vocab ] [ name>> ] bi ;
M: pointer c-type-string dup pointer-string [ ] [ unparse ] ?if ;
M: wrapper c-type-string wrapped>> c-type-string ;
M: array c-type-string
unclip
[ [ unparse "[" "]" surround ] map ]
[ c-type-string ] bi*
prefix concat ;
GENERIC: record-c-type ( c-type -- )
M: word record-c-type record-vocab ;
M: pointer record-c-type record-pointer ;
M: wrapper record-c-type wrapped>> record-c-type ;
M: array record-c-type first record-c-type ;
PRIVATE>
: pprint-c-type ( c-type -- )
[ c-type-string ] keep present-text ;
[ record-c-type ] [ c-type-string ] [ ] tri present-text ;
M: pointer pprint*
<flow \ pointer: pprint-word to>> pprint* block> ;