Moved dispatch to sequences.private

db4
Slava Pestov 2008-02-11 01:19:53 -06:00
parent 6c75da20f1
commit e66e6d70e4
27 changed files with 81 additions and 99 deletions

View File

@ -7,7 +7,7 @@ strings sbufs vectors words quotations assocs system layouts
splitting growable classes tuples words.private splitting growable classes tuples words.private
io.binary io.files vocabs vocabs.loader source-files io.binary io.files vocabs vocabs.loader source-files
definitions debugger float-arrays quotations.private definitions debugger float-arrays quotations.private
combinators.private combinators ; sequences.private combinators ;
IN: bootstrap.image IN: bootstrap.image
: my-arch ( -- arch ) : my-arch ( -- arch )

2
core/combinators/combinators-docs.factor Normal file → Executable file
View File

@ -1,6 +1,6 @@
USING: arrays help.markup help.syntax strings sbufs vectors USING: arrays help.markup help.syntax strings sbufs vectors
kernel quotations generic generic.standard classes kernel quotations generic generic.standard classes
math assocs sequences combinators.private ; math assocs sequences sequences.private ;
IN: combinators IN: combinators
ARTICLE: "combinators-quot" "Quotation construction utilities" ARTICLE: "combinators-quot" "Quotation construction utilities"

View File

@ -4,12 +4,6 @@ IN: combinators
USING: arrays sequences sequences.private math.private USING: arrays sequences sequences.private math.private
kernel kernel.private math assocs quotations vectors ; kernel kernel.private math assocs quotations vectors ;
<PRIVATE
: dispatch ( n array -- ) array-nth (call) ;
PRIVATE>
TUPLE: no-cond ; TUPLE: no-cond ;
: no-cond ( -- * ) \ no-cond construct-empty throw ; : no-cond ( -- * ) \ no-cond construct-empty throw ;

View File

@ -4,7 +4,7 @@ math.private sequences strings tools.test words continuations
sequences.private hashtables.private byte-arrays strings.private sequences.private hashtables.private byte-arrays strings.private
system random layouts vectors.private sbufs.private system random layouts vectors.private sbufs.private
strings.private slots.private alien alien.accessors strings.private slots.private alien alien.accessors
alien.c-types alien.syntax namespaces libc combinators.private ; alien.c-types alien.syntax namespaces libc sequences.private ;
! Make sure that intrinsic ops compile to correct code. ! Make sure that intrinsic ops compile to correct code.
[ ] [ 1 [ drop ] compile-call ] unit-test [ ] [ 1 [ drop ] compile-call ] unit-test

View File

@ -1,5 +1,5 @@
USING: compiler tools.test kernel kernel.private USING: compiler tools.test kernel kernel.private
combinators.private math.private math combinators strings sequences.private math.private math combinators strings
alien arrays memory ; alien arrays memory ;
IN: temporary IN: temporary

View File

@ -2,7 +2,7 @@
USING: arrays compiler kernel kernel.private math USING: arrays compiler kernel kernel.private math
hashtables.private math.private namespaces sequences hashtables.private math.private namespaces sequences
sequences.private tools.test namespaces.private slots.private sequences.private tools.test namespaces.private slots.private
combinators.private byte-arrays alien alien.accessors layouts sequences.private byte-arrays alien alien.accessors layouts
words definitions compiler.units ; words definitions compiler.units ;
IN: temporary IN: temporary

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic hashtables kernel kernel.private USING: arrays generic hashtables kernel kernel.private
math namespaces sequences words quotations layouts combinators math namespaces sequences words quotations layouts combinators
combinators.private classes definitions ; sequences.private classes definitions ;
IN: generic.math IN: generic.math
PREDICATE: class math-class ( object -- ? ) PREDICATE: class math-class ( object -- ? )

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs kernel kernel.private slots.private math USING: arrays assocs kernel kernel.private slots.private math
namespaces sequences vectors words quotations definitions namespaces sequences vectors words quotations definitions
hashtables layouts combinators combinators.private generic hashtables layouts combinators sequences.private generic
classes classes.private ; classes classes.private ;
IN: generic.standard IN: generic.standard

View File

@ -1,6 +1,6 @@
USING: help.syntax help.markup words effects inference.dataflow USING: help.syntax help.markup words effects inference.dataflow
inference.state inference.backend kernel sequences inference.state inference.backend kernel sequences
kernel.private combinators combinators.private ; kernel.private combinators sequences.private ;
HELP: literal-expected HELP: literal-expected
{ $error-description "Thrown when inference encounters a " { $link call } " or " { $link if } " being applied to a value which is not known to be a literal. Such a form can have an arbitrary stack effect, and does not compile." } { $error-description "Thrown when inference encounters a " { $link call } " or " { $link if } " being applied to a value which is not known to be a literal. Such a form can have an arbitrary stack effect, and does not compile." }

View File

@ -5,7 +5,7 @@ sequences strings vectors words quotations effects tools.test
continuations generic.standard sorting assocs definitions continuations generic.standard sorting assocs definitions
prettyprint io inspector tuples classes.union classes.predicate prettyprint io inspector tuples classes.union classes.predicate
debugger threads.private io.streams.string io.timeouts debugger threads.private io.streams.string io.timeouts
combinators.private ; sequences.private ;
IN: temporary IN: temporary
{ 0 2 } [ 2 "Hello" ] must-infer-as { 0 2 } [ 2 "Hello" ] must-infer-as

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.accessors arrays bit-arrays byte-arrays USING: alien alien.accessors arrays bit-arrays byte-arrays
classes combinators.private continuations.private effects classes sequences.private continuations.private effects
float-arrays generic hashtables hashtables.private float-arrays generic hashtables hashtables.private
inference.state inference.backend inference.dataflow io inference.state inference.backend inference.dataflow io
io.backend io.files io.files.private io.streams.c kernel io.backend io.files io.files.private io.streams.c kernel

View File

@ -17,6 +17,7 @@ IN: kernel
: clear ( -- ) { } set-datastack ; : clear ( -- ) { } set-datastack ;
! Combinators ! Combinators
: call ( callable -- ) uncurry (call) ; : call ( callable -- ) uncurry (call) ;
DEFER: if DEFER: if

View File

@ -8,7 +8,7 @@ assocs quotations sequences.private io.binary io.crc32
io.streams.string layouts splitting math.intervals io.streams.string layouts splitting math.intervals
math.floats.private tuples tuples.private classes math.floats.private tuples tuples.private classes
optimizer.def-use optimizer.backend optimizer.pattern-match optimizer.def-use optimizer.backend optimizer.pattern-match
float-arrays combinators.private combinators ; float-arrays sequences.private combinators ;
! the output of <tuple> and <tuple-boa> has the class which is ! the output of <tuple> and <tuple-boa> has the class which is
! its second-to-last input ! its second-to-last input

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic hashtables kernel kernel.private math USING: arrays generic hashtables kernel kernel.private math
namespaces sequences vectors words strings layouts combinators namespaces sequences vectors words strings layouts combinators
combinators.private classes generic.standard assocs ; sequences.private classes generic.standard assocs ;
IN: optimizer.specializers IN: optimizer.specializers
: (make-specializer) ( class picker -- quot ) : (make-specializer) ( class picker -- quot )

View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2007 Slava Pestov. ! Copyright (C) 2005, 2008 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: sequences IN: sequences
USING: kernel kernel.private slots.private math math.private ; USING: kernel kernel.private slots.private math math.private ;
@ -77,6 +77,8 @@ PREDICATE: fixnum array-capacity
: set-array-nth ( elt n array -- ) : set-array-nth ( elt n array -- )
swap 2 fixnum+fast set-slot ; inline swap 2 fixnum+fast set-slot ; inline
: dispatch ( n array -- ) array-nth (call) ;
GENERIC: resize ( n seq -- newseq ) flushable GENERIC: resize ( n seq -- newseq ) flushable
! Unsafe sequence protocol for inner loops ! Unsafe sequence protocol for inner loops
@ -614,13 +616,21 @@ M: sequence <=>
dup midpoint@ cut-slice ; dup midpoint@ cut-slice ;
: binary-reduce ( seq start quot -- value ) : binary-reduce ( seq start quot -- value )
pick length { #! We can't use case here since combinators depends on
{ 0 [ drop nip ] } #! sequences
{ 1 [ 2drop first ] } pick length dup 0 3 between? [
{ 2 [ >r drop first2 r> call ] } >fixnum {
{ 3 [ >r drop first3 r> 2apply ] } [ drop nip ]
[ drop >r >r halves r> r> [ [ split-reduce ] 2curry 2apply ] keep call ] [ 2drop first ]
} case ; inline [ >r drop first2 r> call ]
[ >r drop first3 r> 2apply ]
} dispatch
] [
drop
>r >r halves r> r>
[ [ binary-reduce ] 2curry 2apply ] keep
call
] if ; inline
: cut ( seq n -- before after ) : cut ( seq n -- before after )
[ head ] 2keep tail ; [ head ] 2keep tail ;

View File

@ -42,23 +42,9 @@ HELP: vocab-main
HELP: vocab-roots HELP: vocab-roots
{ $var-description "A sequence of pathname strings to search for vocabularies." } ; { $var-description "A sequence of pathname strings to search for vocabularies." } ;
HELP: vocab-source
{ $values { "vocab" "a vocabulary specifier" } { "path" string } }
{ $description "Outputs a pathname relative to a vocabulary root where the source code for " { $snippet "vocab" } " might be found." } ;
{ vocab-source vocab-source-path } related-words
HELP: vocab-docs
{ $values { "vocab" "a vocabulary specifier" } { "path" string } }
{ $description "Outputs a pathname relative to a vocabulary root where the documentation for " { $snippet "vocab" } " might be found." } ;
{ vocab-docs vocab-docs-path } related-words
HELP: vocab-tests HELP: vocab-tests
{ $values { "vocab" "a vocabulary specifier" } { "path" string } } { $values { "vocab" "a vocabulary specifier" } { "tests" "a sequence of pathname strings" } }
{ $description "Outputs a pathname relative to a vocabulary root where the unit tests for " { $snippet "vocab" } " might be found." } ; { $description "Outputs a sequence of pathnames where the unit tests for " { $snippet "vocab" } " are located." } ;
{ vocab-tests vocab-tests-path } related-words
HELP: find-vocab-root HELP: find-vocab-root
{ $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string" } } { $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string" } }
@ -86,14 +72,6 @@ HELP: load-docs
{ $values { "root" "a pathname string" } { "name" "a vocabulary name" } } { $values { "root" "a pathname string" } { "name" "a vocabulary name" } }
{ $description "If " { $link load-help? } " is on, loads a vocabulary's documentation from the specified vocabulary root." } ; { $description "If " { $link load-help? } " is on, loads a vocabulary's documentation from the specified vocabulary root." } ;
HELP: amend-vocab-from-root
{ $values { "root" "a pathname string" } { "name" "a vocabulary name" } { "vocab" vocab } }
{ $description "Loads a vocabulary's source code and documentation if they have not already been loaded, and outputs the vocabulary." } ;
HELP: load-vocab-from-root
{ $values { "root" "a pathname string" } { "name" "a vocabulary name" } }
{ $description "Loads a vocabulary's source code and documentation." } ;
HELP: reload HELP: reload
{ $values { "name" "a vocabulary name" } } { $values { "name" "a vocabulary name" } }
{ $description "Loads it's source code and documentation." } { $description "Loads it's source code and documentation." }
@ -116,10 +94,6 @@ HELP: vocab-docs-path
{ $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string or " { $link f } } } { $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string or " { $link f } } }
{ $description "Outputs a pathname where the documentation for " { $snippet "vocab" } " might be found. Outputs " { $link f } " if the vocabulary does not have a directory on disk." } ; { $description "Outputs a pathname where the documentation for " { $snippet "vocab" } " might be found. Outputs " { $link f } " if the vocabulary does not have a directory on disk." } ;
HELP: vocab-tests-path
{ $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string or " { $link f } } }
{ $description "Outputs a pathname where the unit tests for " { $snippet "vocab" } " might be found. Outputs " { $link f } " if the vocabulary does not have a directory on disk." } ;
HELP: refresh HELP: refresh
{ $values { "prefix" string } } { $values { "prefix" string } }
{ $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ; { $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ;

2
extra/benchmark/dispatch4/dispatch4.factor Normal file → Executable file
View File

@ -1,5 +1,5 @@
USING: kernel.private kernel sequences math combinators USING: kernel.private kernel sequences math combinators
combinators.private ; sequences.private ;
IN: benchmark.dispatch4 IN: benchmark.dispatch4
: foobar-1 : foobar-1

View File

@ -47,42 +47,6 @@ HELP: nkeep
} }
{ $see-also keep nslip } ; { $see-also keep nslip } ;
HELP: map-withn
{ $values { "seq" sequence } { "quot" quotation } { "n" number } { "newseq" sequence } }
{ $description "A generalisation of " { $link map } ". The first " { $snippet "n" } " items after the quotation will be "
"passed to the quotation given to map-withn for each element in the sequence."
}
{ $examples
{ $example "USE: combinators.lib" "1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn .s" "{ 16 17 18 19 20 }" }
}
{ $see-also each-withn } ;
HELP: each-withn
{ $values { "seq" sequence } { "quot" quotation } { "n" number } }
{ $description "A generalisation of " { $link each } ". The first " { $snippet "n" } " items after the quotation will be "
"passed to the quotation given to each-withn for each element in the sequence."
}
{ $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.ranges combinators.lib ;"
"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.ranges combinators.lib ;"
"100 [1,b] [ even? ] count ."
"50"
} ;
HELP: && HELP: &&
{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } }
{ $description "Calls each quotation in turn; outputs " { $link f } " if one of the quotations output " { $link f } ", otherwise outputs " { $link t } ". As soon as a quotation outputs " { $link f } ", evaluation stops and subsequent quotations are not called." } ; { $description "Calls each quotation in turn; outputs " { $link f } " if one of the quotations output " { $link f } ", otherwise outputs " { $link t } ". As soon as a quotation outputs " { $link f } ", evaluation stops and subsequent quotations are not called." } ;

2
extra/cpu/8080/emulator/emulator.factor Normal file → Executable file
View File

@ -4,7 +4,7 @@
USING: kernel math sequences words arrays io USING: kernel math sequences words arrays io
io.files namespaces math.parser kernel.private io.files namespaces math.parser kernel.private
assocs quotations parser parser-combinators tools.time assocs quotations parser parser-combinators tools.time
combinators.private compiler.units ; sequences.private compiler.units ;
IN: cpu.8080.emulator IN: cpu.8080.emulator
TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles ram ; TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles ram ;

2
extra/icfp/2006/2006.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Gavin Harrison ! Copyright (C) 2007 Gavin Harrison
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences kernel.private namespaces arrays io io.files USING: kernel math sequences kernel.private namespaces arrays io io.files
splitting io.binary math.functions vectors quotations combinators.private ; splitting io.binary math.functions vectors quotations sequences.private ;
IN: icfp.2006 IN: icfp.2006
SYMBOL: regs SYMBOL: regs

2
extra/inverse/inverse.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
USING: kernel words inspector slots quotations sequences assocs USING: kernel words inspector slots quotations sequences assocs
math arrays inference effects shuffle continuations debugger math arrays inference effects shuffle continuations debugger
tuples namespaces vectors bit-arrays byte-arrays strings sbufs tuples namespaces vectors bit-arrays byte-arrays strings sbufs
math.functions macros combinators.private combinators ; math.functions macros sequences.private combinators ;
IN: inverse IN: inverse
TUPLE: fail ; TUPLE: fail ;

View File

@ -3,7 +3,7 @@
USING: classes inference inference.dataflow io kernel USING: classes inference inference.dataflow io kernel
kernel.private math.parser namespaces optimizer prettyprint kernel.private math.parser namespaces optimizer prettyprint
prettyprint.backend sequences words arrays match macros prettyprint.backend sequences words arrays match macros
assocs combinators.private ; assocs sequences.private ;
IN: optimizer.debugger IN: optimizer.debugger
! A simple tool for turning dataflow IR into quotations, for ! A simple tool for turning dataflow IR into quotations, for

View File

@ -0,0 +1,39 @@
USING: help.syntax help.markup kernel prettyprint sequences
quotations math ;
IN: sequences.lib
HELP: map-withn
{ $values { "seq" sequence } { "quot" quotation } { "n" number } { "newseq" sequence } }
{ $description "A generalisation of " { $link map } ". The first " { $snippet "n" } " items after the quotation will be "
"passed to the quotation given to map-withn for each element in the sequence."
}
{ $examples
{ $example "USE: combinators.lib" "1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn .s" "{ 16 17 18 19 20 }" }
}
{ $see-also each-withn } ;
HELP: each-withn
{ $values { "seq" sequence } { "quot" quotation } { "n" number } }
{ $description "A generalisation of " { $link each } ". The first " { $snippet "n" } " items after the quotation will be "
"passed to the quotation given to each-withn for each element in the sequence."
}
{ $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.ranges combinators.lib ;"
"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.ranges combinators.lib ;"
"100 [1,b] [ even? ] count ."
"50"
} ;

View File

@ -3,7 +3,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel sequences math namespaces assocs USING: combinators.lib kernel sequences math namespaces assocs
random sequences.private shuffle math.functions mirrors random sequences.private shuffle math.functions mirrors
arrays math.parser sorting strings ascii ; arrays math.parser sorting strings ascii macros ;
IN: sequences.lib IN: sequences.lib
: each-withn ( seq quot n -- ) nwith each ; inline : each-withn ( seq quot n -- ) nwith each ; inline

View File

@ -5,7 +5,7 @@ USING: cpu.8080 cpu.8080.emulator openal math alien.c-types sequences kernel
shuffle arrays io.files combinators kernel.private shuffle arrays io.files combinators kernel.private
ui.gestures ui.gadgets ui.render opengl.gl system ui.gestures ui.gadgets ui.render opengl.gl system
threads concurrency match ui byte-arrays combinators.lib threads concurrency match ui byte-arrays combinators.lib
combinators.private ; sequences.private ;
IN: space-invaders IN: space-invaders
TUPLE: space-invaders port1 port2i port2o port3o port4lo port4hi port5o bitmap sounds looping? ; TUPLE: space-invaders port1 port2i port2o port3o port4lo port4hi port5o bitmap sounds looping? ;

2
extra/state-machine/state-machine.factor Normal file → Executable file
View File

@ -1,5 +1,5 @@
USING: kernel parser strings math namespaces sequences words io USING: kernel parser strings math namespaces sequences words io
arrays quotations debugger kernel.private combinators.private ; arrays quotations debugger kernel.private sequences.private ;
IN: state-machine IN: state-machine
: STATES: : STATES:

View File

@ -1,6 +1,6 @@
! Copyright (C) 2004, 2007 Slava Pestov. ! Copyright (C) 2004, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs classes combinators combinators.private USING: arrays assocs classes combinators sequences.private
continuations continuations.private generic hashtables io kernel continuations continuations.private generic hashtables io kernel
kernel.private math namespaces namespaces.private prettyprint kernel.private math namespaces namespaces.private prettyprint
quotations sequences splitting strings threads vectors words ; quotations sequences splitting strings threads vectors words ;