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

core/classes/classes-docs.factor

@@ -1,7 +1,7 @@
 USING: help.markup help.syntax kernel kernel.private
 namespaces sequences words arrays layouts help effects math
 layouts classes.private classes.union classes.mixin
-classes.predicate ;
+classes.predicate quotations ;
 IN: classes
 
 ARTICLE: "builtin-classes" "Built-in classes"
@@ -114,24 +114,9 @@ HELP: predicate-word
 { $values { "word" "a word" } { "predicate" "a predicate word" } }
 { $description "Suffixes the word's name with \"?\" and creates a word with that name in the same vocabulary as the word itself." } ;
 
-HELP: define-predicate*
-{ $values { "class" class } { "predicate" "a predicate word" } { "quot" "a quotation" } }
-{ $description
-    "Defines a predicate word. This is identical to a word definition associating " { $snippet "quot" } " with " { $snippet "predicate" } " with the added perk that three word properties are set:"
-    { $list
-        { "the class word's " { $snippet "\"predicate\"" } " property is set to a quotation that calls the predicate" }
-        { "the predicate word's " { $snippet "\"predicating\"" } " property is set to the class word" }
-        { "the predicate word's " { $snippet "\"declared-effect\"" } " word property is set to a descriptive " { $link effect } }
-    }
-    "These properties are used by method dispatch and the help system."
-}
-$low-level-note ;
-
 HELP: define-predicate
-{ $values { "class" class } { "quot" "a quotation" } }
+{ $values { "class" class } { "quot" quotation } }
-{ $description
+{ $description "Defines a predicate word for a class." }
-    "Defines a predicate word named " { $snippet "class?" } " with " { $link define-predicate* } "."
-}
 $low-level-note ;
 
 HELP: superclass

core/classes/classes-tests.factor

@@ -178,11 +178,10 @@ UNION: forget-class-bug-2 forget-class-bug-1 dll ;
 
 [ f ] [ forget-class-bug-2 typemap get values [ memq? ] with contains? ] unit-test
 
-DEFER: mixin-forget-test-g
+2 [
+    [ "mixin-forget-test" forget-source ] with-compilation-unit
     
-[ "mixin-forget-test" forget-source ] with-compilation-unit
+    [ ] [
-
-[ ] [
         {
             "USING: sequences ;"
             "IN: classes.tests"
@@ -192,12 +191,12 @@ DEFER: mixin-forget-test-g
             "M: mixin-forget-test mixin-forget-test-g ;"
         } "\n" join <string-reader> "mixin-forget-test"
         parse-stream drop
-] unit-test
+    ] unit-test
     
-[ { } ] [ { } mixin-forget-test-g ] unit-test
+    [ { } ] [ { } "mixin-forget-test-g" "classes.tests" lookup execute ] unit-test
-[ H{ } mixin-forget-test-g ] must-fail
+    [ H{ } "mixin-forget-test-g" "classes.tests" lookup execute ] must-fail
     
-[ ] [
+    [ ] [
         {
             "USING: hashtables ;"
             "IN: classes.tests"
@@ -207,10 +206,11 @@ DEFER: mixin-forget-test-g
             "M: mixin-forget-test mixin-forget-test-g ;"
         } "\n" join <string-reader> "mixin-forget-test"
         parse-stream drop
-] unit-test
+    ] unit-test
     
-[ { } mixin-forget-test-g ] must-fail
+    [ { } "mixin-forget-test-g" "classes.tests" lookup execute ] must-fail
-[ H{ } ] [ H{ } mixin-forget-test-g ] unit-test
+    [ H{ } ] [ H{ } "mixin-forget-test-g" "classes.tests" lookup execute ] unit-test
+] times
 
 ! Method flattening interfered with mixin update
 MIXIN: flat-mx-1

core/classes/classes.factor

@@ -31,17 +31,9 @@ PREDICATE: class tuple-class
 
 PREDICATE: word predicate "predicating" word-prop >boolean ;
 
-: define-predicate* ( class predicate quot -- )
-    over [
-        dupd predicate-effect define-declared
-        2dup 1quotation "predicate" set-word-prop
-        swap "predicating" set-word-prop
-    ] [ 3drop ] if ;
-
 : define-predicate ( class quot -- )
-    over "forgotten" word-prop [ 2drop ] [
+    >r "predicate" word-prop first
-        >r dup predicate-word r> define-predicate*
+    r> predicate-effect define-declared ;
-    ] if ;
 
 : superclass ( class -- super )
     "superclass" word-prop ;
@@ -257,6 +249,8 @@ PRIVATE>
     over reset-class
     over deferred? [ over define-symbol ] when
     >r dup word-props r> union over set-word-props
+    dup predicate-word 2dup 1quotation "predicate" set-word-prop
+    over "predicating" set-word-prop
     t "class" set-word-prop ;
 
 GENERIC: update-predicate ( class -- )

core/io/files/files.factor

@@ -86,11 +86,11 @@ SYMBOL: +unknown+
 : stat ( path -- directory? permissions length modified )
     normalize-pathname (stat) ;
 
-: file-length ( path -- n ) stat drop 2nip ;
+! : file-length ( path -- n ) stat drop 2nip ;
 
 : file-modified ( path -- n ) stat >r 3drop r> ;
 
-: file-permissions ( path -- perm ) stat 2drop nip ;
+! : file-permissions ( path -- perm ) stat 2drop nip ;
 
 : exists? ( path -- ? ) file-modified >boolean ;
 
@@ -219,11 +219,11 @@ M: pathname <=> [ pathname-string ] compare ;
 : with-file-reader ( path encoding quot -- )
     >r <file-reader> r> with-stream ; inline
 
-! : file-contents ( path encoding -- str )
-!     dupd [ file-info file-info-size read ] with-file-reader ;
-
 : file-contents ( path encoding -- str )
-    dupd [ file-length read ] with-file-reader ;
+    dupd [ file-info file-info-size read ] with-file-reader ;
+
+! : file-contents ( path encoding -- str )
+!     dupd [ file-length read ] with-file-reader ;
 
 : with-file-writer ( path encoding quot -- )
     >r <file-writer> r> with-stream ; inline

extra/combinators/cleave/cleave-docs.factor

@@ -9,6 +9,7 @@ ARTICLE: "cleave-combinators" "Cleave Combinators"
 
 { $subsection bi  }
 { $subsection tri }
+{ $subsection cleave }
 
 { $notes
   "From the Merriam-Webster Dictionary: "
@@ -49,10 +50,17 @@ HELP: tri
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+HELP: cleave
+
+{ $code "( obj { q1 q2 ... qN } -- q1(obj) q2(obj) ... qN(obj) )" } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 ARTICLE: "spread-combinators" "Spread Combinators"
 
 { $subsection bi* }
-{ $subsection tri* } ;
+{ $subsection tri* }
+{ $subsection spread } ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -80,3 +88,9 @@ HELP: tri*
             { "p(x)" "p applied to x" }
             { "q(y)" "q applied to y" }
             { "r(z)" "r applied to z" } } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+HELP: spread
+
+{ $code "( v1 v2 ... vN { q1 q2 ... qN } -- q1(v1) q2(v2) ... qN(vN) )" } ;

extra/combinators/cleave/cleave.factor

@@ -15,9 +15,9 @@ IN: combinators.cleave
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: 2bi ( obj obj quot quot -- val val ) >r 2keep r> call ; inline
+: 2bi ( x y p q -- p(x,y) q(x,y) ) >r 2keep r> call ; inline
 
-: 2tri ( obj obj quot quot quot -- val val val )
+: 2tri ( x y z p q r -- p(x,y,z) q(x,y,z) r(x,y,z) )
   >r >r 2keep r> 2keep r> call ; inline
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -36,6 +36,18 @@ MACRO: cleave ( seq -- )
     [ drop ]
   append ;
 
+MACRO: 2cleave ( seq -- )
+  dup
+    [ drop [ 2dup ] ] map concat
+  swap
+  dup
+    [ drop [ >r >r ] ] map concat
+  swap
+    [ [ r> r> ] append ] map concat
+  3append
+    [ 2drop ]
+  append ;
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! The spread family
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

extra/http/server/static/static.factor

@@ -14,7 +14,8 @@ TUPLE: file-responder root hook special ;
     >r unix-1970 r> seconds time+ ;
 
 : file-http-date ( filename -- string )
-    file-modified unix-time>timestamp timestamp>http-string ;
+    file-info file-info-modified
+    unix-time>timestamp timestamp>http-string ;
 
 : last-modified-matches? ( filename -- ? )
     file-http-date dup [
@@ -31,7 +32,7 @@ TUPLE: file-responder root hook special ;
     [
         <content>
         swap
-        [ file-length "content-length" set-header ]
+        [ file-info file-info-size "content-length" set-header ]
         [ file-http-date "last-modified" set-header ]
         [ '[ , binary <file-reader> stdio get stream-copy ] >>body ]
         tri