diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor index d8bad5ec41..81359690db 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor +++ b/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 diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor index 86bd388d8d..ec8fe62dfb 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor +++ b/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* diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 5619a70740..d152a8cc33 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/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 } ; diff --git a/basis/compiler/cfg/value-numbering/expressions/expressions.factor b/basis/compiler/cfg/value-numbering/expressions/expressions.factor index 476ba7d0ab..cc790c6c0a 100644 --- a/basis/compiler/cfg/value-numbering/expressions/expressions.factor +++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor @@ -39,8 +39,6 @@ GENERIC: >expr ( insn -- expr ) M: ##load-immediate >expr val>> ; -M: ##load-indirect >expr obj>> ; - M: ##unary >expr [ class ] [ src>> vreg>vn ] bi unary-expr boa ; diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor index 641ccceb5d..ac9603522e 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor +++ b/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= } diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 91acbeed19..3d7f574cf8 100644 --- a/basis/compiler/codegen/codegen.factor +++ b/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 - [ dst>> register ] [ obj>> ] bi %load-indirect ; +M: ##load-reference generate-insn + [ dst>> register ] [ obj>> ] bi %load-reference ; M: ##peek generate-insn [ dst>> register ] [ loc>> ] bi %peek ; diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index 8ee120012d..78e95ffb91 100644 --- a/basis/compiler/tests/codegen.factor +++ b/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 \ No newline at end of file diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index c609b9e98d..5670110f04 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/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 -- ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 232608e4ef..b177c71d77 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/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 diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 5e06e72118..affd39ffc5 100755 --- a/basis/cpu/x86/32/32.factor +++ b/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 ; diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index e46c8f6914..8cc69958a4 100644 --- a/basis/cpu/x86/64/64.factor +++ b/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 -- ) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 44300a75f9..2859e71be2 100644 --- a/basis/cpu/x86/x86.factor +++ b/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 diff --git a/basis/farkup/farkup-tests.factor b/basis/farkup/farkup-tests.factor index ee09486a03..49c4dab0db 100644 --- a/basis/farkup/farkup-tests.factor +++ b/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 [ "" ] [ "[[]]" check-link-escaping ] unit-test diff --git a/basis/io/mmap/mmap-docs.factor b/basis/io/mmap/mmap-docs.factor index bd971656d4..5ef3400a6d 100644 --- a/basis/io/mmap/mmap-docs.factor +++ b/basis/io/mmap/mmap-docs.factor @@ -19,6 +19,7 @@ HELP: 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 diff --git a/basis/math/ranges/ranges-tests.factor b/basis/math/ranges/ranges-tests.factor index 825c68d1b9..aedd2f7933 100644 --- a/basis/math/ranges/ranges-tests.factor +++ b/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 @@ -11,7 +11,7 @@ IN: math.ranges.tests [ { 1 } ] [ 1 2 [a,b) >array ] unit-test [ { 1 2 } ] [ 1 2 [a,b] >array ] unit-test -[ { } ] [ 2 1 (a,b) >array ] unit-test +[ { } ] [ 2 1 (a,b) >array ] unit-test [ { 1 } ] [ 2 1 (a,b] >array ] unit-test [ { 2 } ] [ 2 1 [a,b) >array ] unit-test [ { 2 1 } ] [ 2 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 \ No newline at end of file diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor index 1a28904705..068f599b6f 100644 --- a/basis/math/ranges/ranges.factor +++ b/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 diff --git a/basis/unicode/collation/collation-docs.factor b/basis/unicode/collation/collation-docs.factor index 183ca85b69..990390e82f 100644 --- a/basis/unicode/collation/collation-docs.factor +++ b/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" } } -{ $description "This word takes a sequence of strings and sorts them according to the UCA, using code point order as a tie-breaker." } ; +{ $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 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." } ; diff --git a/basis/xmode/code2html/code2html-tests.factor b/basis/xmode/code2html/code2html-tests.factor new file mode 100644 index 0000000000..cd11ba50d0 --- /dev/null +++ b/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 + +[ ] [ + <"