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 ; [ "bootstrap." prepend require ] each ;
: count-words ( pred -- ) : count-words ( pred -- )
all-words swap filter length number>string write ; all-words swap count number>string write ;
: print-report ( time -- ) : print-report ( time -- )
1000 /i 1000 /i

View File

@ -107,7 +107,7 @@ ERROR: bad-superclass class ;
: superclass-size ( class -- n ) : superclass-size ( class -- n )
superclasses but-last-slice superclasses but-last-slice
[ slot-names length ] map sum ; [ slot-names length ] sigma ;
: (instance-check-quot) ( class -- quot ) : (instance-check-quot) ( class -- quot )
[ [

View File

@ -48,7 +48,7 @@ DEFER: (flat-length)
{ [ dup word? ] [ word-flat-length ] } { [ dup word? ] [ word-flat-length ] }
[ drop 1 ] [ drop 1 ]
} cond } cond
] map sum ; ] sigma ;
: flat-length ( word -- n ) : flat-length ( word -- n )
[ def>> (flat-length) ] with-scope ; [ def>> (flat-length) ] with-scope ;

View File

@ -1,6 +1,5 @@
USING: arrays help.markup help.syntax math USING: arrays help.markup help.syntax math
sequences.private vectors strings sbufs kernel math.order sequences.private vectors strings kernel math.order ;
layouts ;
IN: sequences IN: sequences
ARTICLE: "sequences-unsafe" "Unsafe sequence operations" 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:" "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 }" } { $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 = ] trim ] unit-test
[ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test [ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test
[ " asdf" ] [ " asdf " [ CHAR: \s = ] right-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 dup [ length ] map infimum
swap [ [ nth-unsafe ] with { } map-as ] curry { } map-as swap [ [ nth-unsafe ] with { } map-as ] curry { } map-as
] unless ; ] 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. ! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license. ! 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 ; quotations arrays namespaces qualified ;
QUALIFIED: namespaces QUALIFIED: namespaces
IN: fry IN: fry
@ -35,29 +35,25 @@ DEFER: shallow-fry
: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ; : shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
: deep-fry ( quot -- quot' ) : deep-fry ( quot -- quot )
{ _ } last-split1 [ { _ } last-split1 dup [
[ shallow-fry [ >r ] rot
shallow-fry % deep-fry [ [ dip ] curry r> compose ] 4array concat
[ >r ] %
deep-fry %
[ [ dip ] curry r> compose ] %
] [ ] make
] [ ] [
shallow-fry drop shallow-fry
] if* ; ] if ;
: fry-specifier? ( obj -- ? ) { , namespaces:, @ } member? ; : fry-specifier? ( obj -- ? ) { , namespaces:, @ } member? ;
: count-inputs ( quot -- n ) : count-inputs ( quot -- n )
[ [
{ {
{ [ dup callable? ] [ count-inputs ] } { [ dup callable? ] [ count-inputs ] }
{ [ dup fry-specifier? ] [ drop 1 ] } { [ dup fry-specifier? ] [ drop 1 ] }
[ drop 0 ] [ drop 0 ]
} cond } cond
] map sum ; ] map sum ;
: fry ( quot -- quot' ) : fry ( quot -- quot' )
[ [
[ [

View File

@ -159,6 +159,11 @@ METHOD: as-mutate { object object assoc } set-at ;
: prefix-on ( elt seq -- seq ) swap prefix ; : prefix-on ( elt seq -- seq ) swap prefix ;
: suffix-on ( elt seq -- seq ) swap suffix ; : 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 ; : 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. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: project-euler.028
! http://projecteuler.net/index.php?section=problems&id=28 ! http://projecteuler.net/index.php?section=problems&id=28

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: project-euler.048
! http://projecteuler.net/index.php?section=problems&id=48 ! http://projecteuler.net/index.php?section=problems&id=48

View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: project-euler.053
! http://projecteuler.net/index.php?section=problems&id=53 ! http://projecteuler.net/index.php?section=problems&id=53

View File

@ -19,25 +19,6 @@ HELP: each-withn
} }
{ $see-also map-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 HELP: if-seq
{ $values { "seq" sequence } { "quot1" quotation } { "quot2" quotation } } { $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." } { $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 ; tools.test strings ;
IN: sequences.lib.tests 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 [ 1 2 { 3 4 } [ + + drop ] 2 each-withn ] must-infer
{ 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test { 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 [ 3 ] [ { 1 2 3 } ?third ] unit-test
[ f ] [ { 1 2 3 } ?fourth ] 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 [ 1 2 { 3 4 } [ + + ] 2 map-withn ] must-infer
{ { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test { { 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 { { 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 ) : map-reduce ( seq map-quot reduce-quot -- result )
>r [ unclip ] dip [ call ] keep r> compose reduce ; inline >r [ unclip ] dip [ call ] keep r> compose reduce ; inline