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

basis/compiler/cfg/intrinsics/intrinsics.factor

@@ -131,6 +131,7 @@ IN: compiler.cfg.intrinsics
         { math.libm:fsqrt [ drop "sqrt" emit-unary-float-function ] }
         { math.floats.private:float-min [ drop "fmin" emit-binary-float-function ] }
         { math.floats.private:float-max [ drop "fmax" emit-binary-float-function ] }
+        { math.private:float-mod [ drop "fmod" emit-binary-float-function ] }
     } enable-intrinsics ;
 
 : enable-min/max ( -- )

basis/compiler/tree/propagation/propagation-tests.factor

@@ -819,3 +819,8 @@ M: tuple-with-read-only-slot clone
 
 ! Don't crash if bad literal inputs are passed to unsafe words
 [ f ] [ [ { } 1 fixnum+fast ] final-info first literal?>> ] unit-test
+
+! Converting /i to shift
+[ t ] [ [ >fixnum dup 0 >= [ 16 /i ] when ] { /i fixnum/i fixnum/i-fast } inlined? ] unit-test
+[ f ] [ [ >fixnum dup 0 >= [ 16 /i ] when ] { fixnum-shift-fast } inlined? ] unit-test
+[ f ] [ [ >float dup 0 >= [ 16 /i ] when ] { /i float/f } inlined? ] unit-test

basis/compiler/tree/propagation/transforms/transforms.factor

@@ -80,6 +80,17 @@ IN: compiler.tree.propagation.transforms
     ] [ f ] if
 ] "custom-inlining" set-word-prop
 
+{ /i fixnum/i fixnum/i-fast bignum/i } [
+    [
+        in-d>> first2 [ value-info ] bi@ {
+            [ drop class>> integer class<= ]
+            [ drop interval>> 0 [a,a] interval>= ]
+            [ nip literal>> integer? ]
+            [ nip literal>> power-of-2? ]
+        } 2&& [ [ log2 neg shift ] ] [ f ] if
+    ] "custom-inlining" set-word-prop
+] each
+
 ! Integrate this with generic arithmetic optimization instead?
 : both-inputs? ( #call class -- ? )
     [ in-d>> first2 ] dip '[ value-info class>> _ class<= ] both? ;

basis/definitions/icons/icons.factor

@@ -2,8 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs classes.predicate fry generic io.pathnames kernel
 macros sequences vocabs words words.symbol words.constant
-lexer parser help.topics help.markup help.vocabs namespaces
+lexer parser help.topics help.markup namespaces sorting ;
-sorting ;
 IN: definitions.icons
 
 GENERIC: definition-icon ( definition -- path )
@@ -38,11 +37,9 @@ ICON: symbol symbol-word
 ICON: constant constant-word
 ICON: word normal-word
 ICON: word-link word-help-article
-ICON: link help-article
+ICON: topic help-article
 ICON: runnable-vocab runnable-vocab
 ICON: vocab open-vocab
-ICON: vocab-tag help-article
-ICON: vocab-author help-article
 ICON: vocab-link unopen-vocab
 
 : $definition-icons ( element -- )

basis/literals/literals.factor

@@ -1,6 +1,6 @@
 ! (c) Joe Groff, see license for details
 USING: accessors continuations kernel parser words quotations
-combinators.smart vectors sequences fry ;
+vectors sequences fry ;
 IN: literals
 
 <PRIVATE
@@ -19,7 +19,3 @@ PRIVATE>
 SYNTAX: $ scan-word expand-literal >vector ;
 SYNTAX: $[ parse-quotation with-datastack >vector ;
 SYNTAX: ${ \ } [ expand-literals ] parse-literal ;
-
-SYNTAX: $$
-    scan-word execute( accum -- accum ) dup pop [ >quotation ] keep
-    [ output>sequence ] 2curry call( -- object ) parsed ;

basis/math/vectors/simd/simd-tests.factor

@@ -1,7 +1,8 @@
 IN: math.vectors.simd.tests
 USING: math math.vectors.simd math.vectors.simd.private
 math.vectors math.functions math.private kernel.private compiler
-sequences tools.test compiler.tree.debugger accessors kernel ;
+sequences tools.test compiler.tree.debugger accessors kernel
+system ;
 
 [ float-4{ 0 0 0 0 } ] [ float-4 new ] unit-test
 
@@ -349,13 +350,15 @@ sequences tools.test compiler.tree.debugger accessors kernel ;
     [ { float-8 float } declare v/n ] compile-call
 ] unit-test
 
-! Test puns
+! Test puns; only on x86
-[ double-2{ 4 1024 } ] [
+cpu x86? [
+    [ double-2{ 4 1024 } ] [
         float-4{ 0 1 0 2 }
         [ { float-4 } declare dup v+ underlying>> double-2 boa dup v+ ] compile-call
-] unit-test
+    ] unit-test
     
-[ 33.0 ] [
+    [ 33.0 ] [
         double-2{ 1 2 } double-2{ 10 20 }
         [ { double-2 double-2 } declare v+ underlying>> 3.0 float* ] compile-call
-] unit-test
+    ] unit-test
+] when

extra/project-euler/044/044.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.functions math.ranges math.order
-project-euler.common sequences ;
+project-euler.common sequences layouts ;
 IN: project-euler.044
 
 ! http://projecteuler.net/index.php?section=problems&id=44
@@ -29,20 +29,26 @@ IN: project-euler.044
 <PRIVATE
 
 : nth-pentagonal ( n -- seq )
-    dup 3 * 1 - * 2 / ;
+    dup 3 * 1 - * 2 /i ; inline
 
 : sum-and-diff? ( m n -- ? )
-    [ + ] [ - ] 2bi [ pentagonal? ] bi@ and ;
+    [ + ] [ - ] 2bi [ pentagonal? ] bi@ and ; inline
+
+: euler044-step ( min m n -- min' )
+    [ nth-pentagonal ] bi@
+    2dup sum-and-diff? [ - abs min ] [ 2drop ] if ; inline
 
 PRIVATE>
 
 : euler044 ( -- answer )
-    2500 [1,b] [ nth-pentagonal ] map dup cartesian-product
+    most-positive-fixnum >fixnum
-    [ first2 sum-and-diff? ] filter [ first2 - abs ] [ min ] map-reduce ;
+    2500 [1,b] [
+        dup [1,b] [
+            euler044-step
+        ] with each
+    ] each ;
 
 ! [ euler044 ] 10 ave-time
-! 4996 ms ave run time - 87.46 SD (10 trials)
+! 289 ms ave run time - 0.27 SD (10 trials)
-
-! TODO: this solution is ugly and not very efficient...find a better algorithm
 
 SOLUTION: euler044

extra/project-euler/073/073.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel locals make math project-euler.common sequences ;
+USING: kernel locals math project-euler.common sequences ;
 IN: project-euler.073
 
 ! http://projecteuler.net/index.php?section=problems&id=73
@@ -32,19 +32,19 @@ IN: project-euler.073
 
 <PRIVATE
 
-:: (euler073) ( limit lo hi -- )
+:: (euler073) ( counter limit lo hi -- counter' )
     [let | m [ lo hi mediant ] |
         m denominator limit <= [
-            m ,
+            counter 1 +
             limit lo m (euler073)
             limit m hi (euler073)
-        ] when
+        ] [ counter ] if
     ] ;
 
 PRIVATE>
 
 : euler073 ( -- answer )
-    [ 10000 1/3 1/2 (euler073) ] { } make length ;
+    0 10000 1/3 1/2 (euler073) ;
 
 ! [ euler073 ] 10 ave-time
 ! 20506 ms ave run time - 937.07 SD (10 trials)

extra/project-euler/085/085.factor

@@ -1,6 +1,7 @@
 ! Copyright (c) 2009 Guillaume Nargeot.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math math.ranges project-euler.common sequences ;
+USING: accessors kernel math math.ranges project-euler.common
+sequences locals ;
 IN: project-euler.085
 
 ! http://projecteuler.net/index.php?section=problems&id=85
@@ -23,28 +24,31 @@ IN: project-euler.085
 <PRIVATE
 
 : distance ( m -- n )
-    2000000 - abs ;
+    2000000 - abs ; inline
 
 : rectangles-count ( a b -- n )
-    2dup [ 1 + ] bi@ * * * 4 / ;
+    2dup [ 1 + ] bi@ * * * 4 /i ; inline
 
-: unique-products ( a b -- seq )
+:: each-unique-product ( a b quot: ( i j -- ) -- )
-    tuck [a,b] [
+    a b [a,b] [| i |
-        over dupd [a,b] [ 2array ] with map
+        i b [a,b] [| j |
-    ] map concat nip ;
+            i j quot call
+        ] each
+    ] each ; inline
 
-: max-by-last ( seq seq -- seq )
+TUPLE: result { area read-only } { distance read-only } ;
-    [ [ last ] bi@ < ] most ;
 
-: array2 ( seq -- a b )
+C: <result> result
-    [ first ] [ last ] bi ;
 
-: convert ( seq -- seq )
+: min-by-distance ( seq seq -- seq )
-    array2 [ * ] [ rectangles-count distance ] 2bi 2array ;
+    [ [ distance>> ] bi@ < ] most ; inline
+
+: compute-result ( i j -- pair )
+    [ * ] [ rectangles-count distance ] 2bi <result> ; inline
 
 : area-of-nearest ( -- n )
-    1 2000 unique-products
+    T{ result f 0 2000000 } 1 2000
-    [ convert ] [ max-by-last ] map-reduce first ;
+    [ compute-result min-by-distance ] each-unique-product area>> ;
 
 PRIVATE>
 

extra/project-euler/102/102-tests.factor

@@ -0,0 +1,4 @@
+USING: project-euler.102 tools.test ;
+IN: project-euler.102.tests
+
+[ 228 ] [ euler102 ] unit-test

extra/project-euler/102/102.factor

@@ -0,0 +1,64 @@
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays grouping io.encodings.ascii io.files kernel math 
+math.parser sequences splitting project-euler.common ;
+IN: project-euler.102
+
+! http://projecteuler.net/index.php?section=problems&id=102
+
+! DESCRIPTION
+! -----------
+
+! Three distinct points are plotted at random on a Cartesian plane, for which
+! -1000 ≤ x, y ≤ 1000, such that a triangle is formed.
+
+! Consider the following two triangles:
+
+! A(-340,495), B(-153,-910), C(835,-947)
+! X(-175,41), Y(-421,-714), Z(574,-645)
+
+! It can be verified that triangle ABC contains the origin, whereas triangle
+! XYZ does not.
+
+! Using triangles.txt (right click and 'Save Link/Target As...'), a 27K text
+! file containing the co-ordinates of one thousand "random" triangles, find the
+! number of triangles for which the interior contains the origin.
+
+! NOTE: The first two examples in the file represent the triangles in the
+! example given above.
+
+
+! SOLUTION
+! --------
+
+! A triangle of coordinates (x1, y1) (x2, y2) (x3, y3) contains
+! the origin when (ab * bc > 0) and (bc * ca > 0) where:
+! ab = x1 * (y2 - y1) - y1 * (x2 - x1)
+! bc = x2 * (y3 - y2) - y2 * (x3 - x2)
+! ca = x3 * (y1 - y3) - y3 * (x1 - x3)
+
+<PRIVATE
+
+: source-102 ( -- seq )
+    "resource:extra/project-euler/102/triangles.txt"
+    ascii file-lines [
+        "," split [ string>number ] map 2 group
+    ] map ;
+
+: det ( coord coord -- n )
+    dupd [ [ last ] bi@ - ] [ [ first ] bi@ - ] 2bi 2array
+    [ [ first ] bi@ * ] [ [ last ] bi@ * ] 2bi - ;
+
+: include-origin? ( coord-seq -- ? )
+    dup first suffix 2 clump [ [ first ] [ last ] bi det ] map
+    2 clump [ product 0 > ] all? ;
+
+PRIVATE>
+
+: euler102 ( -- answer )
+    source-102 [ include-origin? ] count ;
+
+! [ euler102 ] 100 ave-time
+! 12 ms ave run time - 0.92 SD (100 trials)
+
+SOLUTION: euler102

extra/project-euler/112/112-tests.factor

@@ -0,0 +1,4 @@
+USING: project-euler.112 tools.test ;
+IN: project-euler.112.tests
+
+[ 1587000 ] [ euler112 ] unit-test

extra/project-euler/112/112.factor

@@ -0,0 +1,52 @@
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel math project-euler.common sequences sorting ;
+IN: project-euler.112
+
+! http://projecteuler.net/index.php?section=problems&id=112
+
+! DESCRIPTION
+! -----------
+
+! Working from left-to-right if no digit is exceeded by the digit to its left
+! it is called an increasing number; for example, 134468.
+
+! Similarly if no digit is exceeded by the digit to its right it is called a
+! decreasing number; for example, 66420.
+
+! We shall call a positive integer that is neither increasing nor decreasing a
+! "bouncy" number; for example, 155349.
+
+! Clearly there cannot be any bouncy numbers below one-hundred, but just over
+! half of the numbers below one-thousand (525) are bouncy. In fact, the least
+! number for which the proportion of bouncy numbers first reaches 50% is 538.
+
+! Surprisingly, bouncy numbers become more and more common and by the time we
+! reach 21780 the proportion of bouncy numbers is equal to 90%.
+
+! Find the least number for which the proportion of bouncy numbers is exactly
+! 99%.
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: bouncy? ( n -- ? )
+    number>digits dup natural-sort
+    [ = not ] [ reverse = not ] 2bi and ;
+
+PRIVATE>
+
+: euler112 ( -- answer )
+    0 0 0 [
+        2dup swap 99 * = not
+    ] [
+        [ 1 + ] 2dip pick bouncy? [ 1 + ] [ [ 1 + ] dip ] if
+    ] do while 2drop ;
+
+! [ euler112 ] 100 ave-time
+! 2749 ms ave run time - 33.76 SD (100 trials)
+
+SOLUTION: euler112

extra/project-euler/common/common.factor

@@ -91,7 +91,7 @@ PRIVATE>
     number>string natural-sort >string "123456789" = ;
 
 : pentagonal? ( n -- ? )
-    dup 0 > [ 24 * 1 + sqrt 1 + 6 / 1 mod zero? ] [ drop f ] if ;
+    dup 0 > [ 24 * 1 + sqrt 1 + 6 / 1 mod zero? ] [ drop f ] if ; inline
 
 : penultimate ( seq -- elt )
     dup length 2 - swap nth ;

extra/project-euler/project-euler.factor

@@ -19,10 +19,11 @@ USING: definitions io io.files io.pathnames kernel math math.parser
     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.116 project-euler.117
+    project-euler.099 project-euler.100 project-euler.102 project-euler.112
-    project-euler.134 project-euler.148 project-euler.150 project-euler.151
+    project-euler.116 project-euler.117 project-euler.134 project-euler.148
-    project-euler.164 project-euler.169 project-euler.173 project-euler.175
+    project-euler.150 project-euler.151 project-euler.164 project-euler.169
-    project-euler.186 project-euler.190 project-euler.203 project-euler.215 ;
+    project-euler.173 project-euler.175 project-euler.186 project-euler.190
+    project-euler.203 project-euler.215 ;
 IN: project-euler
 
 <PRIVATE

vm/local_roots.hpp

@@ -20,9 +20,8 @@ struct gc_root : public tagged<T>
 	~gc_root() {
 #ifdef FACTOR_DEBUG
 		assert(gc_locals.back() == (cell)this);
-#else
-		gc_locals.pop_back();
 #endif
+		gc_locals.pop_back();
 	}
 };