diff --git a/basis/compiler/cfg/linearization/order/order-tests.factor b/basis/compiler/cfg/linearization/order/order-tests.factor index 34eaeffd9a..67fb55f507 100644 --- a/basis/compiler/cfg/linearization/order/order-tests.factor +++ b/basis/compiler/cfg/linearization/order/order-tests.factor @@ -1,5 +1,5 @@ USING: compiler.cfg.debugger compiler.cfg compiler.cfg.linearization.order -kernel accessors sequences sets tools.test ; +kernel accessors sequences sets tools.test namespaces ; IN: compiler.cfg.linearization.order.tests V{ } 0 test-bb diff --git a/basis/compiler/tests/low-level-ir.factor b/basis/compiler/tests/low-level-ir.factor index e2fc26e94b..76d7e6de42 100644 --- a/basis/compiler/tests/low-level-ir.factor +++ b/basis/compiler/tests/low-level-ir.factor @@ -18,7 +18,7 @@ IN: compiler.tests.low-level-ir compile-cfg ; : compile-test-bb ( insns -- result ) - V{ T{ ##prologue } T{ ##branch } } 0 test-bb + V{ T{ ##prologue } T{ ##branch } } [ clone ] map 0 test-bb V{ T{ ##inc-d f 1 } T{ ##replace f 0 D 0 } @@ -73,7 +73,7 @@ IN: compiler.tests.low-level-ir [ t ] [ V{ T{ ##load-reference f 0 { t f t } } - T{ ##slot-imm f 0 0 2 $[ array tag-number ] 2 } + T{ ##slot-imm f 0 0 2 $[ array tag-number ] } } compile-test-bb ] unit-test diff --git a/basis/compiler/tree/propagation/branches/branches.factor b/basis/compiler/tree/propagation/branches/branches.factor index f2613022fc..b8861a6292 100755 --- a/basis/compiler/tree/propagation/branches/branches.factor +++ b/basis/compiler/tree/propagation/branches/branches.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: fry kernel sequences assocs accessors namespaces math.intervals arrays classes.algebra combinators columns -stack-checker.branches +stack-checker.branches locals compiler.utilities compiler.tree compiler.tree.combinators @@ -82,6 +82,13 @@ M: #phi propagate-before ( #phi -- ) [ [ phi-info-d>> flip ] [ out-d>> ] bi merge-value-infos ] bi ; +:: update-constraints ( new old -- ) + new [| key value | key old [ value append ] change-at ] assoc-each ; + +: include-child-constraints ( i -- ) + infer-children-data get nth constraints swap at last + constraints get last update-constraints ; + : branch-phi-constraints ( output values booleans -- ) { { @@ -116,22 +123,24 @@ M: #phi propagate-before ( #phi -- ) swap t--> ] } - ! { - ! { { t f } { } } - ! [ B - ! first - ! [ [ =t ] bi@ <--> ] - ! [ [ =f ] bi@ <--> ] 2bi /\ - ! ] - ! } - ! { - ! { { } { t f } } - ! [ - ! second - ! [ [ =t ] bi@ <--> ] - ! [ [ =f ] bi@ <--> ] 2bi /\ - ! ] - ! } + { + { { t f } { } } + [ + first + [ [ =t ] bi@ <--> ] + [ [ =f ] bi@ <--> ] 2bi /\ + 0 include-child-constraints + ] + } + { + { { } { t f } } + [ + second + [ [ =t ] bi@ <--> ] + [ [ =f ] bi@ <--> ] 2bi /\ + 1 include-child-constraints + ] + } [ 3drop f ] } case assume ; @@ -146,9 +155,6 @@ M: #phi propagate-after ( #phi -- ) ] 3each ] [ drop ] if ; -M: #phi propagate-around ( #phi -- ) - [ propagate-before ] [ propagate-after ] bi ; - M: #branch propagate-around dup live-branches >>live-branches [ infer-children ] [ annotate-node ] bi ; diff --git a/basis/compiler/tree/propagation/constraints/constraints.factor b/basis/compiler/tree/propagation/constraints/constraints.factor index 31f6cea148..59c9912e47 100644 --- a/basis/compiler/tree/propagation/constraints/constraints.factor +++ b/basis/compiler/tree/propagation/constraints/constraints.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs math math.intervals kernel accessors sequences namespaces classes classes.algebra -combinators words +combinators words combinators.short-circuit compiler.tree compiler.tree.propagation.info compiler.tree.propagation.copy ; @@ -28,15 +28,19 @@ M: object satisfied? drop f ; ! Boolean constraints TUPLE: true-constraint value ; -: =t ( value -- constriant ) resolve-copy true-constraint boa ; +: =t ( value -- constraint ) resolve-copy true-constraint boa ; + +: follow-implications ( constraint -- ) + constraints get assoc-stack [ assume ] when* ; M: true-constraint assume* [ \ f class-not swap value>> refine-value-info ] - [ constraints get assoc-stack [ assume ] when* ] + [ follow-implications ] bi ; M: true-constraint satisfied? - value>> value-info class>> true-class? ; + value>> value-info class>> + { [ true-class? ] [ null-class? not ] } 1&& ; TUPLE: false-constraint value ; @@ -44,11 +48,12 @@ TUPLE: false-constraint value ; M: false-constraint assume* [ \ f swap value>> refine-value-info ] - [ constraints get assoc-stack [ assume ] when* ] + [ follow-implications ] bi ; M: false-constraint satisfied? - value>> value-info class>> false-class? ; + value>> value-info class>> + { [ false-class? ] [ null-class? not ] } 1&& ; ! Class constraints TUPLE: class-constraint value class ; @@ -82,7 +87,7 @@ TUPLE: implication p q ; C: --> implication -: assume-implication ( p q -- ) +: assume-implication ( q p -- ) [ constraints get [ assoc-stack swap suffix ] 2keep last set-at ] [ satisfied? [ assume ] [ drop ] if ] 2bi ; diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 0a04b48160..53b2109bbb 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -302,7 +302,7 @@ SYMBOL: value-infos : refine-value-info ( info value -- ) resolve-copy value-infos get - [ assoc-stack value-info-intersect ] 2keep + [ assoc-stack [ value-info-intersect ] when* ] 2keep last set-at ; : value-literal ( value -- obj ? ) diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 0da234791b..b436b21329 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -764,17 +764,17 @@ MIXIN: empty-mixin [ { word object } declare equal? ] final-classes ] unit-test -! [ V{ string } ] [ -! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes -! ] unit-test +[ V{ string } ] [ + [ dup string? t xor [ "A" throw ] [ ] if ] final-classes +] unit-test -! [ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test +[ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test -! [ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test +[ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test -! [ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test +[ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test -! [ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test +[ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test ! generalize-counter-interval wasn't being called in all the right places. ! bug found by littledan diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 2a16a8b6df..eb9709a350 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -9,6 +9,7 @@ compiler.codegen.fixup compiler.cfg.intrinsics compiler.cfg.stack-frame compiler.cfg.build-stack-frame compiler.units compiler.constants compiler.codegen vm ; FROM: cpu.ppc.assembler => B ; +FROM: layouts => cell ; FROM: math => float ; IN: cpu.ppc diff --git a/extra/compiler/graphviz/graphviz-tests.factor b/extra/compiler/graphviz/graphviz-tests.factor index 23f5f6fb60..8f6c0171e7 100644 --- a/extra/compiler/graphviz/graphviz-tests.factor +++ b/extra/compiler/graphviz/graphviz-tests.factor @@ -1,5 +1,5 @@ IN: compiler.graphviz.tests -USING: compiler.graphviz io.files ; +USING: compiler.graphviz io.files kernel tools.test ; [ t ] [ [ [ 1 ] [ 2 ] if ] render-cfg exists? ] unit-test [ t ] [ [ [ 1 ] [ 2 ] if ] render-dom exists? ] unit-test diff --git a/extra/project-euler/072/072-tests.factor b/extra/project-euler/072/072-tests.factor new file mode 100644 index 0000000000..80a8949d0d --- /dev/null +++ b/extra/project-euler/072/072-tests.factor @@ -0,0 +1,4 @@ +USING: project-euler.072 tools.test ; +IN: project-euler.072.tests + +[ 303963552391 ] [ euler072 ] unit-test diff --git a/extra/project-euler/072/072.factor b/extra/project-euler/072/072.factor new file mode 100644 index 0000000000..de6312f2a7 --- /dev/null +++ b/extra/project-euler/072/072.factor @@ -0,0 +1,38 @@ +! Copyright (c) 2009 Guillaume Nargeot. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.primes.factors math.ranges +project-euler.common sequences ; +IN: project-euler.072 + +! http://projecteuler.net/index.php?section=problems&id=072 + +! DESCRIPTION +! ----------- + +! Consider the fraction, n/d, where n and d are positive integers. +! If ndigits [ digit-factorial ] sigma ; + +: chain-length ( n -- n ) + 61 + [ 2dup key? not ] + [ [ conjoin ] [ [ digits-factorial-sum ] dip ] 2bi ] + while nip assoc-size ; + +PRIVATE> + +: euler074 ( -- answer ) + 1000000 [1,b] [ chain-length 60 = ] count ; + +! [ euler074 ] 10 ave-time +! 25134 ms ave run time - 31.96 SD (10 trials) + +SOLUTION: euler074 + diff --git a/extra/project-euler/085/085.factor b/extra/project-euler/085/085.factor index 6c70f65bf7..9c12367cdf 100644 --- a/extra/project-euler/085/085.factor +++ b/extra/project-euler/085/085.factor @@ -19,7 +19,7 @@ IN: project-euler.085 ! SOLUTION ! -------- -! A grid measuring x by y contains x * (x + 1) * y * (x + 1) rectangles. +! A grid measuring x by y contains x * (x + 1) * y * (x + 1) / 4 rectangles. area-of-nearest ; ! [ euler085 ] 100 ave-time -! 2285 ms ave run time - 4.8 SD (100 trials) +! 791 ms ave run time - 17.15 SD (100 trials) SOLUTION: euler085 diff --git a/extra/project-euler/124/124-tests.factor b/extra/project-euler/124/124-tests.factor new file mode 100644 index 0000000000..cdbb5afc18 --- /dev/null +++ b/extra/project-euler/124/124-tests.factor @@ -0,0 +1,4 @@ +USING: project-euler.124 tools.test ; +IN: project-euler.124.tests + +[ 21417 ] [ euler124 ] unit-test diff --git a/extra/project-euler/124/124.factor b/extra/project-euler/124/124.factor new file mode 100644 index 0000000000..0f4d1ee28f --- /dev/null +++ b/extra/project-euler/124/124.factor @@ -0,0 +1,63 @@ +! Copyright (c) 2009 Guillaume Nargeot. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays kernel math.primes.factors +math.ranges project-euler.common sequences sorting ; +IN: project-euler.124 + +! http://projecteuler.net/index.php?section=problems&id=124 + +! DESCRIPTION +! ----------- + +! The radical of n, rad(n), is the product of distinct prime factors of n. +! For example, 504 = 2^3 × 3^2 × 7, so rad(504) = 2 × 3 × 7 = 42. + +! If we calculate rad(n) for 1 ≤ n ≤ 10, then sort them on rad(n), +! and sorting on n if the radical values are equal, we get: + +! Unsorted Sorted +! n rad(n) n rad(n) k +! 1 1 1 1 1 +! 2 2 2 2 2 +! 3 3 4 2 3 +! 4 2 8 2 4 +! 5 5 3 3 5 +! 6 6 9 3 6 +! 7 7 5 5 7 +! 8 2 6 6 8 +! 9 3 7 7 9 +! 10 10 10 10 10 + +! Let E(k) be the kth element in the sorted n column; for example, +! E(4) = 8 and E(6) = 9. + +! If rad(n) is sorted for 1 ≤ n ≤ 100000, find E(10000). + + +! SOLUTION +! -------- + + + +: euler124 ( -- answer ) + 10000 (euler124) nth first ; + +! [ euler124 ] 100 ave-time +! 373 ms ave run time - 17.61 SD (100 trials) + +! TODO: instead of the brute-force method, making the rad +! array in the way of the sieve of eratosthene would scale +! better on bigger values. + +SOLUTION: euler124 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index f0e40674da..1bba3182d1 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -17,13 +17,14 @@ USING: definitions io io.files io.pathnames kernel math math.parser project-euler.049 project-euler.052 project-euler.053 project-euler.054 project-euler.055 project-euler.056 project-euler.057 project-euler.058 project-euler.059 project-euler.063 project-euler.067 project-euler.069 - project-euler.071 project-euler.073 project-euler.075 project-euler.076 - project-euler.079 project-euler.085 project-euler.092 project-euler.097 - project-euler.099 project-euler.100 project-euler.102 project-euler.112 - project-euler.116 project-euler.117 project-euler.134 project-euler.148 - project-euler.150 project-euler.151 project-euler.164 project-euler.169 - project-euler.173 project-euler.175 project-euler.186 project-euler.190 - project-euler.203 project-euler.215 ; + project-euler.071 project-euler.072 project-euler.073 project-euler.074 + project-euler.075 project-euler.076 project-euler.079 project-euler.085 + project-euler.092 project-euler.097 project-euler.099 project-euler.100 + project-euler.102 project-euler.112 project-euler.116 project-euler.117 + project-euler.124 project-euler.134 project-euler.148 project-euler.150 + project-euler.151 project-euler.164 project-euler.169 project-euler.173 + project-euler.175 project-euler.186 project-euler.190 project-euler.203 + project-euler.215 ; IN: project-euler