prettyprint.callables: not needed anymore since fry output is prettier
Slava Pestov
parent
3259ef4bec
commit
13eba38801
|
|
@ -1 +0,0 @@
|
||||||
Joe Groff
|
|
||||||
|
|
@ -1,6 +0,0 @@
|
||||||
USING: help help.markup help.syntax kernel quotations ;
|
|
||||||
IN: prettyprint.callables
|
|
||||||
|
|
||||||
HELP: simplify-callable
|
|
||||||
{ $values { "quot" callable } { "quot'" callable } }
|
|
||||||
{ $description "Converts " { $snippet "quot" } " into an equivalent quotation by simplifying usages of " { $link dip } ", " { $link call } ", " { $link curry } ", and " { $link compose } " with literal parameters. This word is used when callable objects are prettyprinted." } ;
|
|
||||||
|
|
@ -1,15 +0,0 @@
|
||||||
! (c) 2009 Joe Groff bsd license
|
|
||||||
USING: kernel math prettyprint prettyprint.callables
|
|
||||||
tools.test ;
|
|
||||||
IN: prettyprint.callables.tests
|
|
||||||
|
|
||||||
[ [ dip ] ] [ [ dip ] simplify-callable ] unit-test
|
|
||||||
[ [ [ + ] dip ] ] [ [ [ + ] dip ] simplify-callable ] unit-test
|
|
||||||
[ [ + 5 ] ] [ [ 5 [ + ] dip ] simplify-callable ] unit-test
|
|
||||||
[ [ + ] ] [ [ [ + ] call ] simplify-callable ] unit-test
|
|
||||||
[ [ call ] ] [ [ call ] simplify-callable ] unit-test
|
|
||||||
[ [ 5 + ] ] [ [ 5 [ + ] curry call ] simplify-callable ] unit-test
|
|
||||||
[ [ 4 5 + ] ] [ [ 4 5 [ + ] 2curry call ] simplify-callable ] unit-test
|
|
||||||
[ [ 4 5 6 + ] ] [ [ 4 5 6 [ + ] 3curry call ] simplify-callable ] unit-test
|
|
||||||
[ [ + . ] ] [ [ [ + ] [ . ] compose call ] simplify-callable ] unit-test
|
|
||||||
[ [ . + ] ] [ [ [ + ] [ . ] prepose call ] simplify-callable ] unit-test
|
|
||||||
|
|
@ -1,75 +0,0 @@
|
||||||
! (c) 2009 Joe Groff bsd license
|
|
||||||
USING: combinators combinators.short-circuit generalizations
|
|
||||||
kernel macros math math.ranges prettyprint.custom quotations
|
|
||||||
sequences words ;
|
|
||||||
IN: prettyprint.callables
|
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
CONSTANT: simple-combinators { dip call curry 2curry 3curry compose prepose }
|
|
||||||
|
|
||||||
: literal? ( obj -- ? ) word? not ;
|
|
||||||
|
|
||||||
MACRO: slice-match? ( quots -- quot: ( seq end -- ? ) )
|
|
||||||
dup length
|
|
||||||
[ 0 [a,b) [ [ - swap nth ] swap prefix prepend ] 2map ]
|
|
||||||
[ nip \ nip swap \ >= [ ] 3sequence ] 2bi
|
|
||||||
prefix \ 2&& [ ] 2sequence ;
|
|
||||||
|
|
||||||
: end-len>from-to ( seq end len -- from to seq )
|
|
||||||
[ - ] [ drop 1 + ] 2bi rot ;
|
|
||||||
|
|
||||||
: slice-change ( seq end len quot -- seq' )
|
|
||||||
[ end-len>from-to ] dip
|
|
||||||
[ [ subseq ] dip call ] curry
|
|
||||||
[ replace-slice ] 3bi ; inline
|
|
||||||
|
|
||||||
: when-slice-match ( seq i criteria quot -- seq' )
|
|
||||||
[ [ 2dup ] dip slice-match? ] dip [ drop ] if ; inline
|
|
||||||
|
|
||||||
: simplify-dip ( quot i -- quot' )
|
|
||||||
{ [ literal? ] [ callable? ] }
|
|
||||||
[ 2 [ first2 swap suffix ] slice-change ] when-slice-match ;
|
|
||||||
|
|
||||||
: simplify-call ( quot i -- quot' )
|
|
||||||
{ [ callable? ] }
|
|
||||||
[ 1 [ first ] slice-change ] when-slice-match ;
|
|
||||||
|
|
||||||
: simplify-curry ( quot i -- quot' )
|
|
||||||
{ [ literal? ] [ callable? ] }
|
|
||||||
[ 2 [ first2 swap prefix 1quotation ] slice-change ] when-slice-match ;
|
|
||||||
|
|
||||||
: simplify-2curry ( quot i -- quot' )
|
|
||||||
{ [ literal? ] [ literal? ] [ callable? ] }
|
|
||||||
[ 3 [ [ 2 head ] [ third ] bi append 1quotation ] slice-change ] when-slice-match ;
|
|
||||||
|
|
||||||
: simplify-3curry ( quot i -- quot' )
|
|
||||||
{ [ literal? ] [ literal? ] [ literal? ] [ callable? ] }
|
|
||||||
[ 4 [ [ 3 head ] [ fourth ] bi append 1quotation ] slice-change ] when-slice-match ;
|
|
||||||
|
|
||||||
: simplify-compose ( quot i -- quot' )
|
|
||||||
{ [ callable? ] [ callable? ] }
|
|
||||||
[ 2 [ first2 append 1quotation ] slice-change ] when-slice-match ;
|
|
||||||
|
|
||||||
: simplify-prepose ( quot i -- quot' )
|
|
||||||
{ [ callable? ] [ callable? ] }
|
|
||||||
[ 2 [ first2 swap append 1quotation ] slice-change ] when-slice-match ;
|
|
||||||
|
|
||||||
: (simplify-callable) ( quot -- quot' )
|
|
||||||
dup [ simple-combinators member? ] find {
|
|
||||||
{ \ dip [ simplify-dip ] }
|
|
||||||
{ \ call [ simplify-call ] }
|
|
||||||
{ \ curry [ simplify-curry ] }
|
|
||||||
{ \ 2curry [ simplify-2curry ] }
|
|
||||||
{ \ 3curry [ simplify-3curry ] }
|
|
||||||
{ \ compose [ simplify-compose ] }
|
|
||||||
{ \ prepose [ simplify-prepose ] }
|
|
||||||
[ 2drop ]
|
|
||||||
} case ;
|
|
||||||
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
: simplify-callable ( quot -- quot' )
|
|
||||||
[ (simplify-callable) ] to-fixed-point ;
|
|
||||||
|
|
||||||
M: callable >pprint-sequence simplify-callable ;
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
Quotation simplification for prettyprinting automatically-constructed callable objects
|
|
||||||
Loading…
Reference in New Issue