Merge branch 'master' of git://factorcode.org/git/factor

basis/compiler/cfg/linear-scan/resolve/resolve.factor

@@ -1,11 +1,10 @@
 ! Copyright (C) 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs classes.parser classes.tuple
-combinators combinators.short-circuit compiler.cfg.instructions
-compiler.cfg.linear-scan.live-intervals compiler.cfg.liveness
-fry hashtables kernel locals make math math.order
-namespaces parser prettyprint random sequences sets
-sorting.functor sorting.slots words io ;
+combinators combinators.short-circuit fry hashtables kernel locals
+make math math.order namespaces sequences sets words parser
+compiler.cfg.instructions compiler.cfg.linear-scan.live-intervals
+compiler.cfg.liveness ;
 IN: compiler.cfg.linear-scan.resolve
 
 <<
@@ -125,10 +124,9 @@ M: register->register to-loc drop register ;
     1 + temp-spill set ;
 
 : set-tos/froms ( operations -- )
-    {
-        [ [ [ from-reg ] keep ] H{ } map>assoc froms set ]
-        [ [ [ to-reg ] keep ] H{ } map>assoc tos set ]
-    } cleave ;
+    [ [ [ from-reg ] keep ] H{ } map>assoc froms set ]
+    [ [ [ to-reg ] keep ] H{ } map>assoc tos set ]
+    bi ;
 
 :: (trace-chain) ( obj hashtable -- )
     obj to-reg froms get at* [

basis/compiler/cfg/stack-analysis/merge/merge.factor

@@ -37,25 +37,25 @@ IN: compiler.cfg.stack-analysis.merge
     '[ _ untranslate-loc ] assoc-map-values ;
 
 : collect-locs ( loc-maps states -- assoc )
-    ! assoc maps locs to sequences of vregs
+    ! assoc maps locs to sequences
     [ untranslate-locs ] 2map
     [ [ keys ] map concat prune ] keep
     '[ dup _ [ at ] with map ] H{ } map>assoc ;
 
-: insert-peek ( predecessor loc -- vreg )
-    '[ _ ^^peek ] add-instructions ;
+: insert-peek ( predecessor loc state -- vreg )
+    '[ _ _ translate-loc ^^peek ] add-instructions ;
 
-: merge-loc ( predecessors vregs loc -- vreg )
+: merge-loc ( predecessors vregs loc state -- vreg )
     ! Insert a ##phi in the current block where the input
     ! is the vreg storing loc from each predecessor block
-    '[ [ ] [ _ insert-peek ] ?if ] 2map
+    '[ [ ] [ _ _ insert-peek ] ?if ] 2map
     dup all-equal? [ first ] [ ^^phi ] if ;
 
 :: merge-locs ( state predecessors states -- state )
     states [ locs>vregs>> ] map states collect-locs
     [| key value |
         key
-        predecessors value key merge-loc
+        predecessors value key state merge-loc
     ] assoc-map
     state translate-locs
     state (>>locs>vregs)
@@ -64,14 +64,17 @@ IN: compiler.cfg.stack-analysis.merge
 : merge-actual-loc ( vregs -- vreg/f )
     dup all-equal? [ first ] [ drop f ] if ;
 
-: merge-actual-locs ( state states -- state )
-    [ [ actual-locs>vregs>> ] map ] keep collect-locs
+:: merge-actual-locs ( state states -- state )
+    states [ actual-locs>vregs>> ] map states collect-locs
     [ merge-actual-loc ] assoc-map [ nip ] assoc-filter
-    over translate-locs
-    >>actual-locs>vregs ;
+    state translate-locs
+    state (>>actual-locs>vregs)
+    state ;
 
 : merge-changed-locs ( state states -- state )
-    [ changed-locs>> ] map assoc-combine >>changed-locs ;
+    [ [ changed-locs>> ] keep untranslate-locs ] map assoc-combine
+    over translate-locs
+    >>changed-locs ;
 
 ERROR: cannot-merge-poisoned states ;
 

basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor

@@ -158,5 +158,49 @@ local-only? off
     stack-analysis
     drop
 
+    3 get instructions>> [ ##peek? ] find nip loc>>
+] unit-test
+
+! Missing ##replace
+[ t ] [
+    [ [ "B" ] 2dip dup [ [ /mod ] dip ] when ] test-stack-analysis
+    reverse-post-order last
+    instructions>> [ ##replace? ] filter [ loc>> ] map
+    { D 0 D 1 D 2 } set=
+] unit-test
+
+! Inserted ##peeks reference the wrong stack location
+[ t ] [
+    [ [ "B" ] 2dip dup [ [ /mod ] dip ] when ] test-stack-analysis
+    eliminate-dead-code reverse-post-order 3 swap nth
+    instructions>> [ ##peek? ] filter [ loc>> ] map
+    { R 0 D 0 D 1 } set=
+] unit-test
+
+[ D 0 ] [
+    V{ T{ ##branch } } 0 test-bb
+
+    V{ T{ ##branch } } 1 test-bb
+
+    V{
+        T{ ##peek f V int-regs 1 D 0 }
+        T{ ##inc-d f 1 }
+        T{ ##branch }
+    } 2 test-bb
+
+    V{
+        T{ ##inc-d f 1 }
+        T{ ##branch }
+    } 3 test-bb
+
+    V{ T{ ##return } } 4 test-bb
+
+    test-diamond
+
+    cfg new 0 get >>entry
+    compute-predecessors
+    stack-analysis
+    drop
+
     3 get instructions>> [ ##peek? ] find nip loc>>
 ] unit-test

basis/compiler/cfg/stack-analysis/stack-analysis.factor

@@ -18,10 +18,10 @@ IN: compiler.cfg.stack-analysis
     [ 2drop t ] [ state get actual-locs>vregs>> at = ] if ;
 
 : save-changed-locs ( state -- )
-    [ changed-locs>> ] [ locs>vregs>> ] bi '[
-        _ at swap 2dup redundant-replace?
+    [ changed-locs>> keys ] [ locs>vregs>> ] bi '[
+        dup _ at swap 2dup redundant-replace?
         [ 2drop ] [ state get untranslate-loc ##replace ] if
-    ] assoc-each ;
+    ] each ;
 
 ERROR: poisoned-state state ;
 

basis/math/primes/factors/factors-docs.factor

@@ -1,7 +1,7 @@
 USING: help.markup help.syntax math sequences ;
 IN: math.primes.factors
 
-{ factors group-factors unique-factors } related-words
+{ divisors factors group-factors unique-factors } related-words
 
 HELP: factors
 { $values { "n" "a positive integer" } { "seq" sequence } }
@@ -21,3 +21,7 @@ HELP: unique-factors
 HELP: totient
 { $values { "n" "a positive integer" } { "t" integer } }
 { $description { "Return the number of integers between 1 and " { $snippet "n-1" } " that are relatively prime to " { $snippet "n" } "." } } ;
+
+HELP: divisors
+{ $values { "n" "a positive integer" } { "seq" sequence } }
+{ $description { "Return the ordered list of divisors of " { $snippet "n" } ", including 1 and " { $snippet "n" } "." } } ;

basis/math/primes/factors/factors-tests.factor

@@ -1,4 +1,4 @@
-USING: math.primes.factors tools.test ;
+USING: math.primes.factors sequences tools.test ;
 
 { { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test
 { { } } [ -5 factors ] unit-test
@@ -8,3 +8,5 @@ USING: math.primes.factors tools.test ;
 { 0 } [ 1 totient ] unit-test
 { { 425612003 } } [ 425612003 factors ] unit-test
 { { 13 4253 15823 32472893749823741 } } [ 28408516453955558205925627 factors ] unit-test
+{ { 1 2 3 4 6 8 12 24 } } [ 24 divisors ] unit-test
+{ 24 } [ 360 divisors length ] unit-test

basis/math/primes/factors/factors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007-2009 Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays combinators kernel make math math.functions
-math.primes sequences ;
+math.primes math.ranges sequences sequences.product sorting ;
 IN: math.primes.factors
 
 <PRIVATE
@@ -41,3 +41,7 @@ PRIVATE>
         { [ dup 2 < ] [ drop 0 ] }
         [ dup unique-factors [ 1 [ 1- * ] reduce ] [ product ] bi / * ]
     } cond ; foldable
+
+: divisors ( n -- seq )
+    group-factors [ first2 [0,b] [ ^ ] with map ] map
+    [ product ] product-map natural-sort ;