prettyprinting for FUNCTION: definitions

db4
Joe Groff 2009-09-15 22:39:25 -05:00
parent b629391477
commit 2bbd29a561
2 changed files with 28 additions and 10 deletions
basis/alien

View File

@ -1,8 +1,9 @@
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays assocs combinators effects
grouping kernel parser sequences splitting words fry locals
lexer namespaces summary math vocabs.parser ;
USING: accessors alien alien.c-types arrays assocs
combinators effects grouping kernel parser sequences
splitting words fry locals lexer namespaces summary
math vocabs.parser ;
IN: alien.parser
: parse-c-type-name ( name -- word/string )
@ -55,3 +56,6 @@ IN: alien.parser
: define-function ( return library function parameters -- )
make-function define-declared ;
PREDICATE: alien-function-word < word
def>> [ length 5 = ] [ last \ alien-invoke eq? ] bi and ;

View File

@ -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*
@ -21,16 +21,30 @@ M: typedef-word declarations. drop ;
GENERIC: pprint-c-type ( c-type -- )
M: word pprint-c-type pprint-word ;
M: wrapper pprint-c-type wrapped>> pprint-word ;
M: string pprint-c-type text ;
M: array pprint-c-type pprint* ;
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> ;
pprint-word ;
: pprint-function-arg ( type name -- )
[ pprint-c-type ] [ text ] bi* ;
: pprint-function-args ( word -- )
[ def>> fourth ] [ stack-effect in>> ] bi zip unclip-last
[ [ first2 "," append pprint-function-arg ] each ] dip
first2 pprint-function-arg ;
M: alien-function-word definer
drop \ FUNCTION: \ ; ;
M: alien-function-word definition drop f ;
M: alien-function-word synopsis*
\ FUNCTION: pprint-word
[ def>> first pprint-c-type ]
[ pprint-word ]
[ <block "(" text pprint-function-args ")" text block> ] tri ;