minor prettyprint improvements
Slava Pestov
parent
22dc78433c
commit
52efd14bce
|
|
@ -78,6 +78,7 @@ USE: stdio
|
|||
"/library/presentation.factor"
|
||||
"/library/vocabulary-style.factor"
|
||||
"/library/syntax/prettyprint.factor"
|
||||
"/library/syntax/see.factor"
|
||||
"/library/platform/native/debugger.factor"
|
||||
"/library/tools/debugger.factor"
|
||||
"/library/platform/native/init.factor"
|
||||
|
|
|
|||
|
|
@ -193,11 +193,17 @@ IN: syntax
|
|||
parsing
|
||||
|
||||
! Comments
|
||||
: ( ")" until parsed-stack-effect ; parsing
|
||||
: (
|
||||
#! Stack comment.
|
||||
")" until parsed-stack-effect ; parsing
|
||||
|
||||
: ! until-eol drop ; parsing
|
||||
: !
|
||||
#! EOL comment.
|
||||
until-eol drop ; parsing
|
||||
|
||||
: #! until-eol parsed-documentation ; parsing
|
||||
: #!
|
||||
#! Documentation comment.
|
||||
until-eol parsed-documentation ; parsing
|
||||
|
||||
! Reading numbers in other bases
|
||||
|
||||
|
|
|
|||
|
|
@ -81,6 +81,40 @@ DEFER: prettyprint*
|
|||
dup prettyprint-newline
|
||||
] unless ;
|
||||
|
||||
: word-link ( word -- link )
|
||||
[
|
||||
"vocabularies'" ,
|
||||
dup word-vocabulary ,
|
||||
"'" ,
|
||||
word-name ,
|
||||
] make-string ;
|
||||
|
||||
: word-actions ( -- list )
|
||||
[
|
||||
[ "Describe" | "describe-path" ]
|
||||
[ "Push" | "lookup" ]
|
||||
[ "Execute" | "lookup execute" ]
|
||||
[ "jEdit" | "lookup jedit" ]
|
||||
[ "Usages" | "lookup usages." ]
|
||||
] ;
|
||||
|
||||
: word-attrs ( word -- attrs )
|
||||
#! Words without a vocabulary do not get a link or an action
|
||||
#! popup.
|
||||
dup word-vocabulary [
|
||||
word-link [ "object-link" swons ] keep
|
||||
word-actions <actions> "actions" swons
|
||||
t "underline" swons
|
||||
3list
|
||||
] [
|
||||
drop [ ]
|
||||
] ifte ;
|
||||
|
||||
: prettyprint-word ( word -- )
|
||||
dup word-name
|
||||
swap dup word-attrs swap word-style append
|
||||
write-attr ;
|
||||
|
||||
: prettyprint-[ ( indent -- indent )
|
||||
\ [ prettyprint-word <prettyprint ;
|
||||
|
||||
|
|
@ -95,7 +129,8 @@ DEFER: prettyprint*
|
|||
prettyprint-list
|
||||
] [
|
||||
[
|
||||
"|" write prettyprint-space prettyprint-element
|
||||
\ | prettyprint-word
|
||||
prettyprint-space prettyprint-element
|
||||
] when*
|
||||
] ifte
|
||||
] when* ;
|
||||
|
|
@ -133,52 +168,12 @@ DEFER: prettyprint*
|
|||
swap prettyprint-{{ swap prettyprint-list prettyprint-}}
|
||||
] ifte ;
|
||||
|
||||
: trim-newline ( str -- str )
|
||||
dup ends-with-newline? dup [ nip ] [ drop ] ifte ;
|
||||
|
||||
: prettyprint-comment ( comment -- )
|
||||
trim-newline "comments" style write-attr ;
|
||||
|
||||
: word-link ( word -- link )
|
||||
[
|
||||
"vocabularies'" ,
|
||||
dup word-vocabulary ,
|
||||
"'" ,
|
||||
word-name ,
|
||||
] make-string ;
|
||||
|
||||
: word-actions ( -- list )
|
||||
[
|
||||
[ "Describe" | "describe-path" ]
|
||||
[ "Push" | "lookup" ]
|
||||
[ "Execute" | "lookup execute" ]
|
||||
[ "jEdit" | "lookup jedit" ]
|
||||
[ "Usages" | "lookup usages." ]
|
||||
] ;
|
||||
|
||||
: word-attrs ( word -- attrs )
|
||||
#! Words without a vocabulary do not get a link or an action
|
||||
#! popup.
|
||||
dup word-vocabulary [
|
||||
word-link [ "object-link" swons ] keep
|
||||
word-actions <actions> "actions" swons
|
||||
t "underline" swons
|
||||
3list
|
||||
] [
|
||||
drop [ ]
|
||||
] ifte ;
|
||||
|
||||
: prettyprint-word ( word -- )
|
||||
dup word-name
|
||||
swap dup word-attrs swap word-style append
|
||||
write-attr ;
|
||||
|
||||
: prettyprint-object ( indent obj -- indent )
|
||||
unparse write ;
|
||||
|
||||
: prettyprint* ( indent obj -- indent )
|
||||
over prettyprint-limit >= [
|
||||
unparse write
|
||||
prettyprint-object
|
||||
] [
|
||||
[
|
||||
[ f = ] [ prettyprint-object ]
|
||||
|
|
@ -196,28 +191,6 @@ DEFER: prettyprint*
|
|||
: vocab-link ( vocab -- link )
|
||||
"vocabularies'" swap cat2 ;
|
||||
|
||||
: vocab-attrs ( word -- attrs )
|
||||
vocab-link "object-link" default-style acons ;
|
||||
|
||||
: prettyprint-vocab ( vocab -- )
|
||||
dup vocab-attrs write-attr ;
|
||||
|
||||
: prettyprint-IN: ( indent word -- )
|
||||
\ IN: prettyprint-word prettyprint-space
|
||||
word-vocabulary prettyprint-vocab prettyprint-newline ;
|
||||
|
||||
: prettyprint-: ( indent -- indent )
|
||||
\ : prettyprint-word prettyprint-space
|
||||
tab-size + ;
|
||||
|
||||
: prettyprint-; ( indent -- indent )
|
||||
\ ; prettyprint-word
|
||||
tab-size - ;
|
||||
|
||||
: prettyprint-plist ( word -- )
|
||||
dup "parsing" word-property [ " parsing" write ] when
|
||||
"inline" word-property [ " inline" write ] when ;
|
||||
|
||||
: . ( obj -- )
|
||||
[
|
||||
"prettyprint-single-line" on
|
||||
|
|
@ -242,49 +215,3 @@ DEFER: prettyprint*
|
|||
: .b >bin print ;
|
||||
: .o >oct print ;
|
||||
: .h >hex print ;
|
||||
|
||||
: stack-effect. ( word -- )
|
||||
stack-effect [
|
||||
" " write
|
||||
[ CHAR: ( , , CHAR: ) , ] make-string prettyprint-comment
|
||||
] when* ;
|
||||
|
||||
: documentation. ( indent word -- indent )
|
||||
documentation [
|
||||
"\n" split [
|
||||
"#!" swap cat2 prettyprint-comment
|
||||
dup prettyprint-newline
|
||||
] each
|
||||
] when* ;
|
||||
|
||||
: prettyprint-docs ( indent word -- indent )
|
||||
[
|
||||
stack-effect. dup prettyprint-newline
|
||||
] keep documentation. ;
|
||||
|
||||
: see-compound ( word -- )
|
||||
0 swap
|
||||
[ dupd prettyprint-IN: prettyprint-: ] keep
|
||||
[ prettyprint-word ] keep
|
||||
[ prettyprint-docs ] keep
|
||||
[ word-parameter prettyprint-list prettyprint-; ] keep
|
||||
prettyprint-plist prettyprint-newline ;
|
||||
|
||||
: see-primitive ( word -- )
|
||||
"PRIMITIVE: " write dup unparse write stack-effect. terpri ;
|
||||
|
||||
: see-symbol ( word -- )
|
||||
"SYMBOL: " write . ;
|
||||
|
||||
: see-undefined ( word -- )
|
||||
drop "Not defined" print ;
|
||||
|
||||
: see ( name -- )
|
||||
#! Show a word definition.
|
||||
[
|
||||
[ compound? ] [ see-compound ]
|
||||
[ symbol? ] [ see-symbol ]
|
||||
[ primitive? ] [ see-primitive ]
|
||||
[ word? ] [ see-undefined ]
|
||||
[ drop t ] [ "Not a word: " write . ]
|
||||
] cond ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,117 @@
|
|||
! :folding=indent:collapseFolds=1:
|
||||
|
||||
! $Id$
|
||||
!
|
||||
! Copyright (C) 2003, 2004 Slava Pestov.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice,
|
||||
! this list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
||||
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
||||
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
||||
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
||||
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
IN: prettyprint
|
||||
USE: combinators
|
||||
USE: lists
|
||||
USE: math
|
||||
USE: stack
|
||||
USE: stdio
|
||||
USE: strings
|
||||
USE: presentation
|
||||
USE: unparser
|
||||
USE: words
|
||||
|
||||
! Prettyprinting words
|
||||
: vocab-attrs ( word -- attrs )
|
||||
vocab-link "object-link" default-style acons ;
|
||||
|
||||
: prettyprint-vocab ( vocab -- )
|
||||
dup vocab-attrs write-attr ;
|
||||
|
||||
: prettyprint-IN: ( indent word -- )
|
||||
\ IN: prettyprint-word prettyprint-space
|
||||
word-vocabulary prettyprint-vocab prettyprint-newline ;
|
||||
|
||||
: prettyprint-: ( indent -- indent )
|
||||
\ : prettyprint-word prettyprint-space
|
||||
tab-size + ;
|
||||
|
||||
: prettyprint-; ( indent -- indent )
|
||||
\ ; prettyprint-word
|
||||
tab-size - ;
|
||||
|
||||
: prettyprint-prop ( word prop -- )
|
||||
tuck word-name word-property [
|
||||
prettyprint-space prettyprint-word
|
||||
] [
|
||||
drop
|
||||
] ifte ;
|
||||
|
||||
: prettyprint-plist ( word -- )
|
||||
dup
|
||||
\ parsing prettyprint-prop
|
||||
\ inline prettyprint-prop ;
|
||||
|
||||
: prettyprint-comment ( comment -- )
|
||||
"comments" style write-attr ;
|
||||
|
||||
: stack-effect. ( word -- )
|
||||
stack-effect [
|
||||
" " write
|
||||
[ CHAR: ( , , CHAR: ) , ] make-string prettyprint-comment
|
||||
] when* ;
|
||||
|
||||
: documentation. ( indent word -- indent )
|
||||
documentation [
|
||||
"\n" split [
|
||||
"#!" swap cat2 prettyprint-comment
|
||||
dup prettyprint-newline
|
||||
] each
|
||||
] when* ;
|
||||
|
||||
: prettyprint-docs ( indent word -- indent )
|
||||
[
|
||||
stack-effect. dup prettyprint-newline
|
||||
] keep documentation. ;
|
||||
|
||||
: see-compound ( word -- )
|
||||
0 swap
|
||||
[ dupd prettyprint-IN: prettyprint-: ] keep
|
||||
[ prettyprint-word ] keep
|
||||
[ prettyprint-docs ] keep
|
||||
[ word-parameter prettyprint-list prettyprint-; ] keep
|
||||
prettyprint-plist prettyprint-newline ;
|
||||
|
||||
: see-primitive ( word -- )
|
||||
"PRIMITIVE: " write dup unparse write stack-effect. terpri ;
|
||||
|
||||
: see-symbol ( word -- )
|
||||
\ SYMBOL: prettyprint-word . ;
|
||||
|
||||
: see-undefined ( word -- )
|
||||
drop "Not defined" print ;
|
||||
|
||||
: see ( name -- )
|
||||
#! Show a word definition.
|
||||
[
|
||||
[ compound? ] [ see-compound ]
|
||||
[ symbol? ] [ see-symbol ]
|
||||
[ primitive? ] [ see-primitive ]
|
||||
[ word? ] [ see-undefined ]
|
||||
[ drop t ] [ "Not a word: " write . ]
|
||||
] cond ;
|
||||
|
|
@ -115,3 +115,6 @@ USE: words
|
|||
[ "ansi-fg" | "3" ]
|
||||
[ "fg" | [ 2 185 2 ] ]
|
||||
] "vectors" set-vocab-style
|
||||
[
|
||||
[ "fg" | [ 128 128 128 ] ]
|
||||
] "syntax" set-vocab-style
|
||||
|
|
|
|||
Loading…
Reference in New Issue