From adecd623d023f983f43979882cc07375079008c8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 30 May 2010 16:21:43 -0400
Subject: [PATCH] alien.prettyprint: fix prettyprinting of array types and
 CALLBACK: (reported by Anton Gorenko)

---
 .../prettyprint/prettyprint-tests.factor      | 55 +++++++++++++++++++
 basis/alien/prettyprint/prettyprint.factor    | 36 ++++++------
 2 files changed, 75 insertions(+), 16 deletions(-)
 create mode 100644 basis/alien/prettyprint/prettyprint-tests.factor

diff --git a/basis/alien/prettyprint/prettyprint-tests.factor b/basis/alien/prettyprint/prettyprint-tests.factor
new file mode 100644
index 0000000000..3a51471703
--- /dev/null
+++ b/basis/alien/prettyprint/prettyprint-tests.factor
@@ -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
diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
index 8ba1328dcd..b0178081dc 100644
--- a/basis/alien/prettyprint/prettyprint.factor
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -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>
         ]