steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into integer-simd

db4
Slava Pestov 2009-09-22 20:21:40 -05:00
parent 629fd1fc82 7cfc63af51
commit d23826906f
16 changed files with 242 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/cfg/linearization/order/order-tests.factor
View File

@ -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

4
basis/compiler/tests/low-level-ir.factor
View File

@ -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

46
basis/compiler/tree/propagation/branches/branches.factor
View File

@ -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 ;

19
basis/compiler/tree/propagation/constraints/constraints.factor
View File

@ -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 <class-info> 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 <class-info> 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 ;

2
basis/compiler/tree/propagation/info/info.factor
View File

@ -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 ? )

14
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -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

1
basis/cpu/ppc/ppc.factor
View File

@ -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

2
extra/compiler/graphviz/graphviz-tests.factor
View File

@ -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

4
extra/project-euler/072/072-tests.factor Normal file
View File

@ -0,0 +1,4 @@
USING: project-euler.072 tools.test ;
IN: project-euler.072.tests
[ 303963552391 ] [ euler072 ] unit-test

38
extra/project-euler/072/072.factor Normal file
View File

@ -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 n<d and HCF(n,d)=1, it is called a reduced proper fraction.
! If we list the set of reduced proper fractions for d ≤ 8 in ascending order
! of size, we get:
! 1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7, 1/2, 4/7, 3/5, 5/8, 2/3,
! 5/7, 3/4, 4/5, 5/6, 6/7, 7/8
! It can be seen that there are 21 elements in this set.
! How many elements would be contained in the set of reduced proper fractions
! for d ≤ 1,000,000?
! SOLUTION
! --------
! The answer can be found by adding totient(n) for 2 ≤ n ≤ 1e6
: euler072 ( -- answer )
2 1000000 [a,b] [ totient ] [ + ] map-reduce ;
! [ euler072 ] 100 ave-time
! 5274 ms ave run time - 102.7 SD (100 trials)
SOLUTION: euler072

4
extra/project-euler/074/074-tests.factor Normal file
View File

@ -0,0 +1,4 @@
USING: project-euler.074 tools.test ;
IN: project-euler.074.tests
[ 402 ] [ euler074 ] unit-test

68
extra/project-euler/074/074.factor Normal file
View File

@ -0,0 +1,68 @@
! Copyright (c) 2009 Guillaume Nargeot.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs hashtables kernel math math.ranges
project-euler.common sequences sets ;
IN: project-euler.074
! http://projecteuler.net/index.php?section=problems&id=074
! DESCRIPTION
! -----------
! The number 145 is well known for the property that the sum of the factorial
! of its digits is equal to 145:
! 1! + 4! + 5! = 1 + 24 + 120 = 145
! Perhaps less well known is 169, in that it produces the longest chain of
! numbers that link back to 169; it turns out that there are only three such
! loops that exist:
! 169 → 363601 → 1454 → 169
! 871 → 45361 → 871
! 872 → 45362 → 872
! It is not difficult to prove that EVERY starting number will eventually get
! stuck in a loop. For example,
! 69 → 363600 → 1454 → 169 → 363601 (→ 1454)
! 78 → 45360 → 871 → 45361 (→ 871)
! 540 → 145 (→ 145)
! Starting with 69 produces a chain of five non-repeating terms, but the
! longest non-repeating chain with a starting number below one million is sixty
! terms.
! How many chains, with a starting number below one million, contain exactly
! sixty non-repeating terms?
! SOLUTION
! --------
! Brute force
<PRIVATE
: digit-factorial ( n -- n! )
{ 1 1 2 6 24 120 720 5040 40320 362880 } nth ;
: digits-factorial-sum ( n -- n )
number>digits [ digit-factorial ] sigma ;
: chain-length ( n -- n )
61 <hashtable>
[ 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

4
extra/project-euler/085/085.factor
View File

@ -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.
<PRIVATE
@ -56,6 +56,6 @@ PRIVATE>
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

4
extra/project-euler/124/124-tests.factor Normal file
View File

@ -0,0 +1,4 @@
USING: project-euler.124 tools.test ;
IN: project-euler.124.tests
[ 21417 ] [ euler124 ] unit-test

63
extra/project-euler/124/124.factor Normal file
View File

@ -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
! --------
<PRIVATE
: rad ( n -- n )
unique-factors product ; inline
: rads-upto ( n -- seq )
[0,b] [ dup rad 2array ] map ;
: (euler124) ( -- seq )
100000 rads-upto sort-values ;
PRIVATE>
: 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

15
extra/project-euler/project-euler.factor
View File

@ -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
<PRIVATE