use a "pointer" wrapper tuple to indicate pointer types instead of the current slipsh...

[factor.git] / basis / alien / prettyprint / prettyprint.factor

diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
index 4b53f36c3bd55fc33c41240ae54b251670158b4c..6bfbf313a1f94ec9999b6ec961b207a72a08cac3 100644 (file)
--- a/basis/alien/prettyprint/prettyprint.factor
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel combinators alien alien.strings alien.c-types
-alien.syntax arrays math.parser prettyprint.backend
-prettyprint.custom prettyprint.sections definitions see see.private
-strings words ;
+USING: accessors kernel combinators alien 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 ;
 IN: alien.prettyprint
 
 M: alien pprint*
@@ -17,20 +17,72 @@ M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;
 
 M: c-type-word definer drop \ C-TYPE: f ;
 M: c-type-word definition drop f ;
-M: typedef-word declarations. drop ;
+M: c-type-word declarations. drop ;
 
 GENERIC: pprint-c-type ( c-type -- )
 M: word pprint-c-type pprint-word ;
+M: pointer pprint-c-type to>> pprint-c-type "*" text ;
+M: wrapper pprint-c-type wrapped>> pprint-word ;
 M: string pprint-c-type text ;
 M: array pprint-c-type pprint* ;
 
+M: pointer pprint* \ pointer: pprint-word to>> pprint-c-type ;
+
 M: typedef-word definer drop \ TYPEDEF: f ;
 
 M: typedef-word synopsis*
-    <colon
-    \ TYPEDEF: pprint-word
-    dup "c-type" word-prop pprint-c-type
-    pprint-word
-    block> ;
+    {
+        [ seeing-word ]
+        [ definer. ]
+        [ "c-type" word-prop pprint-c-type ]
+        [ pprint-word ]
+    } cleave ;
+
+: pprint-function-arg ( type name -- )
+    [ pprint-c-type ] [ text ] bi* ;
+
+: pprint-function-args ( types names -- )
+    zip [ ] [
+        unclip-last
+        [ [ first2 "," append pprint-function-arg ] each ] dip
+        first2 pprint-function-arg
+    ] if-empty ;
 
+: pprint-library ( library -- )
+    [ \ LIBRARY: [ text ] pprint-prefix ] when* ;
 
+M: alien-function-word definer
+    drop \ FUNCTION: \ ; ;
+M: alien-function-word definition drop f ;
+M: alien-function-word synopsis*
+    {
+        [ seeing-word ]
+        [ def>> second pprint-library ]
+        [ definer. ]
+        [ def>> first pprint-c-type ]
+        [ pprint-word ]
+        [
+            <block "(" text
+            [ def>> fourth ] [ stack-effect in>> ] bi
+            pprint-function-args
+            ")" text block>
+        ]
+    } cleave ;
+
+M: alien-callback-type-word definer
+    drop \ CALLBACK: \ ; ;
+M: alien-callback-type-word definition drop f ;
+M: alien-callback-type-word synopsis*
+    {
+        [ seeing-word ]
+        [ "callback-library" word-prop pprint-library ]
+        [ definer. ]
+        [ def>> first pprint-c-type ]
+        [ pprint-word ]
+        [
+            <block "(" text 
+            [ def>> second ] [ "callback-effect" word-prop in>> ] bi
+            pprint-function-args
+            ")" text block>
+        ]
+    } cleave ;