Merge branch 'master' into new_gc

basis/bootstrap/compiler/compiler.factor

@@ -49,7 +49,7 @@ gc
     {
         not ?
 
-        2over roll -roll
+        2over
 
         array? hashtable? vector?
         tuple? sbuf? tombstone?

basis/bootstrap/image/image.factor

@@ -1,14 +1,16 @@
 ! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays byte-arrays generic hashtables hashtables.private
+USING: alien arrays byte-arrays generic hashtables
-io io.binary io.files io.encodings.binary io.pathnames kernel
+hashtables.private io io.binary io.files io.encodings.binary
-kernel.private math namespaces make parser prettyprint sequences
+io.pathnames kernel kernel.private math namespaces make parser
-strings sbufs vectors words quotations assocs system layouts splitting
+prettyprint sequences strings sbufs vectors words quotations
-grouping growable classes classes.builtin classes.tuple
+assocs system layouts splitting grouping growable classes
-classes.tuple.private vocabs vocabs.loader source-files definitions
+classes.builtin classes.tuple classes.tuple.private vocabs
-debugger quotations.private combinators math.order math.private
+vocabs.loader source-files definitions debugger
-accessors slots.private generic.single.private compiler.units
+quotations.private combinators combinators.short-circuit
-compiler.constants fry bootstrap.image.syntax ;
+math.order math.private accessors slots.private
+generic.single.private compiler.units compiler.constants fry
+bootstrap.image.syntax ;
 IN: bootstrap.image
 
 : arch ( os cpu -- arch )
@@ -38,7 +40,7 @@ IN: bootstrap.image
 
 ! Object cache; we only consider numbers equal if they have the
 ! same type
-TUPLE: eql-wrapper obj ;
+TUPLE: eql-wrapper { obj read-only } ;
 
 C: <eql-wrapper> eql-wrapper
 
@@ -47,25 +49,22 @@ M: eql-wrapper hashcode* obj>> hashcode* ;
 GENERIC: (eql?) ( obj1 obj2 -- ? )
 
 : eql? ( obj1 obj2 -- ? )
-    [ (eql?) ] [ [ class ] bi@ = ] 2bi and ;
+    { [ [ class ] bi@ = ] [ (eql?) ] } 2&& ;
 
-M: integer (eql?) = ;
+M: fixnum (eql?) eq? ;
 
-M: float (eql?)
+M: bignum (eql?) = ;
-    over float? [ fp-bitwise= ] [ 2drop f ] if ;
 
-M: sequence (eql?)
+M: float (eql?) fp-bitwise= ;
-    over sequence? [
+
-        2dup [ length ] bi@ =
+M: sequence (eql?) 2dup [ length ] bi@ = [ [ eql? ] 2all? ] [ 2drop f ] if ;
-        [ [ eql? ] 2all? ] [ 2drop f ] if
-    ] [ 2drop f ] if ;
 
 M: object (eql?) = ;
 
 M: eql-wrapper equal?
     over eql-wrapper? [ [ obj>> ] bi@ eql? ] [ 2drop f ] if ;
 
-TUPLE: eq-wrapper obj ;
+TUPLE: eq-wrapper { obj read-only } ;
 
 C: <eq-wrapper> eq-wrapper
 

basis/compiler/tests/optimizer.factor

@@ -4,7 +4,7 @@ sbufs strings tools.test vectors words sequences.private
 quotations classes classes.algebra classes.tuple.private
 continuations growable namespaces hints alien.accessors
 compiler.tree.builder compiler.tree.optimizer sequences.deep
-compiler definitions generic.single ;
+compiler definitions generic.single shuffle ;
 IN: compiler.tests.optimizer
 
 GENERIC: xyz ( obj -- obj )

basis/compiler/tree/dead-code/dead-code-tests.factor

@@ -6,7 +6,7 @@ compiler.tree.tuple-unboxing compiler.tree.debugger
 compiler.tree.recursive compiler.tree.normalization
 compiler.tree.checker tools.test kernel math stack-checker.state
 accessors combinators io prettyprint words sequences.deep
-sequences.private arrays classes kernel.private ;
+sequences.private arrays classes kernel.private shuffle ;
 IN: compiler.tree.dead-code.tests
 
 : count-live-values ( quot -- n )

basis/debugger/debugger.factor

@@ -22,7 +22,7 @@ M: source-file-error error-help error>> error-help ;
 
 GENERIC: error. ( error -- )
 
-M: object error. . ;
+M: object error. short. ;
 
 M: string error. print ;
 

basis/help/lint/checks/checks.factor

@@ -44,6 +44,7 @@ SYMBOL: vocab-articles
 : contains-funky-elements? ( element -- ? )
     {
         $shuffle
+        $complex-shuffle
         $values-x/y
         $predicate
         $class-description

basis/math/functions/functions-docs.factor

@@ -54,6 +54,8 @@ ARTICLE: "power-functions" "Powers and logarithms"
 { $subsections log1+ log10 }
 "Raising a number to a power:"
 { $subsections ^ 10^ }
+"Finding the root of a number:"
+{ $subsections nth-root }
 "Converting between rectangular and polar form:"
 { $subsections
     abs
@@ -259,6 +261,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: nth-root
+{ $values { "n" integer } { "x" number } { "y" number } }
+{ $description "Calculates the nth root of a number, such that " { $snippet "y^n=x" } "." } ;
+
 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." } ;

basis/math/statistics/statistics-docs.factor

@@ -1,57 +1,67 @@
 USING: assocs debugger hashtables help.markup help.syntax
-quotations sequences ;
+quotations sequences math ;
 IN: math.statistics
 
 HELP: geometric-mean
-{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
+{ $values { "seq" sequence } { "x" "a non-negative real number"} }
-{ $description "Computes the geometric mean of all elements in " { $snippet "seq" } ". The geometric mean measures the central tendency of a data set that minimizes the effects of extreme values." }
+{ $description "Computes the geometric mean of all elements in " { $snippet "seq" } ". The geometric mean measures the central tendency of a data set and minimizes the effects of extreme values." }
 { $examples { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } geometric-mean ." "1.81712059283214" } }
 { $errors "Throws a " { $link signal-error. } " (square-root of 0) if the sequence is empty." } ;
 
 HELP: harmonic-mean
-{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
+{ $values { "seq" sequence } { "x" "a non-negative real number"} }
 { $description "Computes the harmonic mean of the elements in " { $snippet "seq" } ". The harmonic mean is appropriate when the average of rates is desired." }
 { $notes "Positive reals only." }
 { $examples { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } harmonic-mean ." "6/11" } }
 { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
 
 HELP: mean
-{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
+{ $values { "seq" sequence } { "x" "a non-negative real number"} }
-{ $description "Computes the arithmetic mean of all elements in " { $snippet "seq" } "." }
+{ $description "Computes the arithmetic mean of the elements in " { $snippet "seq" } "." }
 { $examples { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } mean ." "2" } }
 { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
 
 HELP: median
-{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
+{ $values { "seq" sequence } { "x" "a non-negative real number"} }
-{ $description "Computes the median of " { $snippet "seq" } " by sorting the sequence from lowest value to highest and outputting the middle one. If there is an even number of elements in the sequence, the median is not unique, so the mean of the two middle values is outputted." }
+{ $description "Computes the median of " { $snippet "seq" } " by finding the middle element of the sequence using " { $link kth-smallest } ". If there is an even number of elements in the sequence, the median is not unique, so the mean of the two middle values is output." }
 { $examples
   { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } median ." "2" }
   { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 4 } median ." "2+1/2" } }
 { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
 
 HELP: range
-{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
+{ $values { "seq" sequence } { "x" "a non-negative real number"} }
-{ $description "Computes the distance of the maximum and minimum values in " { $snippet "seq" } "." }
+{ $description "Computes the difference of the maximum and minimum values in " { $snippet "seq" } "." }
 { $examples
   { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } range ." "2" }
   { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 4 } range ." "3" } }  ;
 
+HELP: minmax
+{ $values { "seq" sequence } { "min" real } { "max" real } }
+{ $description "Finds the minimum and maximum elements of " { $snippet "seq" } " in one pass." }
+{ $examples
+    { $example "USING: arrays math.statistics prettyprint ;"
+        "{ 1 2 3 } minmax 2array ."
+        "{ 1 3 }"
+    }
+} ;
+
 HELP: std
-{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
+{ $values { "seq" sequence } { "x" "a non-negative real number"} }
 { $description "Computes the standard deviation of " { $snippet "seq" } ", which is the square root of the variance. It measures how widely spread the values in a sequence are about the mean." }
 { $examples
   { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } std ." "1.0" }
   { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 4 } std ." "1.290994448735806" } } ;
 
 HELP: ste
-  { $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
+  { $values { "seq" sequence } { "x" "a non-negative real number"} }
   { $description "Computes the standard error of the mean for " { $snippet "seq" } ". It's defined as the standard deviation divided by the square root of the length of the sequence, and measures uncertainty associated with the estimate of the mean." }
   { $examples
     { $example "USING: math.statistics prettyprint ;" "{ -2 2 } ste ." "2.0" }
     { $example "USING: math.statistics prettyprint ;" "{ -2 2 2 } ste ." "1.333333333333333" } } ;
 
 HELP: var
-{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
+{ $values { "seq" sequence } { "x" "a non-negative real number"} }
 { $description "Computes the variance of " { $snippet "seq" } ". It's a measurement of the spread of values in a sequence. The larger the variance, the larger the distance of values from the mean." }
 { $notes "If the number of elements in " { $snippet "seq" } " is 1 or less, it outputs 0." }
 { $examples
@@ -67,7 +77,7 @@ HELP: histogram
 }
 { $examples 
     { $example "! Count the number of times an element appears in a sequence."
-               "USING: prettyprint histogram ;"
+               "USING: prettyprint math.statistics ;"
                "\"aaabc\" histogram ."
                "H{ { 97 3 } { 98 1 } { 99 1 } }"
     }
@@ -81,7 +91,7 @@ HELP: histogram*
 }
 { $examples 
     { $example "! Count the number of times the elements of two sequences appear."
-               "USING: prettyprint histogram ;"
+               "USING: prettyprint math.statistics ;"
                "\"aaabc\" histogram \"aaaaaabc\" histogram* ."
                "H{ { 97 9 } { 98 2 } { 99 2 } }"
     }
@@ -95,7 +105,7 @@ HELP: sequence>assoc
 }
 { $examples 
     { $example "! Iterate over a sequence and increment the count at each element"
-               "USING: assocs prettyprint histogram ;"
+               "USING: assocs prettyprint math.statistics ;"
                "\"aaabc\" [ inc-at ] H{ } sequence>assoc ."
                "H{ { 97 3 } { 98 1 } { 99 1 } }"
     }
@@ -109,7 +119,7 @@ HELP: sequence>assoc*
 }
 { $examples 
     { $example "! Iterate over a sequence and add the counts to an existing assoc"
-               "USING: assocs prettyprint histogram kernel ;"
+               "USING: assocs prettyprint math.statistics kernel ;"
                "H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ inc-at ] sequence>assoc* ."
                "H{ { 97 5 } { 98 2 } { 99 1 } }"
     }
@@ -123,7 +133,7 @@ HELP: sequence>hashtable
 }
 { $examples 
     { $example "! Count the number of times an element occurs in a sequence"
-               "USING: assocs prettyprint histogram ;"
+               "USING: assocs prettyprint math.statistics ;"
                "\"aaabc\" [ inc-at ] sequence>hashtable ."
                "H{ { 97 3 } { 98 1 } { 99 1 } }"
     }
@@ -150,8 +160,8 @@ ARTICLE: "math.statistics" "Statistics"
 { $subsections median lower-median upper-median medians }
 "Computing the mode:"
 { $subsections mode }
-"Computing the standard deviation and variance:"
+"Computing the standard deviation, standard error, and variance:"
-{ $subsections std var }
+{ $subsections std ste var }
 "Computing the range and minimum and maximum elements:"
 { $subsections range minmax }
 "Computing the kth smallest element:"

basis/shuffle/shuffle-docs.factor

@@ -0,0 +1,5 @@
+USING: help.markup help.syntax ;
+IN: shuffle
+
+HELP: roll  $complex-shuffle ;
+HELP: -roll $complex-shuffle ;

basis/shuffle/shuffle-tests.factor

@@ -1,5 +1,10 @@
 USING: shuffle tools.test ;
+IN: shuffle.tests
 
 [ 1 2 3 4 ] [ 3 4 1 2 2swap ] unit-test
 
 [ 4 2 3 ] [ 1 2 3 4 shuffle( a b c d -- d b c ) ] unit-test
+
+[ 2 3 4 1 ] [ 1 2 3 4 roll ] unit-test
+[ 1 2 3 4 ] [ 2 3 4 1 -roll ] unit-test
+

basis/shuffle/shuffle.factor

@@ -22,6 +22,10 @@ MACRO: shuffle-effect ( effect -- )
 SYNTAX: shuffle(
     ")" parse-effect suffix! \ shuffle-effect suffix! ;
 
+: roll ( x y z t -- y z t x ) [ rot ] dip swap ; inline deprecated
+
+: -roll ( x y z t -- t x y z ) swap [ -rot ] dip ; inline deprecated
+
 : 2swap ( x y z t -- z t x y ) 2 2 mnswap ; inline
 
 : 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline

basis/stack-checker/stack-checker-tests.factor

@@ -7,7 +7,7 @@ sorting assocs definitions prettyprint io inspector
 classes.tuple classes.union classes.predicate debugger
 threads.private io.streams.string io.timeouts io.thread
 sequences.private destructors combinators eval locals.backend
-system compiler.units ;
+system compiler.units shuffle ;
 IN: stack-checker.tests
 
 [ 1234 infer ] must-fail

core/assocs/assocs.factor

@@ -202,6 +202,10 @@ M: sequence assoc-like
 M: sequence >alist ; inline
 
 ! Override sequence => assoc instance for f
+M: f at* 2drop f f ; inline
+
+M: f assoc-size drop 0 ; inline
+
 M: f clear-assoc drop ; inline
 
 M: f assoc-like drop dup assoc-empty? [ drop f ] when ; inline

core/growable/growable.factor

@@ -23,7 +23,7 @@ GENERIC: contract ( len seq -- )
 M: growable contract ( len seq -- )
     [ length ] keep
     [ [ 0 ] 2dip set-nth-unsafe ] curry
-    (each-integer) ;
+    (each-integer) ; inline
 
 : growable-check ( n seq -- n seq )
     over 0 < [ bounds-error ] when ; inline

core/kernel/kernel-docs.factor

@@ -27,8 +27,6 @@ HELP: -rot  ( x y z -- z x y ) $complex-shuffle ;
 HELP: dupd  ( x y -- x x y )   $complex-shuffle ;
 HELP: swapd ( x y z -- y x z ) $complex-shuffle ;
 HELP: tuck  ( x y -- y x y )   $complex-shuffle ;
-HELP: roll  $complex-shuffle ;
-HELP: -roll $complex-shuffle ;
 
 HELP: datastack ( -- ds )
 { $values { "ds" array } }
@@ -280,11 +278,6 @@ HELP: 3bi
         "[ p ] [ q ] 3bi"
         "3dup p q"
     }
-    "If " { $snippet "[ p ]" } " and " { $snippet "[ q ]" } " have stack effect " { $snippet "( x y z -- w )" } ", then the following two lines are equivalent:"
-    { $code
-        "[ p ] [ q ] 3bi"
-        "3dup p -roll q"
-    }
     "In general, the following two lines are equivalent:"
     { $code
         "[ p ] [ q ] 3bi"
@@ -835,8 +828,6 @@ $nl
     swapd
     rot
     -rot
-    roll
-    -roll
     spin
 } ;
 

core/kernel/kernel-tests.factor

@@ -48,9 +48,6 @@ IN: kernel.tests
 
 [ -7 <byte-array> ] must-fail
 
-[ 2 3 4 1 ] [ 1 2 3 4 roll ] unit-test
-[ 1 2 3 4 ] [ 2 3 4 1 -roll ] unit-test
-
 [ 3 ] [ t 3 and ] unit-test
 [ f ] [ f 3 and ] unit-test
 [ f ] [ 3 f and ] unit-test
@@ -113,7 +110,7 @@ IN: kernel.tests
     < [ [ 1 + ] 3dip (loop) ] [ 2drop 2drop ] if ; inline recursive
 
 : loop ( obj -- )
-    H{ } values swap [ dup length swap ] dip 0 -roll (loop) ;
+    H{ } values swap [ dup length swap ] dip [ 0 ] 3dip (loop) ;
 
 [ loop ] must-fail
 

core/kernel/kernel.factor

@@ -10,10 +10,6 @@ DEFER: 3dip
 ! Stack stuff
 : spin ( x y z -- z y x ) swap rot ; inline
 
-: roll ( x y z t -- y z t x ) [ rot ] dip swap ; inline
-
-: -roll ( x y z t -- t x y z ) swap [ -rot ] dip ; inline
-
 : 2over ( x y z -- x y z x y ) pick pick ; inline
 
 : clear ( -- ) { } set-datastack ;
@@ -63,9 +59,9 @@ DEFER: if
 
 : dip ( x quot -- x ) swap [ call ] dip ;
 
-: 2dip ( x y quot -- x y ) -rot [ call ] 2dip ;
+: 2dip ( x y quot -- x y ) swap [ dip ] dip ;
 
-: 3dip ( x y z quot -- x y z ) -roll [ call ] 3dip ;
+: 3dip ( x y z quot -- x y z ) swap [ 2dip ] dip ;
 
 : 4dip ( w x y z quot -- w x y z ) swap [ 3dip ] dip ; inline
 

core/math/math.factor

@@ -147,14 +147,16 @@ PRIVATE>
 
 : (find-integer) ( i n quot: ( i -- ? ) -- i )
     [
-        iterate-step roll
+        iterate-step
-        [ 2drop ] [ iterate-next (find-integer) ] if
+        [ [ ] ] 2dip
+        [ iterate-next (find-integer) ] 2curry bi-curry if
     ] [ 3drop f ] if-iterate? ; inline recursive
 
 : (all-integers?) ( i n quot: ( i -- ? ) -- ? )
     [
-        iterate-step roll
+        iterate-step
-        [ iterate-next (all-integers?) ] [ 3drop f ] if
+        [ iterate-next (all-integers?) ] 3curry
+        [ f ] if
     ] [ 3drop t ] if-iterate? ; inline recursive
 
 : each-integer ( n quot -- )

core/sequences/sequences.factor

@@ -270,29 +270,34 @@ ERROR: integer-length-expected obj ;
 : check-length ( n -- n )
     dup integer? [ integer-length-expected ] unless ; inline
 
-: ((copy)) ( dst i src j n -- )
+TUPLE: copy-state
-    dup -roll + swap nth-unsafe -roll + swap set-nth-unsafe ; inline
+    { src-i integer read-only }
+    { src sequence read-only }
+    { dst-i integer read-only }
+    { dst sequence read-only } ;
 
-: 5bi ( a b c d e x y -- )
+C: <copy> copy-state
-    bi-curry bi-curry bi-curry bi-curry bi ; inline
 
-: (copy) ( dst i src j n -- dst )
+: ((copy)) ( n copy -- )
-    dup 0 <= [ 2drop 2drop ] [ 1 - [ ((copy)) ] [ (copy) ] 5bi ] if ;
+    [ [ src-i>> + ] [ src>> ] bi nth-unsafe ]
+    [ [ dst-i>> + ] [ dst>> ] bi set-nth-unsafe ] 2bi ; inline
+
+: (copy) ( n copy -- dst )
+    over 0 <= [ nip dst>> ] [ [ 1 - ] dip [ ((copy)) ] [ (copy) ] 2bi ] if ;
     inline recursive
 
-: prepare-subseq ( from to seq -- dst i src j n )
+: subseq>copy ( from to seq -- n copy )
-    #! The check-length call forces partial dispatch
+    [ over - check-length swap ] dip
-    [ [ swap - ] dip new-sequence dup 0 ] 3keep
+    3dup nip new-sequence 0 swap <copy> ; inline
-    -rot drop roll length check-length ; inline
 
-: check-copy ( src n dst -- )
+: check-copy ( src n dst -- src n dst )
-    over 0 < [ bounds-error ] when
+    3dup over 0 < [ bounds-error ] when
     [ swap length + ] dip lengthen ; inline
 
 PRIVATE>
 
 : subseq ( from to seq -- subseq )
-    [ check-slice prepare-subseq (copy) ] keep like ;
+    [ check-slice subseq>copy (copy) ] keep like ;
 
 : head ( seq n -- headseq ) (head) subseq ;
 
@@ -308,8 +313,8 @@ PRIVATE>
 
 : copy ( src i dst -- )
     #! The check-length call forces partial dispatch
-    pick length check-length [ 3dup check-copy spin 0 ] dip
+    [ [ length check-length 0 ] keep ] 2dip
-    (copy) drop ; inline
+    check-copy <copy> (copy) drop ; inline
 
 M: sequence clone-like
     [ dup length ] dip new-sequence [ 0 swap copy ] keep ; inline

extra/bunny/model/model.factor

@@ -1,6 +1,6 @@
 USING: accessors alien.c-types arrays combinators destructors
 http.client io io.encodings.ascii io.files io.files.temp kernel
-math math.matrices math.parser math.vectors opengl
+locals math math.matrices math.parser math.vectors opengl
 opengl.capabilities opengl.gl opengl.demo-support sequences
 splitting vectors words specialized-arrays ;
 QUALIFIED-WITH: alien.c-types c
@@ -51,8 +51,11 @@ IN: bunny.model
         over download-to
     ] unless ;
 
-: (draw-triangle) ( ns vs triple -- )
+:: (draw-triangle) ( ns vs triple -- )
-    [ dup roll nth gl-normal swap nth gl-vertex ] with with each ;
+    triple [| elt |
+        elt ns nth gl-normal
+        elt vs nth gl-vertex
+    ] each ;
 
 : draw-triangles ( ns vs is -- )
     GL_TRIANGLES [ [ (draw-triangle) ] with with each ] do-state ;

extra/math/analysis/analysis-docs.factor

@@ -9,10 +9,6 @@ HELP: gammaln
 { $values { "x" number } { "gamma[x]" number } }
 { $description "An alternative to " { $link gamma } " when gamma(x)'s range varies too widely." } ;
 
-HELP: nth-root
-{ $values { "n" integer } { "x" number } { "y" number } }
-{ $description "Calculates the nth root of a number, such that " { $snippet "y^n=x" } "." } ;
-
 HELP: exp-int
 { $values { "x" number } { "y" number } }
 { $description "Exponential integral function." }

extra/math/quadratic/quadratic.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions ;
+USING: kernel locals math math.functions ;
 IN: math.quadratic
 
 : monic ( c b a -- c' b' ) tuck [ / ] 2bi@ ;
@@ -12,9 +12,7 @@ IN: math.quadratic
 : +- ( x y -- x+y x-y ) [ + ] [ - ] 2bi ;
 
 : quadratic ( c b a -- alpha beta )
-    #! Solve a quadratic equation ax^2 + bx + c = 0
     monic discriminant critical +- ;
 
-: qeval ( x c b a -- y )
+:: qeval ( x c b a -- y )
-    #! Evaluate ax^2 + bx + c
+    c b x * + a x sq * + ;
-    [ pick * ] dip roll sq * + + ;

extra/reports/noise/noise.factor

@@ -10,7 +10,6 @@ IN: reports.noise
 : badness ( word -- n )
     H{
         { -nrot 5 }
-        { -roll 4 }
         { -rot 3 }
         { bi@ 1 }
         { 2curry 1 }
@@ -54,7 +53,6 @@ IN: reports.noise
         { nwith 4 }
         { over 2 }
         { pick 4 }
-        { roll 4 }
         { rot 3 }
         { spin 3 }
         { swap 1 }

extra/spider/unique-deque/unique-deque.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs deques dlists kernel ;
+USING: accessors assocs deques dlists kernel locals ;
 IN: spider.unique-deque
 
 TUPLE: todo-url url depth ;
@@ -30,8 +30,9 @@ TUPLE: unique-deque assoc deque ;
 
 : peek-url ( unique-deque -- todo-url ) deque>> peek-front ;
 
-: slurp-deque-when ( deque quot1 quot2: ( value -- ) -- )
+:: slurp-deque-when ( deque quot1 quot2: ( value -- ) -- )
-    pick deque-empty? [ 3drop ] [
+    deque deque-empty? [
-        [ [ pop-front dup ] 2dip [ call ] dip [ t ] compose [ drop f ] if ]
+        deque pop-front dup quot1 call
-        [ roll [ slurp-deque-when ] [ 3drop ] if ] 3bi
+        [ quot2 call t ] [ drop f ] if
-    ] if ; inline recursive
+        [ deque quot1 quot2 slurp-deque-when ] when
+    ] unless ; inline recursive

extra/sudokus/sudokus.factor

@@ -2,7 +2,7 @@ USING: accessors arrays combinators.short-circuit grouping kernel lists
 lists.lazy locals math math.functions math.parser math.ranges
 models.product monads random sequences sets ui ui.gadgets.controls
 ui.gadgets.layout models.combinators ui.gadgets.alerts vectors fry
-ui.gadgets.labels ;
+ui.gadgets.labels shuffle ;
 IN: sudokus
 
 : row ( index -- row ) 1 + 9 / ceiling ;

extra/synth/synth.factor

@@ -16,7 +16,7 @@ MEMO: single-sine-wave ( samples/wave -- seq )
     [ sample-freq>> -rot sine-wave ] keep swap >>data ;
 
 : >silent-buffer ( seconds buffer -- buffer )
-    tuck sample-freq>> * >integer 0 <repetition> >>data ;
+    [ sample-freq>> * >integer 0 <repetition> ] [ (>>data) ] [ ] tri ;
 
 TUPLE: harmonic n amplitude ;
 C: <harmonic> harmonic
@@ -32,5 +32,5 @@ C: <note> note
     harmonic amplitude>> <scaled> ;
 
 : >note ( harmonics note buffer -- buffer )
-    dup -roll [ note-harmonic-data ] 2curry map <summed> >>data ;
+    [ [ note-harmonic-data ] 2curry map <summed> ] [ (>>data) ] [ ] tri ;