Fix conflict

db4
Slava Pestov 2008-07-03 16:46:21 -05:00
commit ef2fddb1ec
14 changed files with 64 additions and 59 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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' )
[
[

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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