Add nsum, nspread and nweave to generalizations

db4
Slava Pestov 2009-02-07 23:04:55 -06:00
parent 36e5536110
commit f36ec3f0c5
3 changed files with 67 additions and 13 deletions

View File

@ -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"

View File

@ -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

View File

@ -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