diff --git a/core/bootstrap/stage2.factor b/core/bootstrap/stage2.factor index 69f594b9fa..3b98e89095 100755 --- a/core/bootstrap/stage2.factor +++ b/core/bootstrap/stage2.factor @@ -28,7 +28,7 @@ SYMBOL: bootstrap-time [ "bootstrap." prepend require ] each ; : count-words ( pred -- ) - all-words swap filter length number>string write ; + all-words swap count number>string write ; : print-report ( time -- ) 1000 /i diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 59a2d15749..830ace3bf6 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -107,7 +107,7 @@ ERROR: bad-superclass class ; : superclass-size ( class -- n ) superclasses but-last-slice - [ slot-names length ] map sum ; + [ slot-names length ] sigma ; : (instance-check-quot) ( class -- quot ) [ diff --git a/core/optimizer/inlining/inlining.factor b/core/optimizer/inlining/inlining.factor index 9647f42d51..e36d38180c 100755 --- a/core/optimizer/inlining/inlining.factor +++ b/core/optimizer/inlining/inlining.factor @@ -48,7 +48,7 @@ DEFER: (flat-length) { [ dup word? ] [ word-flat-length ] } [ drop 1 ] } cond - ] map sum ; + ] sigma ; : flat-length ( word -- n ) [ def>> (flat-length) ] with-scope ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index a753e478bf..7cf83d2e37 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -1,6 +1,5 @@ USING: arrays help.markup help.syntax math -sequences.private vectors strings sbufs kernel math.order -layouts ; +sequences.private vectors strings kernel math.order ; IN: sequences ARTICLE: "sequences-unsafe" "Unsafe sequence operations" @@ -959,3 +958,23 @@ HELP: unfold "The " { $snippet "tail" } " quotation is used when the predicate produces more than one output value. In this case, we have to drop this value even if the predicate fails in order for stack inference to calculate a stack effect for the " { $link unfold } " call:" { $unchecked-example "USING: kernel prettyprint random sequences ;" "[ 10 random dup 1 > ] [ ] [ drop ] unfold ." "{ 8 2 2 9 }" } } ; + +HELP: sigma +{ $values { "seq" sequence } { "quot" quotation } { "n" number } } +{ $description "Like map sum, but without creating an intermediate sequence." } +{ $example + "! Find the sum of the squares [0,99]" + "USING: math math.ranges sequences.lib prettyprint ;" + "100 [1,b] [ sq ] sigma ." + "338350" +} ; + +HELP: count +{ $values { "seq" sequence } { "quot" quotation } { "n" integer } } +{ $description "Efficiently returns the number of elements that the predicate quotation matches." } +{ $example + "USING: math math.ranges sequences.lib prettyprint ;" + "100 [1,b] [ even? ] count ." + "50" +} ; + diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index a12184690d..81c832660e 100755 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -241,3 +241,8 @@ unit-test [ "asdf" ] [ " asdf " [ CHAR: \s = ] trim ] unit-test [ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test [ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test + +[ 328350 ] [ 100 [ sq ] sigma ] unit-test + +[ 50 ] [ 100 [ even? ] count ] unit-test +[ 50 ] [ 100 [ odd? ] count ] unit-test diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 1ea93080e9..7560c8f73e 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -718,3 +718,8 @@ PRIVATE> dup [ length ] map infimum swap [ [ nth-unsafe ] with { } map-as ] curry { } map-as ] unless ; + +: sigma ( seq quot -- n ) [ + ] compose 0 swap reduce ; inline + +: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline + diff --git a/extra/fry/fry.factor b/extra/fry/fry.factor index 4a97ace2fe..e2feb3cc17 100755 --- a/extra/fry/fry.factor +++ b/extra/fry/fry.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences combinators parser splitting +USING: kernel sequences combinators parser splitting math quotations arrays namespaces qualified ; QUALIFIED: namespaces IN: fry @@ -35,29 +35,25 @@ DEFER: shallow-fry : shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ; -: deep-fry ( quot -- quot' ) - { _ } last-split1 [ - [ - shallow-fry % - [ >r ] % - deep-fry % - [ [ dip ] curry r> compose ] % - ] [ ] make +: deep-fry ( quot -- quot ) + { _ } last-split1 dup [ + shallow-fry [ >r ] rot + deep-fry [ [ dip ] curry r> compose ] 4array concat ] [ - shallow-fry - ] if* ; + drop shallow-fry + ] if ; : fry-specifier? ( obj -- ? ) { , namespaces:, @ } member? ; : count-inputs ( quot -- n ) [ { - { [ dup callable? ] [ count-inputs ] } - { [ dup fry-specifier? ] [ drop 1 ] } - [ drop 0 ] + { [ dup callable? ] [ count-inputs ] } + { [ dup fry-specifier? ] [ drop 1 ] } + [ drop 0 ] } cond ] map sum ; - + : fry ( quot -- quot' ) [ [ diff --git a/extra/newfx/newfx.factor b/extra/newfx/newfx.factor index e62747a2eb..9335c61025 100644 --- a/extra/newfx/newfx.factor +++ b/extra/newfx/newfx.factor @@ -159,6 +159,11 @@ METHOD: as-mutate { object object assoc } set-at ; : prefix-on ( elt seq -- seq ) swap prefix ; : suffix-on ( elt seq -- seq ) swap suffix ; +: suffix! ( seq elt -- seq ) over sequences:push ; +: suffix-on! ( elt seq -- seq ) tuck sequences:push ; +: suffixed! ( seq elt -- ) swap sequences:push ; +: suffixed-on! ( elt seq -- ) sequences:push ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : subseq ( seq from to -- subseq ) rot sequences:subseq ; @@ -221,4 +226,14 @@ METHOD: as-mutate { object object assoc } set-at ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: invert-index ( seq i -- seq i ) >r dup length 1 - r> - ; \ No newline at end of file +: invert-index ( seq i -- seq i ) >r dup length 1 - r> - ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: append! ( a b -- ab ) over sequences:push-all ; +: append-to! ( b a -- ab ) swap over sequences:push-all ; +: appended! ( a b -- ) swap sequences:push-all ; +: appended-to! ( b a -- ) sequences:push-all ; + +: prepend! ( a b -- ba ) over append 0 pick copy ; +: prepended! ( a b -- ) over append 0 rot copy ; diff --git a/extra/project-euler/028/028.factor b/extra/project-euler/028/028.factor index 3ef65481ed..d0f3892956 100644 --- a/extra/project-euler/028/028.factor +++ b/extra/project-euler/028/028.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.ranges sequences.lib ; +USING: kernel math math.ranges sequences ; IN: project-euler.028 ! http://projecteuler.net/index.php?section=problems&id=28 diff --git a/extra/project-euler/048/048.factor b/extra/project-euler/048/048.factor index 011511c560..baa1a430e8 100644 --- a/extra/project-euler/048/048.factor +++ b/extra/project-euler/048/048.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.functions sequences.lib ; +USING: kernel math math.functions sequences ; IN: project-euler.048 ! http://projecteuler.net/index.php?section=problems&id=48 diff --git a/extra/project-euler/053/053.factor b/extra/project-euler/053/053.factor index ae47440415..b2a50e4ac7 100644 --- a/extra/project-euler/053/053.factor +++ b/extra/project-euler/053/053.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.combinatorics math.ranges sequences.lib ; +USING: kernel math math.combinatorics math.ranges sequences ; IN: project-euler.053 ! http://projecteuler.net/index.php?section=problems&id=53 diff --git a/extra/sequences/lib/lib-docs.factor b/extra/sequences/lib/lib-docs.factor index 14fb6eaebf..b2e805304e 100755 --- a/extra/sequences/lib/lib-docs.factor +++ b/extra/sequences/lib/lib-docs.factor @@ -19,25 +19,6 @@ HELP: each-withn } { $see-also map-withn } ; -HELP: sigma -{ $values { "seq" sequence } { "quot" quotation } { "n" number } } -{ $description "Like map sum, but without creating an intermediate sequence." } -{ $example - "! Find the sum of the squares [0,99]" - "USING: math math.ranges sequences.lib prettyprint ;" - "100 [1,b] [ sq ] sigma ." - "338350" -} ; - -HELP: count -{ $values { "seq" sequence } { "quot" quotation } { "n" integer } } -{ $description "Efficiently returns the number of elements that the predicate quotation matches." } -{ $example - "USING: math math.ranges sequences.lib prettyprint ;" - "100 [1,b] [ even? ] count ." - "50" -} ; - HELP: if-seq { $values { "seq" sequence } { "quot1" quotation } { "quot2" quotation } } { $description "Makes an implicit check if the sequence is empty. If the sequence has any elements, " { $snippet "quot1" } " is called on it. Otherwise, the empty sequence is dropped and " { $snippet "quot2" } " is called." } diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor index 019796c1a1..4b8114f67f 100755 --- a/extra/sequences/lib/lib-tests.factor +++ b/extra/sequences/lib/lib-tests.factor @@ -2,10 +2,6 @@ USING: arrays kernel sequences sequences.lib math math.functions math.ranges tools.test strings ; IN: sequences.lib.tests -[ 50 ] [ 100 [1,b] [ even? ] count ] unit-test -[ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test -[ 328350 ] [ 100 [ sq ] sigma ] unit-test - [ 1 2 { 3 4 } [ + + drop ] 2 each-withn ] must-infer { 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test @@ -64,10 +60,6 @@ IN: sequences.lib.tests [ 3 ] [ { 1 2 3 } ?third ] unit-test [ f ] [ { 1 2 3 } ?fourth ] unit-test -[ 50 ] [ 100 [1,b] [ even? ] count ] unit-test -[ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test -[ 328350 ] [ 100 [ sq ] sigma ] unit-test - [ 1 2 { 3 4 } [ + + ] 2 map-withn ] must-infer { { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test { { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index cf6521c999..1debe3f91b 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -51,14 +51,6 @@ MACRO: firstn ( n -- ) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: sigma ( seq quot -- n ) - [ + ] compose 0 swap reduce ; inline - -: count ( seq quot -- n ) - [ 1 0 ? ] compose sigma ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : map-reduce ( seq map-quot reduce-quot -- result ) >r [ unclip ] dip [ call ] keep r> compose reduce ; inline