Merge branch 'master' into new_ui

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

@@ -13,7 +13,7 @@ IN: compiler.cfg.alias-analysis.tests
 
 [ ] [
     {
-        T{ ##load-indirect f V int-regs 1 "hello" }
+        T{ ##load-reference f V int-regs 1 "hello" }
         T{ ##slot-imm f V int-regs 0 V int-regs 1 0 3 }
     } alias-analysis drop
 ] unit-test

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

@@ -224,7 +224,7 @@ GENERIC: analyze-aliases* ( insn -- insn' )
 M: ##load-immediate analyze-aliases*
     dup [ val>> ] [ dst>> ] bi constants get set-at ;
 
-M: ##load-indirect analyze-aliases*
+M: ##load-reference analyze-aliases*
     dup dst>> set-heap-ac ;
 
 M: ##alien-global analyze-aliases*

basis/compiler/cfg/instructions/instructions.factor

@@ -36,13 +36,13 @@ TUPLE: ##alien-setter < ##effect { value vreg } ;
 
 ! Stack operations
 INSN: ##load-immediate < ##pure { val integer } ;
-INSN: ##load-indirect < ##pure obj ;
+INSN: ##load-reference < ##pure obj ;
 
 GENERIC: ##load-literal ( dst value -- )
 
 M: fixnum ##load-literal tag-fixnum ##load-immediate ;
 M: f ##load-literal drop \ f tag-number ##load-immediate ;
-M: object ##load-literal ##load-indirect ;
+M: object ##load-literal ##load-reference ;
 
 INSN: ##peek < ##read { loc loc } ;
 INSN: ##replace < ##write { loc loc } ;

basis/compiler/cfg/value-numbering/expressions/expressions.factor

@@ -39,8 +39,6 @@ GENERIC: >expr ( insn -- expr )
 
 M: ##load-immediate >expr val>> <constant> ;
 
-M: ##load-indirect >expr obj>> <constant> ;
-
 M: ##unary >expr
     [ class ] [ src>> vreg>vn ] bi unary-expr boa ;
 

basis/compiler/cfg/value-numbering/value-numbering-tests.factor

@@ -81,7 +81,7 @@ sequences ;
 
 [
     {
-        T{ ##load-indirect f V int-regs 1 + }
+        T{ ##load-reference f V int-regs 1 + }
         T{ ##peek f V int-regs 2 D 0 }
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> }
         T{ ##compare f V int-regs 6 V int-regs 2 V int-regs 1 cc> }
@@ -89,7 +89,7 @@ sequences ;
     }
 ] [
     {
-        T{ ##load-indirect f V int-regs 1 + }
+        T{ ##load-reference f V int-regs 1 + }
         T{ ##peek f V int-regs 2 D 0 }
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> }
         T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc/= }
@@ -99,7 +99,7 @@ sequences ;
 
 [
     {
-        T{ ##load-indirect f V int-regs 1 + }
+        T{ ##load-reference f V int-regs 1 + }
         T{ ##peek f V int-regs 2 D 0 }
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= }
         T{ ##compare f V int-regs 6 V int-regs 2 V int-regs 1 cc> }
@@ -107,7 +107,7 @@ sequences ;
     }
 ] [
     {
-        T{ ##load-indirect f V int-regs 1 + }
+        T{ ##load-reference f V int-regs 1 + }
         T{ ##peek f V int-regs 2 D 0 }
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= }
         T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc= }

basis/compiler/codegen/codegen.factor

@@ -70,8 +70,8 @@ SYMBOL: labels
 M: ##load-immediate generate-insn
     [ dst>> register ] [ val>> ] bi %load-immediate ;
 
-M: ##load-indirect generate-insn
+M: ##load-reference generate-insn
-    [ dst>> register ] [ obj>> ] bi %load-indirect ;
+    [ dst>> register ] [ obj>> ] bi %load-reference ;
 
 M: ##peek generate-insn
     [ dst>> register ] [ loc>> ] bi %peek ;

basis/compiler/tests/codegen.factor

@@ -276,3 +276,9 @@ TUPLE: id obj ;
 
 [ 4 ] [ 2 [ dup fixnum* ] compile-call ] unit-test
 [ 7 ] [ 2 [ dup fixnum* 3 fixnum+fast ] compile-call ] unit-test
+
+TUPLE: cucumber ;
+
+M: cucumber equal? "The cucumber has no equal" throw ;
+
+[ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test

basis/cpu/architecture/architecture.factor

@@ -38,7 +38,7 @@ M: object param-reg param-regs nth ;
 HOOK: two-operand? cpu ( -- ? )
 
 HOOK: %load-immediate cpu ( reg obj -- )
-HOOK: %load-indirect cpu ( reg obj -- )
+HOOK: %load-reference cpu ( reg obj -- )
 
 HOOK: %peek cpu ( vreg loc -- )
 HOOK: %replace cpu ( vreg loc -- )

basis/cpu/ppc/ppc.factor

@@ -34,7 +34,7 @@ M: ppc two-operand? f ;
 
 M: ppc %load-immediate ( reg n -- ) swap LOAD ;
 
-M: ppc %load-indirect ( reg obj -- )
+M: ppc %load-reference ( reg obj -- )
     [ 0 swap LOAD32 ] [ rc-absolute-ppc-2/2 rel-immediate ] bi* ;
 
 M: ppc %alien-global ( register symbol dll -- )
@@ -261,7 +261,7 @@ M:: ppc %fixnum-mul-tail ( src1 src2 temp1 temp2 -- )
 M:: ppc %integer>bignum ( dst src temp -- )
     [
         "end" define-label
-        dst 0 >bignum %load-indirect
+        dst 0 >bignum %load-reference
         ! Is it zero? Then just go to the end and return this zero
         0 src 0 CMPI
         "end" get BEQ
@@ -321,7 +321,7 @@ M:: ppc %integer>float ( dst src -- )
     scratch-reg dup HEX: 8000 XORIS
     scratch-reg 1 4 scratch@ STW
     dst 1 0 scratch@ LFD
-    scratch-reg 4503601774854144.0 %load-indirect
+    scratch-reg 4503601774854144.0 %load-reference
     fp-scratch-reg scratch-reg float-offset LFD
     dst dst fp-scratch-reg FSUB ;
 
@@ -488,7 +488,7 @@ M: ppc %epilogue ( n -- )
     "end" define-label
     dst \ f tag-number %load-immediate
     "end" get word execute
-    dst \ t %load-indirect
+    dst \ t %load-reference
     "end" get resolve-label ; inline
 
 : %boolean ( dst temp cc -- )
@@ -637,7 +637,7 @@ M: ppc %alien-invoke ( symbol dll -- )
     [ 11 ] 2dip %alien-global 11 MTLR BLRL ;
 
 M: ppc %alien-callback ( quot -- )
-    3 swap %load-indirect "c_to_factor" f %alien-invoke ;
+    3 swap %load-reference "c_to_factor" f %alien-invoke ;
 
 M: ppc %prepare-alien-indirect ( -- )
     "unbox_alien" f %alien-invoke

basis/cpu/x86/32/32.factor

@@ -237,7 +237,7 @@ M: x86.32 %alien-indirect ( -- )
 
 M: x86.32 %alien-callback ( quot -- )
     4 [
-        EAX swap %load-indirect
+        EAX swap %load-reference
         EAX PUSH
         "c_to_factor" f %alien-invoke
     ] with-aligned-stack ;

basis/cpu/x86/64/64.factor

@@ -176,7 +176,7 @@ M: x86.64 %alien-indirect ( -- )
     RBP CALL ;
 
 M: x86.64 %alien-callback ( quot -- )
-    param-reg-1 swap %load-indirect
+    param-reg-1 swap %load-reference
     "c_to_factor" f %alien-invoke ;
 
 M: x86.64 %callback-value ( ctype -- )

basis/cpu/x86/x86.factor

@@ -21,7 +21,7 @@ HOOK: param-reg-2 cpu ( -- reg )
 
 M: x86 %load-immediate MOV ;
 
-M: x86 %load-indirect swap 0 MOV rc-absolute-cell rel-immediate ;
+M: x86 %load-reference swap 0 MOV rc-absolute-cell rel-immediate ;
 
 HOOK: ds-reg cpu ( -- reg )
 HOOK: rs-reg cpu ( -- reg )
@@ -188,7 +188,7 @@ M:: x86 %integer>bignum ( dst src temp -- )
     [
         "end" define-label
         ! Load cached zero value
-        dst 0 >bignum %load-indirect
+        dst 0 >bignum %load-reference
         src 0 CMP
         ! Is it zero? Then just go to the end and return this zero
         "end" get JE

basis/farkup/farkup-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: farkup kernel peg peg.ebnf tools.test namespaces xml
-urls.encoding assocs xml.utilities ;
+urls.encoding assocs xml.utilities xml.data ;
 IN: farkup.tests
 
 relative-link-prefix off
@@ -161,7 +161,7 @@ link-no-follow? off
 
 : check-link-escaping ( string -- link )
     convert-farkup string>xml-chunk
-    "a" deep-tag-named "href" swap at url-decode ;
+    "a" deep-tag-named "href" attr url-decode ;
 
 [ "Trader Joe\"s" ] [ "[[Trader Joe\"s]]" check-link-escaping ] unit-test
 [ "<foo>" ] [ "[[<foo>]]" check-link-escaping ] unit-test

basis/io/mmap/mmap-docs.factor

@@ -19,6 +19,7 @@ HELP: <mapped-file>
 HELP: with-mapped-file
 { $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } }
 { $contract "Opens a file and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
+{ $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." }
 { $errors "Throws an error if a memory mapping could not be established." } ;
 
 HELP: close-mapped-file

basis/math/ranges/ranges-tests.factor

@@ -1,4 +1,4 @@
-USING: math.ranges sequences tools.test arrays ;
+USING: math math.ranges sequences sets tools.test arrays ;
 IN: math.ranges.tests
 
 [ { } ] [ 1 1 (a,b) >array ] unit-test
@@ -32,3 +32,7 @@ IN: math.ranges.tests
 [ 0 ] [ -1 5 [0,b] clamp-to-range ] unit-test
 [ 5 ] [ 6 5 [0,b] clamp-to-range ] unit-test
 [ { 0 1 2 3 4 } ] [ 5 sequence-index-range >array ] unit-test
+
+[ 100 ] [
+    1 100 [a,b] [ 2^ [1,b] ] map prune length
+] unit-test

basis/math/ranges/ranges.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel layouts math math.order namespaces sequences
-sequences.private accessors ;
+sequences.private accessors classes.tuple arrays ;
 IN: math.ranges
 
 TUPLE: range
@@ -18,6 +18,12 @@ M: range length ( seq -- n )
 M: range nth-unsafe ( n range -- obj )
     [ step>> * ] keep from>> + ;
 
+! For ranges with many elements, the default element-wise methods
+! sequences define are unsuitable because they're O(n)
+M: range equal? over range? [ tuple= ] [ 2drop f ] if ;
+
+M: range hashcode* tuple-hashcode ;
+
 INSTANCE: range immutable-sequence
 
 : twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline

basis/unicode/collation/collation-docs.factor

@@ -1,11 +1,12 @@
-USING: help.syntax help.markup strings byte-arrays ;
+USING: help.syntax help.markup strings byte-arrays math.order ;
 IN: unicode.collation
 
 ARTICLE: "unicode.collation" "Collation and weak comparison"
-"The " { $vocab-link "unicode.collation" "unicode.collation" } " vocabulary implements the Unicode Collation Algorithm. The Unicode Collation Algorithm (UTS #10) forms a reasonable way to sort strings when accouting for all of the characters in Unicode. It is far preferred over code point order when sorting for human consumption, in user interfaces. At the moment, only the default Unicode collation element table (DUCET) is used, but a more accurate collation would take locale into account. The following words are defined:"
+"The " { $vocab-link "unicode.collation" "unicode.collation" } " vocabulary implements the Unicode Collation Algorithm. The Unicode Collation Algorithm (UTS #10) forms a reasonable way to sort strings when accouting for all of the characters in Unicode. It is far preferred over code point order when sorting for human consumption, in user interfaces. At the moment, only the default Unicode collation element table (DUCET) is used, but a more accurate collation would take locale into account. The following words are useful for collation directly:"
 { $subsection sort-strings }
 { $subsection collation-key }
 { $subsection string<=> }
+"Predicates for weak equality testing:"
 { $subsection primary= }
 { $subsection secondary= }
 { $subsection tertiary= }
@@ -14,12 +15,12 @@ ARTICLE: "unicode.collation" "Collation and weak comparison"
 ABOUT: "unicode.collation"
 
 HELP: sort-strings
-{ $values { "strings" "a sequence of strings" } { "sorted" "the strings in DUCET order" } }
+{ $values { "strings" "a sequence of strings" } { "sorted" "the strings in lexicographical order" } }
-{ $description "This word takes a sequence of strings and sorts them according to the UCA, using code point order as a tie-breaker." } ;
+{ $description "This word takes a sequence of strings and sorts them according to the Unicode Collation Algorithm with the default collation order described in the DUCET. It uses code point order as a tie-breaker." } ;
 
 HELP: collation-key
 { $values { "string" string } { "key" byte-array } }
-{ $description "This takes a string and gives a representation of the collation key, which can be compared with <=>" } ;
+{ $description "This takes a string and gives a representation of the collation key, which can be compared with " { $link <=> } ". The representation is according to the DUCET." } ;
 
 HELP: string<=>
 { $values { "str1" string } { "str2" string } { "<=>" "one of +lt+, +gt+ or +eq+" } }
@@ -27,16 +28,16 @@ HELP: string<=>
 
 HELP: primary=
 { $values { "str1" string } { "str2" string } { "?" "t or f" } }
-{ $description "This checks whether the first level of collation is identical. This is the least specific kind of equality test. In Latin script, it can be understood as ignoring case, punctuation and accent marks." } ;
+{ $description "This checks whether the first level of collation key is identical. This is the least specific kind of equality test. In Latin script, it can be understood as ignoring case, punctuation, whitespace and accent marks." } ;
 
 HELP: secondary=
 { $values { "str1" string } { "str2" string } { "?" "t or f" } }
-{ $description "This checks whether the first two levels of collation are equal. For Latin script, this means accent marks are significant again, and it is otherwise similar to primary=." } ;
+{ $description "This checks whether the first two levels of collation key are equal. For Latin script, this means accent marks are significant again, and it is otherwise similar to " { $link primary= } "." } ;
 
 HELP: tertiary=
 { $values { "str1" string } { "str2" string } { "?" "t or f" } }
-{ $description "Along the same lines as secondary=, but case is significant." } ;
+{ $description "This checks if the first three levels of collation key are equal. For Latin-based scripts, it can be understood as testing for what " { $link secondary= } " tests for, but case is significant." } ;
 
 HELP: quaternary=
 { $values { "str1" string } { "str2" string } { "?" "t or f" } }
-{ $description "This is similar to tertiary= but it makes punctuation significant again, while still leaving out things like null bytes and Hebrew vowel marks, which mean absolutely nothing in collation." } ;
+{ $description "This checks if the first four levels of collation key are equal. This is similar to " { $link tertiary= } " but it makes punctuation significant again, while still leaving out things like null bytes and Hebrew vowel marks, which mean absolutely nothing in collation." } ;

basis/xmode/code2html/code2html-tests.factor

@@ -0,0 +1,12 @@
+IN: xmode.code2html.tests
+USING: xmode.code2html xmode.catalog
+tools.test multiline splitting memoize
+kernel ;
+
+[ ] [ \ (load-mode) reset-memoized ] unit-test
+
+[ ] [
+    <" <style type="text/css" media="screen" >
+    *        {margin:0; padding:0; border:0;} ">
+    string-lines "html" htmlize-lines drop
+] unit-test

core/classes/tuple/tuple.factor

@@ -79,16 +79,16 @@ M: tuple-class slots>tuple
 
 ERROR: bad-superclass class ;
 
-<PRIVATE
-
 : tuple= ( tuple1 tuple2 -- ? )
+    2dup [ tuple? ] both? [
         2dup [ layout-of ] bi@ eq? [
             [ drop tuple-size ]
             [ [ [ drop array-nth ] [ nip array-nth ] 3bi = ] 2curry ]
             2bi all-integers?
-    ] [
+        ] [ 2drop f ] if
-        2drop f
+    ] [ 2drop f ] if ; inline
-    ] if ; inline
+
+<PRIVATE
 
 : tuple-predicate-quot/1 ( class -- quot )
     #! Fast path for tuples with no superclass
@@ -328,7 +328,9 @@ M: tuple clone (clone) ;
 
 M: tuple equal? over tuple? [ tuple= ] [ 2drop f ] if ;
 
-M: tuple hashcode*
+GENERIC: tuple-hashcode ( n tuple -- x )
+
+M: tuple tuple-hashcode
     [
         [ class hashcode ] [ tuple-size ] [ ] tri
         [ rot ] dip [
@@ -336,6 +338,8 @@ M: tuple hashcode*
         ] 2curry each
     ] recursive-hashcode ;
 
+M: tuple hashcode* tuple-hashcode ;
+
 M: tuple-class new
     dup "prototype" word-prop
     [ (clone) ] [ tuple-layout <tuple> ] ?if ;

core/io/files/files-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax io strings arrays io.backend
-io.files.private quotations ;
+io.files.private quotations sequences ;
 IN: io.files
 
 ARTICLE: "io.files" "Reading and writing files"
@@ -63,13 +63,13 @@ HELP: file-lines
 { $errors "Throws an error if the file cannot be opened for reading." } ;
 
 HELP: set-file-contents
-{ $values { "str" "a string" } { "path" "a pathname string" } { "encoding" "an encoding descriptor" } }
+{ $values { "seq" sequence } { "path" "a pathname string" } { "encoding" "an encoding descriptor" } }
-{ $description "Sets the contents of a file to a string with the given encoding." }
+{ $description "Sets the contents of a file to a sequence with the given encoding." }
 { $errors "Throws an error if the file cannot be opened for writing." } ;
 
 HELP: file-contents
-{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "str" "a string" } }
+{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "seq" sequence } }
-{ $description "Opens the file at the given path using the given encoding, and the contents of that file as a string." }
+{ $description "Opens the file at the given path using the given encoding, and the contents of that file as a sequence." }
 { $errors "Throws an error if the file cannot be opened for reading." } ;
 
 { set-file-lines file-lines set-file-contents file-contents } related-words

core/io/files/files-tests.factor

@@ -1,9 +1,8 @@
 USING: tools.test io.files io.files.private io.files.temp
 io.directories io.encodings.8-bit arrays make system
-io.encodings.binary io
+io.encodings.binary io threads kernel continuations
-threads kernel continuations io.encodings.ascii sequences
+io.encodings.ascii sequences strings accessors
-strings accessors io.encodings.utf8 math destructors namespaces
+io.encodings.utf8 math destructors namespaces ;
-;
 IN: io.files.tests
 
 \ exists? must-infer

core/io/files/files.factor

@@ -25,7 +25,7 @@ HOOK: (file-appender) io-backend ( path -- stream )
 : with-file-reader ( path encoding quot -- )
     [ <file-reader> ] dip with-input-stream ; inline
 
-: file-contents ( path encoding -- str )
+: file-contents ( path encoding -- seq )
     <file-reader> contents ;
 
 : with-file-writer ( path encoding quot -- )
@@ -34,7 +34,7 @@ HOOK: (file-appender) io-backend ( path -- stream )
 : set-file-lines ( seq path encoding -- )
     [ [ print ] each ] with-file-writer ;
 
-: set-file-contents ( str path encoding -- )
+: set-file-contents ( seq path encoding -- )
     [ write ] with-file-writer ;
 
 : with-file-appender ( path encoding quot -- )