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

basis/calendar/calendar-docs.factor

@@ -27,7 +27,7 @@ HELP: <date>
 } ;
 
 HELP: month-names
-{ $values { "array" array } }
+{ $values { "value" object } }
 { $description "Returns an array with the English names of all the months." }
 { $warning "Do not use this array for looking up a month name directly. Use month-name instead." } ;
 

basis/calendar/calendar.factor

@@ -45,11 +45,11 @@ M: not-a-month summary
 
 PRIVATE>
 
-: month-names ( -- array )
+CONSTANT: month-names 
     {
         "January" "February" "March" "April" "May" "June"
         "July" "August" "September" "October" "November" "December"
-    } ;
+    }
 
 : month-name ( n -- string )
     check-month 1- month-names nth ;

basis/calendar/format/format.factor

@@ -162,7 +162,7 @@ M: timestamp year. ( timestamp -- )
 
 : read-rfc3339-seconds ( s -- s' ch )
     "+-Z" read-until [
-        [ string>number ] [ length 10 swap ^ ] bi / +
+        [ string>number ] [ length 10^ ] bi / +
     ] dip ;
 
 : (rfc3339>timestamp) ( -- timestamp )

basis/compiler/tests/optimizer.factor

@@ -391,6 +391,17 @@ DEFER: loop-bbb
 
 [ ] [ [ \ broken-declaration forget ] with-compilation-unit ] unit-test
 
+! Interval inference issue
+[ f ] [
+    10 70
+    [
+        dup 70 >=
+        [ dup 700 <= [ swap 1024 rem rem ] [ 2drop 70 ] if ]
+        [ 2drop 70 ] if
+        70 >=
+    ] compile-call
+] unit-test
+
 ! Modular arithmetic bug
 : modular-arithmetic-bug ( a -- b ) >integer 256 mod ;
 

basis/compiler/tree/propagation/info/info.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs classes classes.algebra classes.tuple
 classes.tuple.private kernel accessors math math.intervals namespaces
-sequences sequences.private words combinators
+sequences sequences.private words combinators memoize
 combinators.short-circuit byte-arrays strings arrays layouts
 cpu.architecture compiler.tree.propagation.copy ;
 IN: compiler.tree.propagation.info
@@ -78,21 +78,37 @@ UNION: fixed-length array byte-array string ;
 : empty-set? ( info -- ? )
     {
         [ class>> null-class? ]
-        [ [ class>> real class<= ] [ interval>> empty-interval eq? ] bi and ]
+        [ [ interval>> empty-interval eq? ] [ class>> real class<= ] bi and ]
     } 1|| ;
 
-: min-value ( class -- n ) fixnum eq? [ most-negative-fixnum ] [ -1/0. ] if ;
+: min-value ( class -- n )
+    {
+        { fixnum [ most-negative-fixnum ] }
+        { array-capacity [ 0 ] }
+        [ drop -1/0. ]
+    } case ;
 
-: max-value ( class -- n ) fixnum eq? [ most-positive-fixnum ] [ 1/0. ] if ;
+: max-value ( class -- n )
+    {
+        { fixnum [ most-positive-fixnum ] }
+        { array-capacity [ max-array-capacity ] }
+        [ drop 1/0. ]
+    } case ;
 
-: class-interval ( class -- i ) fixnum eq? [ fixnum-interval ] [ full-interval ] if ;
+: class-interval ( class -- i )
+    {
+        { fixnum [ fixnum-interval ] }
+        { array-capacity [ array-capacity-interval ] }
+        [ drop full-interval ]
+    } case ;
 
 : wrap-interval ( interval class -- interval' )
     {
-        { fixnum [ interval->fixnum ] }
-        { array-capacity [ max-array-capacity [a,a] interval-rem ] }
+        { [ over empty-interval eq? ] [ drop ] }
+        { [ over full-interval eq? ] [ nip class-interval ] }
+        { [ 2dup class-interval interval-subset? not ] [ nip class-interval ] }
         [ drop ]
-    } case ;
+    } cond ;
 
 : init-interval ( info -- info )
     dup [ interval>> full-interval or ] [ class>> ] bi wrap-interval >>interval

basis/formatting/formatting.factor

@@ -32,7 +32,7 @@ IN: formatting
     [ "." split1 ] dip [ CHAR: 0 pad-tail ] [ head-slice ] bi "." glue ;
 
 : max-digits ( n digits -- n' )
-    10 swap ^ [ * round ] keep / ; inline
+    10^ [ * round ] keep / ; inline
 
 : >exp ( x -- exp base )
     [ 

basis/fry/fry.factor

@@ -26,7 +26,7 @@ M: >r/r>-in-fry-error summary
 
 : check-fry ( quot -- quot )
     dup { load-local load-locals get-local drop-locals } intersect
-    empty? [ >r/r>-in-fry-error ] unless ;
+    [ >r/r>-in-fry-error ] unless-empty ;
 
 PREDICATE: fry-specifier < word { _ @ } memq? ;
 

basis/io/files/info/windows/windows.factor

@@ -9,11 +9,11 @@ calendar ascii combinators.short-circuit locals ;
 IN: io.files.info.windows
 
 :: round-up-to ( n multiple -- n' )
-    n multiple rem dup 0 = [
-        drop n
+    n multiple rem [
+        n
     ] [
         multiple swap - n +
-    ] if ;
+    ] if-zero ;
 
 TUPLE: windows-file-info < file-info attributes ;
 

basis/io/sockets/unix/unix.factor

@@ -19,7 +19,7 @@ IN: io.sockets.unix
     [ handle-fd ] 2dip 1 <int> "int" heap-size setsockopt io-error ;
 
 M: unix addrinfo-error ( n -- )
-    dup zero? [ drop ] [ gai_strerror throw ] if ;
+    [ gai_strerror throw ] unless-zero ;
 
 ! Client sockets - TCP and Unix domain
 M: object (get-local-address) ( handle remote -- sockaddr )

basis/math/bits/bits.factor

@@ -7,7 +7,7 @@ TUPLE: bits { number read-only } { length read-only } ;
 C: <bits> bits
 
 : make-bits ( number -- bits )
-    dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1 + <bits> ] if ; inline
+    [ T{ bits f 0 0 } ] [ dup abs log2 1 + <bits> ] if-zero ; inline
 
 M: bits length length>> ;
 

basis/math/functions/functions-docs.factor

@@ -50,8 +50,10 @@ ARTICLE: "power-functions" "Powers and logarithms"
 { $subsection exp }
 { $subsection cis }
 { $subsection log }
+{ $subsection log10 }
 "Raising a number to a power:"
 { $subsection ^ }
+{ $subsection 10^ }
 "Converting between rectangular and polar form:"
 { $subsection abs }
 { $subsection absq }
@@ -122,6 +124,10 @@ HELP: log
 { $values { "x" number } { "y" number } }
 { $description "Natural logarithm function. Outputs negative infinity if " { $snippet "x" } " is 0." } ;
 
+HELP: log10
+{ $values { "x" number } { "y" number } }
+{ $description "Logarithm function base 10. Outputs negative infinity if " { $snippet "x" } " is 0." } ;
+
 HELP: sqrt
 { $values { "x" number } { "y" number } }
 { $description "Square root function." } ;
@@ -261,6 +267,10 @@ HELP: ^
 { $description "Raises " { $snippet "x" } " to the power of " { $snippet "y" } ". If " { $snippet "y" } " is an integer the answer is computed exactly, otherwise a floating point approximation is used." }
 { $errors "Throws an error if " { $snippet "x" } " and " { $snippet "y" } " are both integer 0." } ;
 
+HELP: 10^
+{ $values { "x" number } { "y" number } }
+{ $description "Raises " { $snippet "x" } " to the power of 10. If " { $snippet "x" } " is an integer the answer is computed exactly, otherwise a floating point approximation is used." } ;
+
 HELP: gcd
 { $values { "x" integer } { "y" integer } { "a" integer } { "d" integer } }
 { $description "Computes the positive greatest common divisor " { $snippet "d" } " of " { $snippet "x" } " and " { $snippet "y" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*y = d mod x" } }

basis/math/functions/functions.factor

@@ -71,7 +71,7 @@ PRIVATE>
     2dup [ real? ] both? [ drop 0 >= ] [ 2drop f ] if ; inline
 
 : 0^ ( x -- z )
-    dup zero? [ drop 0/0. ] [ 0 < 1/0. 0 ? ] if ; inline
+    [ 0/0. ] [ 0 < 1/0. 0 ? ] if-zero ; inline
 
 : (^mod) ( n x y -- z )
     make-bits 1 [
@@ -104,10 +104,12 @@ PRIVATE>
 : divisor? ( m n -- ? )
     mod 0 = ;
 
+ERROR: non-trivial-divisor n ;
+
 : mod-inv ( x n -- y )
     [ nip ] [ gcd 1 = ] 2bi
     [ dup 0 < [ + ] [ nip ] if ]
-    [ "Non-trivial divisor found" throw ] if ; foldable
+    [ non-trivial-divisor ] if ; foldable
 
 : ^mod ( x y n -- z )
     over 0 < [
@@ -156,6 +158,10 @@ M: real log dup 0.0 >= [ flog ] [ 0.0 rect> log ] if ;
 
 M: complex log >polar swap flog swap rect> ;
 
+: 10^ ( x -- y ) 10 swap ^ ; inline
+
+: log10 ( x -- y ) log 10 log / ; inline
+
 GENERIC: cos ( x -- y ) foldable
 
 M: complex cos
@@ -259,13 +265,13 @@ M: real atan fatan ;
 : round ( x -- y ) dup sgn 2 / + truncate ; inline
 
 : floor ( x -- y )
-    dup 1 mod dup zero?
-    [ drop ] [ dup 0 < [ - 1 - ] [ - ] if ] if ; foldable
+    dup 1 mod
+    [ ] [ dup 0 < [ - 1 - ] [ - ] if ] if-zero ; foldable
 
 : ceiling ( x -- y ) neg floor neg ; foldable
 
 : floor-to ( x step -- y )
-    dup zero? [ drop ] [ [ / floor ] [ * ] bi ] if ;
+    [ [ / floor ] [ * ] bi ] unless-zero ;
 
 : lerp ( a b t -- a_t ) [ over - ] dip * + ; inline
 

basis/math/intervals/intervals-tests.factor

@@ -1,6 +1,6 @@
 USING: math.intervals kernel sequences words math math.order
 arrays prettyprint tools.test random vocabs combinators
-accessors math.constants ;
+accessors math.constants fry ;
 IN: math.intervals.tests
 
 [ empty-interval ] [ 2 2 (a,b) ] unit-test
@@ -113,6 +113,22 @@ IN: math.intervals.tests
     0 1 (a,b) 0 1 [a,b] interval-subset?
 ] unit-test
 
+[ t ] [
+    full-interval -1/0. 1/0. [a,b] interval-subset?
+] unit-test
+
+[ t ] [
+    -1/0. 1/0. [a,b] full-interval interval-subset?
+] unit-test
+
+[ f ] [
+    full-interval 0 1/0. [a,b] interval-subset?
+] unit-test
+
+[ t ] [
+    0 1/0. [a,b] full-interval interval-subset?
+] unit-test
+
 [ f ] [
     0 0 1 (a,b) interval-contains?
 ] unit-test
@@ -246,7 +262,7 @@ IN: math.intervals.tests
         } case
     ] if ;
 
-: random-unary-op ( -- pair )
+: unary-ops ( -- alist )
     {
         { bitnot interval-bitnot }
         { abs interval-abs }
@@ -257,11 +273,10 @@ IN: math.intervals.tests
     }
     "math.ratios.private" vocab [
         { recip interval-recip } suffix
-    ] when
-    random ;
+    ] when ;
 
-: unary-test ( -- ? )
-    random-interval random-unary-op ! 2dup . .
+: unary-test ( op -- ? )
+    [ random-interval ] dip
     0 pick interval-contains? over first \ recip eq? and [
         2drop t
     ] [
@@ -269,9 +284,11 @@ IN: math.intervals.tests
         second execute( a -- b ) interval-contains?
     ] if ;
 
-[ t ] [ 80000 iota [ drop unary-test ] all? ] unit-test
+unary-ops [
+    [ [ t ] ] dip '[ 8000 iota [ drop _ unary-test ] all? ] unit-test
+] each
 
-: random-binary-op ( -- pair )
+: binary-ops ( -- alist )
     {
         { + interval+ }
         { - interval- }
@@ -282,17 +299,15 @@ IN: math.intervals.tests
         { bitand interval-bitand }
         { bitor interval-bitor }
         { bitxor interval-bitxor }
-        ! { shift interval-shift }
         { min interval-min }
         { max interval-max }
     }
     "math.ratios.private" vocab [
         { / interval/ } suffix
-    ] when
-    random ;
+    ] when ;
 
-: binary-test ( -- ? )
-    random-interval random-interval random-binary-op ! 3dup . . .
+: binary-test ( op -- ? )
+    [ random-interval random-interval ] dip
     0 pick interval-contains? over first { / /i mod rem } member? and [
         3drop t
     ] [
@@ -300,22 +315,26 @@ IN: math.intervals.tests
         second execute( a b -- c ) interval-contains?
     ] if ;
 
-[ t ] [ 80000 iota [ drop binary-test ] all? ] unit-test
+binary-ops [
+    [ [ t ] ] dip '[ 8000 iota [ drop _ binary-test ] all? ] unit-test
+] each
 
-: random-comparison ( -- pair )
+: comparison-ops ( -- alist )
     {
         { < interval< }
         { <= interval<= }
         { > interval> }
         { >= interval>= }
-    } random ;
+    } ;
 
-: comparison-test ( -- ? )
-    random-interval random-interval random-comparison
+: comparison-test ( op -- ? )
+    [ random-interval random-interval ] dip
     [ [ [ random-element ] bi@ ] dip first execute( a b -- ? ) ] 3keep
     second execute( a b -- ? ) dup incomparable eq? [ 2drop t ] [ = ] if ;
 
-[ t ] [ 40000 iota [ drop comparison-test ] all? ] unit-test
+comparison-ops [
+    [ [ t ] ] dip '[ 8000 iota [ drop _ comparison-test ] all? ] unit-test
+] each
 
 [ t ] [ -10 10 [a,b] 0 100 [a,b] assume> 0 10 (a,b] = ] unit-test
 
@@ -335,18 +354,19 @@ IN: math.intervals.tests
 : random-interval-or-empty ( -- obj )
     10 random 0 = [ empty-interval ] [ random-interval ] if ;
 
-: random-commutative-op ( -- op )
+: commutative-ops ( -- seq )
     {
         interval+ interval*
         interval-bitor interval-bitand interval-bitxor
         interval-max interval-min
-    } random ;
+    } ;
 
-[ t ] [
-    80000 iota [
-        drop
-        random-interval-or-empty random-interval-or-empty
-        random-commutative-op
-        [ execute ] [ swapd execute ] 3bi =
-    ] all?
-] unit-test
+commutative-ops [
+    [ [ t ] ] dip '[
+        8000 iota [
+            drop
+            random-interval-or-empty random-interval-or-empty _
+            [ execute ] [ swapd execute ] 3bi =
+        ] all?
+    ] unit-test
+] each

basis/math/intervals/intervals.factor

@@ -11,14 +11,21 @@ SYMBOL: full-interval
 
 TUPLE: interval { from read-only } { to read-only } ;
 
+: closed-point? ( from to -- ? )
+    2dup [ first ] bi@ number=
+    [ [ second ] both? ] [ 2drop f ] if ;
+
 : <interval> ( from to -- interval )
-    2dup [ first ] bi@ {
-        { [ 2dup > ] [ 2drop 2drop empty-interval ] }
-        { [ 2dup number= ] [
-            2drop 2dup [ second ] both?
+    {
+        { [ 2dup [ first ] bi@ > ] [ 2drop empty-interval ] }
+        { [ 2dup [ first ] bi@ number= ] [
+            2dup [ second ] both?
             [ interval boa ] [ 2drop empty-interval ] if
         ] }
-        [ 2drop interval boa ]
+        { [ 2dup [ { -1/0. t } = ] [ { 1/0. t } = ] bi* and ] [
+            2drop full-interval
+        ] }
+        [ interval boa ]
     } cond ;
 
 : open-point ( n -- endpoint ) f 2array ;
@@ -53,6 +60,9 @@ MEMO: [0,inf] ( -- interval ) 0 [a,inf] ; foldable
 MEMO: fixnum-interval ( -- interval )
     most-negative-fixnum most-positive-fixnum [a,b] ; inline
 
+MEMO: array-capacity-interval ( -- interval )
+    0 max-array-capacity [a,b] ; inline
+
 : [-inf,inf] ( -- interval ) full-interval ; inline
 
 : compare-endpoints ( p1 p2 quot -- ? )
@@ -340,16 +350,8 @@ SYMBOL: incomparable
     {
         { [ over empty-interval eq? ] [ drop ] }
         { [ dup empty-interval eq? ] [ nip ] }
-        { [ dup full-interval eq? ] [ nip ] }
-        [ (rem-range) 2dup interval-subset? [ drop ] [ nip ] if ]
-    } cond ;
-
-: interval->fixnum ( i1 -- i2 )
-    {
-        { [ dup empty-interval eq? ] [ ] }
-        { [ dup full-interval eq? ] [ drop fixnum-interval ] }
-        { [ dup fixnum-interval interval-subset? not ] [ drop fixnum-interval ] }
-        [ ]
+        { [ dup full-interval eq? ] [ 2drop [0,inf] ] }
+        [ nip (rem-range) ]
     } cond ;
 
 : interval-bitand-pos ( i1 i2 -- ? )

basis/math/primes/erato/erato.factor

@@ -9,7 +9,7 @@ IN: math.primes.erato
 CONSTANT: masks B{ 0 128 0 0 0 0 0 64 0 0 0 32 0 16 0 0 0 8 0 4 0 0 0 2 0 0 0 0 0 1 }
 
 : bit-pos ( n -- byte/f mask/f )
-    30 /mod masks nth-unsafe dup zero? [ 2drop f f ] when ;
+    30 /mod masks nth-unsafe [ drop f f ] when-zero ;
 
 : marked-unsafe? ( n arr -- ? )
     [ bit-pos ] dip swap [ [ nth-unsafe ] [ bitand zero? not ] bi* ] [ 2drop f ] if* ;
@@ -38,4 +38,4 @@ PRIVATE>
 
 : marked-prime? ( n arr -- ? )
     2dup upper-bound 2 swap between? [ bounds-error ] unless
-    over { 2 3 5 } member? [ 2drop t ] [ marked-unsafe? ] if ;
+    over { 2 3 5 } member? [ 2drop t ] [ marked-unsafe? ] if ;

basis/math/ratios/ratios.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel kernel.private math math.functions math.private ;
+USING: accessors kernel kernel.private math math.functions
+math.private sequences summary ;
 IN: math.ratios
 
 : 2>fraction ( a/b c/d -- a c b d )
@@ -19,13 +20,18 @@ IN: math.ratios
 
 PRIVATE>
 
+ERROR: division-by-zero x ;
+
+M: division-by-zero summary
+    drop "Division by zero" ;
+
 M: integer /
-    dup zero? [
-        "Division by zero" throw
+    [
+        division-by-zero
     ] [
         dup 0 < [ [ neg ] bi@ ] when
         2dup gcd nip [ /i ] curry bi@ fraction>
-    ] if ;
+    ] if-zero ;
 
 M: ratio hashcode*
     nip >fraction [ hashcode ] bi@ bitxor ;

basis/serialize/serialize.factor

@@ -47,7 +47,7 @@ M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ;
 ! The last case is needed because a very large number would
 ! otherwise be confused with a small number.
 : serialize-cell ( n -- )
-    dup zero? [ drop 0 write1 ] [
+    [ 0 write1 ] [
         dup HEX: 7e <= [
             HEX: 80 bitor write1
         ] [
@@ -60,7 +60,7 @@ M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ;
             ] if
             >be write
         ] if
-    ] if ;
+    ] if-zero ;
 
 : deserialize-cell ( -- n )
     read1 {
@@ -79,12 +79,12 @@ M: f (serialize) ( obj -- )
     drop CHAR: n write1 ;
 
 M: integer (serialize) ( obj -- )
-    dup zero? [
-        drop CHAR: z write1
+    [
+        CHAR: z write1
     ] [
         dup 0 < [ neg CHAR: m ] [ CHAR: p ] if write1
         serialize-cell
-    ] if ;
+    ] if-zero ;
 
 M: float (serialize) ( obj -- )
     CHAR: F write1
@@ -295,4 +295,4 @@ PRIVATE>
     binary [ deserialize ] with-byte-reader ;
 
 : object>bytes ( obj -- bytes )
-    binary [ serialize ] with-byte-writer ;
+    binary [ serialize ] with-byte-writer ;

basis/stack-checker/backend/backend.factor

@@ -5,7 +5,7 @@ parser sequences strings vectors words quotations effects classes
 continuations assocs combinators compiler.errors accessors math.order
 definitions sets hints macros stack-checker.state
 stack-checker.visitor stack-checker.errors stack-checker.values
-stack-checker.recursive-state ;
+stack-checker.recursive-state summary ;
 IN: stack-checker.backend
 
 : push-d ( obj -- ) meta-d push ;
@@ -98,8 +98,10 @@ M: object apply-object push-literal ;
 : time-bomb ( error -- )
     '[ _ throw ] infer-quot-here ;
 
-: bad-call ( -- )
-    "call must be given a callable" time-bomb ;
+ERROR: bad-call obj ;
+
+M: bad-call summary
+    drop "call must be given a callable" ;
 
 : infer-literal-quot ( literal -- )
     dup recursive-quotation? [
@@ -110,7 +112,7 @@ M: object apply-object push-literal ;
             [ [ recursion>> ] keep add-local-quotation ]
             bi infer-quot
         ] [
-            drop bad-call
+            value>> \ bad-call boa time-bomb
         ] if
     ] if ;
 

basis/stack-checker/known-words/known-words.factor

@@ -134,13 +134,17 @@ M: object infer-call*
 
 \ compose [ infer-compose ] "special" set-word-prop
 
+ERROR: bad-executable obj ;
+
+M: bad-executable summary
+    drop "execute must be given a word" ;
+
 : infer-execute ( -- )
     pop-literal nip
     dup word? [
         apply-object
     ] [
-        drop
-        "execute must be given a word" time-bomb
+        \ bad-executable boa time-bomb
     ] if ;
 
 \ execute [ infer-execute ] "special" set-word-prop

basis/windows/errors/errors.factor

@@ -713,11 +713,7 @@ ERROR: error-message-failed id ;
     GetLastError n>win32-error-string ;
 
 : (win32-error) ( n -- )
-    dup zero? [
-        drop
-    ] [
-        win32-error-string throw
-    ] if ;
+    [ win32-error-string throw ] unless-zero ;
 
 : win32-error ( -- )
     GetLastError (win32-error) ;

core/arrays/arrays.factor

@@ -14,7 +14,7 @@ M: array resize resize-array ;
 
 M: object new-sequence drop 0 <array> ;
 
-M: f new-sequence drop dup zero? [ drop f ] [ 0 <array> ] if ;
+M: f new-sequence drop [ f ] [ 0 <array> ] if-zero ;
 
 M: array equal?
     over array? [ sequence= ] [ 2drop f ] if ;

core/classes/algebra/algebra.factor

@@ -202,9 +202,11 @@ M: anonymous-complement (classes-intersect?)
 : class= ( first second -- ? )
     [ class<= ] [ swap class<= ] 2bi and ;
 
+ERROR: topological-sort-failed ;
+
 : largest-class ( seq -- n elt )
     dup [ [ class< ] with any? not ] curry find-last
-    [ "Topological sort failed" throw ] unless* ;
+    [ topological-sort-failed ] unless* ;
 
 : sort-classes ( seq -- newseq )
     [ name>> ] sort-with >vector

core/effects/parser/parser.factor

@@ -24,9 +24,11 @@ ERROR: bad-effect ;
 : parse-effect-tokens ( end -- tokens )
     [ parse-effect-token dup ] curry [ ] produce nip ;
 
+ERROR: stack-effect-omits-dashes effect ;
+
 : parse-effect ( end -- effect )
     parse-effect-tokens { "--" } split1 dup
-    [ <effect> ] [ "Stack effect declaration must contain --" throw ] if ;
+    [ <effect> ] [ drop stack-effect-omits-dashes ] if ;
 
 : complete-effect ( -- effect )
     "(" expect ")" parse-effect ;

core/generic/single/single.factor

@@ -208,9 +208,11 @@ SYMBOL: predicate-engines
 : keep-going? ( assoc -- ? )
     assumed get swap second first class<= ;
 
+ERROR: unreachable ;
+
 : prune-redundant-predicates ( assoc -- default assoc' )
     {
-        { [ dup empty? ] [ drop [ "Unreachable" throw ] { } ] }
+        { [ dup empty? ] [ drop [ unreachable ] { } ] }
         { [ dup length 1 = ] [ first second { } ] }
         { [ dup keep-going? ] [ rest-slice prune-redundant-predicates ] }
         [ [ first second ] [ rest-slice ] bi ]

core/io/encodings/utf8/utf8.factor

@@ -73,14 +73,14 @@ M: utf8 encode-char
 PRIVATE>
 
 : code-point-length ( n -- x )
-    dup zero? [ drop 1 ] [
+    [ 1 ] [
         log2 {
             { [ dup 0 6 between? ] [ 1 ] }
             { [ dup 7 10 between? ] [ 2 ] }
             { [ dup 11 15 between? ] [ 3 ] }
             { [ dup 16 20 between? ] [ 4 ] }
         } cond nip
-    ] if ;
+    ] if-zero ;
 
 : code-point-offsets ( string -- indices )
     0 [ code-point-length + ] accumulate swap suffix ;

core/math/integers/integers.factor

@@ -121,14 +121,14 @@ M: bignum (log2) bignum-log2 ;
     over zero? [
         2drop 0.0
     ] [
-        dup zero? [
-            2drop 1/0.
+        [
+            drop 1/0.
         ] [
             pre-scale
             /f-loop over odd?
             [ zero? [ 1 + ] unless ] [ drop ] if
             post-scale
-        ] if
+        ] if-zero
     ] if ; inline
 
 M: bignum /f ( m n -- f )

core/math/math-docs.factor

@@ -213,9 +213,9 @@ HELP: sgn
 { $description
     "Outputs one of the following:"
     { $list
-        "-1 if " { $snippet "x" } " is negative"
-        "0 if " { $snippet "x" } " is equal to 0"
-        "1 if " { $snippet "x" } " is positive"
+        { "-1 if " { $snippet "x" } " is negative" }
+        { "0 if " { $snippet "x" } " is equal to 0" }
+        { "1 if " { $snippet "x" } " is positive" }
     }
 } ;
 

core/math/math.factor

@@ -48,9 +48,11 @@ GENERIC: (log2) ( x -- n ) foldable
 
 PRIVATE>
 
+ERROR: log2-expects-positive x ;
+
 : log2 ( x -- n )
     dup 0 <= [
-        "log2 expects positive inputs" throw
+        log2-expects-positive
     ] [
         (log2)
     ] if ; inline

core/math/parser/parser.factor

@@ -131,7 +131,7 @@ M: ratio >base
     [
         dup 0 < negative? set
         abs 1 /mod
-        [ dup zero? [ drop "" ] [ (>base) sign append ] if ]
+        [ [ "" ] [ (>base) sign append ] if-zero ]
         [
             [ numerator (>base) ]
             [ denominator (>base) ] bi

core/sequences/sequences-docs.factor

@@ -123,7 +123,48 @@ HELP: unless-empty
     }
 } ;
 
-{ if-empty when-empty unless-empty } related-words
+HELP: if-zero
+{ $values { "n" number } { "quot1" quotation } { "quot2" quotation } }
+{ $description "Makes an implicit check if the number is zero. A zero is dropped and " { $snippet "quot1" } " is called. Otherwise, if the number is not zero, " { $snippet "quot2" } " is called on it." }
+{ $example
+    "USING: kernel math prettyprint sequences ;"
+    "3 [ \"zero\" ] [ sq ] if-zero ."
+    "9"
+} ;
+
+HELP: when-zero
+{ $values
+     { "n" number } { "quot" "the first quotation of an " { $link if-zero } } }
+{ $description "Makes an implicit check if the sequence is empty. A zero is dropped and the " { $snippet "quot" } " is called." }
+{ $examples "This word is equivalent to " { $link if-zero } " with an empty second quotation:"
+    { $example
+    "USING: sequences prettyprint ;"
+    "0 [ 4 ] [ ] if-zero ."
+    "4"
+    }
+    { $example
+    "USING: sequences prettyprint ;"
+    "0 [ 4 ] when-zero ."
+    "4"
+    }
+} ;
+
+HELP: unless-zero
+{ $values
+     { "n" number } { "quot" "the second quotation of an " { $link if-empty } } }
+{ $description "Makes an implicit check if the number is zero. A zero is dropped. Otherwise, the " { $snippet "quot" } " is called on the number." }
+{ $examples "This word is equivalent to " { $link if-zero } " with an empty first quotation:"
+    { $example
+    "USING: sequences math prettyprint ;"
+    "3 [ ] [ sq ] if-empty ."
+    "9"
+    }
+    { $example
+    "USING: sequences math prettyprint ;"
+    "3 [ sq ] unless-zero ."
+    "9"
+    }
+} ;
 
 HELP: delete-all
 { $values { "seq" "a resizable sequence" } }
@@ -1214,7 +1255,7 @@ HELP: follow
 { $examples "Get random numbers until zero is reached:"
     { $unchecked-example
     "USING: random sequences prettyprint math ;"
-    "100 [ random dup zero? [ drop f ] when ] follow ."
+    "100 [ random [ f ] when-zero ] follow ."
     "{ 100 86 34 32 24 11 7 2 }"
 } } ;
 
@@ -1393,6 +1434,18 @@ $nl
 $nl
 "More elaborate counted loops can be performed with " { $link "math.ranges" } "." ;
 
+ARTICLE: "sequences-if" "Control flow with sequences"
+"To reduce the boilerplate of checking if a sequence is empty or a number is zero, several combinators are provided."
+$nl
+"Checking if a sequence is empty:"
+{ $subsection if-empty }
+{ $subsection when-empty }
+{ $subsection unless-empty }
+"Checking if a number is zero:"
+{ $subsection if-zero }
+{ $subsection when-zero }
+{ $subsection unless-zero } ;
+
 ARTICLE: "sequences-access" "Accessing sequence elements"
 { $subsection ?nth }
 "Concise way of extracting one of the first four elements:"
@@ -1658,6 +1711,8 @@ $nl
 "Using sequences for looping:"
 { $subsection "sequences-integers" }
 { $subsection "math.ranges" }
+"Using sequences for control flow:"
+{ $subsection "sequences-if" }
 "For inner loops:"
 { $subsection "sequences-unsafe" } ;
 

core/sequences/sequences.factor

@@ -29,13 +29,27 @@ M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ;
 
 : empty? ( seq -- ? ) length 0 = ; inline
 
+<PRIVATE
+
+: (if-empty) ( seq quot1 quot2 quot3 -- )
+    [ [ drop ] prepose ] [ ] tri* if ; inline
+
+PRIVATE>
+
 : if-empty ( seq quot1 quot2 -- )
-    [ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline
+    [ dup empty? ] (if-empty) ; inline
 
 : when-empty ( seq quot -- ) [ ] if-empty ; inline
 
 : unless-empty ( seq quot -- ) [ ] swap if-empty ; inline
 
+: if-zero ( n quot1 quot2 -- )
+    [ dup zero? ] (if-empty) ; inline
+
+: when-zero ( n quot -- ) [ ] if-zero ; inline
+
+: unless-zero ( n quot -- ) [ ] swap if-zero ; inline
+
 : delete-all ( seq -- ) 0 swap set-length ;
 
 : first ( seq -- first ) 0 swap nth ; inline
@@ -267,9 +281,11 @@ INSTANCE: repetition immutable-sequence
 
 <PRIVATE
 
+ERROR: integer-length-expected obj ;
+
 : check-length ( n -- n )
     #! Ricing.
-    dup integer? [ "length not an integer" throw ] unless ; inline
+    dup integer? [ integer-length-expected ] unless ; inline
 
 : ((copy)) ( dst i src j n -- dst i src j n )
     dup -roll [

core/splitting/splitting.factor

@@ -58,7 +58,7 @@ PRIVATE>
 : (split) ( separators n seq -- )
     3dup rot [ member? ] curry find-from drop
     [ [ swap subseq , ] 2keep 1 + swap (split) ]
-    [ swap dup zero? [ drop ] [ tail ] if , drop ] if* ; inline recursive
+    [ swap [ tail ] unless-zero , drop ] if* ; inline recursive
 
 : split, ( seq separators -- ) 0 rot (split) ;
 

extra/benchmark/chameneos-redux/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/benchmark/chameneos-redux/chameneos-redux.factor

@@ -0,0 +1,106 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs combinators
+concurrency.mailboxes fry io kernel make math math.parser
+math.text.english sequences threads ;
+IN: benchmark.chameneos-redux
+
+SYMBOLS: red yellow blue ;
+
+ERROR: bad-color-pair pair ;
+
+TUPLE: creature n color count self-count mailbox ;
+
+TUPLE: meeting-place count mailbox ;
+
+: <meeting-place> ( count -- meeting-place )
+    meeting-place new
+        swap >>count
+        <mailbox> >>mailbox ;
+
+: <creature> ( n color -- creature )
+    creature new
+        swap >>color
+        swap >>n
+        0 >>count
+        0 >>self-count
+        <mailbox> >>mailbox ;
+
+: make-creatures ( colors -- seq )
+    [ length iota ] [ ] bi [ <creature> ] 2map ;
+
+: complement-color ( color1 color2 -- color3 )
+    2dup = [ drop ] [
+        2array {
+            { { red yellow } [ blue ] }
+            { { red blue } [ yellow ] }
+            { { yellow red } [ blue ] }
+            { { yellow blue } [ red ] }
+            { { blue red } [ yellow ] }
+            { { blue yellow } [ red ] }
+            [ bad-color-pair ]
+        } case
+    ] if ;
+
+: color-string ( color1 color2 -- string )
+    [
+        [ [ name>> ] bi@ " + " glue % " -> " % ]
+        [ complement-color name>> % ] 2bi
+    ] "" make ;
+
+: print-color-table ( -- )
+    { blue red yellow } dup
+    '[ _ '[ color-string print ] with each ] each ;
+
+: try-meet ( meeting-place creature -- )
+    over count>> 0 < [
+        2drop
+    ] [
+        [ swap mailbox>> mailbox-put ]
+        [ nip mailbox>> mailbox-get drop ]
+        [ try-meet ] 2tri
+    ] if ;
+
+: creature-meeting ( seq -- )
+    first2 {
+        [ [ [ 1 + ] change-count ] bi@ 2drop ]
+        [ 2dup = [ [ 1 + ] change-self-count ] when 2drop ]
+        [ [ [ color>> ] bi@ complement-color ] [ [ (>>color) ] bi-curry@ bi ] 2bi ]
+        [ [ mailbox>> f swap mailbox-put ] bi@ ]
+    } 2cleave ;
+
+: run-meeting-place ( meeting-place -- )
+    [ 1 - ] change-count
+    dup count>> 0 < [
+        mailbox>> mailbox-get-all
+        [ f swap mailbox>> mailbox-put ] each
+    ] [
+        [ mailbox>> 2 swap '[ _ mailbox-get ] replicate creature-meeting ]
+        [ run-meeting-place ] bi
+    ] if ;
+
+: number>chameneos-string ( n -- string )
+    number>string string>digits [ number>text ] { } map-as " " join ;
+
+: chameneos-redux ( n colors -- )
+    [ <meeting-place> ] [ make-creatures ] bi*
+    {
+        [ nip nl bl [ bl ] [ color>> name>> write ] interleave nl ]
+        [ [ '[ _ _ try-meet ] in-thread ] with each ]
+        [ drop run-meeting-place ]
+    
+        [ nip [ [ count>> number>string write bl ] [ self-count>> number>text write nl ] bi ] each ]
+        [ nip 0 [ count>> + ] reduce bl number>chameneos-string print ]
+    } 2cleave ;
+
+! 6000000 for shootout, too slow right now
+
+: chameneos-redux-main ( -- )
+    print-color-table
+    60000 [
+        { blue red yellow } chameneos-redux
+    ] [
+        { blue red yellow red yellow blue red yellow red blue } chameneos-redux
+    ] bi ;
+
+MAIN: chameneos-redux-main

extra/benchmark/fasta/fasta.factor

@@ -63,7 +63,7 @@ CONSTANT: homo-sapiens
 :: split-lines ( n quot -- )
     n line-length /mod
     [ [ line-length quot call ] times ] dip
-    dup zero? [ drop ] quot if ; inline
+    quot unless-zero ; inline
 
 : write-random-fasta ( seed n chars floats desc id -- seed )
     write-description

extra/descriptive/descriptive-tests.factor

@@ -1,16 +1,34 @@
-USING: descriptive kernel math tools.test continuations prettyprint io.streams.string see ;
+USING: descriptive kernel math tools.test continuations prettyprint io.streams.string see
+math.ratios ;
 IN: descriptive.tests
 
 DESCRIPTIVE: divide ( num denom -- fraction ) / ;
 
 [ 3 ] [ 9 3 divide ] unit-test
-[ T{ descriptive-error f { { "num" 3 } { "denom" 0 } } "Division by zero" divide } ] [ [ 3 0 divide ] [ ] recover ] unit-test
 
-[ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE: divide ( num denom -- fraction ) / ;\n" ] [ \ divide [ see ] with-string-writer ] unit-test
+[
+    T{ descriptive-error f
+        { { "num" 3 } { "denom" 0 } }
+        T{ division-by-zero f 3 }
+        divide
+    }
+] [
+    [ 3 0 divide ] [ ] recover
+] unit-test
+
+[ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE: divide ( num denom -- fraction ) / ;\n" ]
+[ \ divide [ see ] with-string-writer ] unit-test
 
 DESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ;
 
 [ 3 ] [ 9 3 divide* ] unit-test
-[ T{ descriptive-error f { { "num" 3 } { "denom" 0 } } "Division by zero" divide* } ] [ [ 3 0 divide* ] [ ] recover ] unit-test
+
+[
+    T{ descriptive-error f
+        { { "num" 3 } { "denom" 0 } }
+        T{ division-by-zero f 3 }
+        divide*
+    }
+] [ [ 3 0 divide* ] [ ] recover ] unit-test
 
 [ "USING: descriptive math ;\nIN: descriptive.tests\nDESCRIPTIVE:: divide* ( num denom -- fraction ) num denom / ;\n" ] [ \ divide* [ see ] with-string-writer ] unit-test

extra/game-loop/game-loop.factor

@@ -1,5 +1,6 @@
 USING: accessors calendar continuations destructors kernel math
-math.order namespaces system threads ui ui.gadgets.worlds ;
+math.order namespaces system threads ui ui.gadgets.worlds
+sequences ;
 IN: game-loop
 
 TUPLE: game-loop
@@ -52,11 +53,11 @@ TUPLE: game-loop-error game-loop error ;
     drop ;
 
 : ?tick ( loop count -- )
-    dup zero? [ drop millis >>last-tick drop ] [
+    [ millis >>last-tick drop ] [
         over [ since-last-tick ] [ tick-length>> ] bi >=
         [ [ drop increment-tick ] [ drop tick ] [ 1- ?tick ] 2tri ]
         [ 2drop ] if
-    ] if ;
+    ] if-zero ;
 
 : (run-loop) ( loop -- )
     dup running?>>

extra/math/analysis/analysis.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman, Slava Pestov, Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit kernel math math.constants math.functions
-    math.vectors sequences ;
+USING: combinators.short-circuit kernel math math.constants
+math.functions math.vectors sequences ;
 IN: math.analysis
 
 <PRIVATE

extra/math/text/english/english-docs.factor

@@ -4,4 +4,4 @@ IN: math.text.english
 HELP: number>text
 { $values { "n" integer } { "str" string } }
 { $description "Converts an integer to a text string representation in English, including appropriate punctuation and conjunctions." }
-{ $examples { $example "USING: math.text.english prettyprint ;" "12345 number>text ." "\"Twelve Thousand, Three Hundred and Forty-Five\"" } } ;
+{ $examples { $example "USING: math.text.english prettyprint ;" "12345 number>text ." "\"twelve thousand, three hundred and forty-five\"" } } ;

extra/math/text/english/english-tests.factor

@@ -1,15 +1,15 @@
 USING: math.functions math.text.english tools.test ;
 IN: math.text.english.tests
 
-[ "Zero" ] [ 0 number>text ] unit-test
-[ "Twenty-One" ] [ 21 number>text ] unit-test
-[ "One Hundred" ] [ 100 number>text ] unit-test
-[ "One Hundred and One" ] [ 101 number>text ] unit-test
-[ "One Thousand and One" ] [ 1001 number>text ] unit-test
-[ "One Thousand, One Hundred and One" ] [ 1101 number>text ] unit-test
-[ "One Million, One Thousand and One" ] [ 1001001 number>text ] unit-test
-[ "One Million, One Thousand, One Hundred and One" ] [ 1001101 number>text ] unit-test
-[ "One Million, One Hundred and Eleven Thousand, One Hundred and Eleven" ] [ 1111111 number>text ] unit-test
-[ "One Duotrigintillion" ] [ 10 99 ^ number>text ] unit-test
+[ "zero" ] [ 0 number>text ] unit-test
+[ "twenty-one" ] [ 21 number>text ] unit-test
+[ "one hundred" ] [ 100 number>text ] unit-test
+[ "one hundred and one" ] [ 101 number>text ] unit-test
+[ "one thousand and one" ] [ 1001 number>text ] unit-test
+[ "one thousand, one hundred and one" ] [ 1101 number>text ] unit-test
+[ "one million, one thousand and one" ] [ 1001001 number>text ] unit-test
+[ "one million, one thousand, one hundred and one" ] [ 1001101 number>text ] unit-test
+[ "one million, one hundred and eleven thousand, one hundred and eleven" ] [ 1111111 number>text ] unit-test
+[ "one duotrigintillion" ] [ 10 99 ^ number>text ] unit-test
 
-[ "Negative One Hundred and Twenty-Three" ] [ -123 number>text ] unit-test
+[ "negative one hundred and twenty-three" ] [ -123 number>text ] unit-test

extra/math/text/english/english.factor

@@ -7,35 +7,44 @@ IN: math.text.english
 <PRIVATE
 
 : small-numbers ( n -- str )
-    { "Zero" "One" "Two" "Three" "Four" "Five" "Six" "Seven" "Eight" "Nine"
-    "Ten" "Eleven" "Twelve" "Thirteen" "Fourteen" "Fifteen" "Sixteen"
-    "Seventeen" "Eighteen" "Nineteen" } nth ;
+    {
+        "zero" "one" "two" "three" "four" "five" "six"
+        "seven" "eight" "nine" "ten" "eleven" "twelve"
+        "thirteen" "fourteen" "fifteen" "sixteen" "seventeen"
+        "eighteen" "nineteen"
+    } nth ;
 
 : tens ( n -- str )
-    { f f "Twenty" "Thirty" "Forty" "Fifty" "Sixty" "Seventy" "Eighty" "Ninety" } nth ;
-
+    {
+        f f "twenty" "thirty" "forty" "fifty" "sixty"
+        "seventy" "eighty" "ninety"
+    } nth ;
+    
 : scale-numbers ( n -- str )  ! up to 10^99
-    { f "Thousand" "Million" "Billion" "Trillion" "Quadrillion" "Quintillion"
-    "Sextillion" "Septillion" "Octillion" "Nonillion" "Decillion" "Undecillion"
-    "Duodecillion" "Tredecillion" "Quattuordecillion" "Quindecillion"
-    "Sexdecillion" "Septendecillion" "Octodecillion" "Novemdecillion"
-    "Vigintillion" "Unvigintillion" "Duovigintillion" "Trevigintillion"
-    "Quattuorvigintillion" "Quinvigintillion" "Sexvigintillion"
-    "Septvigintillion" "Octovigintillion" "Novemvigintillion" "Trigintillion"
-    "Untrigintillion" "Duotrigintillion" } nth ;
+    {
+        f "thousand" "million" "billion" "trillion" "quadrillion"
+        "quintillion" "sextillion" "septillion" "octillion"
+        "nonillion" "decillion" "undecillion" "duodecillion"
+        "tredecillion" "quattuordecillion" "quindecillion"
+        "sexdecillion" "septendecillion" "octodecillion" "novemdecillion"
+        "vigintillion" "unvigintillion" "duovigintillion" "trevigintillion"
+        "quattuorvigintillion" "quinvigintillion" "sexvigintillion"
+        "septvigintillion" "octovigintillion" "novemvigintillion"
+        "trigintillion" "untrigintillion" "duotrigintillion"
+    } nth ;
 
 SYMBOL: and-needed?
 : set-conjunction ( seq -- )
     first { [ 100 < ] [ 0 > ] } 1&& and-needed? set ;
 
 : negative-text ( n -- str )
-    0 < "Negative " "" ? ;
+    0 < "negative " "" ? ;
 
 : hundreds-place ( n -- str )
     100 /mod over 0 = [
         2drop ""
     ] [
-        [ small-numbers " Hundred" append ] dip
+        [ small-numbers " hundred" append ] dip
         0 = [ " and " append ] unless
     ] if ;
 
@@ -78,7 +87,7 @@ SYMBOL: and-needed?
     ] if ;
 
 : (number>text) ( n -- str )
-    [ negative-text ] [ abs 3digit-groups recombine ] bi append ;
+    [ negative-text ] [ abs 3 digit-groups recombine ] bi append ;
 
 PRIVATE>
 

extra/math/text/french/french.factor

@@ -73,7 +73,7 @@ MEMO: units ( -- seq ) ! up to 10^99
     } cond ;
 
 : over-1000000 ( n -- str )
-    3digit-groups [ 1+ units nth n-units ] map-index sift
+    3 digit-groups [ 1+ units nth n-units ] map-index sift
     reverse " " join ;
 
 : decompose ( n -- str ) 1000000 /mod [ over-1000000 ] dip complete ;

extra/math/text/utils/utils-docs.factor

@@ -1,6 +1,6 @@
 USING: help.markup help.syntax ;
 IN: math.text.utils
 
-HELP: 3digit-groups
-{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
-{ $description "Decompose a number into 3 digits groups and return them in a sequence, starting with the units, then the tenths, etc." } ;
+HELP: digit-groups
+{ $values { "n" "a positive integer" } { "k" "a positive integer" } { "seq" "a sequence" } }
+{ $description "Decompose a number into groups of " { $snippet "k" } " digits and return them in a sequence starting with the least significant grouped digits first." } ;

extra/math/text/utils/utils-tests.factor

@@ -1,3 +1,3 @@
 USING: math.text.utils tools.test ;
 
-[ { 1 999 2 } ] [ 2999001 3digit-groups ] unit-test
+[ { 1 999 2 } ] [ 2999001 3 digit-groups ] unit-test

extra/math/text/utils/utils.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2007, 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences ;
+USING: kernel fry math.functions math sequences ;
 IN: math.text.utils
 
-: 3digit-groups ( n -- seq )
-    [ dup 0 > ] [ 1000 /mod ] produce nip ;
+: digit-groups ( n k -- seq )
+    [ dup 0 > ] swap '[ _ 10^ /mod ] produce nip ;

extra/money/money.factor

@@ -28,6 +28,6 @@ ERROR: not-an-integer x ;
     [
         [ dup string>number [ nip ] [ not-an-integer ] if* ] bi@
     ] keep length
-    10 swap ^ / + swap [ neg ] when ;
+    10^ / + swap [ neg ] when ;
 
 SYNTAX: DECIMAL: scan parse-decimal parsed ;

extra/project-euler/048/048.factor

@@ -1,6 +1,7 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions math.ranges project-euler.common sequences ;
+USING: kernel math math.functions math.ranges
+project-euler.common sequences ;
 IN: project-euler.048
 
 ! http://projecteuler.net/index.php?section=problems&id=48
@@ -17,7 +18,7 @@ IN: project-euler.048
 ! --------
 
 : euler048 ( -- answer )
-    1000 [1,b] [ dup ^ ] sigma 10 10 ^ mod ;
+    1000 [1,b] [ dup ^ ] sigma 10 10^ mod ;
 
 ! [ euler048 ] 100 ave-time
 ! 276 ms run / 1 ms GC ave time - 100 trials

extra/project-euler/151/151-tests.factor

@@ -0,0 +1,4 @@
+USING: project-euler.151 tools.test ;
+IN: project-euler.151.tests
+
+[ 12138569781349/26138246400000 ] [ euler151 ] unit-test

extra/project-euler/151/151.factor

@@ -39,11 +39,11 @@ SYMBOL: table
 
 : (pick-sheet) ( seq i -- newseq )
     [
-        <=> sgn
+        <=>
         {
-            { -1 [ ] }
-            {  0 [ 1- ] }
-            {  1 [ 1+ ] }
+            { +lt+ [ ] }
+            { +eq+ [ 1- ] }
+            { +gt+ [ 1+ ] }
         } case
     ] curry map-index ;
 
@@ -71,8 +71,6 @@ DEFER: (euler151)
         { 1 1 1 1 } (euler151)
     ] with-scope ;
 
-! TODO: doesn't work currently, problem in area of 'with map' in (euler151)
-
 ! [ euler151 ] 100 ave-time
 ! ? ms run time - 100 trials
 

extra/project-euler/ave-time/ave-time.factor

@@ -1,11 +1,11 @@
 ! Copyright (c) 2007, 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: continuations fry io kernel make math math.functions math.parser
-    math.statistics memory tools.time ;
+USING: continuations fry io kernel make math math.functions
+math.parser math.statistics memory tools.time ;
 IN: project-euler.ave-time
 
 : nth-place ( x n -- y )
-    10 swap ^ [ * round >integer ] keep /f ;
+    10^ [ * round >integer ] keep /f ;
 
 : collect-benchmarks ( quot n -- seq )
     [

extra/project-euler/common/common.factor

@@ -62,9 +62,6 @@ PRIVATE>
 : cartesian-product ( seq1 seq2 -- seq1xseq2 )
     [ [ 2array ] with map ] curry map concat ;
 
-: log10 ( m -- n )
-    log 10 log / ;
-
 : mediant ( a/c b/d -- (a+b)/(c+d) )
     2>fraction [ + ] 2bi@ / ;
 

extra/svg/svg.factor

@@ -11,7 +11,7 @@ XML-NS: inkscape-name http://www.inkscape.org/namespaces/inkscape
 
 : svg-string>number ( string -- number )
     { { CHAR: E CHAR: e } } substitute "e" split1
-    [ string>number ] [ [ string>number 10 swap ^ ] [ 1 ] if* ] bi* *
+    [ string>number ] [ [ string>number 10^ ] [ 1 ] if* ] bi* *
     >float ;
 
 : degrees ( deg -- rad ) pi * 180.0 / ;