Remove 3compose: nothing in core used it, and basis code can use fry

db4
Slava Pestov 2008-12-02 00:25:23 -06:00
parent 2777f54e74
commit c27faa3de4
8 changed files with 21 additions and 42 deletions

View File

@ -46,10 +46,10 @@ $nl
"{ 10 20 30 } [ sq ] [ . ] compose each" "{ 10 20 30 } [ sq ] [ . ] compose each"
"{ 10 20 30 } [ sq . ] each" "{ 10 20 30 } [ sq . ] each"
} }
"The " { $link _ } " and " { $link @ } " specifiers may be freely mixed:" "The " { $link _ } " and " { $link @ } " specifiers may be freely mixed, and the result is considerably more concise and readable than the version using " { $link curry } " and " { $link compose } " directly:"
{ $code { $code
"{ 8 13 14 27 } [ even? ] 5 '[ @ dup _ ? ] map" "{ 8 13 14 27 } [ even? ] 5 '[ @ dup _ ? ] map"
"{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry 3compose map" "{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry compose compose map"
"{ 8 13 14 27 } [ even? dup 5 ? ] map" "{ 8 13 14 27 } [ even? dup 5 ? ] map"
} }
"The following is a no-op:" "The following is a no-op:"

View File

@ -1,30 +1,30 @@
USING: accessors sequences assocs kernel quotations namespaces USING: accessors sequences assocs kernel quotations namespaces
xml.data xml.utilities combinators macros parser lexer words ; xml.data xml.utilities combinators macros parser lexer words fry ;
IN: xmode.utilities IN: xmode.utilities
: implies >r not r> or ; inline : implies [ not ] dip or ; inline
: child-tags ( tag -- seq ) children>> [ tag? ] filter ; : child-tags ( tag -- seq ) children>> [ tag? ] filter ;
: map-find ( seq quot -- result elt ) : map-find ( seq quot -- result elt )
f -rot f -rot
[ nip ] swap [ dup ] 3compose find '[ nip @ dup ] find
>r [ drop f ] unless r> ; inline [ [ drop f ] unless ] dip ; inline
: tag-init-form ( spec -- quot ) : tag-init-form ( spec -- quot )
{ {
{ [ dup quotation? ] [ [ object get tag get ] prepose ] } { [ dup quotation? ] [ [ object get tag get ] prepose ] }
{ [ dup length 2 = ] [ { [ dup length 2 = ] [
first2 [ first2 '[
>r >r tag get children>string tag get children>string
r> [ execute ] when* object get r> execute _ [ execute ] when* object get _ execute
] 2curry ]
] } ] }
{ [ dup length 3 = ] [ { [ dup length 3 = ] [
first3 [ first3 '[
>r >r tag get at _ tag get at
r> [ execute ] when* object get r> execute _ [ execute ] when* object get _ execute
] 3curry ]
] } ] }
} cond ; } cond ;
@ -36,7 +36,7 @@ MACRO: (init-from-tag) ( specs -- )
[ with-tag-initializer ] curry ; [ with-tag-initializer ] curry ;
: init-from-tag ( tag tuple specs -- tuple ) : init-from-tag ( tag tuple specs -- tuple )
over >r (init-from-tag) r> ; inline over [ (init-from-tag) ] dip ; inline
SYMBOL: tag-handlers SYMBOL: tag-handlers
SYMBOL: tag-handler-word SYMBOL: tag-handler-word

View File

@ -65,7 +65,7 @@ SYMBOL: error-stream
: with-streams ( input output quot -- ) : with-streams ( input output quot -- )
[ [ with-streams* ] 3curry ] [ [ with-streams* ] 3curry ]
[ [ drop dispose dispose ] 3curry ] 3bi [ drop [ [ dispose ] bi@ ] 2curry ] 3bi
[ ] cleanup ; inline [ ] cleanup ; inline
: tabular-output ( style quot -- ) : tabular-output ( style quot -- )

View File

@ -578,18 +578,6 @@ HELP: prepose
{ compose prepose } related-words { compose prepose } related-words
HELP: 3compose
{ $values { "quot1" callable } { "quot2" callable } { "quot3" callable } { "compose" compose } }
{ $description "Quotation composition. Outputs a " { $link callable } " which calls " { $snippet "quot1" } ", " { $snippet "quot2" } " and then " { $snippet "quot3" } "." }
{ $notes
"The following two lines are equivalent:"
{ $code
"3compose call"
"3append call"
}
"However, " { $link 3compose } " runs in constant time, and the compiler is able to compile code which calls composed quotations."
} ;
HELP: dip HELP: dip
{ $values { "x" object } { "quot" quotation } } { $values { "x" object } { "quot" quotation } }
{ $description "Calls " { $snippet "quot" } " with " { $snippet "obj" } " hidden on the retain stack." } { $description "Calls " { $snippet "quot" } " with " { $snippet "obj" } " hidden on the retain stack." }
@ -814,7 +802,6 @@ ARTICLE: "compositional-combinators" "Compositional combinators"
{ $subsection 3curry } { $subsection 3curry }
{ $subsection with } { $subsection with }
{ $subsection compose } { $subsection compose }
{ $subsection 3compose }
{ $subsection prepose } { $subsection prepose }
"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } "." ; "Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } "." ;

View File

@ -179,9 +179,6 @@ GENERIC: boa ( ... class -- tuple )
: prepose ( quot1 quot2 -- compose ) : prepose ( quot1 quot2 -- compose )
swap compose ; inline swap compose ; inline
: 3compose ( quot1 quot2 quot3 -- compose )
compose compose ; inline
! Booleans ! Booleans
: not ( obj -- ? ) [ f ] [ t ] if ; inline : not ( obj -- ? ) [ f ] [ t ] if ; inline

View File

@ -142,7 +142,7 @@ MACRO: multikeep ( word out-indexes -- ... )
[ tuck 2slip ] dip while ; inline [ tuck 2slip ] dip while ; inline
: generate ( generator predicate -- obj ) : generate ( generator predicate -- obj )
[ dup ] swap [ dup [ nip ] unless not ] 3compose '[ dup @ dup [ nip ] unless not ]
swap [ ] do-while ; swap [ ] do-while ;
MACRO: predicates ( seq -- quot/f ) MACRO: predicates ( seq -- quot/f )

View File

@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations
continuations debugger classes.tuple namespaces make vectors continuations debugger classes.tuple namespaces make vectors
bit-arrays byte-arrays strings sbufs math.functions macros bit-arrays byte-arrays strings sbufs math.functions macros
sequences.private combinators mirrors sequences.private combinators mirrors
combinators.short-circuit ; combinators.short-circuit fry ;
IN: inverse IN: inverse
TUPLE: fail ; TUPLE: fail ;
@ -46,7 +46,7 @@ M: no-inverse summary
dup word? [ "Badly formed math inverse" throw ] when 1quotation ; dup word? [ "Badly formed math inverse" throw ] when 1quotation ;
: swap-inverse ( math-inverse revquot -- revquot* quot ) : swap-inverse ( math-inverse revquot -- revquot* quot )
next assure-constant rot second [ swap ] swap 3compose ; next assure-constant rot second '[ @ swap @ ] ;
: pull-inverse ( math-inverse revquot const -- revquot* quot ) : pull-inverse ( math-inverse revquot const -- revquot* quot )
assure-constant rot first compose ; assure-constant rot first compose ;
@ -236,8 +236,7 @@ DEFER: _
] recover ; inline ] recover ; inline
: true-out ( quot effect -- quot' ) : true-out ( quot effect -- quot' )
out>> [ ndrop ] curry out>> '[ @ _ ndrop t ] ;
[ t ] 3compose ;
: false-recover ( effect -- quot ) : false-recover ( effect -- quot )
in>> [ ndrop f ] curry [ recover-fail ] curry ; in>> [ ndrop f ] curry [ recover-fail ] curry ;

View File

@ -90,12 +90,8 @@ ERROR: element-not-found ;
dupd find over [ element-not-found ] unless dupd find over [ element-not-found ] unless
>r cut rest r> swap ; inline >r cut rest r> swap ; inline
: (map-until) ( quot pred -- quot )
[ dup ] swap 3compose
[ [ drop t ] [ , f ] if ] compose [ find 2drop ] curry ;
: map-until ( seq quot pred -- newseq ) : map-until ( seq quot pred -- newseq )
(map-until) { } make ; '[ [ @ dup @ [ drop t ] [ , f ] if ] find 2drop ] { } make ;
: take-while ( seq quot -- newseq ) : take-while ( seq quot -- newseq )
[ not ] compose [ not ] compose