steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

alien.prettyprint: fix prettyprinting of array types and CALLBACK: (reported by Anton Gorenko)

db4
Slava Pestov 2010-05-30 16:21:43 -04:00
parent b924c3623d
commit adecd623d0
2 changed files with 75 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
basis/alien/prettyprint/prettyprint-tests.factor Normal file
View File

@ -0,0 +1,55 @@
USING: alien.c-types alien.prettyprint alien.syntax
io.streams.string see tools.test prettyprint ;
IN: alien.prettyprint.tests
CONSTANT: FOO 10
FUNCTION: int function_test ( float x, int[4][FOO] y, char* z, ushort *w ) ;
[ "USING: alien.c-types alien.syntax ;
IN: alien.prettyprint.tests
FUNCTION: int function_test
( float x, int[4][FOO] y, char* z, ushort* w ) ;
" ] [
[ \ function_test see ] with-string-writer
] unit-test
FUNCTION-ALIAS: function-test int function_test
( float x, int[4][FOO] y, char* z, ushort *w ) ;
[ "USING: alien.c-types alien.syntax ;
IN: alien.prettyprint.tests
FUNCTION-ALIAS: function-test int function_test
( float x, int[4][FOO] y, char* z, ushort* w ) ;
" ] [
[ \ function-test see ] with-string-writer
] unit-test
C-TYPE: opaque-c-type
[ "USING: alien.syntax ;
IN: alien.prettyprint.tests
C-TYPE: opaque-c-type
" ] [
[ \ opaque-c-type see ] with-string-writer
] unit-test
TYPEDEF: pointer: int pint
[ "USING: alien.c-types alien.syntax ;
IN: alien.prettyprint.tests
TYPEDEF: int* pint
" ] [
[ \ pint see ] with-string-writer
] unit-test
[ "pointer: int" ] [ pointer: int unparse ] unit-test
CALLBACK: void callback-test ( int x, float[4] y ) ;
[ "USING: alien.c-types alien.syntax ;
IN: alien.prettyprint.tests
CALLBACK: void callback-test ( int x, float[4] y ) ;
" ] [
[ \ callback-test see ] with-string-writer
] unit-test

36
basis/alien/prettyprint/prettyprint.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel combinators alien alien.enums
alien.strings alien.c-types alien.parser alien.syntax arrays
assocs effects math.parser prettyprint.backend prettyprint.custom
prettyprint.sections definitions see see.private sequences
strings words ;
assocs effects math.parser prettyprint prettyprint.backend
prettyprint.custom prettyprint.sections definitions see
see.private sequences strings words ;
IN: alien.prettyprint
M: alien pprint*
@ -23,19 +23,23 @@ M: c-type-word declarations. drop ;
<PRIVATE
GENERIC: pointer-string ( pointer -- string/f )
M: object pointer-string drop f ;
M: word pointer-string name>> ;
M: word pointer-string [ record-vocab ] [ name>> ] bi ;
M: pointer pointer-string to>> pointer-string [ CHAR: * suffix ] [ f ] if* ;
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 "" join ;
PRIVATE>
GENERIC: pprint-c-type ( c-type -- )
M: word pprint-c-type pprint-word ;
M: pointer pprint-c-type
dup pointer-string
[ swap present-text ]
[ pprint* ] if* ;
M: wrapper pprint-c-type wrapped>> pprint-word ;
M: string pprint-c-type text ;
M: array pprint-c-type pprint* ;
: pprint-c-type ( c-type -- )
[ c-type-string ] keep present-text ;
M: pointer pprint* \ pointer: pprint-word to>> pprint-c-type ;
@ -102,11 +106,11 @@ M: alien-callback-type-word synopsis*
[ seeing-word ]
[ "callback-library" word-prop pprint-library ]
[ definer. ]
[ def>> first pprint-c-type ]
[ def>> first first pprint-c-type ]
[ pprint-word ]
[
<block "(" text
[ def>> second ] [ "callback-effect" word-prop in>> ] bi
[ def>> first second ] [ "callback-effect" word-prop in>> ] bi
pprint-function-args
")" text block>
]