diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index 2088e468c6..3671511194 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -272,8 +272,8 @@ HELP: nweave HELP: n*quot { $values - { "n" integer } { "seq" sequence } - { "seq'" sequence } + { "n" integer } { "quot" quotation } + { "quot'" quotation } } { $examples { $example "USING: generalizations prettyprint math ;" diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index 0aa042d4f2..637f958eb5 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -7,7 +7,7 @@ IN: generalizations << -: n*quot ( n seq -- seq' ) concat >quotation ; +: n*quot ( n quot -- seq' ) concat >quotation ; : repeat ( n obj quot -- ) swapd times ; inline @@ -94,4 +94,4 @@ MACRO: nweave ( n -- ) : nappend-as ( n exemplar -- seq ) [ narray concat ] dip like ; inline -: nappend ( n -- seq ) narray concat ; inline \ No newline at end of file +: nappend ( n -- seq ) narray concat ; inline diff --git a/basis/sorting/slots/slots-docs.factor b/basis/sorting/slots/slots-docs.factor index cc89d497e7..b427cf2956 100644 --- a/basis/sorting/slots/slots-docs.factor +++ b/basis/sorting/slots/slots-docs.factor @@ -14,7 +14,7 @@ HELP: compare-slots HELP: sort-by-slots { $values { "seq" sequence } { "sort-specs" "a sequence of accessors ending with a comparator" } - { "sortedseq" sequence } + { "seq'" sequence } } { $description "Sorts a sequence of tuples by the sort-specs in " { $snippet "sort-spec" } ". A sort-spec is a sequence of slot accessors ending in a comparator." } { $examples @@ -42,7 +42,7 @@ HELP: split-by-slots HELP: sort-by { $values { "seq" sequence } { "sort-seq" "a sequence of comparators" } - { "sortedseq" sequence } + { "seq'" sequence } } { $description "Sorts a sequence by comparing elements by comparators, using subsequent comparators when there is a tie." } ; diff --git a/basis/sorting/slots/slots-tests.factor b/basis/sorting/slots/slots-tests.factor index 83900461c3..e31b9be359 100644 --- a/basis/sorting/slots/slots-tests.factor +++ b/basis/sorting/slots/slots-tests.factor @@ -159,3 +159,15 @@ TUPLE: tuple2 d ; { { 3 2 1 } { 1 2 3 } { 1 3 2 } { 1 } } { length-test<=> <=> } sort-by ] unit-test + +[ { { 0 1 } { 1 2 } { 1 1 } { 3 2 } } ] +[ + { { 3 2 } { 1 2 } { 0 1 } { 1 1 } } + { length-test<=> <=> } sort-keys-by +] unit-test + +[ { { 0 1 } { 1 1 } { 3 2 } { 1 2 } } ] +[ + { { 3 2 } { 1 2 } { 0 1 } { 1 1 } } + { length-test<=> <=> } sort-values-by +] unit-test diff --git a/basis/sorting/slots/slots.factor b/basis/sorting/slots/slots.factor index efec960c27..9a0455c3a7 100644 --- a/basis/sorting/slots/slots.factor +++ b/basis/sorting/slots/slots.factor @@ -8,12 +8,13 @@ IN: sorting.slots ) #! sort-spec: { accessors comparator } [ slot-comparator ] map '[ _ 2|| +eq+ or ] ; -MACRO: sort-by-slots ( sort-specs -- quot ) - '[ [ _ compare-slots ] sort ] ; +: sort-by-slots ( seq sort-specs -- seq' ) + '[ _ compare-slots ] sort ; MACRO: compare-seq ( seq -- quot ) [ '[ _ short-circuit-comparator ] ] map '[ _ 2|| +eq+ or ] ; -MACRO: sort-by ( sort-seq -- quot ) - '[ [ _ compare-seq ] sort ] ; +: sort-by ( seq sort-seq -- seq' ) + '[ _ compare-seq ] sort ; -MACRO: sort-keys-by ( sort-seq -- quot ) +: sort-keys-by ( seq sort-seq -- seq' ) '[ [ first ] bi@ _ compare-seq ] sort ; -MACRO: sort-values-by ( sort-seq -- quot ) +: sort-values-by ( seq sort-seq -- seq' ) '[ [ second ] bi@ _ compare-seq ] sort ; MACRO: split-by-slots ( accessor-seqs -- quot ) - [ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map + [ [ '[ [ _ execute( tuple -- value ) ] bi@ ] ] map concat + [ = ] compose ] map '[ [ _ 2&& ] slice monotonic-slice ] ; diff --git a/core/slots/slots.factor b/core/slots/slots.factor index a353f50947..63c0319c1c 100755 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -222,7 +222,7 @@ M: slot-spec make-slot [ make-slot ] map ; : finalize-slots ( specs base -- specs ) - over length [ + ] with map [ >>offset ] 2map ; + over length iota [ + ] with map [ >>offset ] 2map ; : slot-named ( name specs -- spec/f ) [ name>> = ] with find nip ;