From 32a51b584c4404453dd6a52bd944908f8ae3e5ae Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Oct 2009 03:06:03 -0500 Subject: [PATCH 01/15] slightly better math.statistics docs --- basis/math/statistics/statistics-docs.factor | 42 +++++++++++++------- 1 file changed, 28 insertions(+), 14 deletions(-) diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor index dc54f4181f..3ce5a62b9a 100644 --- a/basis/math/statistics/statistics-docs.factor +++ b/basis/math/statistics/statistics-docs.factor @@ -1,57 +1,71 @@ 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." } { $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"} } -{ $description "Computes the arithmetic mean of all elements in " { $snippet "seq" } "." } +{ $values { "seq" sequence } { "x" "a non-negative real number"} } +{ $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"} } -{ $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." } +{ $values { "seq" sequence } { "x" "a non-negative real number"} } +{ $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"} } -{ $description "Computes the distance of the maximum and minimum values in " { $snippet "seq" } "." } +{ $values { "seq" sequence } { "x" "a non-negative real number"} } +{ $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 }" + } + { $example "USING: arrays math.statistics prettyprint ;" + "{ 1 2 3 4 } minmax 2array ." + "{ 1 4 }" + } +} ; + 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 @@ -150,8 +164,8 @@ ARTICLE: "math.statistics" "Statistics" { $subsections median lower-median upper-median medians } "Computing the mode:" { $subsections mode } -"Computing the standard deviation and variance:" -{ $subsections std var } +"Computing the standard deviation, standard error, and variance:" +{ $subsections std ste var } "Computing the range and minimum and maximum elements:" { $subsections range minmax } "Computing the kth smallest element:" From 44acd45f2aa2f1ab771a51c7510ee41d94e6f875 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Oct 2009 06:37:02 -0500 Subject: [PATCH 02/15] move docs for nth-root, fix docs for minmax --- basis/math/functions/functions-docs.factor | 6 ++++++ basis/math/statistics/statistics-docs.factor | 6 +----- extra/math/analysis/analysis-docs.factor | 4 ---- 3 files changed, 7 insertions(+), 9 deletions(-) diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor index 1939de4f97..5f7c066efa 100644 --- a/basis/math/functions/functions-docs.factor +++ b/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." } ; diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor index 3ce5a62b9a..9e812d94ca 100644 --- a/basis/math/statistics/statistics-docs.factor +++ b/basis/math/statistics/statistics-docs.factor @@ -4,7 +4,7 @@ IN: math.statistics HELP: geometric-mean { $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." } ; @@ -44,10 +44,6 @@ HELP: minmax "{ 1 2 3 } minmax 2array ." "{ 1 3 }" } - { $example "USING: arrays math.statistics prettyprint ;" - "{ 1 2 3 4 } minmax 2array ." - "{ 1 4 }" - } } ; HELP: std diff --git a/extra/math/analysis/analysis-docs.factor b/extra/math/analysis/analysis-docs.factor index a810ffc1bd..586a6d4971 100644 --- a/extra/math/analysis/analysis-docs.factor +++ b/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." } From 89a426d7971ba775a0cd94ea83ff9bceb05646a3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Oct 2009 13:35:20 -0500 Subject: [PATCH 03/15] fix help lint --- basis/help/lint/checks/checks.factor | 1 + basis/math/statistics/statistics-docs.factor | 10 +++++----- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor index dac3900cc9..340f9b16d3 100644 --- a/basis/help/lint/checks/checks.factor +++ b/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 diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor index 9e812d94ca..3b6e7d62ba 100644 --- a/basis/math/statistics/statistics-docs.factor +++ b/basis/math/statistics/statistics-docs.factor @@ -77,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 } }" } @@ -91,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 } }" } @@ -105,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 } }" } @@ -119,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 } }" } @@ -133,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 } }" } From 70ffa003ec151f669fa10a70d8e3a15c3a1fb60e Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Oct 2009 13:36:15 -0500 Subject: [PATCH 04/15] eliminate roll/-roll from core --- core/kernel/kernel-tests.factor | 2 +- core/math/math.factor | 10 ++++++---- core/sequences/sequences.factor | 9 +++++---- 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor index c8e0fcd2a9..024254663c 100644 --- a/core/kernel/kernel-tests.factor +++ b/core/kernel/kernel-tests.factor @@ -113,7 +113,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 diff --git a/core/math/math.factor b/core/math/math.factor index 8ef4f38f9a..c1a8ba32f7 100755 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -147,14 +147,16 @@ PRIVATE> : (find-integer) ( i n quot: ( i -- ? ) -- i ) [ - iterate-step roll - [ 2drop ] [ iterate-next (find-integer) ] if + iterate-step + [ [ ] ] 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-next (all-integers?) ] [ 3drop f ] if + iterate-step + [ iterate-next (all-integers?) ] 3curry + [ f ] if ] [ 3drop t ] if-iterate? ; inline recursive : each-integer ( n quot -- ) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 557c6603ee..d773c9e7d3 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -271,7 +271,8 @@ ERROR: integer-length-expected obj ; dup integer? [ integer-length-expected ] unless ; inline : ((copy)) ( dst i src j n -- ) - dup -roll + swap nth-unsafe -roll + swap set-nth-unsafe ; inline + [ + swap nth-unsafe [ ] curry 2dip ] keep + + swap set-nth-unsafe ; inline : 5bi ( a b c d e x y -- ) bi-curry bi-curry bi-curry bi-curry bi ; inline @@ -281,9 +282,9 @@ ERROR: integer-length-expected obj ; inline recursive : prepare-subseq ( from to seq -- dst i src j n ) - #! The check-length call forces partial dispatch - [ [ swap - ] dip new-sequence dup 0 ] 3keep - -rot drop roll length check-length ; inline + [ over - ] dip + [ new-sequence 0 rot ] 2keep + [ ] curry 2dip check-length ; inline : check-copy ( src n dst -- ) over 0 < [ bounds-error ] when From 2bc75e390aa9cfd8e824963a9f74fb7ffbbe141e Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Oct 2009 13:46:43 -0500 Subject: [PATCH 05/15] move adsoda to unmaintained --- {extra => unmaintained}/adsoda/adsoda-docs.factor | 0 {extra => unmaintained}/adsoda/adsoda-tests.factor | 0 {extra => unmaintained}/adsoda/adsoda.factor | 0 {extra => unmaintained}/adsoda/adsoda.tests | 0 {extra => unmaintained}/adsoda/authors.txt | 0 {extra => unmaintained}/adsoda/combinators/authors.txt | 0 .../adsoda/combinators/combinators-docs.factor | 0 .../adsoda/combinators/combinators-tests.factor | 0 {extra => unmaintained}/adsoda/combinators/combinators.factor | 0 {extra => unmaintained}/adsoda/solution2/solution2.factor | 0 {extra => unmaintained}/adsoda/solution2/summary.txt | 0 {extra => unmaintained}/adsoda/summary.txt | 0 {extra => unmaintained}/adsoda/tags.txt | 0 {extra => unmaintained}/adsoda/tools/authors.txt | 0 {extra => unmaintained}/adsoda/tools/tools-docs.factor | 0 {extra => unmaintained}/adsoda/tools/tools-tests.factor | 0 {extra => unmaintained}/adsoda/tools/tools.factor | 0 17 files changed, 0 insertions(+), 0 deletions(-) rename {extra => unmaintained}/adsoda/adsoda-docs.factor (100%) rename {extra => unmaintained}/adsoda/adsoda-tests.factor (100%) rename {extra => unmaintained}/adsoda/adsoda.factor (100%) rename {extra => unmaintained}/adsoda/adsoda.tests (100%) rename {extra => unmaintained}/adsoda/authors.txt (100%) rename {extra => unmaintained}/adsoda/combinators/authors.txt (100%) rename {extra => unmaintained}/adsoda/combinators/combinators-docs.factor (100%) rename {extra => unmaintained}/adsoda/combinators/combinators-tests.factor (100%) rename {extra => unmaintained}/adsoda/combinators/combinators.factor (100%) rename {extra => unmaintained}/adsoda/solution2/solution2.factor (100%) rename {extra => unmaintained}/adsoda/solution2/summary.txt (100%) rename {extra => unmaintained}/adsoda/summary.txt (100%) rename {extra => unmaintained}/adsoda/tags.txt (100%) rename {extra => unmaintained}/adsoda/tools/authors.txt (100%) rename {extra => unmaintained}/adsoda/tools/tools-docs.factor (100%) rename {extra => unmaintained}/adsoda/tools/tools-tests.factor (100%) rename {extra => unmaintained}/adsoda/tools/tools.factor (100%) diff --git a/extra/adsoda/adsoda-docs.factor b/unmaintained/adsoda/adsoda-docs.factor similarity index 100% rename from extra/adsoda/adsoda-docs.factor rename to unmaintained/adsoda/adsoda-docs.factor diff --git a/extra/adsoda/adsoda-tests.factor b/unmaintained/adsoda/adsoda-tests.factor similarity index 100% rename from extra/adsoda/adsoda-tests.factor rename to unmaintained/adsoda/adsoda-tests.factor diff --git a/extra/adsoda/adsoda.factor b/unmaintained/adsoda/adsoda.factor similarity index 100% rename from extra/adsoda/adsoda.factor rename to unmaintained/adsoda/adsoda.factor diff --git a/extra/adsoda/adsoda.tests b/unmaintained/adsoda/adsoda.tests similarity index 100% rename from extra/adsoda/adsoda.tests rename to unmaintained/adsoda/adsoda.tests diff --git a/extra/adsoda/authors.txt b/unmaintained/adsoda/authors.txt similarity index 100% rename from extra/adsoda/authors.txt rename to unmaintained/adsoda/authors.txt diff --git a/extra/adsoda/combinators/authors.txt b/unmaintained/adsoda/combinators/authors.txt similarity index 100% rename from extra/adsoda/combinators/authors.txt rename to unmaintained/adsoda/combinators/authors.txt diff --git a/extra/adsoda/combinators/combinators-docs.factor b/unmaintained/adsoda/combinators/combinators-docs.factor similarity index 100% rename from extra/adsoda/combinators/combinators-docs.factor rename to unmaintained/adsoda/combinators/combinators-docs.factor diff --git a/extra/adsoda/combinators/combinators-tests.factor b/unmaintained/adsoda/combinators/combinators-tests.factor similarity index 100% rename from extra/adsoda/combinators/combinators-tests.factor rename to unmaintained/adsoda/combinators/combinators-tests.factor diff --git a/extra/adsoda/combinators/combinators.factor b/unmaintained/adsoda/combinators/combinators.factor similarity index 100% rename from extra/adsoda/combinators/combinators.factor rename to unmaintained/adsoda/combinators/combinators.factor diff --git a/extra/adsoda/solution2/solution2.factor b/unmaintained/adsoda/solution2/solution2.factor similarity index 100% rename from extra/adsoda/solution2/solution2.factor rename to unmaintained/adsoda/solution2/solution2.factor diff --git a/extra/adsoda/solution2/summary.txt b/unmaintained/adsoda/solution2/summary.txt similarity index 100% rename from extra/adsoda/solution2/summary.txt rename to unmaintained/adsoda/solution2/summary.txt diff --git a/extra/adsoda/summary.txt b/unmaintained/adsoda/summary.txt similarity index 100% rename from extra/adsoda/summary.txt rename to unmaintained/adsoda/summary.txt diff --git a/extra/adsoda/tags.txt b/unmaintained/adsoda/tags.txt similarity index 100% rename from extra/adsoda/tags.txt rename to unmaintained/adsoda/tags.txt diff --git a/extra/adsoda/tools/authors.txt b/unmaintained/adsoda/tools/authors.txt similarity index 100% rename from extra/adsoda/tools/authors.txt rename to unmaintained/adsoda/tools/authors.txt diff --git a/extra/adsoda/tools/tools-docs.factor b/unmaintained/adsoda/tools/tools-docs.factor similarity index 100% rename from extra/adsoda/tools/tools-docs.factor rename to unmaintained/adsoda/tools/tools-docs.factor diff --git a/extra/adsoda/tools/tools-tests.factor b/unmaintained/adsoda/tools/tools-tests.factor similarity index 100% rename from extra/adsoda/tools/tools-tests.factor rename to unmaintained/adsoda/tools/tools-tests.factor diff --git a/extra/adsoda/tools/tools.factor b/unmaintained/adsoda/tools/tools.factor similarity index 100% rename from extra/adsoda/tools/tools.factor rename to unmaintained/adsoda/tools/tools.factor From cac1778bd0bd1668e3c67301e07ce743fe912802 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Oct 2009 14:14:24 -0500 Subject: [PATCH 06/15] remove most uses of roll/-roll from extra --- extra/bunny/model/model.factor | 9 ++++++--- extra/math/quadratic/quadratic.factor | 8 +++----- extra/spider/unique-deque/unique-deque.factor | 13 +++++++------ extra/synth/synth.factor | 4 ++-- 4 files changed, 18 insertions(+), 16 deletions(-) diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index d80f3aa98a..b9923d5976 100755 --- a/extra/bunny/model/model.factor +++ b/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 -- ) - [ dup roll nth gl-normal swap nth gl-vertex ] with with each ; +:: (draw-triangle) ( ns vs triple -- ) + 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 ; diff --git a/extra/math/quadratic/quadratic.factor b/extra/math/quadratic/quadratic.factor index 60929b92cb..e4642a863b 100644 --- a/extra/math/quadratic/quadratic.factor +++ b/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 ) - #! Evaluate ax^2 + bx + c - [ pick * ] dip roll sq * + + ; +:: qeval ( x c b a -- y ) + c b x * + a x sq * + ; diff --git a/extra/spider/unique-deque/unique-deque.factor b/extra/spider/unique-deque/unique-deque.factor index b4bbc9fbf8..9003b56b15 100644 --- a/extra/spider/unique-deque/unique-deque.factor +++ b/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 -- ) -- ) - pick deque-empty? [ 3drop ] [ - [ [ pop-front dup ] 2dip [ call ] dip [ t ] compose [ drop f ] if ] - [ roll [ slurp-deque-when ] [ 3drop ] if ] 3bi - ] if ; inline recursive +:: slurp-deque-when ( deque quot1 quot2: ( value -- ) -- ) + deque deque-empty? [ + deque pop-front dup quot1 call + [ quot2 call t ] [ drop f ] if + [ deque quot1 quot2 slurp-deque-when ] when + ] unless ; inline recursive diff --git a/extra/synth/synth.factor b/extra/synth/synth.factor index be1e5943af..def610d356 100644 --- a/extra/synth/synth.factor +++ b/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 >>data ; + [ sample-freq>> * >integer 0 ] [ (>>data) ] [ ] tri ; TUPLE: harmonic n amplitude ; C: harmonic @@ -32,5 +32,5 @@ C: note harmonic amplitude>> ; : >note ( harmonics note buffer -- buffer ) - dup -roll [ note-harmonic-data ] 2curry map >>data ; + [ [ note-harmonic-data ] 2curry map ] [ (>>data) ] [ ] tri ; From 9624b0c5c3c85f9f05b9d4ccab4d43d8740f1135 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Oct 2009 15:22:14 -0500 Subject: [PATCH 07/15] add inlinable assoc methods on f --- core/assocs/assocs.factor | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 6b66a79358..e441855ed1 100755 --- a/core/assocs/assocs.factor +++ b/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 From 3f15e028f7e2f962b33fca8693ea527784be0949 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Oct 2009 17:11:45 -0500 Subject: [PATCH 08/15] exile roll and -roll to basis/shuffle and mark them deprecated --- basis/bootstrap/compiler/compiler.factor | 2 +- basis/compiler/tests/optimizer.factor | 4 ++-- basis/compiler/tree/dead-code/dead-code-tests.factor | 2 +- basis/shuffle/shuffle-docs.factor | 5 +++++ basis/shuffle/shuffle-tests.factor | 5 +++++ basis/shuffle/shuffle.factor | 4 ++++ core/kernel/kernel-docs.factor | 9 --------- core/kernel/kernel-tests.factor | 3 --- core/kernel/kernel.factor | 8 ++------ extra/reports/noise/noise.factor | 2 -- extra/sudokus/sudokus.factor | 4 ++-- 11 files changed, 22 insertions(+), 26 deletions(-) create mode 100644 basis/shuffle/shuffle-docs.factor diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor index 4c96ed4000..e401f85f6e 100755 --- a/basis/bootstrap/compiler/compiler.factor +++ b/basis/bootstrap/compiler/compiler.factor @@ -4,7 +4,7 @@ USING: accessors cpu.architecture vocabs.loader system sequences namespaces parser kernel kernel.private classes classes.private arrays hashtables vectors classes.tuple sbufs hashtables.private sequences.private math classes.tuple.private -growable namespaces.private assocs words command-line vocabs io +growable namespaces.private shuffle assocs words command-line vocabs io io.encodings.string libc splitting math.parser memory compiler.units math.order quotations quotations.private assocs.private ; FROM: compiler => enable-optimizer ; diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index 3a0fada735..32f5750cd3 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/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 ) @@ -446,4 +446,4 @@ M: object bad-dispatch-position-test* ; [ 1024 bignum ] [ 10 [ 1 >bignum swap >fixnum shift ] compile-call dup class ] unit-test ! Not sure if I want to fix this... -! [ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with \ No newline at end of file +! [ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor index ed4df91eec..d859096e1d 100644 --- a/basis/compiler/tree/dead-code/dead-code-tests.factor +++ b/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 ) diff --git a/basis/shuffle/shuffle-docs.factor b/basis/shuffle/shuffle-docs.factor new file mode 100644 index 0000000000..15398450a7 --- /dev/null +++ b/basis/shuffle/shuffle-docs.factor @@ -0,0 +1,5 @@ +USING: help.markup help.syntax ; +IN: shuffle + +HELP: roll $complex-shuffle ; +HELP: -roll $complex-shuffle ; diff --git a/basis/shuffle/shuffle-tests.factor b/basis/shuffle/shuffle-tests.factor index e091af2d06..4165efdcfd 100644 --- a/basis/shuffle/shuffle-tests.factor +++ b/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 + diff --git a/basis/shuffle/shuffle.factor b/basis/shuffle/shuffle.factor index 079e81d082..43c0b75be1 100644 --- a/basis/shuffle/shuffle.factor +++ b/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 diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index b837c0a3ff..f7ae292630 100644 --- a/core/kernel/kernel-docs.factor +++ b/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 } ; diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor index 024254663c..d9babb5fd7 100644 --- a/core/kernel/kernel-tests.factor +++ b/core/kernel/kernel-tests.factor @@ -48,9 +48,6 @@ IN: kernel.tests [ -7 ] 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 diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 6538109687..22c96c4318 100644 --- a/core/kernel/kernel.factor +++ b/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 diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor index cae2c20877..9eb2804b42 100755 --- a/extra/reports/noise/noise.factor +++ b/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 } diff --git a/extra/sudokus/sudokus.factor b/extra/sudokus/sudokus.factor index 9de9a6fe7c..ff20f15204 100644 --- a/extra/sudokus/sudokus.factor +++ b/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 ; @@ -37,4 +37,4 @@ IN: sudokus ] with-self , ] { 280 220 } >>pref-dim "Sudoku Sleuth" open-window ] with-ui ; -MAIN: do-sudoku \ No newline at end of file +MAIN: do-sudoku From 6bcd6c68dde029a7017b747a7c245c65243f4f9c Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Oct 2009 18:00:47 -0500 Subject: [PATCH 09/15] no need to pre-compile roll/-roll since they're not used in core or basis anymore --- basis/bootstrap/compiler/compiler.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor index e401f85f6e..3b7848251b 100755 --- a/basis/bootstrap/compiler/compiler.factor +++ b/basis/bootstrap/compiler/compiler.factor @@ -4,7 +4,7 @@ USING: accessors cpu.architecture vocabs.loader system sequences namespaces parser kernel kernel.private classes classes.private arrays hashtables vectors classes.tuple sbufs hashtables.private sequences.private math classes.tuple.private -growable namespaces.private shuffle assocs words command-line vocabs io +growable namespaces.private assocs words command-line vocabs io io.encodings.string libc splitting math.parser memory compiler.units math.order quotations quotations.private assocs.private ; FROM: compiler => enable-optimizer ; @@ -49,7 +49,7 @@ gc { not ? - 2over roll -roll + 2over array? hashtable? vector? tuple? sbuf? tombstone? From 3af35364043b0a435519b17436b31d9723134ff3 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Oct 2009 19:39:46 -0500 Subject: [PATCH 10/15] clean up copy implementation for real --- core/sequences/sequences.factor | 36 ++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index d773c9e7d3..8400a6b7e7 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -270,30 +270,34 @@ ERROR: integer-length-expected obj ; : check-length ( n -- n ) dup integer? [ integer-length-expected ] unless ; inline -: ((copy)) ( dst i src j n -- ) - [ + swap nth-unsafe [ ] curry 2dip ] keep - + swap set-nth-unsafe ; inline +TUPLE: copy-state + { 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 -- ) - bi-curry bi-curry bi-curry bi-curry bi ; inline +C: copy-state -: (copy) ( dst i src j n -- dst ) - dup 0 <= [ 2drop 2drop ] [ 1 - [ ((copy)) ] [ (copy) ] 5bi ] if ; +: ((copy)) ( n copy -- ) + [ [ 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 ) - [ over - ] dip - [ new-sequence 0 rot ] 2keep - [ ] curry 2dip check-length ; inline +: subseq>copy ( from to seq -- n copy ) + [ over - check-length swap ] dip + 3dup nip new-sequence 0 swap ; inline -: check-copy ( src n dst -- ) - over 0 < [ bounds-error ] when +: check-copy ( src n dst -- src n dst ) + 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 ; @@ -309,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 - (copy) drop ; inline + [ [ length check-length 0 ] keep ] 2dip + check-copy (copy) drop ; inline M: sequence clone-like [ dup length ] dip new-sequence [ 0 swap copy ] keep ; inline From d72fa710bc3d6cd1d58919bc06558699cb8a3319 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Oct 2009 20:46:29 -0500 Subject: [PATCH 11/15] move 4DNav to unmaintained since it depends on adsoda --- {extra => unmaintained}/4DNav/4DNav-docs.factor | 0 {extra => unmaintained}/4DNav/4DNav.factor | 0 {extra => unmaintained}/4DNav/authors.txt | 0 {extra => unmaintained}/4DNav/camera/authors.txt | 0 {extra => unmaintained}/4DNav/camera/camera-docs.factor | 0 {extra => unmaintained}/4DNav/camera/camera.factor | 0 {extra => unmaintained}/4DNav/deep/deep-docs.factor | 0 {extra => unmaintained}/4DNav/deep/deep.factor | 0 {extra => unmaintained}/4DNav/deploy.factor | 0 {extra => unmaintained}/4DNav/file-chooser/authors.txt | 0 {extra => unmaintained}/4DNav/file-chooser/file-chooser.factor | 0 {extra => unmaintained}/4DNav/hypercube.xml | 0 {extra => unmaintained}/4DNav/light_test.xml | 0 {extra => unmaintained}/4DNav/multi solids.xml | 0 {extra => unmaintained}/4DNav/prismetriagone.xml | 0 {extra => unmaintained}/4DNav/space-file-decoder/authors.txt | 0 .../4DNav/space-file-decoder/space-file-decoder-docs.factor | 0 .../4DNav/space-file-decoder/space-file-decoder.factor | 0 {extra => unmaintained}/4DNav/summary.txt | 0 {extra => unmaintained}/4DNav/tags.txt | 0 {extra => unmaintained}/4DNav/triancube.xml | 0 {extra => unmaintained}/4DNav/turtle/authors.txt | 0 {extra => unmaintained}/4DNav/turtle/turtle-docs.factor | 0 {extra => unmaintained}/4DNav/turtle/turtle.factor | 0 {extra => unmaintained}/4DNav/window3D/authors.txt | 0 {extra => unmaintained}/4DNav/window3D/window3D-docs.factor | 0 {extra => unmaintained}/4DNav/window3D/window3D.factor | 0 27 files changed, 0 insertions(+), 0 deletions(-) rename {extra => unmaintained}/4DNav/4DNav-docs.factor (100%) rename {extra => unmaintained}/4DNav/4DNav.factor (100%) rename {extra => unmaintained}/4DNav/authors.txt (100%) rename {extra => unmaintained}/4DNav/camera/authors.txt (100%) rename {extra => unmaintained}/4DNav/camera/camera-docs.factor (100%) rename {extra => unmaintained}/4DNav/camera/camera.factor (100%) rename {extra => unmaintained}/4DNav/deep/deep-docs.factor (100%) rename {extra => unmaintained}/4DNav/deep/deep.factor (100%) rename {extra => unmaintained}/4DNav/deploy.factor (100%) rename {extra => unmaintained}/4DNav/file-chooser/authors.txt (100%) rename {extra => unmaintained}/4DNav/file-chooser/file-chooser.factor (100%) rename {extra => unmaintained}/4DNav/hypercube.xml (100%) rename {extra => unmaintained}/4DNav/light_test.xml (100%) rename {extra => unmaintained}/4DNav/multi solids.xml (100%) rename {extra => unmaintained}/4DNav/prismetriagone.xml (100%) rename {extra => unmaintained}/4DNav/space-file-decoder/authors.txt (100%) rename {extra => unmaintained}/4DNav/space-file-decoder/space-file-decoder-docs.factor (100%) rename {extra => unmaintained}/4DNav/space-file-decoder/space-file-decoder.factor (100%) rename {extra => unmaintained}/4DNav/summary.txt (100%) rename {extra => unmaintained}/4DNav/tags.txt (100%) rename {extra => unmaintained}/4DNav/triancube.xml (100%) rename {extra => unmaintained}/4DNav/turtle/authors.txt (100%) rename {extra => unmaintained}/4DNav/turtle/turtle-docs.factor (100%) rename {extra => unmaintained}/4DNav/turtle/turtle.factor (100%) rename {extra => unmaintained}/4DNav/window3D/authors.txt (100%) rename {extra => unmaintained}/4DNav/window3D/window3D-docs.factor (100%) rename {extra => unmaintained}/4DNav/window3D/window3D.factor (100%) diff --git a/extra/4DNav/4DNav-docs.factor b/unmaintained/4DNav/4DNav-docs.factor similarity index 100% rename from extra/4DNav/4DNav-docs.factor rename to unmaintained/4DNav/4DNav-docs.factor diff --git a/extra/4DNav/4DNav.factor b/unmaintained/4DNav/4DNav.factor similarity index 100% rename from extra/4DNav/4DNav.factor rename to unmaintained/4DNav/4DNav.factor diff --git a/extra/4DNav/authors.txt b/unmaintained/4DNav/authors.txt similarity index 100% rename from extra/4DNav/authors.txt rename to unmaintained/4DNav/authors.txt diff --git a/extra/4DNav/camera/authors.txt b/unmaintained/4DNav/camera/authors.txt similarity index 100% rename from extra/4DNav/camera/authors.txt rename to unmaintained/4DNav/camera/authors.txt diff --git a/extra/4DNav/camera/camera-docs.factor b/unmaintained/4DNav/camera/camera-docs.factor similarity index 100% rename from extra/4DNav/camera/camera-docs.factor rename to unmaintained/4DNav/camera/camera-docs.factor diff --git a/extra/4DNav/camera/camera.factor b/unmaintained/4DNav/camera/camera.factor similarity index 100% rename from extra/4DNav/camera/camera.factor rename to unmaintained/4DNav/camera/camera.factor diff --git a/extra/4DNav/deep/deep-docs.factor b/unmaintained/4DNav/deep/deep-docs.factor similarity index 100% rename from extra/4DNav/deep/deep-docs.factor rename to unmaintained/4DNav/deep/deep-docs.factor diff --git a/extra/4DNav/deep/deep.factor b/unmaintained/4DNav/deep/deep.factor similarity index 100% rename from extra/4DNav/deep/deep.factor rename to unmaintained/4DNav/deep/deep.factor diff --git a/extra/4DNav/deploy.factor b/unmaintained/4DNav/deploy.factor similarity index 100% rename from extra/4DNav/deploy.factor rename to unmaintained/4DNav/deploy.factor diff --git a/extra/4DNav/file-chooser/authors.txt b/unmaintained/4DNav/file-chooser/authors.txt similarity index 100% rename from extra/4DNav/file-chooser/authors.txt rename to unmaintained/4DNav/file-chooser/authors.txt diff --git a/extra/4DNav/file-chooser/file-chooser.factor b/unmaintained/4DNav/file-chooser/file-chooser.factor similarity index 100% rename from extra/4DNav/file-chooser/file-chooser.factor rename to unmaintained/4DNav/file-chooser/file-chooser.factor diff --git a/extra/4DNav/hypercube.xml b/unmaintained/4DNav/hypercube.xml similarity index 100% rename from extra/4DNav/hypercube.xml rename to unmaintained/4DNav/hypercube.xml diff --git a/extra/4DNav/light_test.xml b/unmaintained/4DNav/light_test.xml similarity index 100% rename from extra/4DNav/light_test.xml rename to unmaintained/4DNav/light_test.xml diff --git a/extra/4DNav/multi solids.xml b/unmaintained/4DNav/multi solids.xml similarity index 100% rename from extra/4DNav/multi solids.xml rename to unmaintained/4DNav/multi solids.xml diff --git a/extra/4DNav/prismetriagone.xml b/unmaintained/4DNav/prismetriagone.xml similarity index 100% rename from extra/4DNav/prismetriagone.xml rename to unmaintained/4DNav/prismetriagone.xml diff --git a/extra/4DNav/space-file-decoder/authors.txt b/unmaintained/4DNav/space-file-decoder/authors.txt similarity index 100% rename from extra/4DNav/space-file-decoder/authors.txt rename to unmaintained/4DNav/space-file-decoder/authors.txt diff --git a/extra/4DNav/space-file-decoder/space-file-decoder-docs.factor b/unmaintained/4DNav/space-file-decoder/space-file-decoder-docs.factor similarity index 100% rename from extra/4DNav/space-file-decoder/space-file-decoder-docs.factor rename to unmaintained/4DNav/space-file-decoder/space-file-decoder-docs.factor diff --git a/extra/4DNav/space-file-decoder/space-file-decoder.factor b/unmaintained/4DNav/space-file-decoder/space-file-decoder.factor similarity index 100% rename from extra/4DNav/space-file-decoder/space-file-decoder.factor rename to unmaintained/4DNav/space-file-decoder/space-file-decoder.factor diff --git a/extra/4DNav/summary.txt b/unmaintained/4DNav/summary.txt similarity index 100% rename from extra/4DNav/summary.txt rename to unmaintained/4DNav/summary.txt diff --git a/extra/4DNav/tags.txt b/unmaintained/4DNav/tags.txt similarity index 100% rename from extra/4DNav/tags.txt rename to unmaintained/4DNav/tags.txt diff --git a/extra/4DNav/triancube.xml b/unmaintained/4DNav/triancube.xml similarity index 100% rename from extra/4DNav/triancube.xml rename to unmaintained/4DNav/triancube.xml diff --git a/extra/4DNav/turtle/authors.txt b/unmaintained/4DNav/turtle/authors.txt similarity index 100% rename from extra/4DNav/turtle/authors.txt rename to unmaintained/4DNav/turtle/authors.txt diff --git a/extra/4DNav/turtle/turtle-docs.factor b/unmaintained/4DNav/turtle/turtle-docs.factor similarity index 100% rename from extra/4DNav/turtle/turtle-docs.factor rename to unmaintained/4DNav/turtle/turtle-docs.factor diff --git a/extra/4DNav/turtle/turtle.factor b/unmaintained/4DNav/turtle/turtle.factor similarity index 100% rename from extra/4DNav/turtle/turtle.factor rename to unmaintained/4DNav/turtle/turtle.factor diff --git a/extra/4DNav/window3D/authors.txt b/unmaintained/4DNav/window3D/authors.txt similarity index 100% rename from extra/4DNav/window3D/authors.txt rename to unmaintained/4DNav/window3D/authors.txt diff --git a/extra/4DNav/window3D/window3D-docs.factor b/unmaintained/4DNav/window3D/window3D-docs.factor similarity index 100% rename from extra/4DNav/window3D/window3D-docs.factor rename to unmaintained/4DNav/window3D/window3D-docs.factor diff --git a/extra/4DNav/window3D/window3D.factor b/unmaintained/4DNav/window3D/window3D.factor similarity index 100% rename from extra/4DNav/window3D/window3D.factor rename to unmaintained/4DNav/window3D/window3D.factor From 32450a0575e5c4da9ff100ee0a90e9820033b184 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Oct 2009 20:49:09 -0500 Subject: [PATCH 12/15] add missing USING: to stack-checker tests --- basis/stack-checker/stack-checker-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 8fee8df538..414bcaaffe 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/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 From 8d613a8c9ae0dd09789b5fc391843897006a5361 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 30 Oct 2009 20:53:18 -0500 Subject: [PATCH 13/15] bootstrap.image: small speedup --- basis/bootstrap/image/image.factor | 39 +++++++++++++++--------------- 1 file changed, 19 insertions(+), 20 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 567a3b8bfd..421a7d2ecd 100644 --- a/basis/bootstrap/image/image.factor +++ b/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 -io io.binary io.files io.encodings.binary io.pathnames kernel -kernel.private math namespaces make parser prettyprint sequences -strings sbufs vectors words quotations assocs system layouts splitting -grouping growable classes classes.builtin classes.tuple -classes.tuple.private vocabs vocabs.loader source-files definitions -debugger quotations.private combinators math.order math.private -accessors slots.private generic.single.private compiler.units -compiler.constants fry bootstrap.image.syntax ; +USING: alien arrays byte-arrays generic hashtables +hashtables.private io io.binary io.files io.encodings.binary +io.pathnames kernel kernel.private math namespaces make parser +prettyprint sequences strings sbufs vectors words quotations +assocs system layouts splitting grouping growable classes +classes.builtin classes.tuple classes.tuple.private vocabs +vocabs.loader source-files definitions debugger +quotations.private combinators combinators.short-circuit +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 @@ -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?) - over float? [ fp-bitwise= ] [ 2drop f ] if ; +M: bignum (eql?) = ; -M: sequence (eql?) - over sequence? [ - 2dup [ length ] bi@ = - [ [ eql? ] 2all? ] [ 2drop f ] if - ] [ 2drop f ] if ; +M: float (eql?) fp-bitwise= ; + +M: sequence (eql?) 2dup [ length ] bi@ = [ [ eql? ] 2all? ] [ 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 From 888fcdb5f87dc454264fbea8b90210160ada8f5e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 30 Oct 2009 20:53:32 -0500 Subject: [PATCH 14/15] debugger: use short. rather than . to print errors if inspector is not loaded --- basis/debugger/debugger.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 2920421e6b..690e631e81 100644 --- a/basis/debugger/debugger.factor +++ b/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 ; From 0d24e65e4e18717a89606daa0b403675a50c131d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 30 Oct 2009 20:53:47 -0500 Subject: [PATCH 15/15] growable: M\ growable contract should be declared inline, fixes performance regression on stack benchmark --- core/growable/growable.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/growable/growable.factor b/core/growable/growable.factor index 2ca11e2e24..3d5f16d7f1 100644 --- a/core/growable/growable.factor +++ b/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