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

prettyprint: some minor cleanup.

db4
John Benediktsson 2014-12-11 07:52:14 -08:00
parent 33500db79f
commit 9a642531e0
2 changed files with 18 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/prettyprint/backend/backend.factor
View File

@ -145,7 +145,7 @@ M: pathname pprint*
: present-text ( str obj -- ) : present-text ( str obj -- )
presented associate styled-text ; presented associate styled-text ;
: check-recursion ( obj quot -- ) : check-recursion ( obj quot: ( obj -- ) -- )
nesting-limit? [ nesting-limit? [
drop drop
[ class-of name>> "~" dup surround ] keep present-text [ class-of name>> "~" dup surround ] keep present-text

34
basis/prettyprint/sections/sections.factor
View File

@ -99,8 +99,7 @@ style overhang ;
M: section section-fits? ( section -- ? ) M: section section-fits? ( section -- ? )
[ end>> 1 - pprinter get last-newline>> - ] [ end>> 1 - pprinter get last-newline>> - ]
[ overhang>> ] bi [ overhang>> ] bi + text-fits? ;
+ text-fits? ;
M: section indent-section? drop f ; M: section indent-section? drop f ;
@ -146,7 +145,7 @@ M: object short-section? section-fits? ;
TUPLE: line-break < section type ; TUPLE: line-break < section type ;
: <line-break> ( type -- section ) : <line-break> ( type -- section )
0 \ line-break new-section 0 line-break new-section
swap >>type ; swap >>type ;
M: line-break short-section drop ; M: line-break short-section drop ;
@ -208,7 +207,7 @@ M: block short-section ( block -- )
: empty-block? ( block -- ? ) sections>> empty? ; : empty-block? ( block -- ? ) sections>> empty? ;
: if-nonempty ( block quot -- ) : unless-empty-block ( block quot: ( block -- ) -- )
[ dup empty-block? [ drop ] ] dip if ; inline [ dup empty-block? [ drop ] ] dip if ; inline
: (<block) ( block -- ) pprinter-stack get push ; : (<block) ( block -- ) pprinter-stack get push ;
@ -289,8 +288,9 @@ M: colon unindent-first-line? drop t ;
position get >>end drop ; position get >>end drop ;
: block> ( -- ) : block> ( -- )
pprinter-stack get pop pprinter-stack get pop [
[ [ save-end-position ] [ add-section ] bi ] if-nonempty ; [ save-end-position ] [ add-section ] bi
] unless-empty-block ;
: do-pprint ( block -- ) : do-pprint ( block -- )
<pprinter> pprinter [ <pprinter> pprinter [
@ -300,7 +300,7 @@ M: colon unindent-first-line? drop t ;
short-section short-section
] curry with-return ] curry with-return
] with-nesting ] with-nesting
] if-nonempty ] unless-empty-block
] with-variable ; ] with-variable ;
! Long section layout algorithm ! Long section layout algorithm
@ -347,25 +347,23 @@ M: block long-section ( block -- )
] if ] if
] each ] each
] each ] each
] if-nonempty ; ] unless-empty-block ;
: pprinter-manifest ( -- manifest ) : pprinter-manifest ( -- manifest )
<manifest> <manifest>
[ [ pprinter-use get members >vector ] dip search-vocabs<< ] pprinter-use get members V{ } like >>search-vocabs
[ [ pprinter-in get ] dip current-vocab<< ] pprinter-in get >>current-vocab ;
[ ]
tri ;
: make-pprint ( obj quot manifest? -- block manifest/f ) : make-pprint ( obj quot manifest? -- block manifest/f )
[ [
0 position ,, 0 position set
HS{ } clone pprinter-use ,, HS{ } clone pprinter-use set
V{ } clone recursion-check ,, V{ } clone recursion-check set
V{ } clone pprinter-stack ,, V{ } clone pprinter-stack set
] H{ } make [
[ over <object call pprinter-block ] dip [ over <object call pprinter-block ] dip
[ pprinter-manifest ] [ f ] if [ pprinter-manifest ] [ f ] if
] with-variables ; inline ] with-scope ; inline
: with-pprint ( obj quot -- ) : with-pprint ( obj quot -- )
f make-pprint drop do-pprint ; inline f make-pprint drop do-pprint ; inline