Merge git://www.rfc1149.net/factor

Conflicts:

	extra/project-euler/project-euler.factor

core/heaps/heaps.factor

@@ -6,7 +6,6 @@ IN: heaps
 MIXIN: priority-queue
 
 GENERIC: heap-push ( value key heap -- )
-GENERIC: heap-push-all ( assoc heap -- )
 GENERIC: heap-peek ( heap -- value key )
 GENERIC: heap-pop* ( heap -- )
 GENERIC: heap-pop ( heap -- value key )
@@ -107,7 +106,7 @@ M: priority-queue heap-push ( value key heap -- )
     [ heap-data ] keep
     up-heap ;
 
-M: priority-queue heap-push-all ( assoc heap -- )
+: heap-push-all ( assoc heap -- )
     [ swapd heap-push ] curry assoc-each ;
 
 M: priority-queue heap-peek ( heap -- value key )

core/io/files/files.factor

@@ -3,7 +3,7 @@
 IN: io.files
 USING: io.backend io.files.private io hashtables kernel math
 memory namespaces sequences strings assocs arrays definitions
-system combinators splitting ;
+system combinators splitting sbufs ;
 
 HOOK: <file-reader> io-backend ( path -- stream )
 
@@ -157,3 +157,8 @@ HOOK: binary-roots io-backend ( -- seq )
 PRIVATE>
 
 : walk-dir ( path -- seq ) [ (walk-dir) ] { } make ;
+
+: file-lines ( path -- seq ) <file-reader> lines ;
+
+: file-contents ( path -- str )
+    dup <file-reader> swap file-length <sbuf> [ stream-copy ] keep >string ;

core/io/io.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: hashtables generic kernel math namespaces sequences strings
-    continuations assocs io.files io.styles sbufs ;
+    continuations assocs io.styles sbufs ;
 IN: io
 
 GENERIC: stream-close ( stream -- )
@@ -90,6 +90,3 @@ SYMBOL: stdio
 
 : contents ( stream -- str )
     2048 <sbuf> [ stream-copy ] keep >string ;
-
-: file-contents ( path -- str )
-    dup <file-reader> swap file-length <sbuf> [ stream-copy ] keep >string ;

extra/assoc-heaps/assoc-heaps-tests.factor

@@ -44,3 +44,12 @@ T{
     T{ max-heap T{ heap f V{ { 1 2 } { 0 1 } } } }
 } heap-pop
 ] unit-test
+
+[
+T{
+    assoc-heap
+    f
+    H{ { 1 2 } { 3 4 } }
+    T{ min-heap T{ heap f V{ { 2 1 } { 4 3 } } } }
+}
+] [ H{ { 1 2 } { 3 4 } } H{ } clone <assoc-min-heap> [ heap-push-all ] keep ] unit-test

extra/assoc-heaps/assoc-heaps.factor

@@ -40,9 +40,6 @@ M: assoc-heap heap-peek ( assoc-heap -- value key )
 M: assoc-heap heap-push ( value key assoc-heap -- )
     set-at ;
 
-M: assoc-heap heap-push-all ( assoc assoc-heap -- )
-    swap [ rot set-at ] curry* each ;
-
 M: assoc-heap heap-pop ( assoc-heap -- value key )
     dup assoc-heap-heap heap-pop swap
     rot dupd assoc-heap-assoc delete-at ;

extra/combinators/lib/lib.factor

@@ -161,3 +161,8 @@ MACRO: map-call-with2 ( quots -- )
   r> length [ narray ] curry append ;
 
 MACRO: map-exec-with ( words -- ) [ 1quotation ] map [ map-call-with ] curry ;
+
+MACRO: construct-slots ( assoc tuple-class -- tuple ) 
+    [ construct-empty ] curry swap [
+        [ dip ] curry swap 1quotation [ keep ] curry compose
+    ] { } assoc>map concat compose ;

extra/macros/macros.factor

@@ -2,18 +2,18 @@
 ! See http://factorcode.org/license.txt for BSD license.
 
 USING: parser kernel sequences words effects inference.transforms
-       combinators assocs definitions quotations namespaces ;
+combinators assocs definitions quotations namespaces memoize ;
 
 IN: macros
 
-: (:)
+: (:) ( -- word definition effect-in )
     CREATE dup reset-generic parse-definition
     over "declared-effect" word-prop effect-in length ;
 
-: (MACRO:)
-    >r
-    2dup "macro" set-word-prop
-    2dup [ call ] append define-compound
+: (MACRO:) ( word definition effect-in -- )
+    >r 2dup "macro" set-word-prop
+    2dup over "declared-effect" word-prop memoize-quot
+    [ call ] append define-compound 
     r> define-transform ;
 
 : MACRO:

extra/memoize/memoize.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel hashtables sequences arrays words namespaces
-parser math assocs effects definitions ;
+parser math assocs effects definitions quotations ;
 IN: memoize
 
 : packer ( n -- quot )
@@ -46,3 +46,7 @@ PREDICATE: compound memoized "memoize" word-prop ;
 
 M: memoized definer drop \ MEMO: \ ; ;
 M: memoized definition "memo-quot" word-prop ;
+
+: memoize-quot ( quot effect -- memo-quot )
+    gensym swap dupd "declared-effect" set-word-prop
+    dup rot define-memoized 1quotation ;

extra/project-euler/011/011.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces project-euler.common sequences ;
+USING: kernel namespaces project-euler.common sequences splitting ;
 IN: project-euler.011
 
 ! http://projecteuler.net/index.php?section=problems&id=11
@@ -45,40 +45,40 @@ IN: project-euler.011
 
 : horizontal ( -- matrix )
     {
-        { 08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08 }
-        { 49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00 }
-        { 81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65 }
-        { 52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91 }
-        { 22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80 }
-        { 24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50 }
-        { 32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70 }
-        { 67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21 }
-        { 24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72 }
-        { 21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95 }
-        { 78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92 }
-        { 16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57 }
-        { 86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58 }
-        { 19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40 }
-        { 04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66 }
-        { 88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69 }
-        { 04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36 }
-        { 20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16 }
-        { 20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54 }
-        { 01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48 }
-    } ;
+      08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08
+      49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00
+      81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65
+      52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91
+      22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80
+      24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50
+      32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70
+      67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21
+      24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72
+      21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95
+      78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92
+      16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57
+      86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58
+      19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40
+      04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66
+      88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69
+      04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36
+      20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16
+      20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54
+      01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48
+    } 20 group ;
 
 : vertical ( -- matrix )
     horizontal flip ;
 
 : pad-front ( matrix -- matrix )
     [
-        length [ 0 <repetition> ] each
-    ] keep [ append ] map ;
+        length [ 0 <repetition> ] map
+    ] keep [ append ] 2map ;
 
 : pad-back ( matrix -- matrix )
     <reversed> [
-        length [ 0 <repetition> ] each
-    ] keep [ <reversed> append ] map ;
+        length [ 0 <repetition> ] map
+    ] keep [ <reversed> append ] 2map ;
 
 : diagonal/ ( -- matrix )
     horizontal reverse pad-front pad-back flip ;
@@ -98,9 +98,6 @@ PRIVATE>
         [ call 4 max-product , ] each
     ] { } make supremum ;
 
-! TODO: solution works but doesn't completely compile due to the creation of
-! the diagonal matrices, there must be a cleaner way to generate those
-
 ! [ euler011 ] 100 ave-time
 ! 4 ms run / 0 ms GC ave time - 100 trials
 

extra/project-euler/018/018.factor

@@ -51,24 +51,24 @@ IN: project-euler.018
 <PRIVATE
 
 : pyramid ( -- seq )
-    {
-                             75
-                            95 64
-                          17 47 82
-                         18 35 87 10
-                       20 04 82 47 65
-                      19 01 23 75 03 34
-                    88 02 77 73 07 63 67
-                   99 65 04 28 06 16 70 92
-                 41 41 26 56 83 40 80 70 33
-                41 48 72 33 47 32 37 16 94 29
-              53 71 44 65 25 43 91 52 97 51 14
-             70 11 33 28 77 73 17 78 39 68 17 57
-           91 71 52 38 17 14 91 43 58 50 27 29 48
-          63 66 04 68 89 53 67 30 73 16 69 87 40 31
-        04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
-    }
-    15 [ 1+ cut swap ] map nip ;
+  {
+                         75
+                        95 64
+                      17 47 82
+                     18 35 87 10
+                   20 04 82 47 65
+                  19 01 23 75 03 34
+                88 02 77 73 07 63 67
+               99 65 04 28 06 16 70 92
+             41 41 26 56 83 40 80 70 33
+            41 48 72 33 47 32 37 16 94 29
+          53 71 44 65 25 43 91 52 97 51 14
+         70 11 33 28 77 73 17 78 39 68 17 57
+       91 71 52 38 17 14 91 43 58 50 27 29 48
+      63 66 04 68 89 53 67 30 73 16 69 87 40 31
+    04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
+  }
+  15 [ 1+ cut swap ] map nip ;
 
 PRIVATE>
 

extra/project-euler/169/169.factor

@@ -0,0 +1,41 @@
+! Copyright (c) 2007 Samuel Tardieu.
+! See http://factorcode.org/license.txt for BSD license.
+IN: project-euler.169
+USING: combinators kernel math math.functions memoize ;
+
+! http://projecteuler.net/index.php?section=problems&id=169
+
+! DESCRIPTION
+! -----------
+
+! Define f(0)=1 and f(n) to be the number of different ways n can be
+! expressed as a sum of integer powers of 2 using each power no more
+! than twice.
+
+! For example, f(10)=5 since there are five different ways to express 10:
+
+! 1 + 1 + 8
+! 1 + 1 + 4 + 4
+! 1 + 1 + 2 + 2 + 4
+! 2 + 4 + 4
+! 2 + 8
+
+! What is f(1025)?
+
+! SOLUTION
+! --------
+
+MEMO: fn ( n -- x )
+  {
+    { [ dup 2 < ]  [ drop 1 ] }
+    { [ dup odd? ] [ 2/ fn ] }
+    { [ t ]        [ 2/ [ fn ] keep 1- fn + ] }
+  } cond ;
+
+: euler169 ( -- result )
+  10 25 ^ fn ;
+
+! [ euler169 ] 100 ave-time
+! 0 ms run / 0 ms GC ave time - 100 trials
+
+MAIN: euler169

extra/project-euler/173/173.factor

@@ -0,0 +1,34 @@
+! Copyright (c) 2007 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.functions math.ranges sequences ;
+IN: project-euler.173
+
+! http://projecteuler.net/index.php?section=problems&id=173
+
+! DESCRIPTION
+! -----------
+
+! We shall define a square lamina to be a square outline with a square
+! "hole" so that the shape possesses vertical and horizontal
+! symmetry. For example, using exactly thirty-two square tiles we can
+! form two different square laminae: [see URL for figure]
+
+! With one-hundred tiles, and not necessarily using all of the tiles at
+! one time, it is possible to form forty-one different square laminae.
+
+! Using up to one million tiles how many different square laminae can be
+! formed?
+
+! SOLUTION
+! --------
+
+: laminaes ( upper -- n )
+  4 / dup sqrt [1,b] 0 rot [ over /mod drop - - ] curry reduce ;
+
+: euler173 ( -- answer )
+  1000000 laminaes ;
+
+! [ euler173 ] 100 ave-time
+! 0 ms run / 0 ms GC ave time - 100 trials
+
+MAIN: euler173

extra/project-euler/175/175.factor

@@ -0,0 +1,54 @@
+! Copyright (c) 2007 Samuel Tardieu.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators kernel math math.parser math.ranges sequences vectors ;
+IN: project-euler.175
+
+! http://projecteuler.net/index.php?section=problems&id=175
+
+! DESCRIPTION
+! -----------
+
+! Define f(0)=1 and f(n) to be the number of ways to write n as a sum of
+! powers of 2 where no power occurs more than twice.
+
+! For example, f(10)=5 since there are five different ways to express
+! 10: 10 = 8+2 = 8+1+1 = 4+4+2 = 4+2+2+1+1 = 4+4+1+1
+
+! It can be shown that for every fraction p/q (p0, q0) there exists at
+! least one integer n such that f(n)/f(n-1)=p/q.
+
+! For instance, the smallest n for which f(n)/f(n-1)=13/17 is 241.  The
+! binary expansion of 241 is 11110001.  Reading this binary number from
+! the most significant bit to the least significant bit there are 4
+! one's, 3 zeroes and 1 one. We shall call the string 4,3,1 the
+! Shortened Binary Expansion of 241.
+
+! Find the Shortened Binary Expansion of the smallest n for which
+! f(n)/f(n-1)=123456789/987654321.
+
+! Give your answer as comma separated integers, without any whitespaces.
+
+! SOLUTION
+! --------
+
+: add-bits ( vec n b -- )
+  over zero? [
+    3drop
+  ] [
+    pick length 1 bitand = [ over pop + ] when swap push
+  ] if ;
+
+: compute ( vec ratio -- )
+  {
+    { [ dup integer? ] [ 1- 0 add-bits ] }
+    { [ dup 1 < ] [ 1 over - / dupd compute 1 1 add-bits ] }
+    { [ t ] [ [ 1 mod compute ] 2keep >integer 0 add-bits ] }
+  } cond ;
+
+: euler175 ( -- result )
+  V{ 1 } clone dup 123456789/987654321 compute [ number>string ] map "," join ;
+
+! [ euler175 ] 100 ave-time
+! 0 ms run / 0 ms GC ave time - 100 trials
+
+MAIN: euler175

extra/project-euler/project-euler.factor

@@ -1,15 +1,15 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: definitions io io.files kernel math.parser sequences vocabs
-    vocabs.loader project-euler.ave-time project-euler.common
+    vocabs.loader project-euler.ave-time project-euler.common math
     project-euler.001 project-euler.002 project-euler.003 project-euler.004
     project-euler.005 project-euler.006 project-euler.007 project-euler.008
     project-euler.009 project-euler.010 project-euler.011 project-euler.012
     project-euler.013 project-euler.014 project-euler.015 project-euler.016
     project-euler.017 project-euler.018 project-euler.019 project-euler.020
     project-euler.021 project-euler.022 project-euler.023 project-euler.024
-    project-euler.025
-    project-euler.067 project-euler.134 ;
+    project-euler.025 project-euler.067 project-euler.134 project-euler.169
+    project-euler.173 project-euler.175 ;
 IN: project-euler
 
 <PRIVATE
@@ -33,7 +33,7 @@ PRIVATE>
 : run-project-euler ( -- )
     problem-prompt dup problem-solved? [
         dup number>euler "project-euler." swap append run
-        "Answer: " swap number>string append print
+        "Answer: " swap dup number? [ number>string ] when append print
         "Source: " swap solution-path append print
     ] [
         drop "That problem has not been solved yet..." print

extra/rss/rss-tests.factor

@@ -10,7 +10,7 @@ USING: rss io kernel io.files tools.test ;
     f
     "Meerkat"
     "http://meerkat.oreillynet.com"
-    V{
+    {
         T{
             entry
             f
@@ -26,7 +26,7 @@ USING: rss io kernel io.files tools.test ;
     f
     "dive into mark"
     "http://example.org/"
-    V{
+    {
         T{
             entry
             f

extra/rss/rss.factor

@@ -85,22 +85,26 @@ C: <entry> entry
     ] if ;
 
 ! Atom generation
+: simple-tag, ( content name -- )
+    [ , ] tag, ;
+
+: simple-tag*, ( content name attrs -- )
+    [ , ] tag*, ;
+
 : entry, ( entry -- )
-    << entry >> [
-        << title >> [ dup entry-title , ]
-        << link [ dup entry-link ] == href // >>
-        << published >> [ dup entry-pub-date , ]
-        << content >> [ entry-description , ]
-    ] ;
+    "entry" [
+        dup entry-title "title" { { "type" "html" } } simple-tag*,
+        "link" over entry-link "href" associate contained*,
+        dup entry-pub-date "published" simple-tag,
+        entry-description [ "content" { { "type" "html" } } simple-tag*, ] when*
+    ] tag, ;
 
 : feed>xml ( feed -- xml )
-    <XML
-        << feed [ "http://www.w3.org/2005/Atom" ] == xmlns >> [
-            << title >> [ dup feed-title , ]
-            << link [ dup feed-link ] == href // >>
-            feed-entries [ entry, ] each
-        ]
-    XML> ;
+    "feed" { { "xmlns" "http://www.w3.org/2005/Atom" } } [
+        dup feed-title "title" simple-tag,
+        "link" over feed-link "href" associate contained*,
+        feed-entries [ entry, ] each
+    ] make-xml* ;
 
 : write-feed ( feed -- )
     feed>xml write-xml ;

extra/sequences/lib/lib-tests.factor

@@ -46,3 +46,10 @@ math.functions tools.test strings ;
 [ { { 0 0 } { 1 0 } { 0 1 } { 1 1 } } ] [ 2 2 exact-strings ] unit-test
 [ t ] [ "ab" 4 strings [ >string ] map "abab" swap member? ] unit-test
 [ { { } { 1 } { 2 } { 1 2 } } ] [ { 1 2 } power-set ] unit-test
+
+[ f ] [ { } ?first ] unit-test
+[ f ] [ { } ?fourth ] unit-test
+[ 1 ] [ { 1 2 3 } ?first ] unit-test
+[ 2 ] [ { 1 2 3 } ?second ] unit-test
+[ 3 ] [ { 1 2 3 } ?third ] unit-test
+[ f ] [ { 1 2 3 } ?fourth ] unit-test

extra/sequences/lib/lib.factor

@@ -126,3 +126,8 @@ PRIVATE>
 : human-sort ( seq -- newseq )
     [ dup [ digit? ] [ string>number ] cut-all ] { } map>assoc
     sort-values keys ;
+
+: ?first ( seq -- first/f ) 0 swap ?nth ; inline
+: ?second ( seq -- second/f ) 1 swap ?nth ; inline
+: ?third ( seq -- third/f ) 2 swap ?nth ; inline
+: ?fourth ( seq -- fourth/f ) 3 swap ?nth ; inline

extra/trees/splay/authors.txt

@@ -1 +1,2 @@
-Mackenzie Straight, Daniel Ehrenberg
+Mackenzie Straight
+Daniel Ehrenberg