Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-06-25 03:25:23 -05:00
commit 726bcb6a0b
40 changed files with 185 additions and 89 deletions

View File

@ -1,5 +1,5 @@
USING: kernel namespaces
USING: combinators.short-circuit kernel namespaces
math
math.constants
math.functions

View File

@ -1,5 +1,5 @@
USING: kernel namespaces
USING: combinators.short-circuit kernel namespaces
math
math.functions
math.vectors

View File

@ -23,35 +23,6 @@ IN: combinators.lib.tests
{ "oof" "bar" } { [ reverse ] [ "x" swap "x" 3append ] } parallel-call
] unit-test
! &&
[ t ] [
3 {
[ dup number? ] [ dup odd? ] [ dup 0 > ]
} 0&& nip
] unit-test
[ f ] [
3 {
[ dup number? ] [ dup even? ] [ dup 0 > ]
} 0&& nip
] unit-test
! ||
[ t ] [
4 {
[ dup array? ] [ dup number? ] [ 3 throw ]
} 0|| nip
] unit-test
[ f ] [
4 {
[ dup array? ] [ dup vector? ] [ dup float? ]
} 0|| nip
] unit-test
{ 1 1 } [
[ even? ] [ drop 1 ] [ drop 2 ] ifte
] must-infer-as

View File

@ -63,42 +63,42 @@ MACRO: napply ( n -- )
! short circuiting words
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: short-circuit ( quots quot default -- quot )
1quotation -rot { } map>assoc <reversed> alist>quot ;
! : short-circuit ( quots quot default -- quot )
! 1quotation -rot { } map>assoc <reversed> alist>quot ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MACRO: 0&& ( quots -- quot )
[ '[ drop @ dup not ] [ drop f ] 2array ] map
{ [ t ] [ ] } suffix
'[ f , cond ] ;
! MACRO: 0&& ( quots -- quot )
! [ '[ drop @ dup not ] [ drop f ] 2array ] map
! { [ t ] [ ] } suffix
! '[ f , cond ] ;
MACRO: 1&& ( quots -- quot )
[ '[ drop dup @ dup not ] [ drop drop f ] 2array ] map
{ [ t ] [ nip ] } suffix
'[ f , cond ] ;
! MACRO: 1&& ( quots -- quot )
! [ '[ drop dup @ dup not ] [ drop drop f ] 2array ] map
! { [ t ] [ nip ] } suffix
! '[ f , cond ] ;
MACRO: 2&& ( quots -- quot )
[ '[ drop 2dup @ dup not ] [ drop 2drop f ] 2array ] map
{ [ t ] [ 2nip ] } suffix
'[ f , cond ] ;
! MACRO: 2&& ( quots -- quot )
! [ '[ drop 2dup @ dup not ] [ drop 2drop f ] 2array ] map
! { [ t ] [ 2nip ] } suffix
! '[ f , cond ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MACRO: 0|| ( quots -- quot )
[ '[ drop @ dup ] [ ] 2array ] map
{ [ drop t ] [ f ] } suffix
'[ f , cond ] ;
! MACRO: 0|| ( quots -- quot )
! [ '[ drop @ dup ] [ ] 2array ] map
! { [ drop t ] [ f ] } suffix
! '[ f , cond ] ;
MACRO: 1|| ( quots -- quot )
[ '[ drop dup @ dup ] [ nip ] 2array ] map
{ [ drop drop t ] [ f ] } suffix
'[ f , cond ] ;
! MACRO: 1|| ( quots -- quot )
! [ '[ drop dup @ dup ] [ nip ] 2array ] map
! { [ drop drop t ] [ f ] } suffix
! '[ f , cond ] ;
MACRO: 2|| ( quots -- quot )
[ '[ drop 2dup @ dup ] [ 2nip ] 2array ] map
{ [ drop 2drop t ] [ f ] } suffix
'[ f , cond ] ;
! MACRO: 2|| ( quots -- quot )
! [ '[ drop 2dup @ dup ] [ 2nip ] 2array ] map
! { [ drop 2drop t ] [ f ] } suffix
! '[ f , cond ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! ifte

View File

@ -0,0 +1,32 @@
USING: kernel math tools.test combinators.short-circuit ;
IN: combinators.short-circuit.tests
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: must-be-t ( in -- ) [ t ] swap unit-test ;
: must-be-f ( in -- ) [ f ] swap unit-test ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ { [ 1 ] [ 2 ] [ 3 ] } 0&& 3 = ] must-be-t
[ 3 { [ 0 > ] [ odd? ] [ 2 + ] } 1&& 5 = ] must-be-t
[ 10 20 { [ + 0 > ] [ - even? ] [ + ] } 2&& 30 = ] must-be-t
[ { [ 1 ] [ f ] [ 3 ] } 0&& 3 = ] must-be-f
[ 3 { [ 0 > ] [ even? ] [ 2 + ] } 1&& ] must-be-f
[ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } 2&& 30 = ] must-be-f
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ { [ 10 0 < ] [ f ] [ "factor" ] } 0|| "factor" = ] must-be-t
[ 10 { [ odd? ] [ 100 > ] [ 1 + ] } 1|| 11 = ] must-be-t
[ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } 2|| 30 = ] must-be-t
[ { [ 10 0 < ] [ f ] [ 0 1 = ] } 0|| ] must-be-f
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -0,0 +1,38 @@
USING: kernel combinators quotations arrays sequences assocs
locals shuffle macros fry newfx ;
IN: combinators.short-circuit
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: short-circuit ( quots quot default -- quot )
1quotation -rot { } map>assoc <reversed> alist>quot ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: n&&-rewrite ( quots N -- quot )
quots
[ '[ drop N ndup @ dup not ] [ drop N ndrop f ] 2array ]
map
[ t ] [ N nnip ] 2array suffix
'[ f , cond ] ;
MACRO: 0&& ( quots -- quot ) 0 n&&-rewrite ;
MACRO: 1&& ( quots -- quot ) 1 n&&-rewrite ;
MACRO: 2&& ( quots -- quot ) 2 n&&-rewrite ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: n||-rewrite ( quots N -- quot )
quots
[ '[ drop N ndup @ dup ] [ N nnip ] 2array ]
map
[ drop N ndrop t ] [ f ] 2array suffix
'[ f , cond ] ;
MACRO: 0|| ( quots -- quot ) 0 n||-rewrite ;
MACRO: 1|| ( quots -- quot ) 1 n||-rewrite ;
MACRO: 2|| ( quots -- quot ) 2 n||-rewrite ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -0,0 +1,32 @@
USING: kernel math tools.test combinators.short-circuit.smart ;
IN: combinators.short-circuit.smart.tests
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: must-be-t ( in -- ) [ t ] swap unit-test ;
: must-be-f ( in -- ) [ f ] swap unit-test ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ { [ 1 ] [ 2 ] [ 3 ] } && 3 = ] must-be-t
[ 3 { [ 0 > ] [ odd? ] [ 2 + ] } && 5 = ] must-be-t
[ 10 20 { [ + 0 > ] [ - even? ] [ + ] } && 30 = ] must-be-t
[ { [ 1 ] [ f ] [ 3 ] } && 3 = ] must-be-f
[ 3 { [ 0 > ] [ even? ] [ 2 + ] } && ] must-be-f
[ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } && 30 = ] must-be-f
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ { [ 10 0 < ] [ f ] [ "factor" ] } || "factor" = ] must-be-t
[ 10 { [ odd? ] [ 100 > ] [ 1 + ] } || 11 = ] must-be-t
[ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } || 30 = ] must-be-t
[ { [ 10 0 < ] [ f ] [ 0 1 = ] } || ] must-be-f
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -0,0 +1,11 @@
USING: kernel sequences math inference accessors macros
combinators.short-circuit ;
IN: combinators.short-circuit.smart
MACRO: && ( quots -- quot )
dup first infer [ in>> ] [ out>> ] bi - 1+ n&&-rewrite ;
MACRO: || ( quots -- quot )
dup first infer [ in>> ] [ out>> ] bi - 1+ n||-rewrite ;

View File

@ -1,5 +1,5 @@
USING: kernel
USING: combinators.short-circuit kernel
combinators
vectors
sequences

View File

@ -1,7 +1,7 @@
USING: kernel combinators sequences sets math threads namespaces continuations
debugger io io.sockets unicode.case accessors destructors
combinators.cleave combinators.lib
combinators.cleave combinators.lib combinators.short-circuit
newfx fry
dns dns.util dns.misc ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators io io.encodings.8-bit
USING: combinators.short-circuit accessors combinators io io.encodings.8-bit
io.encodings io.encodings.binary io.encodings.utf8 io.files
io.sockets kernel math.parser namespaces sequences
ftp io.unix.launcher.parser unicode.case splitting assocs

View File

@ -1,6 +1,8 @@
USING: accessors namespaces combinators.lib kernel
db.tuples db.types
furnace.auth furnace.sessions furnace.cache ;
furnace.auth furnace.sessions furnace.cache
combinators.short-circuit ;
IN: furnace.auth.login.permits
TUPLE: permit < server-state session uid ;

View File

@ -7,7 +7,7 @@ html.templates.chloe
locals
http.server
http.server.filters
furnace ;
furnace combinators.short-circuit ;
IN: furnace.boilerplate
TUPLE: boilerplate < filter-responder template init ;

View File

@ -7,7 +7,7 @@ io.servers.connection
db db.tuples db.types
http http.server http.server.dispatchers http.server.filters
html.elements
furnace furnace.cache ;
furnace furnace.cache combinators.short-circuit ;
IN: furnace.sessions
TUPLE: session < server-state namespace user-agent client changed? ;

View File

@ -1,4 +1,4 @@
USING: math math.order math.parser kernel combinators.lib
USING: combinators.short-circuit math math.order math.parser kernel combinators.lib
sequences sequences.deep peg peg.parsers assocs arrays
hashtables strings unicode.case namespaces ascii ;
IN: http.parsers

View File

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

View File

@ -6,7 +6,7 @@ quotations combinators combinators.lib logging calendar assocs
fry accessors arrays io io.sockets io.encodings.ascii
io.sockets.secure io.files io.streams.duplex io.timeouts
io.encodings threads concurrency.combinators
concurrency.semaphores ;
concurrency.semaphores combinators.short-circuit ;
IN: io.servers.connection
TUPLE: threaded-server

View File

@ -1,5 +1,6 @@
USING: sequences kernel math locals math.order math.ranges
accessors combinators.lib arrays namespaces combinators ;
accessors combinators.lib arrays namespaces combinators
combinators.short-circuit ;
IN: lcs
<PRIVATE

View File

@ -3,7 +3,7 @@
USING: kernel peg sequences arrays strings combinators.lib
namespaces combinators math locals locals.private locals.backend accessors
vectors syntax lisp.parser assocs parser sequences.lib words
quotations fry lists inspector ;
quotations fry lists inspector combinators.short-circuit ;
IN: lisp
DEFER: convert-form

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license.
USING: kernel peg peg.ebnf peg.expr math.parser sequences arrays strings
combinators.lib math fry accessors lists ;
combinators.lib math fry accessors lists combinators.short-circuit ;
IN: lisp.parser

View File

@ -1,6 +1,6 @@
USING: kernel sequences quotations assocs math math.parser
combinators.lib vars lsys.strings ;
combinators.lib vars lsys.strings combinators.short-circuit ;
IN: lsys.strings.interpret

View File

@ -1,6 +1,6 @@
USING: kernel sbufs strings sequences assocs math
combinators.lib vars lsys.strings ;
combinators.lib vars lsys.strings combinators.short-circuit ;
IN: lsys.strings.rewrite

View File

@ -1,5 +1,5 @@
USING: kernel sequences math combinators.lib ;
USING: kernel sequences math combinators.lib combinators.short-circuit ;
IN: lsys.strings

View File

@ -2,7 +2,7 @@
USING: kernel math vectors sequences opengl.gl math.vectors math.order
math.matrices vars opengl self pos ori turtle lsys.tortoise
lsys.strings.interpret ;
lsys.strings.interpret combinators.short-circuit ;
! lsys.strings

View File

@ -16,7 +16,8 @@ USING: kernel namespaces threads math math.order math.vectors
vars rewrite-closures
self pos ori turtle opengl.camera
lsys.tortoise lsys.tortoise.graphics
lsys.strings.rewrite lsys.strings.interpret ;
lsys.strings.rewrite lsys.strings.interpret
combinators.short-circuit ;
! lsys.strings
! lsys.strings.rewrite

View File

@ -1,7 +1,8 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math math.functions math.parser namespaces
sequences splitting grouping sequences.lib ;
sequences splitting grouping sequences.lib
combinators.short-circuit ;
IN: math.text.english
<PRIVATE

View File

@ -3,7 +3,8 @@
USING: kernel compiler.units parser words arrays strings math.parser sequences
quotations vectors namespaces math assocs continuations peg
peg.parsers unicode.categories multiline combinators.lib
splitting accessors effects sequences.deep peg.search ;
splitting accessors effects sequences.deep peg.search
combinators.short-circuit ;
IN: peg.ebnf
TUPLE: ebnf-non-terminal symbol ;

View File

@ -1,7 +1,7 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators.lib kernel math math.ranges namespaces sequences
sorting ;
sorting combinators.short-circuit ;
IN: project-euler.014
! http://projecteuler.net/index.php?section=problems&id=14

View File

@ -1,7 +1,7 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.ranges math.text.english sequences sequences.lib strings
ascii ;
ascii combinators.short-circuit ;
IN: project-euler.017
! http://projecteuler.net/index.php?section=problems&id=17

View File

@ -1,7 +1,8 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math math.functions math.ranges namespaces
project-euler.common sequences sequences.lib ;
project-euler.common sequences sequences.lib
combinators.short-circuit ;
IN: project-euler.021
! http://projecteuler.net/index.php?section=problems&id=21

View File

@ -1,7 +1,7 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math.parser math.ranges project-euler.common
sequences ;
sequences combinators.short-circuit ;
IN: project-euler.036
! http://projecteuler.net/index.php?section=problems&id=36

View File

@ -1,7 +1,8 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib hashtables kernel math math.combinatorics math.parser
math.ranges project-euler.common sequences sequences.lib sorting sets ;
math.ranges project-euler.common sequences sequences.lib sorting
sets combinators.short-circuit ;
IN: project-euler.043
! http://projecteuler.net/index.php?section=problems&id=43

View File

@ -1,6 +1,7 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math project-euler.common sequences sorting ;
USING: combinators.lib kernel math project-euler.common sequences
sorting combinators.short-circuit ;
IN: project-euler.052
! http://projecteuler.net/index.php?section=problems&id=52

View File

@ -17,7 +17,7 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time
project-euler.052 project-euler.053 project-euler.056 project-euler.059
project-euler.067 project-euler.075 project-euler.079 project-euler.092
project-euler.097 project-euler.134 project-euler.169 project-euler.173
project-euler.175 ;
project-euler.175 combinators.short-circuit ;
IN: project-euler
<PRIVATE

View File

@ -1,7 +1,8 @@
USING: arrays combinators kernel lists math math.parser
namespaces parser lexer parser-combinators parser-combinators.simple
promises quotations sequences combinators.lib strings math.order
assocs prettyprint.backend memoize unicode.case unicode.categories ;
assocs prettyprint.backend memoize unicode.case unicode.categories
combinators.short-circuit ;
USE: io
IN: regexp

View File

@ -2,7 +2,8 @@
USING: kernel parser words continuations namespaces debugger
sequences combinators splitting prettyprint
system io io.files io.launcher io.encodings.utf8 io.pipes sequences.deep
accessors multi-methods newfx shell.parser ;
accessors multi-methods newfx shell.parser
combinators.short-circuit ;
IN: shell

View File

@ -1,4 +1,4 @@
USING: unicode.categories kernel math combinators splitting
USING: combinators.short-circuit unicode.categories kernel math combinators splitting
sequences math.parser io.files io assocs arrays namespaces
math.ranges unicode.normalize values io.encodings.ascii
unicode.syntax unicode.data compiler.units alien.syntax sets

View File

@ -1,4 +1,4 @@
USING: sequences io.files io.encodings.ascii kernel values
USING: combinators.short-circuit sequences io.files io.encodings.ascii kernel values
splitting accessors math.parser ascii io assocs strings math
namespaces sorting combinators math.order arrays
unicode.normalize unicode.data combinators.lib locals

View File

@ -1,4 +1,4 @@
USING: assocs math kernel sequences io.files hashtables
USING: combinators.short-circuit assocs math kernel sequences io.files hashtables
quotations splitting grouping arrays math.parser hash2 math.order
byte-arrays words namespaces words compiler.units parser
io.encodings.ascii values interval-maps ascii sets

View File

@ -2,7 +2,8 @@ IN: xmode.marker
USING: kernel namespaces xmode.rules xmode.tokens
xmode.marker.state xmode.marker.context xmode.utilities
xmode.catalog sequences math assocs combinators combinators.lib
strings regexp splitting parser-combinators ascii unicode.case ;
strings regexp splitting parser-combinators ascii unicode.case
combinators.short-circuit ;
! Based on org.gjt.sp.jedit.syntax.TokenMarker