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/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 = [
+    n multiple rem [
-        drop n
+        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?
+    dup 1 mod
-    [ drop ] [ dup 0 < [ - 1 - ] [ - ] if ] if ; foldable
+    [ ] [ 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/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 ( -- )
+ERROR: bad-call obj ;
-    "call must be given a callable" time-bomb ;
+
+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
+        \ bad-executable boa time-bomb
-        "execute must be given a word" 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? [
+    [ win32-error-string throw ] unless-zero ;
-        drop
-    ] [
-        win32-error-string throw
-    ] if ;
 
 : 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"
+        { "-1 if " { $snippet "x" } " is negative" }
-        "0 if " { $snippet "x" } " is equal to 0"
+        { "0 if " { $snippet "x" } " is equal to 0" }
-        "1 if " { $snippet "x" } " is positive"
+        { "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/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
+USING: combinators.short-circuit kernel math math.constants
-    math.vectors sequences ;
+math.functions math.vectors sequences ;
 IN: math.analysis
 
 <PRIVATE

extra/math/text/english/english.factor

@@ -87,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
+HELP: digit-groups
-{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
+{ $values { "n" "a positive integer" } { "k" "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." } ;
+{ $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 )
+: digit-groups ( n k -- seq )
-    [ dup 0 > ] [ 1000 /mod ] produce nip ;
+    [ 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 [ ] }
+            { +lt+ [ ] }
-            {  0 [ 1- ] }
+            { +eq+ [ 1- ] }
-            {  1 [ 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
+USING: continuations fry io kernel make math math.functions
-    math.statistics memory tools.time ;
+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 / ;