Add nsum, nspread and nweave to generalizations
Slava Pestov
parent
36e5536110
commit
f36ec3f0c5
|
|
@ -30,6 +30,10 @@ HELP: narray
|
|||
|
||||
{ nsequence narray } related-words
|
||||
|
||||
HELP: nsum
|
||||
{ $values { "n" integer } }
|
||||
{ $description "Adds the top " { $snippet "n" } " stack values." } ;
|
||||
|
||||
HELP: firstn
|
||||
{ $values { "n" integer } }
|
||||
{ $description "A generalization of " { $link first } ", "
|
||||
|
|
@ -238,6 +242,11 @@ HELP: ncleave
|
|||
}
|
||||
} ;
|
||||
|
||||
HELP: nspread
|
||||
{ $values { "quots" "a sequence of quotations" } { "n" integer } }
|
||||
{ $description "A generalization of " { $link spread } " that can work for any quotation arity."
|
||||
} ;
|
||||
|
||||
HELP: mnswap
|
||||
{ $values { "m" integer } { "n" integer } }
|
||||
{ $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." }
|
||||
|
|
@ -250,6 +259,17 @@ HELP: mnswap
|
|||
}
|
||||
} ;
|
||||
|
||||
HELP: nweave
|
||||
{ $values { "n" integer } }
|
||||
{ $description "Copies the top " { $snippet "n" } " stack elements underneath each one of the " { $snippet "n" } " elements below." }
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: arrays kernel generalizations prettyprint ;"
|
||||
"\"e1\" \"e2\" \"o1\" \"o2\" 2 nweave [ 3array ] 3dip 3array 2array ."
|
||||
"{ { \"e1\" \"o1\" \"o2\" } { \"e2\" \"o1\" \"o2\" } }"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: n*quot
|
||||
{ $values
|
||||
{ "n" integer } { "seq" sequence }
|
||||
|
|
@ -299,18 +319,14 @@ HELP: ntuck
|
|||
}
|
||||
{ $description "A generalization of " { $link tuck } " that can work for any stack depth. The top item will be copied and placed " { $snippet "n" } " items down on the stack." } ;
|
||||
|
||||
ARTICLE: "generalizations" "Generalized shuffle words and combinators"
|
||||
"The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in "
|
||||
"macros where the arity of the input quotations depends on an "
|
||||
"input parameter."
|
||||
$nl
|
||||
"Generalized sequence operations:"
|
||||
ARTICLE: "sequence-generalizations" "Generalized sequence operations"
|
||||
{ $subsection narray }
|
||||
{ $subsection nsequence }
|
||||
{ $subsection firstn }
|
||||
{ $subsection nappend }
|
||||
{ $subsection nappend-as }
|
||||
"Generated stack shuffle operations:"
|
||||
{ $subsection nappend-as } ;
|
||||
|
||||
ARTICLE: "shuffle-generalizations" "Generalized shuffle words"
|
||||
{ $subsection ndup }
|
||||
{ $subsection npick }
|
||||
{ $subsection nrot }
|
||||
|
|
@ -319,14 +335,28 @@ $nl
|
|||
{ $subsection ndrop }
|
||||
{ $subsection ntuck }
|
||||
{ $subsection mnswap }
|
||||
"Generalized combinators:"
|
||||
{ $subsection nweave } ;
|
||||
|
||||
ARTICLE: "combinator-generalizations" "Generalized combinators"
|
||||
{ $subsection ndip }
|
||||
{ $subsection nslip }
|
||||
{ $subsection nkeep }
|
||||
{ $subsection napply }
|
||||
{ $subsection ncleave }
|
||||
"Generalized quotation construction:"
|
||||
{ $subsection nspread } ;
|
||||
|
||||
ARTICLE: "other-generalizations" "Additional generalizations"
|
||||
{ $subsection ncurry }
|
||||
{ $subsection nwith } ;
|
||||
{ $subsection nwith }
|
||||
{ $subsection nsum } ;
|
||||
|
||||
ARTICLE: "generalizations" "Generalized shuffle words and combinators"
|
||||
"The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in "
|
||||
"macros where the arity of the input quotations depends on an "
|
||||
"input parameter."
|
||||
{ $subsection "sequence-generalizations" }
|
||||
{ $subsection "shuffle-generalizations" }
|
||||
{ $subsection "combinator-generalizations" }
|
||||
{ $subsection "other-generalizations" } ;
|
||||
|
||||
ABOUT: "generalizations"
|
||||
|
|
|
|||
|
|
@ -53,3 +53,12 @@ IN: generalizations.tests
|
|||
|
||||
[ 4 nappend ] must-infer
|
||||
[ 4 { } nappend-as ] must-infer
|
||||
|
||||
[ 17 ] [ 3 1 3 3 7 5 nsum ] unit-test
|
||||
{ 4 1 } [ 4 nsum ] must-infer-as
|
||||
|
||||
[ "e1" "o1" "o2" "e2" "o1" "o2" ] [ "e1" "e2" "o1" "o2" 2 nweave ] unit-test
|
||||
{ 3 5 } [ 2 nweave ] must-infer-as
|
||||
|
||||
[ { 0 1 2 } { 3 5 4 } { 7 8 6 } ]
|
||||
[ 9 [ ] each { [ 3array ] [ swap 3array ] [ rot 3array ] } 3 nspread ] unit-test
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007, 2008 Chris Double, Doug Coleman, Eduardo
|
||||
! Copyright (C) 2007, 2009 Chris Double, Doug Coleman, Eduardo
|
||||
! Cavazos, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel sequences sequences.private math combinators
|
||||
|
|
@ -23,6 +23,9 @@ MACRO: nsequence ( n seq -- )
|
|||
MACRO: narray ( n -- )
|
||||
'[ _ { } nsequence ] ;
|
||||
|
||||
MACRO: nsum ( n -- )
|
||||
1- [ + ] n*quot ;
|
||||
|
||||
MACRO: firstn ( n -- )
|
||||
dup zero? [ drop [ drop ] ] [
|
||||
[ [ '[ [ _ ] dip nth-unsafe ] ] map ]
|
||||
|
|
@ -70,11 +73,23 @@ MACRO: ncleave ( quots n -- )
|
|||
[ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi
|
||||
compose ;
|
||||
|
||||
MACRO: nspread ( quots n -- )
|
||||
over empty? [ 2drop [ ] ] [
|
||||
[ [ but-last ] dip ]
|
||||
[ [ peek ] dip ] 2bi
|
||||
swap
|
||||
'[ [ _ _ nspread ] _ ndip @ ]
|
||||
] if ;
|
||||
|
||||
MACRO: napply ( quot n -- )
|
||||
swap <repetition> spread>quot ;
|
||||
|
||||
MACRO: mnswap ( m n -- )
|
||||
1+ '[ _ -nrot ] <repetition> spread>quot ;
|
||||
1+ '[ _ -nrot ] swap '[ _ _ napply ] ;
|
||||
|
||||
MACRO: nweave ( n -- )
|
||||
[ dup <reversed> [ '[ _ _ mnswap ] ] with map ] keep
|
||||
'[ _ _ ncleave ] ;
|
||||
|
||||
: nappend-as ( n exemplar -- seq )
|
||||
[ narray concat ] dip like ; inline
|
||||
|
|
|
|||
Loading…
Reference in New Issue