From 1df869af6a9bc28f620f8dcd8f72ac6ae6aad9a8 Mon Sep 17 00:00:00 2001 From: Guillaume Nargeot Date: Tue, 15 Sep 2009 19:33:56 +0900 Subject: [PATCH 01/77] Solution to Project Euler problem 124 --- extra/project-euler/124/124-tests.factor | 4 ++ extra/project-euler/124/124.factor | 63 ++++++++++++++++++++++++ extra/project-euler/project-euler.factor | 8 +-- 3 files changed, 71 insertions(+), 4 deletions(-) create mode 100644 extra/project-euler/124/124-tests.factor create mode 100644 extra/project-euler/124/124.factor diff --git a/extra/project-euler/124/124-tests.factor b/extra/project-euler/124/124-tests.factor new file mode 100644 index 0000000000..cdbb5afc18 --- /dev/null +++ b/extra/project-euler/124/124-tests.factor @@ -0,0 +1,4 @@ +USING: project-euler.124 tools.test ; +IN: project-euler.124.tests + +[ 21417 ] [ euler124 ] unit-test diff --git a/extra/project-euler/124/124.factor b/extra/project-euler/124/124.factor new file mode 100644 index 0000000000..0f4d1ee28f --- /dev/null +++ b/extra/project-euler/124/124.factor @@ -0,0 +1,63 @@ +! Copyright (c) 2009 Guillaume Nargeot. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays kernel math.primes.factors +math.ranges project-euler.common sequences sorting ; +IN: project-euler.124 + +! http://projecteuler.net/index.php?section=problems&id=124 + +! DESCRIPTION +! ----------- + +! The radical of n, rad(n), is the product of distinct prime factors of n. +! For example, 504 = 2^3 × 3^2 × 7, so rad(504) = 2 × 3 × 7 = 42. + +! If we calculate rad(n) for 1 ≤ n ≤ 10, then sort them on rad(n), +! and sorting on n if the radical values are equal, we get: + +! Unsorted Sorted +! n rad(n) n rad(n) k +! 1 1 1 1 1 +! 2 2 2 2 2 +! 3 3 4 2 3 +! 4 2 8 2 4 +! 5 5 3 3 5 +! 6 6 9 3 6 +! 7 7 5 5 7 +! 8 2 6 6 8 +! 9 3 7 7 9 +! 10 10 10 10 10 + +! Let E(k) be the kth element in the sorted n column; for example, +! E(4) = 8 and E(6) = 9. + +! If rad(n) is sorted for 1 ≤ n ≤ 100000, find E(10000). + + +! SOLUTION +! -------- + + + +: euler124 ( -- answer ) + 10000 (euler124) nth first ; + +! [ euler124 ] 100 ave-time +! 373 ms ave run time - 17.61 SD (100 trials) + +! TODO: instead of the brute-force method, making the rad +! array in the way of the sieve of eratosthene would scale +! better on bigger values. + +SOLUTION: euler124 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index f0e40674da..eedf2272ba 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -20,10 +20,10 @@ USING: definitions io io.files io.pathnames kernel math math.parser 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.102 project-euler.112 - project-euler.116 project-euler.117 project-euler.134 project-euler.148 - project-euler.150 project-euler.151 project-euler.164 project-euler.169 - project-euler.173 project-euler.175 project-euler.186 project-euler.190 - project-euler.203 project-euler.215 ; + project-euler.116 project-euler.117 project-euler.124 project-euler.134 + project-euler.148 project-euler.150 project-euler.151 project-euler.164 + project-euler.169 project-euler.173 project-euler.175 project-euler.186 + project-euler.190 project-euler.203 project-euler.215 ; IN: project-euler Date: Tue, 15 Sep 2009 21:01:25 +0900 Subject: [PATCH 02/77] Fixed comments of project-euler.085 --- extra/project-euler/085/085.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/project-euler/085/085.factor b/extra/project-euler/085/085.factor index 6c70f65bf7..9c12367cdf 100644 --- a/extra/project-euler/085/085.factor +++ b/extra/project-euler/085/085.factor @@ -19,7 +19,7 @@ IN: project-euler.085 ! SOLUTION ! -------- -! A grid measuring x by y contains x * (x + 1) * y * (x + 1) rectangles. +! A grid measuring x by y contains x * (x + 1) * y * (x + 1) / 4 rectangles. area-of-nearest ; ! [ euler085 ] 100 ave-time -! 2285 ms ave run time - 4.8 SD (100 trials) +! 791 ms ave run time - 17.15 SD (100 trials) SOLUTION: euler085 From dc4a544a92b45a45161e5a8668c116618f64c87a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 19 Sep 2009 01:55:05 -0700 Subject: [PATCH 03/77] add multiline string support --- core/strings/parser/parser-tests.factor | 12 ++- core/strings/parser/parser.factor | 99 ++++++++++++++++++++++--- core/strings/strings.factor | 2 +- core/syntax/syntax-docs.factor | 2 +- core/syntax/syntax.factor | 2 +- 5 files changed, 102 insertions(+), 15 deletions(-) diff --git a/core/strings/parser/parser-tests.factor b/core/strings/parser/parser-tests.factor index 80f649c204..c7ce142269 100644 --- a/core/strings/parser/parser-tests.factor +++ b/core/strings/parser/parser-tests.factor @@ -1,4 +1,14 @@ -IN: strings.parser.tests USING: strings.parser tools.test ; +IN: strings.parser.tests [ "Hello\n\rworld" ] [ "Hello\\n\\rworld" unescape-string ] unit-test + +[ "Hello\n\rworld" ] [ "Hello\n\rworld" ] unit-test +[ "Hello\n\rworld" ] [ """Hello\n\rworld""" ] unit-test +[ "Hello\n\rworld\n" ] [ "Hello\n\rworld +" ] unit-test +[ "Hello\n\rworld" "hi" ] [ "Hello\n\rworld" "hi" ] unit-test +[ "Hello\n\rworld" "hi" ] [ """Hello\n\rworld""" """hi""" ] unit-test +[ "Hello\n\rworld\n" "hi" ] [ """Hello\n\rworld +""" """hi""" ] unit-test +[ "Hello\n\rworld\"" "hi" ] [ """Hello\n\rworld\"""" """hi""" ] unit-test diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index c6e58f659a..22b84c830e 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel assocs namespaces make splitting sequences -strings math.parser lexer accessors ; +USING: accessors assocs kernel lexer make math math.parser +namespaces parser sequences splitting strings arrays ; IN: strings.parser ERROR: bad-escape ; @@ -42,6 +42,18 @@ name>char-hook [ unclip-slice escape swap ] if ; +: (unescape-string) ( str -- ) + CHAR: \\ over index dup [ + cut-slice [ % ] dip rest-slice + next-escape [ , ] dip + (unescape-string) + ] [ + drop % + ] if ; + +: unescape-string ( str -- str' ) + [ (unescape-string) ] "" make ; + : (parse-string) ( str -- m ) dup [ "\"\\" member? ] find dup [ [ cut-slice [ % ] dip rest-slice ] dip @@ -59,14 +71,79 @@ name>char-hook [ [ swap tail-slice (parse-string) ] "" make swap ] change-lexer-column ; -: (unescape-string) ( str -- ) - CHAR: \\ over index dup [ - cut-slice [ % ] dip rest-slice - next-escape [ , ] dip - (unescape-string) +> ] [ line-text>> ] bi + ] dip swap subseq ] [ - drop % + lexer get (>>column) + ] bi ; + +: find-next-token ( ch -- i elt ) + CHAR: \ 2array + [ lexer get [ column>> ] [ line-text>> ] bi ] dip + [ member? ] curry find-from ; + +: rest-of-line ( -- seq ) + lexer get [ line-text>> ] [ column>> ] bi tail-slice ; + +: parse-escape ( i -- ) + lexer-advance % CHAR: \ , + lexer get + [ [ 2 + ] change-column drop ] + [ [ column>> 1 - ] [ line-text>> ] bi nth , ] bi ; + +: next-string-line ( obj -- ) + drop rest-of-line % + lexer get next-line "\n" % ; + +: rest-begins? ( string -- ? ) + [ + lexer get [ line-text>> ] [ column>> ] bi tail-slice + ] dip head? ; + +DEFER: (parse-long-string) + +: parse-rest-of-line ( string i token -- ) + CHAR: \ = [ + parse-escape (parse-long-string) + ] [ + lexer-advance % + dup rest-begins? [ + [ lexer get ] dip length [ + ] curry change-column drop + ] [ + rest-of-line % + lexer get next-line "\n" % (parse-long-string) + ] if ] if ; -: unescape-string ( str -- str' ) - [ (unescape-string) ] "" make ; +: parse-til-separator ( string -- ) + dup first find-next-token [ + parse-rest-of-line + ] [ + next-string-line (parse-long-string) + ] if* ; + +: (parse-long-string) ( string -- ) + lexer get still-parsing? [ + parse-til-separator + ] [ + unexpected-eof + ] if ; + +PRIVATE> + +: parse-long-string ( string -- string' ) + [ (parse-long-string) ] "" make unescape-string ; + +: parse-multiline-string ( -- string ) + rest-of-line "\"\"" head? [ + lexer get [ 2 + ] change-column drop + "\"\"\"" parse-long-string + ] [ + "\"" parse-long-string + ] if ; diff --git a/core/strings/strings.factor b/core/strings/strings.factor index 8ab0409318..18af08b3f6 100644 --- a/core/strings/strings.factor +++ b/core/strings/strings.factor @@ -25,7 +25,7 @@ PRIVATE> M: string equal? over string? [ - over hashcode over hashcode eq? + 2dup [ hashcode ] bi@ eq? [ sequence= ] [ 2drop f ] if ] [ 2drop f diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index e34fb0957f..551cc76c0e 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -532,7 +532,7 @@ HELP: CHAR: HELP: " { $syntax "\"string...\"" } { $values { "string" "literal and escaped characters" } } -{ $description "Reads from the input string until the next occurrence of " { $link POSTPONE: " } ", and appends the resulting string to the parse tree. String literals cannot span multiple lines. Strings containing the " { $link POSTPONE: " } " character and various other special characters can be read by inserting " { $link "escape" } "." } +{ $description "Reads from the input string until the next occurrence of " { $link POSTPONE: " } ", and appends the resulting string to the parse tree. String literals can span multiple lines. Strings containing the " { $link POSTPONE: " } " character and various other special characters can be read by inserting " { $link "escape" } "." } { $examples "A string with a newline in it:" { $example "USE: io" "\"Hello\\nworld\" print" "Hello\nworld" } diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 16645e3342..80c7a42f30 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -86,7 +86,7 @@ IN: bootstrap.syntax } cond parsed ] define-core-syntax - "\"" [ parse-string parsed ] define-core-syntax + "\"" [ parse-multiline-string parsed ] define-core-syntax "SBUF\"" [ lexer get skip-blank parse-string >sbuf parsed From de5731fa914ecc0872f150a0209459f8d0487e5d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 19 Sep 2009 14:14:47 -0500 Subject: [PATCH 04/77] make nested-comments work again with new strings --- .../nested-comments-tests.factor | 43 +++++++++++++++++++ extra/nested-comments/nested-comments.factor | 30 +++++++------ 2 files changed, 59 insertions(+), 14 deletions(-) create mode 100644 extra/nested-comments/nested-comments-tests.factor diff --git a/extra/nested-comments/nested-comments-tests.factor b/extra/nested-comments/nested-comments-tests.factor new file mode 100644 index 0000000000..2c446dc229 --- /dev/null +++ b/extra/nested-comments/nested-comments-tests.factor @@ -0,0 +1,43 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors eval kernel lexer nested-comments tools.test ; +IN: nested-comments.tests + +! Correct +[ ] [ + "USE: nested-comments (* comment *)" eval( -- ) +] unit-test + +[ ] [ + "USE: nested-comments (* comment*)" eval( -- ) +] unit-test + +[ ] [ + "USE: nested-comments (* comment +*)" eval( -- ) +] unit-test + +[ ] [ + "USE: nested-comments (* comment +*)" eval( -- ) +] unit-test + +[ ] [ + "USE: nested-comments (* comment +*)" eval( -- ) +] unit-test + +[ ] [ + "USE: nested-comments (* comment + (* *) + +*)" eval( -- ) +] unit-test + +! Malformed +[ + "USE: nested-comments (* comment + (* *)" eval( -- ) +] [ + error>> T{ unexpected f "*)" f } = +] must-fail-with diff --git a/extra/nested-comments/nested-comments.factor b/extra/nested-comments/nested-comments.factor index 94daffec2d..9c85574c80 100644 --- a/extra/nested-comments/nested-comments.factor +++ b/extra/nested-comments/nested-comments.factor @@ -1,20 +1,22 @@ -! by blei on #concatenative +! Copyright (C) 2009 blei, Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences math locals make multiline ; IN: nested-comments -:: (subsequences-at) ( sseq seq n -- ) - sseq seq n start* - [ dup , sseq length + [ sseq seq ] dip (subsequences-at) ] - when* ; +: (count-subsequences) ( count substring string n -- count' ) + [ 2dup ] dip start* [ + pick length + + [ 1 + ] 3dip (count-subsequences) + ] [ + 2drop + ] if* ; -: subsequences-at ( sseq seq -- indices ) - [ 0 (subsequences-at) ] { } make ; +: count-subsequences ( subseq seq -- n ) + [ 0 ] 2dip 0 (count-subsequences) ; -: count-subsequences ( sseq seq -- i ) - subsequences-at length ; +: parse-nestable-comment ( parsed-vector left-to-parse -- parsed-vector ) + 1 - "*)" parse-multiline-string + [ "(*" ] dip + count-subsequences + dup 0 > [ parse-nestable-comment ] [ drop ] if ; -: parse-all-(* ( parsed-vector left-to-parse -- parsed-vector ) - 1 - "*)" parse-multiline-string [ "(*" ] dip - count-subsequences + dup 0 > [ parse-all-(* ] [ drop ] if ; - -SYNTAX: (* 1 parse-all-(* ; \ No newline at end of file +SYNTAX: (* 1 parse-nestable-comment ; From e77341b90cb47978046c12bdbba1ead2de20a337 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 20 Sep 2009 02:08:32 -0500 Subject: [PATCH 05/77] math.vectors.simd: redesign to be more flexible, integer SIMD work in progress --- basis/alien/c-types/c-types.factor | 8 + basis/cpu/architecture/architecture.factor | 34 +++- basis/cpu/x86/features/features.factor | 49 ++--- basis/cpu/x86/x86.factor | 115 ++++++++++- basis/math/floats/env/x86/x86.factor | 4 +- .../math/vectors/simd/functor/functor.factor | 134 +++++++++++-- .../simd/intrinsics/intrinsics-tests.factor | 18 ++ .../vectors/simd/intrinsics/intrinsics.factor | 54 +++++- basis/math/vectors/simd/simd-docs.factor | 84 -------- basis/math/vectors/simd/simd.factor | 180 +----------------- basis/math/vectors/simd/summary.txt | 1 + 11 files changed, 363 insertions(+), 318 deletions(-) create mode 100644 basis/math/vectors/simd/intrinsics/intrinsics-tests.factor create mode 100644 basis/math/vectors/simd/summary.txt diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index fa27e29c04..afbb664fed 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -472,3 +472,11 @@ SYMBOLS: \ ulong \ size_t typedef ] with-compilation-unit +M: char-16-rep rep-component-type drop char ; +M: uchar-16-rep rep-component-type drop uchar ; +M: short-8-rep rep-component-type drop short ; +M: ushort-8-rep rep-component-type drop ushort ; +M: int-4-rep rep-component-type drop int ; +M: uint-4-rep rep-component-type drop uint ; +M: float-4-rep rep-component-type drop float ; +M: double-2-rep rep-component-type drop double ; diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index d6611c3384..61e4e2df37 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -22,8 +22,6 @@ SINGLETONS: float-rep double-rep ; ! On x86, floating point registers are really vector registers SINGLETONS: -float-4-rep -double-2-rep char-16-rep uchar-16-rep short-8-rep @@ -31,9 +29,11 @@ ushort-8-rep int-4-rep uint-4-rep ; -UNION: vector-rep +SINGLETONS: float-4-rep -double-2-rep +double-2-rep ; + +UNION: int-vector-rep char-16-rep uchar-16-rep short-8-rep @@ -41,6 +41,14 @@ ushort-8-rep int-4-rep uint-4-rep ; +UNION: float-vector-rep +float-4-rep +double-2-rep ; + +UNION: vector-rep +int-vector-rep +float-vector-rep ; + UNION: representation any-rep tagged-rep @@ -76,10 +84,15 @@ M: double-rep rep-size drop 8 ; M: stack-params rep-size drop cell ; M: vector-rep rep-size drop 16 ; +GENERIC: rep-component-type ( rep -- n ) + +! Methods defined in alien.c-types + GENERIC: scalar-rep-of ( rep -- rep' ) M: float-4-rep scalar-rep-of drop float-rep ; M: double-2-rep scalar-rep-of drop double-rep ; +M: int-vector-rep scalar-rep-of drop int-rep ; ! Mapping from register class to machine registers HOOK: machine-registers cpu ( -- assoc ) @@ -167,7 +180,6 @@ HOOK: %unbox-vector cpu ( dst src rep -- ) HOOK: %broadcast-vector cpu ( dst src rep -- ) HOOK: %gather-vector-2 cpu ( dst src1 src2 rep -- ) HOOK: %gather-vector-4 cpu ( dst src1 src2 src3 src4 rep -- ) - HOOK: %add-vector cpu ( dst src1 src2 rep -- ) HOOK: %sub-vector cpu ( dst src1 src2 rep -- ) HOOK: %mul-vector cpu ( dst src1 src2 rep -- ) @@ -177,6 +189,18 @@ HOOK: %max-vector cpu ( dst src1 src2 rep -- ) HOOK: %sqrt-vector cpu ( dst src rep -- ) HOOK: %horizontal-add-vector cpu ( dst src rep -- ) +HOOK: %broadcast-vector-reps cpu ( -- reps ) +HOOK: %gather-vector-2-reps cpu ( -- reps ) +HOOK: %gather-vector-4-reps cpu ( -- reps ) +HOOK: %add-vector-reps cpu ( -- reps ) +HOOK: %sub-vector-reps cpu ( -- reps ) +HOOK: %mul-vector-reps cpu ( -- reps ) +HOOK: %div-vector-reps cpu ( -- reps ) +HOOK: %min-vector-reps cpu ( -- reps ) +HOOK: %max-vector-reps cpu ( -- reps ) +HOOK: %sqrt-vector-reps cpu ( -- reps ) +HOOK: %horizontal-add-vector-reps cpu ( -- reps ) + HOOK: %unbox-alien cpu ( dst src -- ) HOOK: %unbox-any-c-ptr cpu ( dst src temp -- ) HOOK: %box-alien cpu ( dst src temp -- ) diff --git a/basis/cpu/x86/features/features.factor b/basis/cpu/x86/features/features.factor index c5cf2d470a..5fad4e802c 100644 --- a/basis/cpu/x86/features/features.factor +++ b/basis/cpu/x86/features/features.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: system kernel math math.order math.parser namespaces -alien.c-types alien.syntax combinators locals init io cpu.x86 +USING: system kernel memoize math math.order math.parser +namespaces alien.c-types alien.syntax combinators locals init io compiler compiler.units accessors ; IN: cpu.x86.features @@ -13,7 +13,16 @@ FUNCTION: longlong read_timestamp_counter ( ) ; PRIVATE> -ALIAS: sse-version sse_version +: sse-version ( -- n ) + sse_version + "sse-version" get string>number [ min ] when* ; foldable + +: sse? ( -- ? ) sse-version 10 >= ; foldable +: sse2? ( -- ? ) sse-version 20 >= ; foldable +: sse3? ( -- ? ) sse-version 30 >= ; foldable +: ssse3? ( -- ? ) sse-version 33 >= ; foldable +: sse4.1? ( -- ? ) sse-version 41 >= ; foldable +: sse4.2? ( -- ? ) sse-version 42 >= ; foldable : sse-string ( version -- string ) { @@ -32,37 +41,3 @@ M: x86 instruction-count read_timestamp_counter ; : count-instructions ( quot -- n ) instruction-count [ call ] dip instruction-count swap - ; inline - -USING: cpu.x86.features cpu.x86.features.private ; - -:: install-sse-check ( version -- ) - [ - sse-version version < [ - "This image was built to use " write - version sse-string write - " but your CPU only supports " write - sse-version sse-string write "." print - "You will need to bootstrap Factor again." print - flush - 1 exit - ] when - ] "cpu.x86" add-init-hook ; - -: enable-sse ( version -- ) - { - { 00 [ ] } - { 10 [ ] } - { 20 [ enable-sse2 ] } - { 30 [ enable-sse3 ] } - { 33 [ enable-sse3 ] } - { 41 [ enable-sse3 ] } - { 42 [ enable-sse3 ] } - } case ; - -[ { sse_version } compile ] with-optimizer - -"Checking for multimedia extensions: " write sse-version -"sse-version" get [ string>number min ] when* -[ sse-string write " detected" print ] -[ install-sse-check ] -[ enable-sse ] tri diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 04b5308836..4d80862ed3 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -4,7 +4,8 @@ USING: accessors assocs alien alien.c-types arrays strings cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands cpu.architecture kernel kernel.private math memory namespaces make sequences words system layouts combinators math.order fry locals -compiler.constants byte-arrays +compiler.constants byte-arrays io macros quotations cpu.x86.features +cpu.x86.features.private compiler compiler.units init compiler.cfg.registers compiler.cfg.instructions compiler.cfg.intrinsics @@ -250,12 +251,26 @@ M:: x86 %unbox-vector ( dst src rep -- ) dst src byte-array-offset [+] rep copy-register ; +MACRO: available-reps ( alist -- ) + ! Each SSE version adds new representations and supports + ! all old ones + unzip { } [ append ] accumulate rest swap suffix + [ [ 1quotation ] map ] bi@ zip + reverse [ { } ] suffix + '[ _ cond ] ; + M: x86 %broadcast-vector ( dst src rep -- ) { { float-4-rep [ [ MOVSS ] [ drop dup 0 SHUFPS ] 2bi ] } { double-2-rep [ [ MOVSD ] [ drop dup UNPCKLPD ] 2bi ] } } case ; +M: x86 %broadcast-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep } } + } available-reps ; + M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- ) rep { { @@ -269,6 +284,11 @@ M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- ) } } case ; +M: x86 %gather-vector-4-reps + { + { sse? { float-4-rep } } + } available-reps ; + M:: x86 %gather-vector-2 ( dst src1 src2 rep -- ) rep { { @@ -280,6 +300,11 @@ M:: x86 %gather-vector-2 ( dst src1 src2 rep -- ) } } case ; +M: x86 %gather-vector-2-reps + { + { sse2? { double-2-rep } } + } available-reps ; + M: x86 %add-vector ( dst src1 src2 rep -- ) { { float-4-rep [ ADDPS ] } @@ -292,6 +317,12 @@ M: x86 %add-vector ( dst src1 src2 rep -- ) { uint-4-rep [ PADDD ] } } case drop ; +M: x86 %add-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } } + } available-reps ; + M: x86 %sub-vector ( dst src1 src2 rep -- ) { { float-4-rep [ SUBPS ] } @@ -304,43 +335,92 @@ M: x86 %sub-vector ( dst src1 src2 rep -- ) { uint-4-rep [ PSUBD ] } } case drop ; +M: x86 %sub-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } } + } available-reps ; + M: x86 %mul-vector ( dst src1 src2 rep -- ) { { float-4-rep [ MULPS ] } { double-2-rep [ MULPD ] } - { int-4-rep [ PMULLW ] } + { short-8-rep [ PMULLW ] } + { ushort-8-rep [ PMULLW ] } + { int-4-rep [ PMULLD ] } + { uint-4-rep [ PMULLD ] } } case drop ; +M: x86 %mul-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } } + } available-reps ; + M: x86 %div-vector ( dst src1 src2 rep -- ) { { float-4-rep [ DIVPS ] } { double-2-rep [ DIVPD ] } } case drop ; +M: x86 %div-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep } } + } available-reps ; + M: x86 %min-vector ( dst src1 src2 rep -- ) { { float-4-rep [ MINPS ] } { double-2-rep [ MINPD ] } + { uchar-16-rep [ PMINUB ] } + { short-8-rep [ PMINSW ] } } case drop ; +M: x86 %min-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep short-8-rep uchar-16-rep } } + } available-reps ; + M: x86 %max-vector ( dst src1 src2 rep -- ) { { float-4-rep [ MAXPS ] } { double-2-rep [ MAXPD ] } + { uchar-16-rep [ PMAXUB ] } + { short-8-rep [ PMAXSW ] } } case drop ; +M: x86 %max-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep short-8-rep uchar-16-rep } } + } available-reps ; + M: x86 %sqrt-vector ( dst src rep -- ) { { float-4-rep [ SQRTPS ] } { double-2-rep [ SQRTPD ] } } case ; +M: x86 %sqrt-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep } } + } available-reps ; + M: x86 %horizontal-add-vector ( dst src rep -- ) { { float-4-rep [ [ MOVAPS ] [ HADDPS ] [ HADDPS ] 2tri ] } { double-2-rep [ [ MOVAPD ] [ HADDPD ] 2bi ] } } case ; +M: x86 %horizontal-add-vector-reps + { + { sse? { float-4-rep } } + { sse2? { double-2-rep short-8-rep uchar-16-rep } } + } available-reps ; + M: x86 %unbox-alien ( dst src -- ) alien-offset [+] MOV ; @@ -775,3 +855,34 @@ M: x86 small-enough? ( n -- ? ) enable-sse3-simd ; enable-min/max + +:: install-sse-check ( version -- ) + [ + sse-version version < [ + "This image was built to use " write + version sse-string write + " but your CPU only supports " write + sse-version sse-string write "." print + "You will need to bootstrap Factor again." print + flush + 1 exit + ] when + ] "cpu.x86" add-init-hook ; + +: enable-sse ( version -- ) + { + { 00 [ ] } + { 10 [ ] } + { 20 [ enable-sse2 ] } + { 30 [ enable-sse3 ] } + { 33 [ enable-sse3 ] } + { 41 [ enable-sse3 ] } + { 42 [ enable-sse3 ] } + } case ; + +[ { sse_version } compile ] with-optimizer + +"Checking for multimedia extensions: " write sse-version 30 min +[ sse-string write " detected" print ] +[ install-sse-check ] +[ enable-sse ] tri diff --git a/basis/math/floats/env/x86/x86.factor b/basis/math/floats/env/x86/x86.factor index e91fc4eda9..e9120567aa 100644 --- a/basis/math/floats/env/x86/x86.factor +++ b/basis/math/floats/env/x86/x86.factor @@ -31,9 +31,7 @@ M: x87-env (set-fp-env-register) set_x87_env ; M: x86 (fp-env-registers) - sse-version 20 >= - [ 2array ] - [ 1array ] if ; + sse2? [ 2array ] [ 1array ] if ; CONSTANT: sse-exception-flag-bits HEX: 3f CONSTANT: sse-exception-flag>bit diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor index 641585a5d7..a97dc192be 100644 --- a/basis/math/vectors/simd/functor/functor.factor +++ b/basis/math/vectors/simd/functor/functor.factor @@ -1,24 +1,94 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types byte-arrays classes functors -kernel math parser prettyprint.custom sequences -sequences.private literals ; +USING: accessors alien.c-types assocs byte-arrays classes +effects fry functors generalizations kernel literals locals +math math.functions math.vectors math.vectors.simd.intrinsics +math.vectors.specialization parser prettyprint.custom sequences +sequences.private strings words definitions macros cpu.architecture ; IN: math.vectors.simd.functor ERROR: bad-length got expected ; +MACRO: simd-boa ( rep class -- simd-array ) + [ rep-components ] [ new ] bi* '[ _ _ nsequence ] ; + +:: define-boa-custom-inlining ( word rep class -- ) + word [ + drop + rep rep rep-gather-word supported-simd-op? [ + [ rep (simd-boa) class boa ] + ] [ word def>> ] if + ] "custom-inlining" set-word-prop ; + +: simd-with ( rep class x -- simd-array ) + [ rep-components ] [ new ] [ '[ _ ] ] tri* swap replicate-as ; inline + +:: define-with-custom-inlining ( word rep class -- ) + word [ + drop + rep \ (simd-broadcast) supported-simd-op? [ + [ rep rep-coerce rep (simd-broadcast) class boa ] + ] [ word def>> ] if + ] "custom-inlining" set-word-prop ; + +: boa-effect ( rep n -- effect ) + [ rep-components ] dip * + [ CHAR: a + 1string ] map + { "simd-vector" } ; + +: supported-simd-ops ( assoc rep -- assoc' ) + [ + { + { v+ (simd-v+) } + { v- (simd-v-) } + { v* (simd-v*) } + { v/ (simd-v/) } + { vmin (simd-vmin) } + { vmax (simd-vmax) } + { sum (simd-sum) } + } + ] dip + '[ nip _ swap supported-simd-op? ] assoc-filter + '[ drop _ key? ] assoc-filter ; + +:: high-level-ops ( ctor -- assoc ) + ! Some SIMD operations are defined in terms of others. + { + { vneg [ [ dup v- ] keep v- ] } + { v. [ v* sum ] } + { n+v [ [ ctor execute ] dip v+ ] } + { v+n [ ctor execute v+ ] } + { n-v [ [ ctor execute ] dip v- ] } + { v-n [ ctor execute v- ] } + { n*v [ [ ctor execute ] dip v* ] } + { v*n [ ctor execute v* ] } + { n/v [ [ ctor execute ] dip v/ ] } + { v/n [ ctor execute v/ ] } + { norm-sq [ dup v. assert-positive ] } + { norm [ norm-sq sqrt ] } + { normalize [ dup norm v/n ] } + { distance [ v- norm ] } + } ; + +:: simd-vector-words ( class ctor rep assoc -- ) + class + rep rep-component-type c-type-boxed-class + assoc rep supported-simd-ops + ctor high-level-ops assoc-union + specialize-vector-words ; + FUNCTOR: define-simd-128 ( T -- ) -T-TYPE IS ${T} - -N [ 16 T-TYPE heap-size /i ] +N [ 16 T heap-size /i ] A DEFINES-CLASS ${T}-${N} +A-boa DEFINES ${A}-boa +A-with DEFINES ${A}-with >A DEFINES >${A} A{ DEFINES ${A}{ -NTH [ T-TYPE dup c-type-getter-boxer array-accessor ] -SET-NTH [ T-TYPE dup c-setter array-accessor ] +NTH [ T dup c-type-getter-boxer array-accessor ] +SET-NTH [ T dup c-setter array-accessor ] A-rep IS ${A}-rep A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op @@ -59,6 +129,16 @@ M: A pprint* pprint-object ; SYNTAX: A{ \ } [ >A ] parse-literal ; +: A-with ( x -- simd-array ) [ A-rep A ] dip simd-with ; + +\ A-with \ A-rep \ A define-with-custom-inlining + +\ A-boa [ \ A-rep \ A simd-boa ] \ A-rep 1 boa-effect define-declared + +\ A-rep rep-gather-word [ + \ A-boa \ A-rep \ A define-boa-custom-inlining +] when + INSTANCE: A sequence n-op ( v quot -- n ) [ underlying>> A-rep ] dip call ; inline +\ A \ A-with \ A-rep H{ + { v+ [ [ (simd-v+) ] \ A-vv->v-op execute ] } + { v- [ [ (simd-v-) ] \ A-vv->v-op execute ] } + { v* [ [ (simd-v*) ] \ A-vv->v-op execute ] } + { v/ [ [ (simd-v/) ] \ A-vv->v-op execute ] } + { vmin [ [ (simd-vmin) ] \ A-vv->v-op execute ] } + { vmax [ [ (simd-vmax) ] \ A-vv->v-op execute ] } + { sum [ [ (simd-sum) ] \ A-v->n-op execute ] } +} simd-vector-words + PRIVATE> ;FUNCTOR @@ -76,14 +166,16 @@ PRIVATE> ! Synthesize 256-bit vectors from a pair of 128-bit vectors FUNCTOR: define-simd-256 ( T -- ) -T-TYPE IS ${T} - -N [ 32 T-TYPE heap-size /i ] +N [ 32 T heap-size /i ] N/2 [ N 2 / ] A/2 IS ${T}-${N/2} +A/2-boa IS ${A/2}-boa +A/2-with IS ${A/2}-with A DEFINES-CLASS ${T}-${N} +A-boa DEFINES ${A}-boa +A-with DEFINES ${A}-with >A DEFINES >${A} A{ DEFINES ${A}{ @@ -137,6 +229,16 @@ M: A >pprint-sequence ; M: A pprint* pprint-object ; +: A-with ( x -- simd-array ) + [ A/2-with ] [ A/2-with ] bi [ underlying>> ] bi@ + \ A boa ; inline + +: A-boa ( ... -- simd-array ) + [ A/2-boa ] N/2 ndip A/2-boa [ underlying>> ] bi@ + \ A boa ; + +\ A-rep 2 boa-effect \ A-boa set-stack-effect + INSTANCE: A sequence : A-vv->v-op ( v1 v2 quot -- v3 ) @@ -148,4 +250,14 @@ INSTANCE: A sequence [ [ [ underlying1>> ] [ underlying2>> ] bi A-rep ] dip call A-rep ] dip call ; inline +\ A \ A-with \ A-rep H{ + { v+ [ [ (simd-v+) ] \ A-vv->v-op execute ] } + { v- [ [ (simd-v-) ] \ A-vv->v-op execute ] } + { v* [ [ (simd-v*) ] \ A-vv->v-op execute ] } + { v/ [ [ (simd-v/) ] \ A-vv->v-op execute ] } + { vmin [ [ (simd-vmin) ] \ A-vv->v-op execute ] } + { vmax [ [ (simd-vmax) ] \ A-vv->v-op execute ] } + { sum [ [ (simd-v+) ] [ (simd-sum) ] \ A-v->n-op execute ] } +} simd-vector-words + ;FUNCTOR diff --git a/basis/math/vectors/simd/intrinsics/intrinsics-tests.factor b/basis/math/vectors/simd/intrinsics/intrinsics-tests.factor new file mode 100644 index 0000000000..84eee935a0 --- /dev/null +++ b/basis/math/vectors/simd/intrinsics/intrinsics-tests.factor @@ -0,0 +1,18 @@ +IN: math.vectors.simd.intrinsics.tests +USING: math.vectors.simd.intrinsics cpu.architecture tools.test ; + +[ 16 ] [ uchar-16-rep rep-components ] unit-test +[ 16 ] [ char-16-rep rep-components ] unit-test +[ 8 ] [ ushort-8-rep rep-components ] unit-test +[ 8 ] [ short-8-rep rep-components ] unit-test +[ 4 ] [ uint-4-rep rep-components ] unit-test +[ 4 ] [ int-4-rep rep-components ] unit-test +[ 4 ] [ float-4-rep rep-components ] unit-test +[ 2 ] [ double-2-rep rep-components ] unit-test + +{ 4 1 } [ uint-4-rep (simd-boa) ] must-infer-as +{ 4 1 } [ int-4-rep (simd-boa) ] must-infer-as +{ 4 1 } [ float-4-rep (simd-boa) ] must-infer-as +{ 2 1 } [ double-2-rep (simd-boa) ] must-infer-as + + diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index 914d1ef169..a7d019af81 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -1,6 +1,8 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel alien alien.data cpu.architecture libc ; +USING: alien alien.c-types alien.data assocs combinators +cpu.architecture fry generalizations kernel libc macros math +sequences ; IN: math.vectors.simd.intrinsics ERROR: bad-simd-call ; @@ -26,3 +28,53 @@ ERROR: bad-simd-call ; ! Inefficient version for when intrinsics are missing [ swap swap ] dip rep-size memcpy ; +<< + +: rep-components ( rep -- n ) + 16 swap rep-component-type heap-size /i ; foldable + +: rep-coercer ( rep -- quot ) + { + { [ dup int-vector-rep? ] [ [ >fixnum ] ] } + { [ dup float-vector-rep? ] [ [ >float ] ] } + } cond nip ; foldable + +: rep-coerce ( value rep -- value' ) + rep-coercer call( value -- value' ) ; inline + +CONSTANT: rep-gather-words + { + { 2 (simd-gather-2) } + { 4 (simd-gather-4) } + } + +: rep-gather-word ( rep -- word ) + rep-components rep-gather-words at ; + +>> + +MACRO: (simd-boa) ( rep -- quot ) + { + [ rep-coercer ] + [ rep-components ] + [ ] + [ rep-gather-word ] + } cleave + '[ _ _ napply _ _ execute ] ; + +GENERIC# supported-simd-op? 1 ( rep intrinsic -- ? ) + +M: vector-rep supported-simd-op? + { + { \ (simd-v+) [ %add-vector-reps ] } + { \ (simd-v-) [ %sub-vector-reps ] } + { \ (simd-v*) [ %mul-vector-reps ] } + { \ (simd-v/) [ %div-vector-reps ] } + { \ (simd-vmin) [ %min-vector-reps ] } + { \ (simd-vmax) [ %max-vector-reps ] } + { \ (simd-vsqrt) [ %sqrt-vector-reps ] } + { \ (simd-sum) [ %horizontal-add-vector-reps ] } + { \ (simd-broadcast) [ %broadcast-vector-reps ] } + { \ (simd-gather-2) [ %gather-vector-2-reps ] } + { \ (simd-gather-4) [ %gather-vector-4-reps ] } + } case member? ; diff --git a/basis/math/vectors/simd/simd-docs.factor b/basis/math/vectors/simd/simd-docs.factor index b110de1de8..d6131b3a71 100644 --- a/basis/math/vectors/simd/simd-docs.factor +++ b/basis/math/vectors/simd/simd-docs.factor @@ -43,22 +43,6 @@ $nl } "The " { $link float-4 } " and " { $link double-2 } " types correspond to 128-bit vector registers. The " { $link float-8 } " and " { $link double-4 } " types are not directly supported in hardware, and instead unbox to a pair of 128-bit vector registers." $nl -"Operations on " { $link float-4 } " instances:" -{ $subsection float-4-with } -{ $subsection float-4-boa } -{ $subsection POSTPONE: float-4{ } -"Operations on " { $link double-2 } " instances:" -{ $subsection double-2-with } -{ $subsection double-2-boa } -{ $subsection POSTPONE: double-2{ } -"Operations on " { $link float-8 } " instances:" -{ $subsection float-8-with } -{ $subsection float-8-boa } -{ $subsection POSTPONE: float-8{ } -"Operations on " { $link double-4 } " instances:" -{ $subsection double-4-with } -{ $subsection double-4-boa } -{ $subsection POSTPONE: double-4{ } "To actually perform vector arithmetic on SIMD vectors, use " { $link "math-vectors" } " words." { $see-also "c-types-specs" } ; @@ -184,72 +168,4 @@ ARTICLE: "math.vectors.simd" "Hardware vector arithmetic (SIMD)" { $subsection "math.vectors.simd.alien" } { $subsection "math.vectors.simd.intrinsics" } ; -! ! ! float-4 - -HELP: float-4 -{ $class-description "A sequence of four single-precision floating point values. New instances can be created with " { $link float-4-with } " or " { $link float-4-boa } "." } ; - -HELP: float-4-with -{ $values { "x" float } { "simd-array" float-4 } } -{ $description "Creates a new vector with all four components equal to a scalar." } ; - -HELP: float-4-boa -{ $values { "a" float } { "b" float } { "c" float } { "d" float } { "simd-array" float-4 } } -{ $description "Creates a new vector from four scalar components." } ; - -HELP: float-4{ -{ $syntax "float-4{ a b c d }" } -{ $description "Literal syntax for a " { $link float-4 } "." } ; - -! ! ! double-2 - -HELP: double-2 -{ $class-description "A sequence of two double-precision floating point values. New instances can be created with " { $link double-2-with } " or " { $link double-2-boa } "." } ; - -HELP: double-2-with -{ $values { "x" float } { "simd-array" double-2 } } -{ $description "Creates a new vector with both components equal to a scalar." } ; - -HELP: double-2-boa -{ $values { "a" float } { "b" float } { "simd-array" double-2 } } -{ $description "Creates a new vector from two scalar components." } ; - -HELP: double-2{ -{ $syntax "double-2{ a b }" } -{ $description "Literal syntax for a " { $link double-2 } "." } ; - -! ! ! float-8 - -HELP: float-8 -{ $class-description "A sequence of eight single-precision floating point values. New instances can be created with " { $link float-8-with } " or " { $link float-8-boa } "." } ; - -HELP: float-8-with -{ $values { "x" float } { "simd-array" float-8 } } -{ $description "Creates a new vector with all eight components equal to a scalar." } ; - -HELP: float-8-boa -{ $values { "a" float } { "b" float } { "c" float } { "d" float } { "e" float } { "f" float } { "g" float } { "h" float } { "simd-array" float-8 } } -{ $description "Creates a new vector from eight scalar components." } ; - -HELP: float-8{ -{ $syntax "float-8{ a b c d e f g h }" } -{ $description "Literal syntax for a " { $link float-8 } "." } ; - -! ! ! double-4 - -HELP: double-4 -{ $class-description "A sequence of four double-precision floating point values. New instances can be created with " { $link double-4-with } " or " { $link double-4-boa } "." } ; - -HELP: double-4-with -{ $values { "x" float } { "simd-array" double-4 } } -{ $description "Creates a new vector with all four components equal to a scalar." } ; - -HELP: double-4-boa -{ $values { "a" float } { "b" float } { "c" float } { "d" float } { "simd-array" double-4 } } -{ $description "Creates a new vector from four scalar components." } ; - -HELP: double-4{ -{ $syntax "double-4{ a b c d }" } -{ $description "Literal syntax for a " { $link double-4 } "." } ; - ABOUT: "math.vectors.simd" diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor index a3c99ae217..c5e7d6f75d 100644 --- a/basis/math/vectors/simd/simd.factor +++ b/basis/math/vectors/simd/simd.factor @@ -1,185 +1,15 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types byte-arrays cpu.architecture -kernel math math.functions math.vectors -math.vectors.simd.functor math.vectors.simd.intrinsics -math.vectors.specialization parser prettyprint.custom sequences -sequences.private locals assocs words fry ; -FROM: alien.c-types => float ; -QUALIFIED-WITH: math m +USING: alien.c-types cpu.architecture kernel +math.vectors.simd.functor vocabs.loader ; +FROM: sequences => each ; IN: math.vectors.simd << -DEFER: float-4 -DEFER: double-2 -DEFER: float-8 -DEFER: double-4 - -"double" define-simd-128 -"float" define-simd-128 -"double" define-simd-256 -"float" define-simd-256 +{ double float char uchar short ushort int uint } +[ [ define-simd-128 ] [ define-simd-256 ] bi ] each >> -: float-4-with ( x -- simd-array ) - [ 4 ] dip >float '[ _ ] \ float-4 new replicate-as ; - -: float-4-boa ( a b c d -- simd-array ) - \ float-4 new 4sequence ; - -: double-2-with ( x -- simd-array ) - [ 2 ] dip >float '[ _ ] \ double-2 new replicate-as ; - -: double-2-boa ( a b -- simd-array ) - \ double-2 new 2sequence ; - -! More efficient expansions for the above, used when SIMD is -! actually available. - -<< - -\ float-4-with [ - drop - \ (simd-broadcast) "intrinsic" word-prop [ - [ >float float-4-rep (simd-broadcast) \ float-4 boa ] - ] [ \ float-4-with def>> ] if -] "custom-inlining" set-word-prop - -\ float-4-boa [ - drop - \ (simd-gather-4) "intrinsic" word-prop [ - [| a b c d | - a >float b >float c >float d >float - float-4-rep (simd-gather-4) \ float-4 boa - ] - ] [ \ float-4-boa def>> ] if -] "custom-inlining" set-word-prop - -\ double-2-with [ - drop - \ (simd-broadcast) "intrinsic" word-prop [ - [ >float double-2-rep (simd-broadcast) \ double-2 boa ] - ] [ \ double-2-with def>> ] if -] "custom-inlining" set-word-prop - -\ double-2-boa [ - drop - \ (simd-gather-4) "intrinsic" word-prop [ - [ [ >float ] bi@ double-2-rep (simd-gather-2) \ double-2 boa ] - ] [ \ double-2-boa def>> ] if -] "custom-inlining" set-word-prop - ->> - -: float-8-with ( x -- simd-array ) - [ float-4-with ] [ float-4-with ] bi [ underlying>> ] bi@ - \ float-8 boa ; inline - -:: float-8-boa ( a b c d e f g h -- simd-array ) - a b c d float-4-boa - e f g h float-4-boa - [ underlying>> ] bi@ - \ float-8 boa ; inline - -: double-4-with ( x -- simd-array ) - [ double-2-with ] [ double-2-with ] bi [ underlying>> ] bi@ - \ double-4 boa ; inline - -:: double-4-boa ( a b c d -- simd-array ) - a b double-2-boa - c d double-2-boa - [ underlying>> ] bi@ - \ double-4 boa ; inline - -<< - - - -\ float-4 \ float-4-with m:float H{ - { v+ [ [ (simd-v+) ] float-4-vv->v-op ] } - { v- [ [ (simd-v-) ] float-4-vv->v-op ] } - { v* [ [ (simd-v*) ] float-4-vv->v-op ] } - { v/ [ [ (simd-v/) ] float-4-vv->v-op ] } - { vmin [ [ (simd-vmin) ] float-4-vv->v-op ] } - { vmax [ [ (simd-vmax) ] float-4-vv->v-op ] } - { sum [ [ (simd-sum) ] float-4-v->n-op ] } -} simd-vector-words - -\ double-2 \ double-2-with m:float H{ - { v+ [ [ (simd-v+) ] double-2-vv->v-op ] } - { v- [ [ (simd-v-) ] double-2-vv->v-op ] } - { v* [ [ (simd-v*) ] double-2-vv->v-op ] } - { v/ [ [ (simd-v/) ] double-2-vv->v-op ] } - { vmin [ [ (simd-vmin) ] double-2-vv->v-op ] } - { vmax [ [ (simd-vmax) ] double-2-vv->v-op ] } - { sum [ [ (simd-sum) ] double-2-v->n-op ] } -} simd-vector-words - -\ float-8 \ float-8-with m:float H{ - { v+ [ [ (simd-v+) ] float-8-vv->v-op ] } - { v- [ [ (simd-v-) ] float-8-vv->v-op ] } - { v* [ [ (simd-v*) ] float-8-vv->v-op ] } - { v/ [ [ (simd-v/) ] float-8-vv->v-op ] } - { vmin [ [ (simd-vmin) ] float-8-vv->v-op ] } - { vmax [ [ (simd-vmax) ] float-8-vv->v-op ] } - { sum [ [ (simd-sum) ] [ + ] float-8-v->n-op ] } -} simd-vector-words - -\ double-4 \ double-4-with m:float H{ - { v+ [ [ (simd-v+) ] double-4-vv->v-op ] } - { v- [ [ (simd-v-) ] double-4-vv->v-op ] } - { v* [ [ (simd-v*) ] double-4-vv->v-op ] } - { v/ [ [ (simd-v/) ] double-4-vv->v-op ] } - { vmin [ [ (simd-vmin) ] double-4-vv->v-op ] } - { vmax [ [ (simd-vmax) ] double-4-vv->v-op ] } - { sum [ [ (simd-v+) ] [ (simd-sum) ] double-4-v->n-op ] } -} simd-vector-words - ->> - -USE: vocabs.loader - "math.vectors.simd.alien" require diff --git a/basis/math/vectors/simd/summary.txt b/basis/math/vectors/simd/summary.txt new file mode 100644 index 0000000000..22593f1286 --- /dev/null +++ b/basis/math/vectors/simd/summary.txt @@ -0,0 +1 @@ +Single-instruction-multiple-data parallel vector operations From e3ff59c30366f1888441ab0fe4d77a06504269f3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 20 Sep 2009 14:18:19 -0500 Subject: [PATCH 06/77] the last character on a multiline string cannot be a backslash --- core/strings/parser/parser-tests.factor | 9 ++++++- core/strings/parser/parser.factor | 32 +++++++++++++++++++------ 2 files changed, 33 insertions(+), 8 deletions(-) diff --git a/core/strings/parser/parser-tests.factor b/core/strings/parser/parser-tests.factor index c7ce142269..c9e5fe1aca 100644 --- a/core/strings/parser/parser-tests.factor +++ b/core/strings/parser/parser-tests.factor @@ -1,4 +1,5 @@ -USING: strings.parser tools.test ; +USING: accessors eval strings.parser strings.parser.private +tools.test ; IN: strings.parser.tests [ "Hello\n\rworld" ] [ "Hello\\n\\rworld" unescape-string ] unit-test @@ -12,3 +13,9 @@ IN: strings.parser.tests [ "Hello\n\rworld\n" "hi" ] [ """Hello\n\rworld """ """hi""" ] unit-test [ "Hello\n\rworld\"" "hi" ] [ """Hello\n\rworld\"""" """hi""" ] unit-test + +[ + "\"\"\"Hello\n\rworld\\\n\"\"\"" eval( -- obj ) +] [ + error>> escaped-char-expected? +] must-fail-with diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index 22b84c830e..e25b640db8 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -91,11 +91,26 @@ name>char-hook [ : rest-of-line ( -- seq ) lexer get [ line-text>> ] [ column>> ] bi tail-slice ; +: current-char ( lexer -- ch ) + [ column>> ] [ line-text>> ] bi nth ; + +: advance-char ( lexer -- ) + [ 1 + ] change-column drop ; + +ERROR: escaped-char-expected ; + +: next-char ( lexer -- ch ) + dup still-parsing-line? [ + [ current-char ] [ advance-char ] bi + ] [ + escaped-char-expected + ] if ; + : parse-escape ( i -- ) lexer-advance % CHAR: \ , lexer get - [ [ 2 + ] change-column drop ] - [ [ column>> 1 - ] [ line-text>> ] bi nth , ] bi ; + [ advance-char ] + [ next-char , ] bi ; : next-string-line ( obj -- ) drop rest-of-line % @@ -135,15 +150,18 @@ DEFER: (parse-long-string) unexpected-eof ] if ; -PRIVATE> - : parse-long-string ( string -- string' ) - [ (parse-long-string) ] "" make unescape-string ; + [ (parse-long-string) ] "" make ; + +: parse-long-string-escaped ( string -- string' ) + parse-long-string unescape-string ; + +PRIVATE> : parse-multiline-string ( -- string ) rest-of-line "\"\"" head? [ lexer get [ 2 + ] change-column drop - "\"\"\"" parse-long-string + "\"\"\"" parse-long-string-escaped ] [ - "\"" parse-long-string + "\"" parse-long-string-escaped ] if ; From 31e7d355fe1ce8dc5909c675f7952f6e5435c015 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 20 Sep 2009 15:08:06 -0500 Subject: [PATCH 07/77] fixing some quotes in strings bugs --- core/strings/parser/parser-tests.factor | 12 ++++++++++++ core/strings/parser/parser.factor | 3 +-- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/core/strings/parser/parser-tests.factor b/core/strings/parser/parser-tests.factor index c9e5fe1aca..4f14869685 100644 --- a/core/strings/parser/parser-tests.factor +++ b/core/strings/parser/parser-tests.factor @@ -19,3 +19,15 @@ IN: strings.parser.tests ] [ error>> escaped-char-expected? ] must-fail-with + +[ + " \" abc \" " +] [ + "\"\"\" \" abc \" \"\"\"" eval( -- string ) +] unit-test + +[ + "\"abc\"" +] [ + "\"\"\"\"abc\"\"\"\"" eval( -- string ) +] unit-test diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index e25b640db8..2ee82a53e3 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -131,8 +131,7 @@ DEFER: (parse-long-string) dup rest-begins? [ [ lexer get ] dip length [ + ] curry change-column drop ] [ - rest-of-line % - lexer get next-line "\n" % (parse-long-string) + lexer get next-char , (parse-long-string) ] if ] if ; From 47d87633406c48f1e7af4f2b5f6cdf21896ea35b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 20 Sep 2009 16:48:17 -0500 Subject: [PATCH 08/77] More integer SIMD work - move generated vocab support from specialized-arrays to vocabs.generated - add fuzz testing to math.vectors.simd - add alien type support for integer SIMD vectors - SIMD: parsing word generates a SIMD type, instead of pre-generating them all in math.vectors.simd --- .../tree/propagation/simd/simd.factor | 1 + basis/cpu/x86/x86.factor | 3 +- .../vectors/simd/alien/alien-tests.factor | 70 --- basis/math/vectors/simd/alien/alien.factor | 42 -- .../math/vectors/simd/functor/functor.factor | 60 +- basis/math/vectors/simd/simd-docs.factor | 65 ++- basis/math/vectors/simd/simd-tests.factor | 544 +++++++----------- basis/math/vectors/simd/simd.factor | 33 +- .../specialized-arrays.factor | 11 +- .../specialized-vectors.factor | 2 +- .../alien => vocabs/generated}/authors.txt | 0 basis/vocabs/generated/generated.factor | 13 + extra/benchmark/nbody-simd/nbody-simd.factor | 1 + .../raytracer-simd/raytracer-simd.factor | 1 + extra/benchmark/simd-1/simd-1.factor | 1 + 15 files changed, 346 insertions(+), 501 deletions(-) delete mode 100644 basis/math/vectors/simd/alien/alien-tests.factor delete mode 100644 basis/math/vectors/simd/alien/alien.factor rename basis/{math/vectors/simd/alien => vocabs/generated}/authors.txt (100%) create mode 100644 basis/vocabs/generated/generated.factor diff --git a/basis/compiler/tree/propagation/simd/simd.factor b/basis/compiler/tree/propagation/simd/simd.factor index 3baa7cdcbf..42c1f35617 100644 --- a/basis/compiler/tree/propagation/simd/simd.factor +++ b/basis/compiler/tree/propagation/simd/simd.factor @@ -24,6 +24,7 @@ IN: compiler.tree.propagation.simd literal>> scalar-rep-of { { float-rep [ float ] } { double-rep [ float ] } + { int-rep [ integer ] } } case ] [ drop real ] if diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 4d80862ed3..322b123d99 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -417,8 +417,7 @@ M: x86 %horizontal-add-vector ( dst src rep -- ) M: x86 %horizontal-add-vector-reps { - { sse? { float-4-rep } } - { sse2? { double-2-rep short-8-rep uchar-16-rep } } + { sse3? { float-4-rep double-2-rep } } } available-reps ; M: x86 %unbox-alien ( dst src -- ) diff --git a/basis/math/vectors/simd/alien/alien-tests.factor b/basis/math/vectors/simd/alien/alien-tests.factor deleted file mode 100644 index 87540dd9a5..0000000000 --- a/basis/math/vectors/simd/alien/alien-tests.factor +++ /dev/null @@ -1,70 +0,0 @@ -USING: cpu.architecture math.vectors.simd -math.vectors.simd.intrinsics accessors math.vectors.simd.alien -kernel classes.struct tools.test compiler sequences byte-arrays -alien math kernel.private specialized-arrays combinators ; -SPECIALIZED-ARRAY: float -IN: math.vectors.simd.alien.tests - -! Vector alien intrinsics -[ float-4{ 1 2 3 4 } ] [ - [ - float-4{ 1 2 3 4 } - underlying>> 0 float-4-rep alien-vector - ] compile-call float-4 boa -] unit-test - -[ B{ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 } ] [ - 16 [ 1 ] B{ } replicate-as 16 - [ - 0 [ - { byte-array c-ptr fixnum } declare - float-4-rep set-alien-vector - ] compile-call - ] keep -] unit-test - -[ float-array{ 1 2 3 4 } ] [ - [ - float-array{ 1 2 3 4 } underlying>> - float-array{ 4 3 2 1 } clone - [ underlying>> 0 float-4-rep set-alien-vector ] keep - ] compile-call -] unit-test - -STRUCT: simd-struct -{ x float-4 } -{ y double-2 } -{ z double-4 } -{ w float-8 } ; - -[ t ] [ [ simd-struct ] compile-call >c-ptr [ 0 = ] all? ] unit-test - -[ - float-4{ 1 2 3 4 } - double-2{ 2 1 } - double-4{ 4 3 2 1 } - float-8{ 1 2 3 4 5 6 7 8 } -] [ - simd-struct - float-4{ 1 2 3 4 } >>x - double-2{ 2 1 } >>y - double-4{ 4 3 2 1 } >>z - float-8{ 1 2 3 4 5 6 7 8 } >>w - { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave -] unit-test - -[ - float-4{ 1 2 3 4 } - double-2{ 2 1 } - double-4{ 4 3 2 1 } - float-8{ 1 2 3 4 5 6 7 8 } -] [ - [ - simd-struct - float-4{ 1 2 3 4 } >>x - double-2{ 2 1 } >>y - double-4{ 4 3 2 1 } >>z - float-8{ 1 2 3 4 5 6 7 8 } >>w - { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave - ] compile-call -] unit-test diff --git a/basis/math/vectors/simd/alien/alien.factor b/basis/math/vectors/simd/alien/alien.factor deleted file mode 100644 index 1486f6d0af..0000000000 --- a/basis/math/vectors/simd/alien/alien.factor +++ /dev/null @@ -1,42 +0,0 @@ -! Copyright (C) 2009 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: alien accessors alien.c-types byte-arrays compiler.units -cpu.architecture locals kernel math math.vectors.simd -math.vectors.simd.intrinsics ; -IN: math.vectors.simd.alien - -:: define-simd-128-type ( class rep -- ) - - byte-array >>class - class >>boxed-class - [ rep alien-vector class boa ] >>getter - [ [ underlying>> ] 2dip rep set-alien-vector ] >>setter - 16 >>size - 8 >>align - rep >>rep - class name>> typedef ; - -:: define-simd-256-type ( class rep -- ) - - class >>class - class >>boxed-class - [ - [ rep alien-vector ] - [ 16 + >fixnum rep alien-vector ] 2bi - class boa - ] >>getter - [ - [ [ underlying1>> ] 2dip rep set-alien-vector ] - [ [ underlying2>> ] 2dip 16 + >fixnum rep set-alien-vector ] - 3bi - ] >>setter - 32 >>size - 8 >>align - rep >>rep - class name>> typedef ; -[ - float-4 float-4-rep define-simd-128-type - double-2 double-2-rep define-simd-128-type - float-8 float-4-rep define-simd-256-type - double-4 double-2-rep define-simd-256-type -] with-compilation-unit diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor index a97dc192be..57126f1bf8 100644 --- a/basis/math/vectors/simd/functor/functor.factor +++ b/basis/math/vectors/simd/functor/functor.factor @@ -5,6 +5,7 @@ effects fry functors generalizations kernel literals locals math math.functions math.vectors math.vectors.simd.intrinsics math.vectors.specialization parser prettyprint.custom sequences sequences.private strings words definitions macros cpu.architecture ; +QUALIFIED-WITH: math m IN: math.vectors.simd.functor ERROR: bad-length got expected ; @@ -51,11 +52,10 @@ MACRO: simd-boa ( rep class -- simd-array ) '[ nip _ swap supported-simd-op? ] assoc-filter '[ drop _ key? ] assoc-filter ; -:: high-level-ops ( ctor -- assoc ) +:: high-level-ops ( ctor elt-class -- assoc ) ! Some SIMD operations are defined in terms of others. { { vneg [ [ dup v- ] keep v- ] } - { v. [ v* sum ] } { n+v [ [ ctor execute ] dip v+ ] } { v+n [ ctor execute v+ ] } { n-v [ [ ctor execute ] dip v- ] } @@ -67,16 +67,36 @@ MACRO: simd-boa ( rep class -- simd-array ) { norm-sq [ dup v. assert-positive ] } { norm [ norm-sq sqrt ] } { normalize [ dup norm v/n ] } - { distance [ v- norm ] } - } ; + } + ! To compute dot product and distance with integer vectors, we + ! have to do things less efficiently, with integer overflow checks, + ! in the general case. + elt-class m:float = [ + { + { distance [ v- norm ] } + { v. [ v* sum ] } + } append + ] when ; :: simd-vector-words ( class ctor rep assoc -- ) + rep rep-component-type c-type-boxed-class :> elt-class class - rep rep-component-type c-type-boxed-class + elt-class assoc rep supported-simd-ops - ctor high-level-ops assoc-union + ctor elt-class high-level-ops assoc-union specialize-vector-words ; +:: define-simd-128-type ( class rep -- ) + + byte-array >>class + class >>boxed-class + [ rep alien-vector class boa ] >>getter + [ [ underlying>> ] 2dip rep set-alien-vector ] >>setter + 16 >>size + 8 >>align + rep >>rep + class typedef ; + FUNCTOR: define-simd-128 ( T -- ) N [ 16 T heap-size /i ] @@ -159,11 +179,35 @@ INSTANCE: A sequence { sum [ [ (simd-sum) ] \ A-v->n-op execute ] } } simd-vector-words +\ A \ A-rep define-simd-128-type + PRIVATE> ;FUNCTOR ! Synthesize 256-bit vectors from a pair of 128-bit vectors +SLOT: underlying1 +SLOT: underlying2 + +:: define-simd-256-type ( class rep -- ) + + class >>class + class >>boxed-class + [ + [ rep alien-vector ] + [ 16 + >fixnum rep alien-vector ] 2bi + class boa + ] >>getter + [ + [ [ underlying1>> ] 2dip rep set-alien-vector ] + [ [ underlying2>> ] 2dip 16 + >fixnum rep set-alien-vector ] + 3bi + ] >>setter + 32 >>size + 8 >>align + rep >>rep + class typedef ; + FUNCTOR: define-simd-256 ( T -- ) N [ 32 T heap-size /i ] @@ -235,7 +279,7 @@ M: A pprint* pprint-object ; : A-boa ( ... -- simd-array ) [ A/2-boa ] N/2 ndip A/2-boa [ underlying>> ] bi@ - \ A boa ; + \ A boa ; inline \ A-rep 2 boa-effect \ A-boa set-stack-effect @@ -260,4 +304,6 @@ INSTANCE: A sequence { sum [ [ (simd-v+) ] [ (simd-sum) ] \ A-v->n-op execute ] } } simd-vector-words +\ A \ A-rep define-simd-256-type + ;FUNCTOR diff --git a/basis/math/vectors/simd/simd-docs.factor b/basis/math/vectors/simd/simd-docs.factor index d6131b3a71..42512feb6f 100644 --- a/basis/math/vectors/simd/simd-docs.factor +++ b/basis/math/vectors/simd/simd-docs.factor @@ -17,23 +17,45 @@ $nl "There should never be any reason to use " { $link "math.vectors.simd.intrinsics" } " directly, but they too have a straightforward, but lower-level, interface." ; ARTICLE: "math.vectors.simd.support" "Supported SIMD instruction sets and operations" -"At present, the SIMD support makes use of SSE2 and a few SSE3 instructions on x86 CPUs." +"At present, the SIMD support makes use of SSE, SSE2 and a few SSE3 instructions on x86 CPUs." $nl -"SSE3 introduces horizontal adds (summing all components of a single vector register), which is useful for computing dot products. Where available, SSE3 operations are used to speed up " { $link sum } ", " { $link v. } ", " { $link norm-sq } ", " { $link norm } ", and " { $link distance } ". If SSE3 is not available, software fallbacks are used for " { $link sum } " and related words, decreasing performance." +"SSE1 only supports single-precision SIMD (" { $snippet "float-4" } " and " { $snippet "float-8" } ")." $nl -"On PowerPC, or older x86 chips without SSE2, software fallbacks are used for all high-level vector operations. SIMD code can run with no loss in functionality, just decreased performance." +"SSE2 introduces double-precision and integer SIMD." +$nl +"SSE3 introduces horizontal adds (summing all components of a single vector register), which is useful for computing dot products. Where available, SSE3 operations are used to speed up " { $link sum } ", " { $link v. } ", " { $link norm-sq } ", " { $link norm } ", and " { $link distance } ". If SSE3 is not available, software fallbacks are used for " { $link sum } " and related words." +$nl +"On PowerPC, or older x86 chips without SSE, software fallbacks are used for all high-level vector operations. SIMD code can run with no loss in functionality, just decreased performance." $nl "The primities in the " { $vocab-link "math.vectors.simd.intrinsics" } " vocabulary do not have software fallbacks, but they should not be called directly in any case." ; ARTICLE: "math.vectors.simd.types" "SIMD vector types" -"Each SIMD vector type is named " { $snippet "scalar-count" } ", where " { $snippet "scalar" } " is a scalar C type such as " { $snippet "float" } " or " { $snippet "double" } ", and " { $snippet "count" } " is a vector dimension, such as 2, 4, or 8." +"Each SIMD vector type is named " { $snippet "scalar-count" } ", where " { $snippet "scalar" } " is a scalar C type and " { $snippet "count" } " is a vector dimension." $nl -"The following vector types are defined:" -{ $subsection float-4 } -{ $subsection double-2 } -{ $subsection float-8 } -{ $subsection double-4 } -"For each vector type, several words are defined:" +"To use a SIMD vector type, a parsing word is used to generate the relevant code and bring it into the vocabulary search path; this is the same idea as with " { $link "specialized-arrays" } ":" +{ $subsection POSTPONE: SIMD: } +"The following vector types are supported:" +{ $code + "char-16" + "uchar-16" + "char-32" + "uchar-32" + "short-8" + "ushort-8" + "short-16" + "ushort-16" + "int-4" + "uint-4" + "int-8" + "uint-8" + "float-4" + "float-8" + "double-2" + "double-4" +} ; + +ARTICLE: "math.vectors.simd.words" "SIMD vector words" +"For each SIMD vector type, several words are defined:" { $table { "Word" "Stack effect" "Description" } { { $snippet "type-with" } { $snippet "( x -- simd-array )" } "creates a new instance where all components are set to a single scalar" } @@ -41,8 +63,6 @@ $nl { { $snippet ">type" } { $snippet "( seq -- simd-array )" } "creates a new instance initialized with the elements of an existing sequence, which must have the correct length" } { { $snippet "type{" } { $snippet "type{ elements... }" } "parsing word defining literal syntax for an SIMD vector; the correct number of elements must be given" } } -"The " { $link float-4 } " and " { $link double-2 } " types correspond to 128-bit vector registers. The " { $link float-8 } " and " { $link double-4 } " types are not directly supported in hardware, and instead unbox to a pair of 128-bit vector registers." -$nl "To actually perform vector arithmetic on SIMD vectors, use " { $link "math-vectors" } " words." { $see-also "c-types-specs" } ; @@ -68,6 +88,8 @@ SYMBOLS: x y ; { $code <" USING: compiler.tree.debugger kernel.private math.vectors math.vectors.simd ; +SIMD: float-4 +IN: simd-demo : interpolate ( v a b -- w ) { float-4 float-4 float-4 } declare @@ -80,6 +102,8 @@ $nl { $code <" USING: compiler.tree.debugger hints math.vectors math.vectors.simd ; +SIMD: float-4 +IN: simd-demo : interpolate ( v a b -- w ) [ v* ] [ [ 1.0 ] dip n-v v* ] bi-curry* bi v+ ; @@ -94,6 +118,7 @@ $nl "In the " { $snippet "interpolate" } " word, there is still a call to the " { $link } " primitive, because the return value at the end is being boxed on the heap. In the next example, no memory allocation occurs at all because the SIMD vectors are stored inside a struct class (see " { $link "classes.struct" } "); also note the use of inlining:" { $code <" USING: compiler.tree.debugger math.vectors math.vectors.simd ; +SIMD: float-4 IN: simd-demo STRUCT: actor @@ -151,21 +176,23 @@ $nl "For the most part, the above primitives correspond directly to vector arithmetic words. They take a representation parameter, which is one of the singleton members of the " { $link vector-rep } " union in the " { $vocab-link "cpu.architecture" } " vocabulary." ; ARTICLE: "math.vectors.simd.alien" "SIMD data in struct classes" -"Struct classes may contain fields which store SIMD data; use one of the following C type names:" -{ $code -<" float-4 -double-2 -float-8 -double-4"> } -"Passing SIMD data as function parameters is not yet supported." ; +"Struct classes may contain fields which store SIMD data; for each SIMD vector type listed in " { $snippet "math.vectors.simd.types" } " there is a C type with the same name." +$nl +"Only SIMD struct fields are allowed at the moment; passing SIMD data as function parameters is not yet supported." ; ARTICLE: "math.vectors.simd" "Hardware vector arithmetic (SIMD)" "The " { $vocab-link "math.vectors.simd" } " vocabulary extends the " { $vocab-link "math.vectors" } " vocabulary to support efficient vector arithmetic on small, fixed-size vectors." { $subsection "math.vectors.simd.intro" } { $subsection "math.vectors.simd.types" } +{ $subsection "math.vectors.simd.words" } { $subsection "math.vectors.simd.support" } { $subsection "math.vectors.simd.efficiency" } { $subsection "math.vectors.simd.alien" } { $subsection "math.vectors.simd.intrinsics" } ; +HELP: SIMD: +{ $syntax "SIMD: type-length" } +{ $values { "type" "a scalar C type" } { "length" "a vector dimension" } } +{ $description "Brings a SIMD array for holding " { $snippet "length" } " values of " { $snippet "type" } " into the vocabulary search path. The possible type/length combinations are listed in " { $link "math.vectors.simd.types" } " and the generated words are documented in " { $link "math.vectors.simd.words" } "." } ; + ABOUT: "math.vectors.simd" diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor index f5318c341f..39afe3cb03 100644 --- a/basis/math/vectors/simd/simd-tests.factor +++ b/basis/math/vectors/simd/simd-tests.factor @@ -1,8 +1,30 @@ +USING: accessors arrays classes compiler compiler.tree.debugger +effects fry io kernel kernel.private math math.functions +math.private math.vectors math.vectors.simd +math.vectors.simd.private prettyprint random sequences system +tools.test vocabs assocs compiler.cfg.debugger words +locals math.vectors.specialization combinators cpu.architecture +math.vectors.simd.intrinsics namespaces byte-arrays alien +specialized-arrays classes.struct ; +FROM: alien.c-types => c-type-boxed-class ; +SPECIALIZED-ARRAY: float +SIMD: char-16 +SIMD: uchar-16 +SIMD: char-32 +SIMD: uchar-32 +SIMD: short-8 +SIMD: ushort-8 +SIMD: short-16 +SIMD: ushort-16 +SIMD: int-4 +SIMD: uint-4 +SIMD: int-8 +SIMD: uint-8 +SIMD: float-4 +SIMD: float-8 +SIMD: double-2 +SIMD: double-4 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 -system ; [ float-4{ 0 0 0 0 } ] [ float-4 new ] unit-test @@ -12,344 +34,6 @@ system ; [ V{ float } ] [ [ { float-4 } declare norm ] final-classes ] unit-test -[ float-4{ 12 12 12 12 } ] [ - 12 [ float-4-with ] compile-call -] unit-test - -[ float-4{ 1 2 3 4 } ] [ - 1 2 3 4 [ float-4-boa ] compile-call -] unit-test - -[ float-4{ 11 22 33 44 } ] [ - float-4{ 1 2 3 4 } float-4{ 10 20 30 40 } - [ { float-4 float-4 } declare v+ ] compile-call -] unit-test - -[ float-4{ -9 -18 -27 -36 } ] [ - float-4{ 1 2 3 4 } float-4{ 10 20 30 40 } - [ { float-4 float-4 } declare v- ] compile-call -] unit-test - -[ float-4{ 10 40 90 160 } ] [ - float-4{ 1 2 3 4 } float-4{ 10 20 30 40 } - [ { float-4 float-4 } declare v* ] compile-call -] unit-test - -[ float-4{ 10 100 1000 10000 } ] [ - float-4{ 100 2000 30000 400000 } float-4{ 10 20 30 40 } - [ { float-4 float-4 } declare v/ ] compile-call -] unit-test - -[ float-4{ -10 -20 -30 -40 } ] [ - float-4{ -10 20 -30 40 } float-4{ 10 -20 30 -40 } - [ { float-4 float-4 } declare vmin ] compile-call -] unit-test - -[ float-4{ 10 20 30 40 } ] [ - float-4{ -10 20 -30 40 } float-4{ 10 -20 30 -40 } - [ { float-4 float-4 } declare vmax ] compile-call -] unit-test - -[ 10.0 ] [ - float-4{ 1 2 3 4 } - [ { float-4 } declare sum ] compile-call -] unit-test - -[ 13.0 ] [ - float-4{ 1 2 3 4 } - [ { float-4 } declare sum 3.0 + ] compile-call -] unit-test - -[ 8.0 ] [ - float-4{ 1 2 3 4 } float-4{ 2 0 2 0 } - [ { float-4 float-4 } declare v. ] compile-call -] unit-test - -[ float-4{ 5 10 15 20 } ] [ - 5.0 float-4{ 1 2 3 4 } - [ { float float-4 } declare n*v ] compile-call -] unit-test - -[ float-4{ 5 10 15 20 } ] [ - float-4{ 1 2 3 4 } 5.0 - [ { float float-4 } declare v*n ] compile-call -] unit-test - -[ float-4{ 10 5 2 5 } ] [ - 10.0 float-4{ 1 2 5 2 } - [ { float float-4 } declare n/v ] compile-call -] unit-test - -[ float-4{ 0.5 1 1.5 2 } ] [ - float-4{ 1 2 3 4 } 2 - [ { float float-4 } declare v/n ] compile-call -] unit-test - -[ float-4{ 1 0 0 0 } ] [ - float-4{ 10 0 0 0 } - [ { float-4 } declare normalize ] compile-call -] unit-test - -[ 30.0 ] [ - float-4{ 1 2 3 4 } - [ { float-4 } declare norm-sq ] compile-call -] unit-test - -[ t ] [ - float-4{ 1 0 0 0 } - float-4{ 0 1 0 0 } - [ { float-4 float-4 } declare distance ] compile-call - 2 sqrt 1.0e-6 ~ -] unit-test - -[ double-2{ 12 12 } ] [ - 12 [ double-2-with ] compile-call -] unit-test - -[ double-2{ 1 2 } ] [ - 1 2 [ double-2-boa ] compile-call -] unit-test - -[ double-2{ 11 22 } ] [ - double-2{ 1 2 } double-2{ 10 20 } - [ { double-2 double-2 } declare v+ ] compile-call -] unit-test - -[ double-2{ -9 -18 } ] [ - double-2{ 1 2 } double-2{ 10 20 } - [ { double-2 double-2 } declare v- ] compile-call -] unit-test - -[ double-2{ 10 40 } ] [ - double-2{ 1 2 } double-2{ 10 20 } - [ { double-2 double-2 } declare v* ] compile-call -] unit-test - -[ double-2{ 10 100 } ] [ - double-2{ 100 2000 } double-2{ 10 20 } - [ { double-2 double-2 } declare v/ ] compile-call -] unit-test - -[ double-2{ -10 -20 } ] [ - double-2{ -10 20 } double-2{ 10 -20 } - [ { double-2 double-2 } declare vmin ] compile-call -] unit-test - -[ double-2{ 10 20 } ] [ - double-2{ -10 20 } double-2{ 10 -20 } - [ { double-2 double-2 } declare vmax ] compile-call -] unit-test - -[ 3.0 ] [ - double-2{ 1 2 } - [ { double-2 } declare sum ] compile-call -] unit-test - -[ 7.0 ] [ - double-2{ 1 2 } - [ { double-2 } declare sum 4.0 + ] compile-call -] unit-test - -[ 16.0 ] [ - double-2{ 1 2 } double-2{ 2 7 } - [ { double-2 double-2 } declare v. ] compile-call -] unit-test - -[ double-2{ 5 10 } ] [ - 5.0 double-2{ 1 2 } - [ { float double-2 } declare n*v ] compile-call -] unit-test - -[ double-2{ 5 10 } ] [ - double-2{ 1 2 } 5.0 - [ { float double-2 } declare v*n ] compile-call -] unit-test - -[ double-2{ 10 5 } ] [ - 10.0 double-2{ 1 2 } - [ { float double-2 } declare n/v ] compile-call -] unit-test - -[ double-2{ 0.5 1 } ] [ - double-2{ 1 2 } 2 - [ { float double-2 } declare v/n ] compile-call -] unit-test - -[ double-2{ 0 0 } ] [ double-2 new ] unit-test - -[ double-2{ 1 0 } ] [ - double-2{ 10 0 } - [ { double-2 } declare normalize ] compile-call -] unit-test - -[ 5.0 ] [ - double-2{ 1 2 } - [ { double-2 } declare norm-sq ] compile-call -] unit-test - -[ t ] [ - double-2{ 1 0 } - double-2{ 0 1 } - [ { double-2 double-2 } declare distance ] compile-call - 2 sqrt 1.0e-6 ~ -] unit-test - -[ double-4{ 0 0 0 0 } ] [ double-4 new ] unit-test - -[ double-4{ 1 2 3 4 } ] [ - 1 2 3 4 double-4-boa -] unit-test - -[ double-4{ 1 1 1 1 } ] [ - 1 double-4-with -] unit-test - -[ double-4{ 0 1 2 3 } ] [ - 1 double-4-with [ * ] map-index -] unit-test - -[ V{ float } ] [ [ { double-4 } declare norm-sq ] final-classes ] unit-test - -[ V{ float } ] [ [ { double-4 } declare norm ] final-classes ] unit-test - -[ double-4{ 12 12 12 12 } ] [ - 12 [ double-4-with ] compile-call -] unit-test - -[ double-4{ 1 2 3 4 } ] [ - 1 2 3 4 [ double-4-boa ] compile-call -] unit-test - -[ double-4{ 11 22 33 44 } ] [ - double-4{ 1 2 3 4 } double-4{ 10 20 30 40 } - [ { double-4 double-4 } declare v+ ] compile-call -] unit-test - -[ double-4{ -9 -18 -27 -36 } ] [ - double-4{ 1 2 3 4 } double-4{ 10 20 30 40 } - [ { double-4 double-4 } declare v- ] compile-call -] unit-test - -[ double-4{ 10 40 90 160 } ] [ - double-4{ 1 2 3 4 } double-4{ 10 20 30 40 } - [ { double-4 double-4 } declare v* ] compile-call -] unit-test - -[ double-4{ 10 100 1000 10000 } ] [ - double-4{ 100 2000 30000 400000 } double-4{ 10 20 30 40 } - [ { double-4 double-4 } declare v/ ] compile-call -] unit-test - -[ double-4{ -10 -20 -30 -40 } ] [ - double-4{ -10 20 -30 40 } double-4{ 10 -20 30 -40 } - [ { double-4 double-4 } declare vmin ] compile-call -] unit-test - -[ double-4{ 10 20 30 40 } ] [ - double-4{ -10 20 -30 40 } double-4{ 10 -20 30 -40 } - [ { double-4 double-4 } declare vmax ] compile-call -] unit-test - -[ 10.0 ] [ - double-4{ 1 2 3 4 } - [ { double-4 } declare sum ] compile-call -] unit-test - -[ 13.0 ] [ - double-4{ 1 2 3 4 } - [ { double-4 } declare sum 3.0 + ] compile-call -] unit-test - -[ 8.0 ] [ - double-4{ 1 2 3 4 } double-4{ 2 0 2 0 } - [ { double-4 double-4 } declare v. ] compile-call -] unit-test - -[ double-4{ 5 10 15 20 } ] [ - 5.0 double-4{ 1 2 3 4 } - [ { float double-4 } declare n*v ] compile-call -] unit-test - -[ double-4{ 5 10 15 20 } ] [ - double-4{ 1 2 3 4 } 5.0 - [ { float double-4 } declare v*n ] compile-call -] unit-test - -[ double-4{ 10 5 2 5 } ] [ - 10.0 double-4{ 1 2 5 2 } - [ { float double-4 } declare n/v ] compile-call -] unit-test - -[ double-4{ 0.5 1 1.5 2 } ] [ - double-4{ 1 2 3 4 } 2 - [ { float double-4 } declare v/n ] compile-call -] unit-test - -[ double-4{ 1 0 0 0 } ] [ - double-4{ 10 0 0 0 } - [ { double-4 } declare normalize ] compile-call -] unit-test - -[ 30.0 ] [ - double-4{ 1 2 3 4 } - [ { double-4 } declare norm-sq ] compile-call -] unit-test - -[ t ] [ - double-4{ 1 0 0 0 } - double-4{ 0 1 0 0 } - [ { double-4 double-4 } declare distance ] compile-call - 2 sqrt 1.0e-6 ~ -] unit-test - -[ float-8{ 0 0 0 0 0 0 0 0 } ] [ float-8 new ] unit-test - -[ float-8{ 0 0 0 0 0 0 0 0 } ] [ [ float-8 new ] compile-call ] unit-test - -[ float-8{ 1 1 1 1 1 1 1 1 } ] [ 1 float-8-with ] unit-test - -[ float-8{ 1 1 1 1 1 1 1 1 } ] [ [ 1 float-8-with ] compile-call ] unit-test - -[ float-8{ 1 2 3 4 5 6 7 8 } ] [ 1 2 3 4 5 6 7 8 float-8-boa ] unit-test - -[ float-8{ 1 2 3 4 5 6 7 8 } ] [ [ 1 2 3 4 5 6 7 8 float-8-boa ] compile-call ] unit-test - -[ float-8{ 3 6 9 12 15 18 21 24 } ] [ - float-8{ 1 2 3 4 5 6 7 8 } - float-8{ 2 4 6 8 10 12 14 16 } - [ { float-8 float-8 } declare v+ ] compile-call -] unit-test - -[ float-8{ -1 -2 -3 -4 -5 -6 -7 -8 } ] [ - float-8{ 1 2 3 4 5 6 7 8 } - float-8{ 2 4 6 8 10 12 14 16 } - [ { float-8 float-8 } declare v- ] compile-call -] unit-test - -[ float-8{ -1 -2 -3 -4 -5 -6 -7 -8 } ] [ - -0.5 - float-8{ 2 4 6 8 10 12 14 16 } - [ { float float-8 } declare n*v ] compile-call -] unit-test - -[ float-8{ -1 -2 -3 -4 -5 -6 -7 -8 } ] [ - float-8{ 2 4 6 8 10 12 14 16 } - -0.5 - [ { float-8 float } declare v*n ] compile-call -] unit-test - -[ float-8{ 256 128 64 32 16 8 4 2 } ] [ - 256.0 - float-8{ 1 2 4 8 16 32 64 128 } - [ { float float-8 } declare n/v ] compile-call -] unit-test - -[ float-8{ -1 -2 -3 -4 -5 -6 -7 -8 } ] [ - float-8{ 2 4 6 8 10 12 14 16 } - -2.0 - [ { float-8 float } declare v/n ] compile-call -] unit-test - ! Test puns; only on x86 cpu x86? [ [ double-2{ 4 1024 } ] [ @@ -362,3 +46,179 @@ cpu x86? [ [ { double-2 double-2 } declare v+ underlying>> 3.0 float* ] compile-call ] unit-test ] when + +! Fuzz testing +CONSTANT: simd-classes + { + char-16 + uchar-16 + char-32 + uchar-32 + short-8 + ushort-8 + short-16 + ushort-16 + int-4 + uint-4 + int-8 + uint-8 + float-4 + float-8 + double-2 + double-4 + } + +: with-ctors ( -- seq ) + simd-classes [ [ name>> "-with" append ] [ vocabulary>> ] bi lookup ] map ; + +: boa-ctors ( -- seq ) + simd-classes [ [ name>> "-boa" append ] [ vocabulary>> ] bi lookup ] map ; + +: check-optimizer ( seq inputs quot -- ) + [ + [ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ] + [ [ call ] dip call ] + [ [ call ] dip compile-call ] 2tri = not + ] compose filter ; inline + +"== Checking -new constructors" print + +[ { } ] [ + simd-classes [ [ [ ] ] dip '[ _ new ] ] check-optimizer +] unit-test + +[ { } ] [ + simd-classes [ '[ _ new ] compile-call [ zero? ] all? not ] filter +] unit-test + +"== Checking -with constructors" print + +[ { } ] [ + with-ctors [ + [ 1000 random '[ _ ] ] dip '[ { fixnum } declare _ execute ] + ] check-optimizer +] unit-test + +"== Checking -boa constructors" print + +[ { } ] [ + boa-ctors [ + dup stack-effect in>> length + [ nip [ 1000 random ] [ ] replicate-as ] + [ fixnum swap '[ _ declare _ execute ] ] + 2bi + ] check-optimizer +] unit-test + +"== Checking vector operations" print + +: random-vector ( class -- vec ) + new [ drop 1000 random ] map ; + +:: check-vector-op ( word inputs class elt-class -- inputs quot ) + inputs [ + [ + { + { +vector+ [ class random-vector ] } + { +scalar+ [ 1000 random elt-class float = [ >float ] when ] } + } case + ] [ ] map-as + ] [ + [ + { + { +vector+ [ class ] } + { +scalar+ [ elt-class ] } + } case + ] map + ] bi + word '[ _ declare _ execute ] ; + +: ops-to-check ( elt-class -- alist ) + [ vector-words >alist ] dip float = [ + [ drop { n/v v/n v/ normalize } member? not ] assoc-filter + ] unless ; + +: check-vector-ops ( class elt-class -- ) + [ nip ops-to-check ] 2keep + '[ first2 inputs _ _ check-vector-op ] check-optimizer ; inline + +: simd-classes&reps ( -- alist ) + simd-classes [ + dup name>> [ "float" head? ] [ "double" head? ] bi or + float fixnum ? + ] { } map>assoc ; + +simd-classes&reps [ + [ [ { } ] ] 2dip '[ _ _ check-vector-ops ] unit-test +] assoc-each + +! Other regressions +[ 8000000 ] [ + int-8{ 1000 1000 1000 1000 1000 1000 1000 1000 } + [ { int-8 } declare dup [ * ] [ + ] 2map-reduce ] compile-call +] unit-test + + +! Vector alien intrinsics +[ float-4{ 1 2 3 4 } ] [ + [ + float-4{ 1 2 3 4 } + underlying>> 0 float-4-rep alien-vector + ] compile-call float-4 boa +] unit-test + +[ B{ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 } ] [ + 16 [ 1 ] B{ } replicate-as 16 + [ + 0 [ + { byte-array c-ptr fixnum } declare + float-4-rep set-alien-vector + ] compile-call + ] keep +] unit-test + +[ float-array{ 1 2 3 4 } ] [ + [ + float-array{ 1 2 3 4 } underlying>> + float-array{ 4 3 2 1 } clone + [ underlying>> 0 float-4-rep set-alien-vector ] keep + ] compile-call +] unit-test + +STRUCT: simd-struct +{ x float-4 } +{ y double-2 } +{ z double-4 } +{ w float-8 } ; + +[ t ] [ [ simd-struct ] compile-call >c-ptr [ 0 = ] all? ] unit-test + +[ + float-4{ 1 2 3 4 } + double-2{ 2 1 } + double-4{ 4 3 2 1 } + float-8{ 1 2 3 4 5 6 7 8 } +] [ + simd-struct + float-4{ 1 2 3 4 } >>x + double-2{ 2 1 } >>y + double-4{ 4 3 2 1 } >>z + float-8{ 1 2 3 4 5 6 7 8 } >>w + { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave +] unit-test + +[ + float-4{ 1 2 3 4 } + double-2{ 2 1 } + double-4{ 4 3 2 1 } + float-8{ 1 2 3 4 5 6 7 8 } +] [ + [ + simd-struct + float-4{ 1 2 3 4 } >>x + double-2{ 2 1 } >>y + double-4{ 4 3 2 1 } >>z + float-8{ 1 2 3 4 5 6 7 8 } >>w + { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave + ] compile-call +] unit-test diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor index c5e7d6f75d..fe043032b8 100644 --- a/basis/math/vectors/simd/simd.factor +++ b/basis/math/vectors/simd/simd.factor @@ -1,15 +1,32 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types cpu.architecture kernel -math.vectors.simd.functor vocabs.loader ; -FROM: sequences => each ; +USING: alien.c-types combinators fry kernel lexer math math.parser +math.vectors.simd.functor sequences splitting vocabs.generated +vocabs.loader vocabs.parser words ; IN: math.vectors.simd -<< +ERROR: bad-vector-size bits ; -{ double float char uchar short ushort int uint } -[ [ define-simd-128 ] [ define-simd-256 ] bi ] each +> +: simd-vocab ( type -- vocab ) + "math.vectors.simd.instances." prepend ; -"math.vectors.simd.alien" require +: parse-simd-name ( string -- c-type quot ) + "-" split1 + [ "alien.c-types" lookup dup heap-size ] [ string>number ] bi* + * 8 * { + { 128 [ [ define-simd-128 ] ] } + { 256 [ [ define-simd-256 ] ] } + [ bad-vector-size ] + } case ; + +PRIVATE> + +: define-simd-vocab ( type -- vocab ) + [ simd-vocab ] + [ '[ _ parse-simd-name call( type -- ) ] ] bi + generate-vocab ; + +SYNTAX: SIMD: + scan define-simd-vocab use-vocab ; diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 6931c83677..a64d052fd1 100755 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -4,7 +4,7 @@ USING: accessors alien alien.c-types alien.data alien.parser assocs byte-arrays classes compiler.units functors kernel lexer libc math math.vectors.specialization namespaces parser prettyprint.custom sequences sequences.private strings summary vocabs vocabs.loader -vocabs.parser words fry combinators ; +vocabs.parser vocabs.generated words fry combinators ; IN: specialized-arrays MIXIN: specialized-array @@ -123,15 +123,6 @@ M: word (underlying-type) "c-type" word-prop ; PRIVATE> -: generate-vocab ( vocab-name quot -- vocab ) - [ dup vocab [ ] ] dip '[ - [ - [ - _ with-current-vocab - ] with-compilation-unit - ] keep - ] ?if ; inline - : define-array-vocab ( type -- vocab ) underlying-type-name [ specialized-array-vocab ] [ '[ _ define-array ] ] bi diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor index 58fb97764b..7cda026cb3 100644 --- a/basis/specialized-vectors/specialized-vectors.factor +++ b/basis/specialized-vectors/specialized-vectors.factor @@ -3,7 +3,7 @@ USING: accessors alien.c-types assocs compiler.units functors growable kernel lexer namespaces parser prettyprint.custom sequences specialized-arrays specialized-arrays.private strings -vocabs vocabs.parser fry ; +vocabs vocabs.parser vocabs.generated fry ; QUALIFIED: vectors.functor IN: specialized-vectors diff --git a/basis/math/vectors/simd/alien/authors.txt b/basis/vocabs/generated/authors.txt similarity index 100% rename from basis/math/vectors/simd/alien/authors.txt rename to basis/vocabs/generated/authors.txt diff --git a/basis/vocabs/generated/generated.factor b/basis/vocabs/generated/generated.factor new file mode 100644 index 0000000000..1ddcc73db2 --- /dev/null +++ b/basis/vocabs/generated/generated.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: compiler.units fry kernel vocabs vocabs.parser ; +IN: vocabs.generated + +: generate-vocab ( vocab-name quot -- vocab ) + [ dup vocab [ ] ] dip '[ + [ + [ + _ with-current-vocab + ] with-compilation-unit + ] keep + ] ?if ; inline diff --git a/extra/benchmark/nbody-simd/nbody-simd.factor b/extra/benchmark/nbody-simd/nbody-simd.factor index e8bef58923..3aedffed91 100644 --- a/extra/benchmark/nbody-simd/nbody-simd.factor +++ b/extra/benchmark/nbody-simd/nbody-simd.factor @@ -4,6 +4,7 @@ USING: accessors fry kernel locals math math.constants math.functions math.vectors math.vectors.simd prettyprint combinators.smart sequences hints classes.struct specialized-arrays ; +SIMD: double-4 IN: benchmark.nbody-simd : solar-mass ( -- x ) 4 pi sq * ; inline diff --git a/extra/benchmark/raytracer-simd/raytracer-simd.factor b/extra/benchmark/raytracer-simd/raytracer-simd.factor index 3712972862..2d16c8cd1f 100644 --- a/extra/benchmark/raytracer-simd/raytracer-simd.factor +++ b/extra/benchmark/raytracer-simd/raytracer-simd.factor @@ -5,6 +5,7 @@ USING: arrays accessors io io.files io.files.temp io.encodings.binary kernel math math.constants math.functions math.vectors math.vectors.simd math.parser make sequences sequences.private words hints classes.struct ; +SIMD: double-4 IN: benchmark.raytracer-simd ! parameters diff --git a/extra/benchmark/simd-1/simd-1.factor b/extra/benchmark/simd-1/simd-1.factor index 4f57cca0bb..1e753a331d 100644 --- a/extra/benchmark/simd-1/simd-1.factor +++ b/extra/benchmark/simd-1/simd-1.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel io math math.functions math.parser math.vectors math.vectors.simd sequences specialized-arrays ; +SIMD: float-4 SPECIALIZED-ARRAY: float-4 IN: benchmark.simd-1 From acea55c692ce994311287d8c3fe6466d70d23bb3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 20 Sep 2009 17:43:16 -0500 Subject: [PATCH 09/77] math.vectors: add v+- word which is accelerated by SSE3 --- .../cfg/instructions/instructions.factor | 5 +++ .../compiler/cfg/intrinsics/intrinsics.factor | 1 + .../cfg/two-operand/two-operand.factor | 1 + basis/compiler/codegen/codegen.factor | 1 + .../tree/propagation/simd/simd.factor | 37 ++++++++----------- basis/cpu/architecture/architecture.factor | 2 + basis/cpu/x86/32/32.factor | 2 +- basis/cpu/x86/64/64.factor | 2 +- basis/cpu/x86/x86.factor | 22 ++++++++--- .../math/vectors/simd/functor/functor.factor | 3 ++ .../vectors/simd/intrinsics/intrinsics.factor | 2 + basis/math/vectors/simd/simd-docs.factor | 1 + .../specialization/specialization.factor | 1 + basis/math/vectors/vectors-docs.factor | 12 ++++++ basis/math/vectors/vectors-tests.factor | 4 +- basis/math/vectors/vectors.factor | 5 +++ 16 files changed, 71 insertions(+), 30 deletions(-) diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 32e5d46c61..63297b9bdf 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -310,6 +310,11 @@ def: dst use: src1 src2 literal: rep ; +PURE-INSN: ##add-sub-vector +def: dst +use: src1 src2 +literal: rep ; + PURE-INSN: ##mul-vector def: dst use: src1 src2 diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index 0daab82395..5b3fd1b324 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -155,6 +155,7 @@ IN: compiler.cfg.intrinsics { { math.vectors.simd.intrinsics:assert-positive [ drop ] } { math.vectors.simd.intrinsics:(simd-v+) [ [ ^^add-vector ] emit-binary-vector-op ] } + { math.vectors.simd.intrinsics:(simd-v+-) [ [ ^^add-sub-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-v-) [ [ ^^sub-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-v*) [ [ ^^mul-vector ] emit-binary-vector-op ] } { math.vectors.simd.intrinsics:(simd-v/) [ [ ^^div-vector ] emit-binary-vector-op ] } diff --git a/basis/compiler/cfg/two-operand/two-operand.factor b/basis/compiler/cfg/two-operand/two-operand.factor index 20fa1d0b18..c275756046 100644 --- a/basis/compiler/cfg/two-operand/two-operand.factor +++ b/basis/compiler/cfg/two-operand/two-operand.factor @@ -48,6 +48,7 @@ UNION: two-operand-insn ##max-float ##add-vector ##sub-vector + ##add-sub-vector ##mul-vector ##div-vector ##min-vector diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index ddf5aa0e02..14246a3fbf 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -170,6 +170,7 @@ CODEGEN: ##gather-vector-4 %gather-vector-4 CODEGEN: ##box-vector %box-vector CODEGEN: ##add-vector %add-vector CODEGEN: ##sub-vector %sub-vector +CODEGEN: ##add-sub-vector %add-sub-vector CODEGEN: ##mul-vector %mul-vector CODEGEN: ##div-vector %div-vector CODEGEN: ##min-vector %min-vector diff --git a/basis/compiler/tree/propagation/simd/simd.factor b/basis/compiler/tree/propagation/simd/simd.factor index 42c1f35617..db39985c94 100644 --- a/basis/compiler/tree/propagation/simd/simd.factor +++ b/basis/compiler/tree/propagation/simd/simd.factor @@ -1,23 +1,24 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors byte-arrays combinators fry +USING: accessors byte-arrays combinators fry sequences compiler.tree.propagation.info cpu.architecture kernel words math math.intervals math.vectors.simd.intrinsics ; IN: compiler.tree.propagation.simd -\ (simd-v+) { byte-array } "default-output-classes" set-word-prop - -\ (simd-v-) { byte-array } "default-output-classes" set-word-prop - -\ (simd-v*) { byte-array } "default-output-classes" set-word-prop - -\ (simd-v/) { byte-array } "default-output-classes" set-word-prop - -\ (simd-vmin) { byte-array } "default-output-classes" set-word-prop - -\ (simd-vmax) { byte-array } "default-output-classes" set-word-prop - -\ (simd-vsqrt) { byte-array } "default-output-classes" set-word-prop +{ + (simd-v+) + (simd-v-) + (simd-v+-) + (simd-v*) + (simd-v/) + (simd-vmin) + (simd-vmax) + (simd-vsqrt) + (simd-broadcast) + (simd-gather-2) + (simd-gather-4) + alien-vector +} [ { byte-array } "default-output-classes" set-word-prop ] each \ (simd-sum) [ nip dup literal?>> [ @@ -30,18 +31,10 @@ IN: compiler.tree.propagation.simd ] "outputs" set-word-prop -\ (simd-broadcast) { byte-array } "default-output-classes" set-word-prop - -\ (simd-gather-2) { byte-array } "default-output-classes" set-word-prop - -\ (simd-gather-4) { byte-array } "default-output-classes" set-word-prop - \ assert-positive [ real [0,inf] value-info-intersect ] "outputs" set-word-prop -\ alien-vector { byte-array } "default-output-classes" set-word-prop - ! If SIMD is not available, inline alien-vector and set-alien-vector ! to get a speedup : inline-unless-intrinsic ( word -- ) diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 61e4e2df37..331d459adf 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -182,6 +182,7 @@ HOOK: %gather-vector-2 cpu ( dst src1 src2 rep -- ) HOOK: %gather-vector-4 cpu ( dst src1 src2 src3 src4 rep -- ) HOOK: %add-vector cpu ( dst src1 src2 rep -- ) HOOK: %sub-vector cpu ( dst src1 src2 rep -- ) +HOOK: %add-sub-vector cpu ( dst src1 src2 rep -- ) HOOK: %mul-vector cpu ( dst src1 src2 rep -- ) HOOK: %div-vector cpu ( dst src1 src2 rep -- ) HOOK: %min-vector cpu ( dst src1 src2 rep -- ) @@ -194,6 +195,7 @@ HOOK: %gather-vector-2-reps cpu ( -- reps ) HOOK: %gather-vector-4-reps cpu ( -- reps ) HOOK: %add-vector-reps cpu ( -- reps ) HOOK: %sub-vector-reps cpu ( -- reps ) +HOOK: %add-sub-vector-reps cpu ( -- reps ) HOOK: %mul-vector-reps cpu ( -- reps ) HOOK: %div-vector-reps cpu ( -- reps ) HOOK: %min-vector-reps cpu ( -- reps ) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 9939154512..172b500cd5 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -295,4 +295,4 @@ os windows? [ 4 "double" c-type (>>align) ] unless -"cpu.x86.features" require +check-sse diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index f4018b1508..3958ba5ec8 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -228,4 +228,4 @@ USE: vocabs.loader { [ os winnt? ] [ "cpu.x86.64.winnt" require ] } } cond -"cpu.x86.features" require +check-sse diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 322b123d99..a132947cf1 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -341,6 +341,17 @@ M: x86 %sub-vector-reps { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } } } available-reps ; +M: x86 %add-sub-vector ( dst src1 src2 rep -- ) + { + { float-4-rep [ ADDSUBPS ] } + { double-2-rep [ ADDSUBPD ] } + } case drop ; + +M: x86 %add-sub-vector-reps + { + { sse3? { float-4-rep double-2-rep } } + } available-reps ; + M: x86 %mul-vector ( dst src1 src2 rep -- ) { { float-4-rep [ MULPS ] } @@ -879,9 +890,10 @@ enable-min/max { 42 [ enable-sse3 ] } } case ; -[ { sse_version } compile ] with-optimizer +: check-sse ( -- ) + [ { sse_version } compile ] with-optimizer -"Checking for multimedia extensions: " write sse-version 30 min -[ sse-string write " detected" print ] -[ install-sse-check ] -[ enable-sse ] tri + "Checking for multimedia extensions: " write sse-version 30 min + [ sse-string write " detected" print ] + [ install-sse-check ] + [ enable-sse ] tri ; diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor index 57126f1bf8..2141914d1c 100644 --- a/basis/math/vectors/simd/functor/functor.factor +++ b/basis/math/vectors/simd/functor/functor.factor @@ -42,6 +42,7 @@ MACRO: simd-boa ( rep class -- simd-array ) { { v+ (simd-v+) } { v- (simd-v-) } + { v+- (simd-v+-) } { v* (simd-v*) } { v/ (simd-v/) } { vmin (simd-vmin) } @@ -171,6 +172,7 @@ INSTANCE: A sequence \ A \ A-with \ A-rep H{ { v+ [ [ (simd-v+) ] \ A-vv->v-op execute ] } + { v+- [ [ (simd-v+-) ] \ A-vv->v-op execute ] } { v- [ [ (simd-v-) ] \ A-vv->v-op execute ] } { v* [ [ (simd-v*) ] \ A-vv->v-op execute ] } { v/ [ [ (simd-v/) ] \ A-vv->v-op execute ] } @@ -297,6 +299,7 @@ INSTANCE: A sequence \ A \ A-with \ A-rep H{ { v+ [ [ (simd-v+) ] \ A-vv->v-op execute ] } { v- [ [ (simd-v-) ] \ A-vv->v-op execute ] } + { v+- [ [ (simd-v+-) ] \ A-vv->v-op execute ] } { v* [ [ (simd-v*) ] \ A-vv->v-op execute ] } { v/ [ [ (simd-v/) ] \ A-vv->v-op execute ] } { vmin [ [ (simd-vmin) ] \ A-vv->v-op execute ] } diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor index a7d019af81..6d39b9e70a 100644 --- a/basis/math/vectors/simd/intrinsics/intrinsics.factor +++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor @@ -8,6 +8,7 @@ IN: math.vectors.simd.intrinsics ERROR: bad-simd-call ; : (simd-v+) ( v1 v2 rep -- v3 ) bad-simd-call ; +: (simd-v+-) ( v1 v2 rep -- v3 ) bad-simd-call ; : (simd-v-) ( v1 v2 rep -- v3 ) bad-simd-call ; : (simd-v*) ( v1 v2 rep -- v3 ) bad-simd-call ; : (simd-v/) ( v1 v2 rep -- v3 ) bad-simd-call ; @@ -67,6 +68,7 @@ GENERIC# supported-simd-op? 1 ( rep intrinsic -- ? ) M: vector-rep supported-simd-op? { { \ (simd-v+) [ %add-vector-reps ] } + { \ (simd-v+-) [ %add-sub-vector-reps ] } { \ (simd-v-) [ %sub-vector-reps ] } { \ (simd-v*) [ %mul-vector-reps ] } { \ (simd-v/) [ %div-vector-reps ] } diff --git a/basis/math/vectors/simd/simd-docs.factor b/basis/math/vectors/simd/simd-docs.factor index 42512feb6f..d108d70b26 100644 --- a/basis/math/vectors/simd/simd-docs.factor +++ b/basis/math/vectors/simd/simd-docs.factor @@ -162,6 +162,7 @@ $nl "It is best to avoid calling these primitives directly. To write efficient high-level code that compiles down to primitives and avoids memory allocation, see " { $link "math.vectors.simd.efficiency" } "." { $subsection (simd-v+) } { $subsection (simd-v-) } +{ $subsection (simd-v+-) } { $subsection (simd-v/) } { $subsection (simd-vmin) } { $subsection (simd-vmax) } diff --git a/basis/math/vectors/specialization/specialization.factor b/basis/math/vectors/specialization/specialization.factor index 21ec9f64f3..1a85f5ade7 100644 --- a/basis/math/vectors/specialization/specialization.factor +++ b/basis/math/vectors/specialization/specialization.factor @@ -55,6 +55,7 @@ H{ { v* { +vector+ +vector+ -> +vector+ } } { v*n { +vector+ +scalar+ -> +vector+ } } { v+ { +vector+ +vector+ -> +vector+ } } + { v+- { +vector+ +vector+ -> +vector+ } } { v+n { +vector+ +scalar+ -> +vector+ } } { v- { +vector+ +vector+ -> +vector+ } } { v-n { +vector+ +scalar+ -> +vector+ } } diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor index 7456597278..4f2f093216 100644 --- a/basis/math/vectors/vectors-docs.factor +++ b/basis/math/vectors/vectors-docs.factor @@ -17,6 +17,7 @@ $nl "Combining two vectors to form another vector with " { $link 2map } ":" { $subsection v+ } { $subsection v- } +{ $subsection v+- } { $subsection v* } { $subsection v/ } { $subsection vmax } @@ -57,6 +58,17 @@ HELP: v- { $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } } { $description "Subtracts " { $snippet "v" } " from " { $snippet "u" } " component-wise." } ; +HELP: v+- +{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } } +{ $description "Adds and subtracts alternate elements of " { $snippet "v" } " and " { $snippet "u" } " component-wise." } +{ $examples + { $example + "USING: math.vectors prettyprint ;" + "{ 1 2 3 } { 2 3 2 } v+- ." + "{ -1 5 1 }" + } +} ; + HELP: [v-] { $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "w" "a sequence of real numbers" } } { $description "Subtracts " { $snippet "v" } " from " { $snippet "u" } " component-wise; any components which become negative are set to zero." } ; diff --git a/basis/math/vectors/vectors-tests.factor b/basis/math/vectors/vectors-tests.factor index 3e56644d3e..fc482815a9 100644 --- a/basis/math/vectors/vectors-tests.factor +++ b/basis/math/vectors/vectors-tests.factor @@ -17,4 +17,6 @@ USING: math.vectors tools.test ; [ 1.125 ] [ 0.0 1.0 2.0 4.0 { 0.5 0.25 } bilerp ] unit-test -[ 17 ] [ 0 1 2 3 4 5 6 7 { 1 2 3 } trilerp ] unit-test \ No newline at end of file +[ 17 ] [ 0 1 2 3 4 5 6 7 { 1 2 3 } trilerp ] unit-test + +[ { 0 3 2 5 4 } ] [ { 1 2 3 4 5 } { 1 1 1 1 1 } v+- ] unit-test \ No newline at end of file diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index dd48525b53..deda1dc505 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -24,6 +24,11 @@ IN: math.vectors : vmax ( u v -- w ) [ max ] 2map ; : vmin ( u v -- w ) [ min ] 2map ; +: v+- ( u v -- w ) + [ t ] 2dip + [ [ not ] 2dip pick [ + ] [ - ] if ] 2map + nip ; + : vfloor ( v -- _v_ ) [ floor ] map ; : vceiling ( v -- ^v^ ) [ ceiling ] map ; : vtruncate ( v -- -v- ) [ truncate ] map ; From a4a9dcce00076d9f19af43c24102f67ac191a97d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 20 Sep 2009 21:50:17 -0500 Subject: [PATCH 10/77] fix string parsing --- core/strings/parser/parser-tests.factor | 3 + core/strings/parser/parser.factor | 84 ++++++++++++++----------- 2 files changed, 52 insertions(+), 35 deletions(-) diff --git a/core/strings/parser/parser-tests.factor b/core/strings/parser/parser-tests.factor index 4f14869685..1ec482890d 100644 --- a/core/strings/parser/parser-tests.factor +++ b/core/strings/parser/parser-tests.factor @@ -31,3 +31,6 @@ IN: strings.parser.tests ] [ "\"\"\"\"abc\"\"\"\"" eval( -- string ) ] unit-test + + +[ "\"\\" ] [ "\"\\" ] unit-test diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index 2ee82a53e3..b8aadc608c 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs kernel lexer make math math.parser -namespaces parser sequences splitting strings arrays ; +namespaces parser sequences splitting strings arrays +math.order ; IN: strings.parser ERROR: bad-escape ; @@ -73,7 +74,7 @@ name>char-hook [ char-hook [ [ lexer get [ column>> ] [ line-text>> ] bi ] dip [ member? ] curry find-from ; -: rest-of-line ( -- seq ) - lexer get [ line-text>> ] [ column>> ] bi tail-slice ; +: rest-of-line ( lexer -- seq ) + [ line-text>> ] [ column>> ] bi tail-slice ; -: current-char ( lexer -- ch ) - [ column>> ] [ line-text>> ] bi nth ; +: current-char ( lexer -- ch/f ) + [ column>> ] [ line-text>> ] bi ?nth ; : advance-char ( lexer -- ) [ 1 + ] change-column drop ; @@ -106,61 +107,74 @@ ERROR: escaped-char-expected ; escaped-char-expected ] if ; -: parse-escape ( i -- ) - lexer-advance % CHAR: \ , - lexer get - [ advance-char ] - [ next-char , ] bi ; - -: next-string-line ( obj -- ) - drop rest-of-line % - lexer get next-line "\n" % ; +: next-line% ( lexer -- ) + [ rest-of-line % ] + [ next-line "\n" % ] bi ; : rest-begins? ( string -- ? ) [ lexer get [ line-text>> ] [ column>> ] bi tail-slice ] dip head? ; +: advance-lexer ( n -- ) + [ lexer get ] dip [ + ] curry change-column drop ; inline + +: take-double-quotes ( -- string ) + lexer get dup current-char CHAR: " = [ + [ ] [ column>> ] [ line-text>> ] tri + [ CHAR: " = not ] find-from drop [ + swap column>> - CHAR: " + ] [ + rest-of-line + ] if* + ] [ + drop f + ] if dup length advance-lexer ; + +: end-string-parse ( delimiter -- ) + length 3 = [ + take-double-quotes 3 tail % + ] [ + lexer get advance-char + ] if ; + DEFER: (parse-long-string) -: parse-rest-of-line ( string i token -- ) +: parse-found-token ( i string token -- ) + [ lexer-before % ] dip CHAR: \ = [ - parse-escape (parse-long-string) + lexer get [ next-char , ] [ next-char , ] bi (parse-long-string) ] [ - lexer-advance % dup rest-begins? [ - [ lexer get ] dip length [ + ] curry change-column drop + end-string-parse ] [ lexer get next-char , (parse-long-string) ] if ] if ; -: parse-til-separator ( string -- ) - dup first find-next-token [ - parse-rest-of-line - ] [ - next-string-line (parse-long-string) - ] if* ; +ERROR: trailing-characters string ; : (parse-long-string) ( string -- ) lexer get still-parsing? [ - parse-til-separator + dup first find-next-token [ + parse-found-token + ] [ + drop lexer get next-line% + (parse-long-string) + ] if* ] [ unexpected-eof ] if ; +PRIVATE> + : parse-long-string ( string -- string' ) [ (parse-long-string) ] "" make ; -: parse-long-string-escaped ( string -- string' ) - parse-long-string unescape-string ; - -PRIVATE> - : parse-multiline-string ( -- string ) - rest-of-line "\"\"" head? [ + lexer get rest-of-line "\"\"" head? [ lexer get [ 2 + ] change-column drop - "\"\"\"" parse-long-string-escaped + "\"\"\"" ] [ - "\"" parse-long-string-escaped - ] if ; + "\"" + ] if parse-long-string unescape-string ; From eceed177d6ab6d545eaddad77ffc699fa82f836a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 20 Sep 2009 22:42:40 -0500 Subject: [PATCH 11/77] replace usages of <" with """ --- basis/classes/struct/struct-tests.factor | 10 +- basis/combinators/smart/smart-docs.factor | 6 +- basis/compiler/tests/folding.factor | 16 +- basis/compiler/tests/redefine10.factor | 17 +-- basis/compiler/tests/redefine11.factor | 9 +- basis/compiler/tests/redefine5.factor | 16 +- basis/compiler/tests/redefine6.factor | 16 +- basis/compiler/tests/redefine7.factor | 16 +- basis/compiler/tests/redefine8.factor | 16 +- basis/compiler/tests/redefine9.factor | 16 +- basis/db/db-docs.factor | 26 ++-- basis/db/sqlite/sqlite.factor | 28 ++-- basis/db/tuples/tuples-docs.factor | 33 ++--- basis/delegate/delegate-tests.factor | 30 ++-- .../documents/elements/elements-tests.factor | 6 +- basis/functors/functors-tests.factor | 12 +- basis/furnace/actions/actions-docs.factor | 6 +- basis/furnace/alloy/alloy-docs.factor | 6 +- basis/furnace/auth/auth-docs.factor | 14 +- basis/help/cookbook/cookbook.factor | 10 +- basis/html/templates/fhtml/fhtml-tests.factor | 8 +- basis/http/server/cgi/cgi-docs.factor | 6 +- .../dispatchers/dispatchers-docs.factor | 21 ++- basis/json/reader/reader-tests.factor | 20 +-- basis/json/writer/writer-tests.factor | 8 +- basis/literals/literals-docs.factor | 20 +-- basis/math/blas/config/config-docs.factor | 6 +- basis/math/blas/matrices/matrices-docs.factor | 18 +-- .../combinatorics/combinatorics-docs.factor | 6 +- basis/math/vectors/simd/simd-docs.factor | 26 ++-- .../capabilities/capabilities-docs.factor | 6 +- basis/opengl/debug/debug-docs.factor | 7 +- basis/peg/ebnf/ebnf-tests.factor | 4 +- .../quoted-printable-tests.factor | 16 +- basis/regexp/regexp-docs.factor | 6 +- .../complex-components-docs.factor | 23 ++- basis/sequences/complex/complex-docs.factor | 18 +-- .../specialized-arrays-tests.factor | 12 +- .../splitting/monotonic/monotonic-docs.factor | 11 +- basis/tools/scaffold/scaffold-tests.factor | 6 +- .../pixel-formats/pixel-formats-docs.factor | 6 +- basis/urls/encoding/encoding-docs.factor | 6 +- basis/urls/urls-docs.factor | 6 +- .../prettyprint/prettyprint-tests.factor | 26 ++-- basis/windows/com/syntax/syntax-docs.factor | 12 +- basis/windows/com/wrapper/wrapper-docs.factor | 7 +- basis/xml/syntax/syntax-docs.factor | 22 +-- basis/xml/syntax/syntax-tests.factor | 12 +- basis/xml/traversal/traversal-docs.factor | 12 +- basis/xml/writer/writer-docs.factor | 10 +- basis/xml/writer/writer-tests.factor | 18 +-- basis/xmode/code2html/code2html-tests.factor | 10 +- core/classes/classes-tests.factor | 28 ++-- core/generic/generic-tests.factor | 21 +-- extra/4DNav/4DNav-docs.factor | 6 +- extra/adsoda/adsoda-docs.factor | 6 +- extra/brainfuck/brainfuck-tests.factor | 19 +-- extra/gpu/render/render-docs.factor | 6 +- extra/gpu/shaders/shaders-docs.factor | 10 +- extra/gpu/shaders/shaders-tests.factor | 8 +- extra/gpu/state/state-docs.factor | 7 +- extra/managed-server/chat/chat.factor | 25 ++-- extra/otug-talk/otug-talk.factor | 20 +-- extra/pair-rocket/pair-rocket-docs.factor | 6 +- .../peg/javascript/parser/parser-tests.factor | 14 +- extra/peg/pl0/pl0-tests.factor | 13 +- extra/qw/qw-docs.factor | 13 +- extra/roles/roles-docs.factor | 8 +- extra/sequences/n-based/n-based-docs.factor | 10 +- extra/sequences/product/product-docs.factor | 14 +- extra/spider/spider-docs.factor | 14 +- extra/svg/svg-tests.factor | 6 +- extra/tc-lisp-talk/tc-lisp-talk.factor | 140 +++++++++--------- extra/variants/variants-docs.factor | 12 +- 74 files changed, 538 insertions(+), 572 deletions(-) diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index bbbaf4f1d5..a282eb75ee 100755 --- a/basis/classes/struct/struct-tests.factor +++ b/basis/classes/struct/struct-tests.factor @@ -3,7 +3,7 @@ USING: accessors alien alien.c-types ascii assocs byte-arrays classes.struct classes.tuple.private combinators compiler.tree.debugger compiler.units destructors io.encodings.utf8 io.pathnames io.streams.string kernel libc -literals math mirrors multiline namespaces prettyprint +literals math mirrors namespaces prettyprint prettyprint.config see sequences specialized-arrays system tools.test parser lexer eval layouts ; SPECIALIZED-ARRAY: char @@ -181,18 +181,18 @@ STRUCT: struct-test-string-ptr ] with-scope ] unit-test -[ <" USING: classes.struct ; +[ "USING: classes.struct ; IN: classes.struct.tests STRUCT: struct-test-foo { x char initial: 0 } { y int initial: 123 } { z bool } ; -"> ] +" ] [ [ struct-test-foo see ] with-string-writer ] unit-test -[ <" USING: classes.struct ; +[ "USING: classes.struct ; IN: classes.struct.tests UNION-STRUCT: struct-test-float-and-bits { f float initial: 0.0 } { bits uint initial: 0 } ; -"> ] +" ] [ [ struct-test-float-and-bits see ] with-string-writer ] unit-test [ { diff --git a/basis/combinators/smart/smart-docs.factor b/basis/combinators/smart/smart-docs.factor index 85545a730c..2b98f5c061 100644 --- a/basis/combinators/smart/smart-docs.factor +++ b/basis/combinators/smart/smart-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax kernel quotations math sequences -multiline stack-checker ; +stack-checker ; IN: combinators.smart HELP: inputarray { $description "Infers the number or outputs from the quotation and constructs an array from those outputs." } { $examples { $example - <" USING: combinators combinators.smart math prettyprint ; + "USING: combinators combinators.smart math prettyprint ; 9 [ { [ 1 - ] [ 1 + ] [ sq ] } cleave -] output>array ."> +] output>array ." "{ 8 10 81 }" } } ; diff --git a/basis/compiler/tests/folding.factor b/basis/compiler/tests/folding.factor index 5050ce1950..ebdee36b70 100644 --- a/basis/compiler/tests/folding.factor +++ b/basis/compiler/tests/folding.factor @@ -1,4 +1,4 @@ -USING: eval tools.test compiler.units vocabs multiline words +USING: eval tools.test compiler.units vocabs words kernel classes.mixin arrays ; IN: compiler.tests.folding @@ -7,20 +7,18 @@ IN: compiler.tests.folding [ ] [ [ "compiler.tests.redefine11" forget-vocab ] with-compilation-unit ] unit-test [ ] [ - <" - USING: math arrays ; + "USING: math arrays ; IN: compiler.tests.folding GENERIC: foldable-generic ( a -- b ) foldable - M: integer foldable-generic f ; - "> eval( -- ) + M: integer foldable-generic f ;" + eval( -- ) ] unit-test [ ] [ - <" - USING: math arrays ; + "USING: math arrays ; IN: compiler.tests.folding - : fold-test ( -- x ) 10 foldable-generic ; - "> eval( -- ) + : fold-test ( -- x ) 10 foldable-generic ;" + eval( -- ) ] unit-test [ t ] [ diff --git a/basis/compiler/tests/redefine10.factor b/basis/compiler/tests/redefine10.factor index 66edd75097..768b926389 100644 --- a/basis/compiler/tests/redefine10.factor +++ b/basis/compiler/tests/redefine10.factor @@ -1,5 +1,4 @@ -USING: eval tools.test compiler.units vocabs multiline words -kernel ; +USING: eval tools.test compiler.units vocabs words kernel ; IN: compiler.tests.redefine10 ! Mixin redefinition did not recompile all necessary words. @@ -7,21 +6,19 @@ IN: compiler.tests.redefine10 [ ] [ [ "compiler.tests.redefine10" forget-vocab ] with-compilation-unit ] unit-test [ ] [ - <" - USING: kernel math classes ; + "USING: kernel math classes ; IN: compiler.tests.redefine10 MIXIN: my-mixin INSTANCE: fixnum my-mixin - : my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ; - "> eval( -- ) + : my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ;" + eval( -- ) ] unit-test [ ] [ - <" - USE: math + "USE: math IN: compiler.tests.redefine10 - INSTANCE: float my-mixin - "> eval( -- ) + INSTANCE: float my-mixin" + eval( -- ) ] unit-test [ 2.0 ] [ diff --git a/basis/compiler/tests/redefine11.factor b/basis/compiler/tests/redefine11.factor index dbec57e3d5..0f16a42cc3 100644 --- a/basis/compiler/tests/redefine11.factor +++ b/basis/compiler/tests/redefine11.factor @@ -1,4 +1,4 @@ -USING: eval tools.test compiler.units vocabs multiline words +USING: eval tools.test compiler.units vocabs words kernel classes.mixin arrays ; IN: compiler.tests.redefine11 @@ -7,8 +7,7 @@ IN: compiler.tests.redefine11 [ ] [ [ "compiler.tests.redefine11" forget-vocab ] with-compilation-unit ] unit-test [ ] [ - <" - USING: kernel math classes arrays ; + "USING: kernel math classes arrays ; IN: compiler.tests.redefine11 MIXIN: my-mixin INSTANCE: array my-mixin @@ -16,8 +15,8 @@ IN: compiler.tests.redefine11 GENERIC: my-generic ( a -- b ) M: my-mixin my-generic drop 0 ; M: object my-generic drop 1 ; - : my-inline ( -- b ) { } my-generic ; - "> eval( -- ) + : my-inline ( -- b ) { } my-generic ;" + eval( -- ) ] unit-test [ ] [ diff --git a/basis/compiler/tests/redefine5.factor b/basis/compiler/tests/redefine5.factor index 7613987852..38623393e7 100644 --- a/basis/compiler/tests/redefine5.factor +++ b/basis/compiler/tests/redefine5.factor @@ -1,5 +1,4 @@ -USING: eval tools.test compiler.units vocabs multiline words -kernel ; +USING: eval tools.test compiler.units vocabs words kernel ; IN: compiler.tests.redefine5 ! Regression: if dispatch was eliminated but method was not inlined, @@ -8,22 +7,19 @@ IN: compiler.tests.redefine5 [ "compiler.tests.redefine5" forget-vocab ] with-compilation-unit [ ] [ - <" - USING: sorting kernel math.order ; + "USING: sorting kernel math.order ; IN: compiler.tests.redefine5 GENERIC: my-generic ( a -- b ) M: object my-generic [ <=> ] sort ; - : my-inline ( a -- b ) my-generic ; - "> eval( -- ) + : my-inline ( a -- b ) my-generic ;" + eval( -- ) ] unit-test [ ] [ - <" - USE: kernel + "USE: kernel IN: compiler.tests.redefine5 TUPLE: my-tuple ; - M: my-tuple my-generic drop 0 ; - "> eval( -- ) + M: my-tuple my-generic drop 0 ;" eval( -- ) ] unit-test [ 0 ] [ diff --git a/basis/compiler/tests/redefine6.factor b/basis/compiler/tests/redefine6.factor index fdf3e7edbb..892c768bc5 100644 --- a/basis/compiler/tests/redefine6.factor +++ b/basis/compiler/tests/redefine6.factor @@ -1,4 +1,4 @@ -USING: eval tools.test compiler.units vocabs multiline words +USING: eval tools.test compiler.units vocabs words kernel ; IN: compiler.tests.redefine6 @@ -7,24 +7,22 @@ IN: compiler.tests.redefine6 [ ] [ [ "compiler.tests.redefine6" forget-vocab ] with-compilation-unit ] unit-test [ ] [ - <" - USING: kernel kernel.private ; + "USING: kernel kernel.private ; IN: compiler.tests.redefine6 GENERIC: my-generic ( a -- b ) MIXIN: my-mixin M: my-mixin my-generic drop 0 ; - : my-inline ( a -- b ) { my-mixin } declare my-generic ; - "> eval( -- ) + : my-inline ( a -- b ) { my-mixin } declare my-generic ;" + eval( -- ) ] unit-test [ ] [ - <" - USING: kernel ; + "USING: kernel ; IN: compiler.tests.redefine6 TUPLE: my-tuple ; M: my-tuple my-generic drop 1 ; - INSTANCE: my-tuple my-mixin - "> eval( -- ) + INSTANCE: my-tuple my-mixin" + eval( -- ) ] unit-test [ 1 ] [ diff --git a/basis/compiler/tests/redefine7.factor b/basis/compiler/tests/redefine7.factor index cfe29603f9..8e7abcb372 100644 --- a/basis/compiler/tests/redefine7.factor +++ b/basis/compiler/tests/redefine7.factor @@ -1,4 +1,4 @@ -USING: eval tools.test compiler.units vocabs multiline words +USING: eval tools.test compiler.units vocabs words kernel ; IN: compiler.tests.redefine7 @@ -7,21 +7,19 @@ IN: compiler.tests.redefine7 [ ] [ [ "compiler.tests.redefine7" forget-vocab ] with-compilation-unit ] unit-test [ ] [ - <" - USING: kernel math ; + "USING: kernel math ; IN: compiler.tests.redefine7 MIXIN: my-mixin INSTANCE: fixnum my-mixin - : my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ; - "> eval( -- ) + : my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ;" + eval( -- ) ] unit-test [ ] [ - <" - USE: math + "USE: math IN: compiler.tests.redefine7 - INSTANCE: float my-mixin - "> eval( -- ) + INSTANCE: float my-mixin" + eval( -- ) ] unit-test [ 2.0 ] [ diff --git a/basis/compiler/tests/redefine8.factor b/basis/compiler/tests/redefine8.factor index a79bfb5af5..b4deeb3cc1 100644 --- a/basis/compiler/tests/redefine8.factor +++ b/basis/compiler/tests/redefine8.factor @@ -1,4 +1,4 @@ -USING: eval tools.test compiler.units vocabs multiline words +USING: eval tools.test compiler.units vocabs words kernel ; IN: compiler.tests.redefine8 @@ -7,24 +7,22 @@ IN: compiler.tests.redefine8 [ ] [ [ "compiler.tests.redefine8" forget-vocab ] with-compilation-unit ] unit-test [ ] [ - <" - USING: kernel math math.order sorting ; + "USING: kernel math math.order sorting ; IN: compiler.tests.redefine8 MIXIN: my-mixin INSTANCE: fixnum my-mixin GENERIC: my-generic ( a -- b ) ! We add the bogus quotation here to hinder inlining ! since otherwise we cannot trigger this bug. - M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ; - "> eval( -- ) + M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;" + eval( -- ) ] unit-test [ ] [ - <" - USE: math + "USE: math IN: compiler.tests.redefine8 - INSTANCE: float my-mixin - "> eval( -- ) + INSTANCE: float my-mixin" + eval( -- ) ] unit-test [ 2.0 ] [ diff --git a/basis/compiler/tests/redefine9.factor b/basis/compiler/tests/redefine9.factor index 2598246472..abc677dd77 100644 --- a/basis/compiler/tests/redefine9.factor +++ b/basis/compiler/tests/redefine9.factor @@ -1,4 +1,4 @@ -USING: eval tools.test compiler.units vocabs multiline words +USING: eval tools.test compiler.units vocabs words kernel generic.math ; IN: compiler.tests.redefine9 @@ -7,25 +7,23 @@ IN: compiler.tests.redefine9 [ ] [ [ "compiler.tests.redefine9" forget-vocab ] with-compilation-unit ] unit-test [ ] [ - <" - USING: kernel math math.order sorting ; + "USING: kernel math math.order sorting ; IN: compiler.tests.redefine9 MIXIN: my-mixin INSTANCE: fixnum my-mixin GENERIC: my-generic ( a -- b ) ! We add the bogus quotation here to hinder inlining ! since otherwise we cannot trigger this bug. - M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ; - "> eval( -- ) + M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;" + eval( -- ) ] unit-test [ ] [ - <" - USE: math + "USE: math IN: compiler.tests.redefine9 TUPLE: my-tuple ; - INSTANCE: my-tuple my-mixin - "> eval( -- ) + INSTANCE: my-tuple my-mixin" + eval( -- ) ] unit-test [ diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index e73783fdfc..eb5cc71f81 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: classes kernel help.markup help.syntax sequences -alien assocs strings math multiline quotations db.private ; +alien assocs strings math quotations db.private ; IN: db HELP: db-connection @@ -251,24 +251,24 @@ ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial" { $subsection sql-query } "Here's an example usage where we'll make a book table, insert some objects, and query them." $nl "First, let's set up a custom combinator for using our database. See " { $link "db-custom-database-combinators" } " for more details." -{ $code <" +{ $code " USING: db.sqlite db io.files io.files.temp ; : with-book-db ( quot -- ) - "book.db" temp-file swap with-db ; inline"> } + "book.db" temp-file swap with-db ; inline" } "Now let's create the table manually:" -{ $code <" "create table books +{ $code " "create table books (id integer primary key, title text, author text, date_published timestamp, edition integer, cover_price double, condition text)" - [ sql-command ] with-book-db"> } + [ sql-command ] with-book-db" } "Time to insert some books:" -{ $code <" +{ $code " "insert into books (title, author, date_published, edition, cover_price, condition) values('Factor for Sheeple', 'Mister Stacky Pants', date('now'), 1, 13.37, 'mint')" -[ sql-command ] with-book-db"> } +[ sql-command ] with-book-db" } "Now let's select the book:" -{ $code <" -"select id, title, cover_price from books;" [ sql-query ] with-book-db "> } +{ $code " +"select id, title, cover_price from books;" [ sql-query ] with-book-db " } "Notice that the result of this query is a Factor array containing the database rows as arrays of strings. We would have to convert the " { $snippet "cover_price" } " from a string to a number in order to use it in a calculation." $nl "In conclusion, this method of accessing a database is supported, but it is fairly low-level and generally specific to a single database. The " { $vocab-link "db.tuples" } " vocabulary is a good alternative to writing SQL by hand." ; @@ -278,13 +278,13 @@ ARTICLE: "db-custom-database-combinators" "Custom database combinators" "Make a " { $snippet "with-" } " combinator to open and close a database so that resources are not leaked." $nl "SQLite example combinator:" -{ $code <" +{ $code " USING: db.sqlite db io.files io.files.temp ; : with-sqlite-db ( quot -- ) - "my-database.db" temp-file swap with-db ; inline"> } + "my-database.db" temp-file swap with-db ; inline" } "PostgreSQL example combinator:" -{ $code <" USING: db.postgresql db ; +{ $code " USING: db.postgresql db ; : with-postgresql-db ( quot -- ) "localhost" >>host @@ -292,7 +292,7 @@ USING: db.sqlite db io.files io.files.temp ; "erg" >>username "secrets?" >>password "factor-test" >>database - swap with-db ; inline"> + swap with-db ; inline" } ; ABOUT: "db" diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 5b658f36c9..ec6c2a1568 100755 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -6,7 +6,7 @@ sequences strings classes.tuple alien.c-types continuations db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators math.intervals io nmake accessors vectors math.ranges random math.bitwise db.queries destructors db.tuples.private interpolate -io.streams.string multiline make db.private sequences.deep +io.streams.string make db.private sequences.deep db.errors.sqlite ; IN: db.sqlite @@ -201,19 +201,19 @@ M: sqlite-db-connection persistent-table ( -- assoc ) : insert-trigger ( -- string ) [ - <" + " CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE INSERT ON ${table-name} FOR EACH ROW BEGIN SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fki_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"') WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; END; - "> interpolate + " interpolate ] with-string-writer ; : insert-trigger-not-null ( -- string ) [ - <" + " CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE INSERT ON ${table-name} FOR EACH ROW BEGIN @@ -221,24 +221,24 @@ M: sqlite-db-connection persistent-table ( -- assoc ) WHERE NEW.${table-id} IS NOT NULL AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; END; - "> interpolate + " interpolate ] with-string-writer ; : update-trigger ( -- string ) [ - <" + " CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE UPDATE ON ${table-name} FOR EACH ROW BEGIN SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fku_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"') WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; END; - "> interpolate + " interpolate ] with-string-writer ; : update-trigger-not-null ( -- string ) [ - <" + " CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE UPDATE ON ${table-name} FOR EACH ROW BEGIN @@ -246,30 +246,30 @@ M: sqlite-db-connection persistent-table ( -- assoc ) WHERE NEW.${table-id} IS NOT NULL AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; END; - "> interpolate + " interpolate ] with-string-writer ; : delete-trigger-restrict ( -- string ) [ - <" + " CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE DELETE ON ${foreign-table-name} FOR EACH ROW BEGIN SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table-name}" violates foreign key constraint "fkd_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"') WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = OLD.${foreign-table-id}) IS NOT NULL; END; - "> interpolate + " interpolate ] with-string-writer ; : delete-trigger-cascade ( -- string ) - [ - <" + + " CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id BEFORE DELETE ON ${foreign-table-name} FOR EACH ROW BEGIN DELETE from ${table-name} WHERE ${table-id} = OLD.${foreign-table-id}; END; - "> interpolate + " interpolate ] with-string-writer ; : can-be-null? ( -- ? ) diff --git a/basis/db/tuples/tuples-docs.factor b/basis/db/tuples/tuples-docs.factor index bd88c56431..4d435e6a89 100644 --- a/basis/db/tuples/tuples-docs.factor +++ b/basis/db/tuples/tuples-docs.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: classes help.markup help.syntax io.streams.string kernel -quotations sequences strings multiline math db.types -db.tuples.private db ; +quotations sequences strings math db.types db.tuples.private db ; IN: db.tuples HELP: random-id-generator @@ -209,7 +208,7 @@ ARTICLE: "db-tuples-tutorial" "Tuple database tutorial" "The title, author, and publisher should be strings; the date-published a timestamp; the edition an integer; the cover-price a float. These are the Factor types for which we will need to look up the corresponding " { $link "db.types" } ". " $nl "To actually bind the tuple slots to the database types, we'll use " { $link define-persistent } "." { $code -<" USING: db.tuples db.types ; +"""USING: db.tuples db.types ; book "BOOK" { { "id" "ID" +db-assigned-id+ } @@ -219,9 +218,9 @@ book "BOOK" { "edition" "EDITION" INTEGER } { "cover-price" "COVER_PRICE" DOUBLE } { "condition" "CONDITION" VARCHAR } -} define-persistent "> } +} define-persistent""" } "That's all we'll have to do with the database for this tutorial. Now let's make a book." -{ $code <" USING: calendar namespaces ; +{ $code """USING: calendar namespaces ; T{ book { title "Factor for Sheeple" } { author "Mister Stacky Pants" } @@ -229,9 +228,9 @@ T{ book { edition 1 } { cover-price 13.37 } } book set -"> } +""" } "Now we've created a book. Let's save it to the database." -{ $code <" USING: db db.sqlite fry io.files ; +{ $code """USING: db db.sqlite fry io.files ; : with-book-tutorial ( quot -- ) '[ "book-tutorial.db" temp-file _ with-db ] call ; @@ -239,25 +238,25 @@ T{ book book recreate-table book get insert-tuple ] with-book-tutorial -"> } +""" } "Is it really there?" -{ $code <" [ +{ $code """[ T{ book { title "Factor for Sheeple" } } select-tuples . -] with-book-tutorial "> } +] with-book-tutorial""" } "Oops, we spilled some orange juice on the book cover." -{ $code <" book get "Small orange juice stain on cover" >>condition "> } +{ $code """book get "Small orange juice stain on cover" >>condition""" } "Now let's save the modified book." -{ $code <" [ +{ $code """[ book get update-tuple -] with-book-tutorial "> } +] with-book-tutorial""" } "And select it again. You can query the database by any field -- just set it in the exemplar tuple you pass to " { $link select-tuples } "." -{ $code <" [ +{ $code """[ T{ book { title "Factor for Sheeple" } } select-tuples -] with-book-tutorial "> } +] with-book-tutorial""" } "Let's drop the table because we're done." -{ $code <" [ +{ $code """[ book drop-table -] with-book-tutorial "> } +] with-book-tutorial""" } "To summarize, the steps for using Factor's tuple database are:" { $list "Make a new tuple to represent your data" diff --git a/basis/delegate/delegate-tests.factor b/basis/delegate/delegate-tests.factor index d9581152e1..17f81708c5 100644 --- a/basis/delegate/delegate-tests.factor +++ b/basis/delegate/delegate-tests.factor @@ -105,20 +105,20 @@ PROTOCOL: silly-protocol do-me ; ! Replacing a method definition with a consultation would cause problems [ [ ] ] [ - <" IN: delegate.tests + "IN: delegate.tests USE: kernel - M: a-tuple do-me drop ; "> "delegate-test" parse-stream + M: a-tuple do-me drop ;" "delegate-test" parse-stream ] unit-test [ ] [ T{ a-tuple } do-me ] unit-test ! Change method definition to consultation [ [ ] ] [ - <" IN: delegate.tests + "IN: delegate.tests USE: kernel USE: delegate - CONSULT: silly-protocol a-tuple drop f ; "> "delegate-test" parse-stream + CONSULT: silly-protocol a-tuple drop f ; " "delegate-test" parse-stream ] unit-test ! Method should be there @@ -126,7 +126,7 @@ PROTOCOL: silly-protocol do-me ; ! Now try removing the consulation [ [ ] ] [ - <" IN: delegate.tests "> "delegate-test" parse-stream + "IN: delegate.tests" "delegate-test" parse-stream ] unit-test ! Method should be gone @@ -139,18 +139,18 @@ SLOT: y [ f ] [ \ slot-protocol-test-3 \ y>> method >boolean ] unit-test [ [ ] ] [ - <" IN: delegate.tests + "IN: delegate.tests USING: accessors delegate ; TUPLE: slot-protocol-test-3 x ; -CONSULT: y>> slot-protocol-test-3 x>> ;"> +CONSULT: y>> slot-protocol-test-3 x>> ;" "delegate-test-1" parse-stream ] unit-test [ t ] [ \ slot-protocol-test-3 \ y>> method >boolean ] unit-test [ [ ] ] [ - <" IN: delegate.tests -TUPLE: slot-protocol-test-3 x y ;"> + "IN: delegate.tests +TUPLE: slot-protocol-test-3 x y ;" "delegate-test-1" parse-stream ] unit-test @@ -160,11 +160,11 @@ TUPLE: slot-protocol-test-3 x y ;"> ! We want to be able to override methods after consultation [ [ ] ] [ - <" IN: delegate.tests + "IN: delegate.tests USING: delegate kernel sequences delegate.protocols accessors ; TUPLE: override-method-test seq ; CONSULT: sequence-protocol override-method-test seq>> ; - M: override-method-test like drop ; "> + M: override-method-test like drop ; " "delegate-test-2" parse-stream ] unit-test @@ -172,10 +172,10 @@ DEFER: seq-delegate ! See if removing a consultation updates protocol-consult word prop [ [ ] ] [ - <" IN: delegate.tests + "IN: delegate.tests USING: accessors delegate delegate.protocols ; TUPLE: seq-delegate seq ; - CONSULT: sequence-protocol seq-delegate seq>> ;"> + CONSULT: sequence-protocol seq-delegate seq>> ;" "remove-consult-test" parse-stream ] unit-test @@ -186,9 +186,9 @@ DEFER: seq-delegate ] unit-test [ [ ] ] [ - <" IN: delegate.tests + "IN: delegate.tests USING: delegate delegate.protocols ; - TUPLE: seq-delegate seq ;"> + TUPLE: seq-delegate seq ;" "remove-consult-test" parse-stream ] unit-test diff --git a/basis/documents/elements/elements-tests.factor b/basis/documents/elements/elements-tests.factor index 9b323ae8e9..70476e16a9 100644 --- a/basis/documents/elements/elements-tests.factor +++ b/basis/documents/elements/elements-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test namespaces documents documents.elements multiline ; +USING: tools.test namespaces documents documents.elements ; IN: document.elements.tests SYMBOL: doc @@ -56,12 +56,12 @@ SYMBOL: doc ! page-elt doc set -<" First line +"First line Second line Third line Fourth line Fifth line -Sixth line"> doc get set-doc-string +Sixth line" doc get set-doc-string [ { 0 0 } ] [ { 3 3 } doc get 4 prev-elt ] unit-test [ { 1 2 } ] [ { 5 2 } doc get 4 prev-elt ] unit-test diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor index 32d578d05d..0145e8d989 100644 --- a/basis/functors/functors-tests.factor +++ b/basis/functors/functors-tests.factor @@ -1,5 +1,5 @@ USING: classes.struct functors tools.test math words kernel -multiline parser io.streams.string generic ; +parser io.streams.string generic ; IN: functors.tests << @@ -104,14 +104,13 @@ M: integer W 1 + ; ! Does replacing an ordinary word with a functor-generated one work? [ [ ] ] [ - <" IN: functors.tests + "IN: functors.tests TUPLE: some-tuple ; : some-word ( -- ) ; GENERIC: some-generic ( a -- b ) M: some-tuple some-generic ; - SYMBOL: some-symbol - "> "functors-test" parse-stream + SYMBOL: some-symbol" "functors-test" parse-stream ] unit-test : test-redefinition ( -- ) @@ -144,9 +143,8 @@ SYMBOL: W-symbol ;FUNCTOR [ [ ] ] [ - <" IN: functors.tests - << "some" redefine-test >> - "> "functors-test" parse-stream + """IN: functors.tests + << "some" redefine-test >>""" "functors-test" parse-stream ] unit-test test-redefinition diff --git a/basis/furnace/actions/actions-docs.factor b/basis/furnace/actions/actions-docs.factor index 6468b8deb7..f28be1015a 100644 --- a/basis/furnace/actions/actions-docs.factor +++ b/basis/furnace/actions/actions-docs.factor @@ -1,6 +1,6 @@ USING: assocs classes help.markup help.syntax io.streams.string http http.server.dispatchers http.server.responses -furnace.redirection strings multiline html.forms ; +furnace.redirection strings html.forms ; IN: furnace.actions HELP: @@ -53,12 +53,12 @@ HELP: validate-params { $examples "A simple validator from " { $vocab-link "webapps.todo" } "; this word is invoked from the " { $slot "validate" } " quotation of action for editing a todo list item:" { $code - <" : validate-todo ( -- ) + """: validate-todo ( -- ) { { "summary" [ v-one-line ] } { "priority" [ v-integer 0 v-min-value 10 v-max-value ] } { "description" [ v-required ] } - } validate-params ;"> + } validate-params ;""" } } ; diff --git a/basis/furnace/alloy/alloy-docs.factor b/basis/furnace/alloy/alloy-docs.factor index f21fc237a8..7c5a231be8 100644 --- a/basis/furnace/alloy/alloy-docs.factor +++ b/basis/furnace/alloy/alloy-docs.factor @@ -1,5 +1,5 @@ +USING: help.markup help.syntax db ; IN: furnace.alloy -USING: help.markup help.syntax db multiline ; HELP: init-furnace-tables { $description "Initializes database tables used by asides, conversations and session management. This word must be invoked inside a " { $link with-db } " scope." } ; @@ -10,13 +10,13 @@ HELP: { $examples "The " { $vocab-link "webapps.counter" } " vocabulary uses an alloy to configure the counter:" { $code - <" : counter-db ( -- db ) "counter.db" ; + """: counter-db ( -- db ) "counter.db" ; : run-counter ( -- ) counter-db main-responder set-global - 8080 httpd ;"> + 8080 httpd ;""" } } ; diff --git a/basis/furnace/auth/auth-docs.factor b/basis/furnace/auth/auth-docs.factor index efd6a52ef0..21041c416c 100644 --- a/basis/furnace/auth/auth-docs.factor +++ b/basis/furnace/auth/auth-docs.factor @@ -1,7 +1,7 @@ USING: assocs classes help.markup help.syntax kernel quotations strings words words.symbol furnace.auth.providers.db checksums.sha furnace.auth.providers math byte-arrays -http multiline ; +http ; IN: furnace.auth HELP: @@ -149,24 +149,24 @@ ARTICLE: "furnace.auth.users" "User profiles" ARTICLE: "furnace.auth.example" "Furnace authentication example" "The " { $vocab-link "webapps.todo" } " vocabulary wraps all of its responders in a protected responder. The " { $slot "description" } " slot is set so that the login page contains the message “You must log in to view your todo list”:" { $code - <" - "view your todo list" >>description"> + """ + "view your todo list" >>description""" } "The " { $vocab-link "webapps.wiki" } " vocabulary defines a mix of protected and unprotected actions. One example of a protected action is that for deleting wiki pages, an action normally reserved for administrators. This action is protected with the following code:" { $code - <" + """ "delete wiki articles" >>description - { can-delete-wiki-articles? } >>capabilities"> + { can-delete-wiki-articles? } >>capabilities""" } "The " { $vocab-link "websites.concatenative" } " vocabulary wraps all of its responders, including the wiki, in a login authentication realm:" { $code -<" : ( responder -- responder' ) +""": ( responder -- responder' ) "Factor website" "Factor website" >>name allow-registration allow-password-recovery allow-edit-profile - allow-deactivation ;"> + allow-deactivation ;""" } ; ARTICLE: "furnace.auth" "Furnace authentication" diff --git a/basis/help/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor index 6bf88f8f03..96193c1ab8 100644 --- a/basis/help/cookbook/cookbook.factor +++ b/basis/help/cookbook/cookbook.factor @@ -1,6 +1,6 @@ USING: help.markup help.syntax io kernel math parser prettyprint sequences vocabs.loader namespaces stack-checker -help command-line multiline see ; +help command-line see ; IN: help.cookbook ARTICLE: "cookbook-syntax" "Basic syntax cookbook" @@ -195,7 +195,7 @@ $nl { $heading "Example: ls" } "Here is an example implementing a simplified version of the Unix " { $snippet "ls" } " command in Factor:" { $code - <" USING: command-line namespaces io io.files + """USING: command-line namespaces io io.files io.pathnames tools.files sequences kernel ; command-line get [ @@ -204,13 +204,13 @@ command-line get [ dup length 1 = [ first directory. ] [ [ [ nl write ":" print ] [ directory. ] bi ] each ] if -] if-empty"> +] if-empty""" } "You can put it in a file named " { $snippet "ls.factor" } ", and then run it, to list the " { $snippet "/usr/bin" } " directory for example:" { $code "./factor ls.factor /usr/bin" } { $heading "Example: grep" } "The following is a more complicated example, implementing something like the Unix " { $snippet "grep" } " command:" -{ $code <" USING: kernel fry io io.files io.encodings.ascii sequences +{ $code """USING: kernel fry io io.files io.encodings.ascii sequences regexp command-line namespaces ; IN: grep @@ -231,7 +231,7 @@ command-line get [ ] [ [ grep-file ] with each ] if-empty -] if-empty"> } +] if-empty""" } "You can run it like so," { $code "./factor grep.factor '.*hello.*' myfile.txt" } "You'll notice this script takes a while to start. This is because it is loading and compiling the " { $vocab-link "regexp" } " vocabulary every time. To speed up startup, load the vocabulary into your image, and save the image:" diff --git a/basis/html/templates/fhtml/fhtml-tests.factor b/basis/html/templates/fhtml/fhtml-tests.factor index 427b3215c1..6179e07859 100644 --- a/basis/html/templates/fhtml/fhtml-tests.factor +++ b/basis/html/templates/fhtml/fhtml-tests.factor @@ -1,5 +1,5 @@ USING: io io.files io.streams.string io.encodings.utf8 -html.templates html.templates.fhtml kernel multiline +html.templates html.templates.fhtml kernel tools.test sequences parser splitting prettyprint ; IN: html.templates.fhtml.tests @@ -20,11 +20,9 @@ IN: html.templates.fhtml.tests [ [ ] [ - <" - <% + """<% IN: html.templates.fhtml.tests : test-word ( -- ) ; - %> - "> parse-template drop + %>""" parse-template drop ] unit-test ] with-file-vocabs diff --git a/basis/http/server/cgi/cgi-docs.factor b/basis/http/server/cgi/cgi-docs.factor index e4ce71f626..edc4103f8c 100644 --- a/basis/http/server/cgi/cgi-docs.factor +++ b/basis/http/server/cgi/cgi-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax http.server.static multiline ; +USING: help.markup help.syntax http.server.static ; IN: http.server.cgi HELP: enable-cgi @@ -6,8 +6,8 @@ HELP: enable-cgi { $description "Enables the responder to serve " { $snippet ".cgi" } " scripts by executing them as per the CGI specification." } { $examples { $code - <" - "/var/www/cgi/" enable-cgi "cgi-bin" add-responder" "> + """ + "/var/www/cgi/" enable-cgi "cgi-bin" add-responder""" } } { $side-effects "responder" } ; diff --git a/basis/http/server/dispatchers/dispatchers-docs.factor b/basis/http/server/dispatchers/dispatchers-docs.factor index e0f7f20e69..75c87582f7 100644 --- a/basis/http/server/dispatchers/dispatchers-docs.factor +++ b/basis/http/server/dispatchers/dispatchers-docs.factor @@ -1,7 +1,6 @@ -! Copyright (C) 2008 Your name. +! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: classes help.markup help.syntax io.streams.string -multiline ; +USING: classes help.markup help.syntax io.streams.string ; IN: http.server.dispatchers HELP: new-dispatcher @@ -32,28 +31,28 @@ HELP: add-responder ARTICLE: "http.server.dispatchers.example" "HTTP dispatcher examples" { $heading "Simple pathname dispatcher" } { $code - <" + """ "new" add-responder "edit" add-responder "delete" add-responder "" add-responder -main-responder set-global"> +main-responder set-global""" } "In the above example, visiting any URL other than " { $snippet "/new" } ", " { $snippet "/edit" } ", " { $snippet "/delete" } ", or " { $snippet "/" } " will result in a 404 error." { $heading "Another pathname dispatcher" } "On the other hand, suppose we wanted to route all unrecognized paths to a “view” action:" { $code - <" + """ "new" add-responder "edit" add-responder "delete" add-responder >>default -main-responder set-global"> +main-responder set-global""" } "The " { $slot "default" } " slot holds a responder to which all unrecognized paths are sent to." { $heading "Dispatcher subclassing example" } { $code - <" TUPLE: golf-courses < dispatcher ; + """TUPLE: golf-courses < dispatcher ; : ( -- golf-courses ) golf-courses new-dispatcher ; @@ -63,15 +62,15 @@ main-responder set-global"> "edit" add-responder "delete" add-responder "" add-responder -main-responder set-global"> +main-responder set-global""" } "The action templates can now emit links to responder-relative URLs prefixed by " { $snippet "$golf-courses/" } "." { $heading "Virtual hosting example" } { $code - <" + """ "concatenative-casino.com" add-responder "raptor-dating.com" add-responder -main-responder set-global"> +main-responder set-global""" } "Note that the virtual host dispatcher strips off a " { $snippet "www." } " prefix, so " { $snippet "www.concatenative-casino.com" } " would be routed to the " { $snippet "" } " responder instead of receiving a 404." ; diff --git a/basis/json/reader/reader-tests.factor b/basis/json/reader/reader-tests.factor index 14a54b89c0..79a0e4b5af 100644 --- a/basis/json/reader/reader-tests.factor +++ b/basis/json/reader/reader-tests.factor @@ -1,4 +1,4 @@ -USING: arrays json.reader kernel multiline strings tools.test +USING: arrays json.reader kernel strings tools.test hashtables json ; IN: json.reader.tests @@ -26,26 +26,26 @@ IN: json.reader.tests ! feature to get { -0.0 } [ "-0.0" json> ] unit-test -{ " fuzzy pickles " } [ <" " fuzzy pickles " "> json> ] unit-test -{ "while 1:\n\tpass" } [ <" "while 1:\n\tpass" "> json> ] unit-test +{ " fuzzy pickles " } [ """ " fuzzy pickles " """ json> ] unit-test +{ "while 1:\n\tpass" } [ """ "while 1:\n\tpass" """ json> ] unit-test ! unicode is allowed in json -{ "ß∂¬ƒ˚∆" } [ <" "ß∂¬ƒ˚∆""> json> ] unit-test -{ 8 9 10 12 13 34 47 92 } >string 1array [ <" "\b\t\n\f\r\"\/\\" "> json> ] unit-test -{ HEX: abcd } >string 1array [ <" "\uaBCd" "> json> ] unit-test +{ "ß∂¬ƒ˚∆" } [ """ "ß∂¬ƒ˚∆"""" json> ] unit-test +{ 8 9 10 12 13 34 47 92 } >string 1array [ """ "\\b\\t\\n\\f\\r\\"\\/\\\\" """ json> ] unit-test +{ HEX: abcd } >string 1array [ """ "\\uaBCd" """ json> ] unit-test { H{ { "a" { } } { "b" 123 } } } [ "{\"a\":[],\"b\":123}" json> ] unit-test { { } } [ "[]" json> ] unit-test -{ { 1 "two" 3.0 } } [ <" [1, "two", 3.0] "> json> ] unit-test +{ { 1 "two" 3.0 } } [ """ [1, "two", 3.0] """ json> ] unit-test { H{ } } [ "{}" json> ] unit-test ! the returned hashtable should be different every time { H{ } } [ "key" "value" "{}" json> ?set-at "{}" json> nip ] unit-test -{ H{ { "US$" 1.0 } { "EU€" 1.5 } } } [ <" { "US$":1.00, "EU\u20AC":1.50 } "> json> ] unit-test +{ H{ { "US$" 1.0 } { "EU€" 1.5 } } } [ """ { "US$":1.00, "EU\\u20AC":1.50 } """ json> ] unit-test { H{ { "fib" { 1 1 2 3 5 8 H{ { "etc" "etc" } } } } { "prime" { 2 3 5 7 11 13 } } -} } [ <" { +} } [ """ { "fib": [1, 1, 2, 3, 5, 8, { "etc":"etc" } ], "prime": @@ -53,7 +53,7 @@ IN: json.reader.tests 11, 13 ] } -"> json> ] unit-test +""" json> ] unit-test { 0 } [ " 0" json> ] unit-test { 0 } [ "0 " json> ] unit-test diff --git a/basis/json/writer/writer-tests.factor b/basis/json/writer/writer-tests.factor index 6b6118c443..692a264d0a 100644 --- a/basis/json/writer/writer-tests.factor +++ b/basis/json/writer/writer-tests.factor @@ -1,4 +1,4 @@ -USING: json.writer tools.test multiline json.reader json ; +USING: json.writer tools.test json.reader json ; IN: json.writer.tests { "false" } [ f >json ] unit-test @@ -11,10 +11,10 @@ IN: json.writer.tests { "102.5" } [ 102.5 >json ] unit-test { "[1,\"two\",3.0]" } [ { 1 "two" 3.0 } >json ] unit-test -{ <" {"US$":1.0,"EU€":1.5}"> } [ H{ { "US$" 1.0 } { "EU€" 1.5 } } >json ] unit-test +{ """{"US$":1.0,"EU€":1.5}""" } [ H{ { "US$" 1.0 } { "EU€" 1.5 } } >json ] unit-test ! Random symbols are written simply as strings SYMBOL: testSymbol -{ <" "testSymbol""> } [ testSymbol >json ] unit-test +{ """"testSymbol"""" } [ testSymbol >json ] unit-test -[ { 0.5 } ] [ { 1/2 } >json json> ] unit-test \ No newline at end of file +[ { 0.5 } ] [ { 1/2 } >json json> ] unit-test diff --git a/basis/literals/literals-docs.factor b/basis/literals/literals-docs.factor index 1caa4b746f..3b47d9351f 100644 --- a/basis/literals/literals-docs.factor +++ b/basis/literals/literals-docs.factor @@ -9,21 +9,21 @@ HELP: $ { $notes { $snippet "word" } "'s definition is looked up and " { $link call } "ed at parse time, so words that reference words in the current compilation unit cannot be used with " { $snippet "$" } "." } { $examples - { $example <" + { $example """ USING: kernel literals prettyprint ; IN: scratchpad CONSTANT: five 5 { $ five } . - "> "{ 5 }" } + """ "{ 5 }" } - { $example <" + { $example """ USING: kernel literals prettyprint ; IN: scratchpad : seven-eleven ( -- a b ) 7 11 ; { $ seven-eleven } . - "> "{ 7 11 }" } + """ "{ 7 11 }" } } ; @@ -33,13 +33,13 @@ HELP: $[ { $notes "Since " { $snippet "code" } " is " { $link call } "ed at parse time, it cannot reference any words defined in the same compilation unit." } { $examples - { $example <" + { $example """ USING: kernel literals math prettyprint ; IN: scratchpad << CONSTANT: five 5 >> { $[ five dup 1 + dup 2 + ] } . - "> "{ 5 6 8 }" } + """ "{ 5 6 8 }" } } ; @@ -49,14 +49,14 @@ HELP: ${ { $notes { $snippet "code" } "'s definition is looked up and " { $link call } "ed at parse time, so words that reference words in the current compilation unit cannot be used with " { $snippet "$" } "." } { $examples - { $example <" + { $example """ USING: kernel literals math prettyprint ; IN: scratchpad CONSTANT: five 5 CONSTANT: six 6 ${ five six 7 } . - "> "{ 5 6 7 }" + """ "{ 5 6 7 }" } } ; @@ -64,13 +64,13 @@ ${ five six 7 } . ARTICLE: "literals" "Interpolating code results into literal values" "The " { $vocab-link "literals" } " vocabulary contains words to run code at parse time and insert the results into more complex literal values." -{ $example <" +{ $example """ USE: literals IN: scratchpad CONSTANT: five 5 { $ five $[ five dup 1 + dup 2 + ] } . - "> "{ 5 5 6 8 }" } + """ "{ 5 5 6 8 }" } { $subsection POSTPONE: $ } { $subsection POSTPONE: $[ } { $subsection POSTPONE: ${ } diff --git a/basis/math/blas/config/config-docs.factor b/basis/math/blas/config/config-docs.factor index 60eaff25c2..eadfc3fed0 100644 --- a/basis/math/blas/config/config-docs.factor +++ b/basis/math/blas/config/config-docs.factor @@ -1,4 +1,4 @@ -USING: alien.fortran help.markup help.syntax math.blas.config multiline ; +USING: alien.fortran help.markup help.syntax math.blas.config ; IN: math.blas.config ARTICLE: "math.blas.config" "Configuring the BLAS interface" @@ -6,11 +6,11 @@ ARTICLE: "math.blas.config" "Configuring the BLAS interface" { $subsection blas-library } { $subsection blas-fortran-abi } "The interface attempts to set default values based on the ones encountered on the Factor project's build machines. If these settings don't work with your system's BLAS, or you wish to use a commercial BLAS, you may change the global values of those variables in your " { $link "factor-rc" } ". For example, to use AMD's ACML library on Windows with " { $snippet "math.blas" } ", your " { $snippet "factor-rc" } " would look like this:" -{ $code <" +{ $code """ USING: math.blas.config namespaces ; "X:\\path\\to\\acml.dll" blas-library set-global intel-windows-abi blas-fortran-abi set-global -"> } +""" } "To take effect, the " { $snippet "blas-library" } " and " { $snippet "blas-fortran-abi" } " variables must be set before any other " { $snippet "math.blas" } " vocabularies are loaded." ; diff --git a/basis/math/blas/matrices/matrices-docs.factor b/basis/math/blas/matrices/matrices-docs.factor index 5662cd9905..a42fea3bf6 100644 --- a/basis/math/blas/matrices/matrices-docs.factor +++ b/basis/math/blas/matrices/matrices-docs.factor @@ -1,4 +1,4 @@ -USING: alien byte-arrays help.markup help.syntax math math.blas.vectors sequences strings multiline ; +USING: alien byte-arrays help.markup help.syntax math math.blas.vectors sequences strings ; IN: math.blas.matrices ARTICLE: "math.blas-summary" "Basic Linear Algebra Subroutines (BLAS) interface" @@ -249,39 +249,39 @@ HELP: { $description "Return a vector of zeros with the given " { $snippet "length" } " and the same element type as " { $snippet "v" } "." } ; HELP: smatrix{ -{ $syntax <" smatrix{ +{ $syntax """smatrix{ { 1.0 0.0 0.0 1.0 } { 0.0 1.0 0.0 2.0 } { 0.0 0.0 1.0 3.0 } { 0.0 0.0 0.0 1.0 } -} "> } +}""" } { $description "Construct a literal " { $link float-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ; HELP: dmatrix{ -{ $syntax <" dmatrix{ +{ $syntax """dmatrix{ { 1.0 0.0 0.0 1.0 } { 0.0 1.0 0.0 2.0 } { 0.0 0.0 1.0 3.0 } { 0.0 0.0 0.0 1.0 } -} "> } +}""" } { $description "Construct a literal " { $link double-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ; HELP: cmatrix{ -{ $syntax <" cmatrix{ +{ $syntax """cmatrix{ { 1.0 0.0 0.0 1.0 } { 0.0 C{ 0.0 1.0 } 0.0 2.0 } { 0.0 0.0 -1.0 3.0 } { 0.0 0.0 0.0 C{ 0.0 -1.0 } } -} "> } +}""" } { $description "Construct a literal " { $link complex-float-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ; HELP: zmatrix{ -{ $syntax <" zmatrix{ +{ $syntax """zmatrix{ { 1.0 0.0 0.0 1.0 } { 0.0 C{ 0.0 1.0 } 0.0 2.0 } { 0.0 0.0 -1.0 3.0 } { 0.0 0.0 0.0 C{ 0.0 -1.0 } } -} "> } +}""" } { $description "Construct a literal " { $link complex-double-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ; { diff --git a/basis/math/combinatorics/combinatorics-docs.factor b/basis/math/combinatorics/combinatorics-docs.factor index 0e0b7ae167..10584f2004 100644 --- a/basis/math/combinatorics/combinatorics-docs.factor +++ b/basis/math/combinatorics/combinatorics-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax kernel math math.order multiline sequences ; +USING: help.markup help.syntax kernel math math.order sequences ; IN: math.combinatorics HELP: factorial @@ -76,14 +76,14 @@ HELP: all-combinations { $examples { $example "USING: math.combinatorics prettyprint ;" "{ \"a\" \"b\" \"c\" \"d\" } 2 all-combinations ." -<" { +"""{ { "a" "b" } { "a" "c" } { "a" "d" } { "b" "c" } { "b" "d" } { "c" "d" } -}"> } } ; +}""" } } ; HELP: each-combination { $values { "seq" sequence } { "k" "a non-negative integer" } { "quot" { $quotation "( seq -- )" } } } diff --git a/basis/math/vectors/simd/simd-docs.factor b/basis/math/vectors/simd/simd-docs.factor index b110de1de8..d35f8589b6 100644 --- a/basis/math/vectors/simd/simd-docs.factor +++ b/basis/math/vectors/simd/simd-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax sequences math math.vectors -multiline kernel.private classes.tuple.private +kernel.private classes.tuple.private math.vectors.simd.intrinsics cpu.architecture ; IN: math.vectors.simd @@ -71,7 +71,7 @@ $nl $nl "For example, in the following, no SIMD operations are used at all, because the compiler's propagation pass does not consider dynamic variable usage:" { $code -<" USING: compiler.tree.debugger math.vectors +"""USING: compiler.tree.debugger math.vectors math.vectors.simd ; SYMBOLS: x y ; @@ -79,22 +79,22 @@ SYMBOLS: x y ; double-4{ 1.5 2.0 3.7 0.4 } x set double-4{ 1.5 2.0 3.7 0.4 } y set x get y get v+ -] optimizer-report."> } +] optimizer-report.""" } "The following word benefits from SIMD optimization, because it begins with an unsafe declaration:" { $code -<" USING: compiler.tree.debugger kernel.private +"""USING: compiler.tree.debugger kernel.private math.vectors math.vectors.simd ; : interpolate ( v a b -- w ) { float-4 float-4 float-4 } declare [ v* ] [ [ 1.0 ] dip n-v v* ] bi-curry* bi v+ ; -\ interpolate optimizer-report. "> } +\ interpolate optimizer-report.""" } "Note that using " { $link declare } " is not recommended. Safer ways of getting type information for the input parameters to a word include defining methods on a generic word (the value being dispatched upon has a statically known type in the method body), as well as using " { $link "hints" } " and " { $link POSTPONE: inline } " declarations." $nl "Here is a better version of the " { $snippet "interpolate" } " words above that uses hints:" { $code -<" USING: compiler.tree.debugger hints +"""USING: compiler.tree.debugger hints math.vectors math.vectors.simd ; : interpolate ( v a b -- w ) @@ -102,14 +102,14 @@ math.vectors math.vectors.simd ; HINTS: interpolate float-4 float-4 float-4 ; -\ interpolate optimizer-report. "> } +\ interpolate optimizer-report. """ } "This time, the optimizer report lists calls to both SIMD primitives and high-level vector words, because hints cause two code paths to be generated. The " { $snippet "optimized." } " word can be used to make sure that the fast code path consists entirely of calls to primitives." $nl "If the " { $snippet "interpolate" } " word was to be used in several places with different types of vectors, it would be best to declare it " { $link POSTPONE: inline } "." $nl "In the " { $snippet "interpolate" } " word, there is still a call to the " { $link } " primitive, because the return value at the end is being boxed on the heap. In the next example, no memory allocation occurs at all because the SIMD vectors are stored inside a struct class (see " { $link "classes.struct" } "); also note the use of inlining:" { $code -<" USING: compiler.tree.debugger math.vectors math.vectors.simd ; +"""USING: compiler.tree.debugger math.vectors math.vectors.simd ; IN: simd-demo STRUCT: actor @@ -132,13 +132,13 @@ M: actor advance ( dt actor -- ) [ >float ] dip [ update-velocity ] [ update-position ] 2bi ; -M\ actor advance optimized."> +M\ actor advance optimized.""" } "The " { $vocab-link "compiler.cfg.debugger" } " vocabulary can give a lower-level picture of the generated code, that includes register assignments and other low-level details. To look at low-level optimizer output, call " { $snippet "test-mr mr." } " on a word or quotation:" { $code -<" USE: compiler.tree.debugger +"""USE: compiler.tree.debugger -M\ actor advance test-mr mr."> } +M\ actor advance test-mr mr.""" } "An example of a high-performance algorithm that uses SIMD primitives can be found in the " { $vocab-link "benchmark.nbody-simd" } " vocabulary." ; ARTICLE: "math.vectors.simd.intrinsics" "Low-level SIMD primitives" @@ -169,10 +169,10 @@ $nl ARTICLE: "math.vectors.simd.alien" "SIMD data in struct classes" "Struct classes may contain fields which store SIMD data; use one of the following C type names:" { $code -<" float-4 +"""float-4 double-2 float-8 -double-4"> } +double-4""" } "Passing SIMD data as function parameters is not yet supported." ; ARTICLE: "math.vectors.simd" "Hardware vector arithmetic (SIMD)" diff --git a/basis/opengl/capabilities/capabilities-docs.factor b/basis/opengl/capabilities/capabilities-docs.factor index 959b222671..8b43c56f6d 100644 --- a/basis/opengl/capabilities/capabilities-docs.factor +++ b/basis/opengl/capabilities/capabilities-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax io kernel math quotations -opengl.gl multiline assocs ; +opengl.gl assocs ; IN: opengl.capabilities HELP: gl-version @@ -42,10 +42,10 @@ HELP: has-gl-extensions? { $values { "extensions" "A sequence of extension name strings" } { "?" "A boolean value" } } { $description "Returns true if the set of " { $snippet "extensions" } " is a subset of the implementation-supported extensions returned by " { $link gl-extensions } ". Elements of " { $snippet "extensions" } " can be sequences, in which case true will be returned if any one of the extensions in the subsequence are available." } { $examples "Testing for framebuffer object and pixel buffer support:" - { $code <" { + { $code """{ { "GL_EXT_framebuffer_object" "GL_ARB_framebuffer_object" } "GL_ARB_pixel_buffer_object" -} has-gl-extensions? "> } +} has-gl-extensions?""" } } ; HELP: has-gl-version-or-extensions? diff --git a/basis/opengl/debug/debug-docs.factor b/basis/opengl/debug/debug-docs.factor index 7cb8f9b246..ac666a21c3 100644 --- a/basis/opengl/debug/debug-docs.factor +++ b/basis/opengl/debug/debug-docs.factor @@ -1,15 +1,14 @@ ! (c)2009 Joe Groff bsd license -USING: help.markup help.syntax multiline tools.continuations ; +USING: help.markup help.syntax tools.continuations ; IN: opengl.debug HELP: G { $description "Makes the OpenGL context associated with " { $link G-world } " active for subsequent OpenGL calls. This is intended to be used from the listener, where interactively entered OpenGL calls can be directed to any window. Note that the Factor UI resets the OpenGL context every time a window is updated, so every code snippet entered in the listener must be prefixed with " { $snippet "G" } " in this use case." } -{ $examples { $code <" USING: opengl.debug ui ; +{ $examples { $code """USING: opengl.debug ui ; [ drop t ] find-window G-world set G 0.0 0.0 1.0 1.0 glClearColor -G GL_COLOR_BUFFER_BIT glClear -"> } } ; +G GL_COLOR_BUFFER_BIT glClear""" } } ; HELP: F { $description "Flushes the OpenGL context associated with " { $link G-world } ", thereby committing any outstanding drawing operations." } ; diff --git a/basis/peg/ebnf/ebnf-tests.factor b/basis/peg/ebnf/ebnf-tests.factor index 329156d733..bcd881c03d 100644 --- a/basis/peg/ebnf/ebnf-tests.factor +++ b/basis/peg/ebnf/ebnf-tests.factor @@ -521,10 +521,10 @@ Tok = Spaces (Number | Special ) [ "USE: peg.ebnf [EBNF EBNF]" eval( -- ) ] must-fail -[ <" USE: peg.ebnf [EBNF +[ """USE: peg.ebnf [EBNF lol = a lol = b - EBNF] "> eval( -- ) + EBNF]""" eval( -- ) ] [ error>> [ redefined-rule? ] [ name>> "lol" = ] bi and ] must-fail-with diff --git a/basis/quoted-printable/quoted-printable-tests.factor b/basis/quoted-printable/quoted-printable-tests.factor index abaff9e222..e258cb9a96 100644 --- a/basis/quoted-printable/quoted-printable-tests.factor +++ b/basis/quoted-printable/quoted-printable-tests.factor @@ -1,24 +1,24 @@ ! Copyright (C) 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test quoted-printable multiline io.encodings.string +USING: tools.test quoted-printable io.encodings.string sequences io.encodings.8-bit splitting kernel ; IN: quoted-printable.tests -[ <" José was the +[ """José was the person who knew how to write the letters: ő and ü -and we didn't know hów tö do thât"> ] -[ <" Jos=E9 was the +and we didn't know hów tö do thât""" ] +[ """Jos=E9 was the person who knew how to write the letters: =F5 and =FC=20 and w= -e didn't know h=F3w t=F6 do th=E2t"> quoted> latin2 decode ] unit-test +e didn't know h=F3w t=F6 do th=E2t""" quoted> latin2 decode ] unit-test -[ <" Jos=E9 was the=0Aperson who knew how to write the letters:=0A =F5 and =FC=0Aand we didn't know h=F3w t=F6 do th=E2t"> ] -[ <" José was the +[ """Jos=E9 was the=0Aperson who knew how to write the letters:=0A =F5 and =FC=0Aand we didn't know h=F3w t=F6 do th=E2t""" ] +[ """José was the person who knew how to write the letters: ő and ü -and we didn't know hów tö do thât"> latin2 encode >quoted ] unit-test +and we didn't know hów tö do thât""" latin2 encode >quoted ] unit-test : message ( -- str ) 55 [ "hello" ] replicate concat ; diff --git a/basis/regexp/regexp-docs.factor b/basis/regexp/regexp-docs.factor index 3eb4e8a9bf..b8b89626c8 100644 --- a/basis/regexp/regexp-docs.factor +++ b/basis/regexp/regexp-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: kernel strings help.markup help.syntax math regexp.parser -regexp.ast multiline ; +regexp.ast ; IN: regexp ABOUT: "regexp" @@ -29,9 +29,9 @@ ARTICLE: { "regexp" "intro" } "A quick introduction to regular expressions" "The " { $snippet "+" } " operator matches one or more occurrences of the previous expression; in this case " { $snippet "o" } ". Another useful feature is alternation. Say we want to do this replacement with fooooo or boooo. Then we could use the code" { $code "R/ (f|b)oo+/ \"bar\" re-replace" } "To search a file for all lines that match a given regular expression, you could use code like this:" -{ $code <" "file.txt" ascii file-lines [ R/ (f|b)oo+/ re-contains? ] filter "> } +{ $code """"file.txt" ascii file-lines [ R/ (f|b)oo+/ re-contains? ] filter""" } "To test if a string in its entirety matches a regular expression, the following can be used:" -{ $example <" USE: regexp "fooo" R/ (b|f)oo+/ matches? . "> "t" } +{ $example """USE: regexp "fooo" R/ (b|f)oo+/ matches? .""" "t" } "Regular expressions can't be used for all parsing tasks. For example, they are not powerful enough to match balancing parentheses." ; ARTICLE: { "regexp" "construction" } "Constructing regular expressions" diff --git a/basis/sequences/complex-components/complex-components-docs.factor b/basis/sequences/complex-components/complex-components-docs.factor index 386735aa7d..6209fe535f 100644 --- a/basis/sequences/complex-components/complex-components-docs.factor +++ b/basis/sequences/complex-components/complex-components-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax math multiline +USING: help.markup help.syntax math sequences sequences.complex-components ; IN: sequences.complex-components @@ -11,25 +11,22 @@ ABOUT: "sequences.complex-components" HELP: complex-components { $class-description "Sequence wrapper class that transforms a sequence of " { $link complex } " number values into a sequence of " { $link real } " values, interleaving the real and imaginary parts of the complex values in the original sequence." } -{ $examples { $example <" -USING: prettyprint sequences arrays sequences.complex-components ; -{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } >array . -"> "{ 1.0 -1.0 -2.0 0 3.0 1.0 }" } } ; +{ $examples { $example """USING: prettyprint sequences arrays sequences.complex-components ; +{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } >array .""" +"{ 1.0 -1.0 -2.0 0 3.0 1.0 }" } } ; HELP: { $values { "sequence" sequence } { "complex-components" complex-components } } { $description "Wraps " { $snippet "sequence" } " in a " { $link complex-components } " wrapper." } { $examples -{ $example <" -USING: prettyprint sequences arrays +{ $example """USING: prettyprint sequences arrays sequences.complex-components ; -{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } third . -"> "-2.0" } -{ $example <" -USING: prettyprint sequences arrays +{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } third .""" +"-2.0" } +{ $example """USING: prettyprint sequences arrays sequences.complex-components ; -{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } fourth . -"> "0" } +{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } fourth .""" +"0" } } ; { complex-components } related-words diff --git a/basis/sequences/complex/complex-docs.factor b/basis/sequences/complex/complex-docs.factor index 699fd5c4d9..a2f508648d 100644 --- a/basis/sequences/complex/complex-docs.factor +++ b/basis/sequences/complex/complex-docs.factor @@ -1,5 +1,5 @@ -USING: help.markup help.syntax math multiline -sequences sequences.complex ; +USING: help.markup help.syntax math sequences +sequences.complex ; IN: sequences.complex ARTICLE: "sequences.complex" "Complex virtual sequences" @@ -11,21 +11,19 @@ ABOUT: "sequences.complex" HELP: complex-sequence { $class-description "Sequence wrapper class that transforms a sequence of " { $link real } " number values into a sequence of " { $link complex } " values, treating the underlying sequence as pairs of alternating real and imaginary values." } -{ $examples { $example <" -USING: prettyprint specialized-arrays +{ $examples { $example """USING: prettyprint specialized-arrays sequences.complex sequences arrays ; SPECIALIZED-ARRAY: double -double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } >array . -"> "{ C{ 1.0 -1.0 } C{ -2.0 2.0 } C{ 3.0 0.0 } }" } } ; +double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } >array .""" +"{ C{ 1.0 -1.0 } C{ -2.0 2.0 } C{ 3.0 0.0 } }" } } ; HELP: { $values { "sequence" sequence } { "complex-sequence" complex-sequence } } { $description "Wraps " { $snippet "sequence" } " in a " { $link complex-sequence } "." } -{ $examples { $example <" -USING: prettyprint specialized-arrays +{ $examples { $example """USING: prettyprint specialized-arrays sequences.complex sequences arrays ; SPECIALIZED-ARRAY: double -double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } second . -"> "C{ -2.0 2.0 }" } } ; +double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } second .""" +"C{ -2.0 2.0 }" } } ; { complex-sequence } related-words diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index 2698149bac..1b9bd7e2b2 100755 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -3,8 +3,8 @@ USING: tools.test alien.syntax specialized-arrays specialized-arrays.private sequences alien.c-types accessors kernel arrays combinators compiler compiler.units classes.struct combinators.smart compiler.tree.debugger math libc destructors -sequences.private multiline eval words vocabs namespaces -assocs prettyprint ; +sequences.private eval words vocabs namespaces assocs +prettyprint ; SPECIALIZED-ARRAY: int SPECIALIZED-ARRAY: bool @@ -124,22 +124,22 @@ SPECIALIZED-ARRAY: fixed-string ] unit-test [ - <" + """ IN: specialized-arrays.tests USING: specialized-arrays ; -SPECIALIZED-ARRAY: __does_not_exist__ "> eval( -- ) +SPECIALIZED-ARRAY: __does_not_exist__ """ eval( -- ) ] must-fail [ ] [ - <" + """ IN: specialized-arrays.tests USING: classes.struct specialized-arrays ; STRUCT: __does_not_exist__ { x int } ; SPECIALIZED-ARRAY: __does_not_exist__ -"> eval( -- ) +""" eval( -- ) ] unit-test [ f ] [ diff --git a/basis/splitting/monotonic/monotonic-docs.factor b/basis/splitting/monotonic/monotonic-docs.factor index 983c5b0dea..0c3e54913b 100644 --- a/basis/splitting/monotonic/monotonic-docs.factor +++ b/basis/splitting/monotonic/monotonic-docs.factor @@ -1,7 +1,6 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax kernel quotations classes sequences -multiline ; +USING: help.markup help.syntax kernel quotations classes sequences ; IN: splitting.monotonic HELP: monotonic-slice @@ -14,7 +13,7 @@ HELP: monotonic-slice { $example "USING: splitting.monotonic math prettyprint ;" "{ 1 2 3 2 3 4 } [ < ] upward-slice monotonic-slice ." - <" { + """{ T{ upward-slice { from 0 } { to 3 } @@ -25,7 +24,7 @@ HELP: monotonic-slice { to 6 } { seq { 1 2 3 2 3 4 } } } -}"> +}""" } } ; @@ -74,7 +73,7 @@ HELP: trends { $example "USING: splitting.monotonic math prettyprint ;" "{ 1 2 3 3 2 1 } trends ." - <" { + """{ T{ upward-slice { from 0 } { to 3 } @@ -90,7 +89,7 @@ HELP: trends { to 6 } { seq { 1 2 3 3 2 1 } } } -}"> +}""" } } ; diff --git a/basis/tools/scaffold/scaffold-tests.factor b/basis/tools/scaffold/scaffold-tests.factor index 4c8698c114..43f62a04e6 100644 --- a/basis/tools/scaffold/scaffold-tests.factor +++ b/basis/tools/scaffold/scaffold-tests.factor @@ -1,20 +1,20 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: tools.test tools.scaffold unicode.case kernel -multiline tools.scaffold.private io.streams.string ; +tools.scaffold.private io.streams.string ; IN: tools.scaffold.tests : undocumented-word ( obj1 obj2 -- obj3 obj4 ) [ >lower ] [ >upper ] bi* ; [ -<" HELP: undocumented-word +"""HELP: undocumented-word { $values { "obj1" object } { "obj2" object } { "obj3" object } { "obj4" object } } { $description "" } ; -"> +""" ] [ [ \ undocumented-word (help.) ] with-string-writer diff --git a/basis/ui/pixel-formats/pixel-formats-docs.factor b/basis/ui/pixel-formats/pixel-formats-docs.factor index b1ab1bc398..ca899cd70f 100644 --- a/basis/ui/pixel-formats/pixel-formats-docs.factor +++ b/basis/ui/pixel-formats/pixel-formats-docs.factor @@ -1,4 +1,4 @@ -USING: destructors help.markup help.syntax kernel math multiline sequences +USING: destructors help.markup help.syntax kernel math sequences vocabs vocabs.parser words namespaces ; IN: ui.pixel-formats @@ -41,7 +41,7 @@ ARTICLE: "ui.pixel-formats-attributes" "Pixel format attributes" { $subsection samples } { $examples "The following " { $link world } " subclass will request a double-buffered window with minimum 24-bit color and depth buffers, and will throw an error if the requirements aren't met:" -{ $code <" +{ $code """ USING: kernel ui.worlds ui.pixel-formats ; IN: ui.pixel-formats.examples @@ -60,7 +60,7 @@ M: picky-depth-buffered-world check-world-pixel-format [ color-bits pixel-format-attribute 24 < [ "Not enough color bits!" throw ] when ] [ depth-bits pixel-format-attribute 24 < [ "Not enough depth bits!" throw ] when ] tri ; -"> } } +""" } } ; HELP: double-buffered diff --git a/basis/urls/encoding/encoding-docs.factor b/basis/urls/encoding/encoding-docs.factor index a021bd6d23..10186227ce 100644 --- a/basis/urls/encoding/encoding-docs.factor +++ b/basis/urls/encoding/encoding-docs.factor @@ -1,5 +1,5 @@ +USING: strings help.markup help.syntax assocs ; IN: urls.encoding -USING: strings help.markup help.syntax assocs multiline ; HELP: url-decode { $values { "str" string } { "decoded" string } } @@ -39,12 +39,12 @@ HELP: query>assoc "USING: prettyprint urls.encoding ;" "\"gender=female&agefrom=22&ageto=28&location=Omaha+NE\"" "query>assoc ." - <" H{ + """H{ { "gender" "female" } { "agefrom" "22" } { "ageto" "28" } { "location" "Omaha NE" } -}"> +}""" } } ; diff --git a/basis/urls/urls-docs.factor b/basis/urls/urls-docs.factor index eb8e452ca4..dd6f8265e6 100644 --- a/basis/urls/urls-docs.factor +++ b/basis/urls/urls-docs.factor @@ -1,6 +1,6 @@ USING: assocs hashtables help.markup help.syntax io.streams.string io.files io.pathnames kernel strings present -math multiline ; +math ; IN: urls HELP: url @@ -112,11 +112,11 @@ HELP: set-query-param } { $examples { $code - <" USING: kernel http.client urls ; + """USING: kernel http.client urls ; URL" http://search.yahooapis.com/WebSearchService/V1/webSearch" clone "concatenative programming (NSFW)" "query" set-query-param "1" "adult_ok" set-query-param -http-get"> +http-get""" } "(For a complete Yahoo! search web service implementation, see the " { $vocab-link "yahoo" } " vocabulary.)" } diff --git a/basis/vocabs/prettyprint/prettyprint-tests.factor b/basis/vocabs/prettyprint/prettyprint-tests.factor index 9ad0aae59d..4da5280115 100644 --- a/basis/vocabs/prettyprint/prettyprint-tests.factor +++ b/basis/vocabs/prettyprint/prettyprint-tests.factor @@ -1,44 +1,44 @@ +USING: vocabs.prettyprint tools.test io.streams.string eval ; IN: vocabs.prettyprint.tests -USING: vocabs.prettyprint tools.test io.streams.string multiline eval ; : manifest-test-1 ( -- string ) - <" USING: kernel namespaces vocabs.parser vocabs.prettyprint ; + """USING: kernel namespaces vocabs.parser vocabs.prettyprint ; - << manifest get pprint-manifest >> "> ; + << manifest get pprint-manifest >>""" ; [ -<" USING: kernel namespaces vocabs.parser vocabs.prettyprint ;"> +"""USING: kernel namespaces vocabs.parser vocabs.prettyprint ;""" ] [ [ manifest-test-1 eval( -- ) ] with-string-writer ] unit-test : manifest-test-2 ( -- string ) - <" USING: kernel namespaces vocabs.parser vocabs.prettyprint ; + """USING: kernel namespaces vocabs.parser vocabs.prettyprint ; IN: vocabs.prettyprint.tests - << manifest get pprint-manifest >> "> ; + << manifest get pprint-manifest >>""" ; [ -<" USING: kernel namespaces vocabs.parser vocabs.prettyprint ; -IN: vocabs.prettyprint.tests"> +"""USING: kernel namespaces vocabs.parser vocabs.prettyprint ; +IN: vocabs.prettyprint.tests""" ] [ [ manifest-test-2 eval( -- ) ] with-string-writer ] unit-test : manifest-test-3 ( -- string ) - <" USING: kernel namespaces vocabs.parser vocabs.prettyprint ; + """USING: kernel namespaces vocabs.parser vocabs.prettyprint ; FROM: math => + - ; QUALIFIED: system QUALIFIED-WITH: assocs a EXCLUDE: parser => run-file ; IN: vocabs.prettyprint.tests - << manifest get pprint-manifest >> "> ; + << manifest get pprint-manifest >>""" ; [ -<" USING: kernel namespaces vocabs.parser vocabs.prettyprint ; +"""USING: kernel namespaces vocabs.parser vocabs.prettyprint ; FROM: math => + - ; QUALIFIED: system QUALIFIED-WITH: assocs a EXCLUDE: parser => run-file ; -IN: vocabs.prettyprint.tests"> +IN: vocabs.prettyprint.tests""" ] -[ [ manifest-test-3 eval( -- ) ] with-string-writer ] unit-test \ No newline at end of file +[ [ manifest-test-3 eval( -- ) ] with-string-writer ] unit-test diff --git a/basis/windows/com/syntax/syntax-docs.factor b/basis/windows/com/syntax/syntax-docs.factor index 62a3c6eaa0..bbfbf39cd1 100644 --- a/basis/windows/com/syntax/syntax-docs.factor +++ b/basis/windows/com/syntax/syntax-docs.factor @@ -1,5 +1,4 @@ -USING: help.markup help.syntax io kernel math quotations -multiline ; +USING: help.markup help.syntax io kernel math quotations ; IN: windows.com.syntax HELP: GUID: @@ -7,14 +6,13 @@ HELP: GUID: { $description "\nCreate a COM globally-unique identifier (GUID) literal at parse time, and push it onto the data stack." } ; HELP: COM-INTERFACE: -{ $syntax <" -COM-INTERFACE: +{ $syntax """COM-INTERFACE: ( ) ( ) ... ; -"> } +""" } { $description "\nFor the interface " { $snippet "" } ", a word " { $snippet "-iid ( -- iid )" } " is defined to push the interface GUID (IID) onto the stack. Words of the form " { $snippet "::" } " are also defined to invoke each method, as well as the methods inherited from " { $snippet "" } ". A " { $snippet "" } " of " { $snippet "f" } " indicates that the interface is a root interface. (Note that COM conventions demand that all interfaces at least inherit from " { $snippet "IUnknown" } ".)\n\nExample:" } -{ $code <" +{ $code """ COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046} HRESULT QueryInterface ( REFGUID iid, void** ppvObject ) ULONG AddRef ( ) @@ -27,4 +25,4 @@ COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc} COM-INTERFACE: IInherited ISimple {9620ecec-8438-423b-bb14-86f835aa40dd} int getX ( ) void setX ( int newX ) ; -"> } ; +""" } ; diff --git a/basis/windows/com/wrapper/wrapper-docs.factor b/basis/windows/com/wrapper/wrapper-docs.factor index c863bb2762..6a6f6f2bb4 100644 --- a/basis/windows/com/wrapper/wrapper-docs.factor +++ b/basis/windows/com/wrapper/wrapper-docs.factor @@ -1,12 +1,12 @@ USING: help.markup help.syntax io kernel math quotations -multiline alien windows.com windows.com.syntax continuations +alien windows.com windows.com.syntax continuations destructors ; IN: windows.com.wrapper HELP: { $values { "implementations" "an assoc relating COM interface names to arrays of quotations implementing that interface" } { "wrapper" "a " { $link com-wrapper } " tuple" } } { $description "Constructs a " { $link com-wrapper } " tuple. Each key in the " { $snippet "implementations" } " assoc must be the name of an interface defined with " { $link POSTPONE: COM-INTERFACE: } ". The corresponding value must be an array of quotations implementing the methods of that interface in order, including those of its parent interfaces. The " { $snippet "IUnknown" } " methods (" { $link IUnknown::QueryInterface } ", " { $link IUnknown::AddRef } ", and " { $link IUnknown::Release } ") will be defined automatically and must not be specified in the array. These quotations should have stack effects mirroring those of the interface methods being implemented; for example, a method " { $snippet "void foobar ( int foo, int bar )" } " should be implemented with a quotation of effect " { $snippet "( this foo bar -- )" } ". The " { $snippet "this" } " parameter (that is, the leftmost parameter of any COM method) will be automatically converted from an alien pointer to the underlying Factor object before the quotation is invoked.\n\nThe resulting wrapper can be applied to a Factor object using the " { $link com-wrap } " word. The COM interface pointer returned by " { $snippet "com-wrap" } " can then be passed to C functions requiring a COM object as a parameter. The vtables constructed by " { $snippet "" } " are stored on the non-GC heap in order to be accessible to C functions; when the wrapper object and its vtables are no longer needed, the object's resources must be freed using " { $link dispose } ".\n\nExample:" } -{ $code <" +{ $code """ COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc} HRESULT returnOK ( ) HRESULT returnError ( ) ; @@ -30,8 +30,7 @@ COM-INTERFACE: IUnrelated IUnknown {b06ac3f4-30e4-406b-a7cd-c29cead4552c} [ swap x>> + ] ! IUnrelated::xPlus [ spin x>> * + ] ! IUnrealted::xMulAdd } } -} -"> } ; +} """ } ; HELP: com-wrap { $values { "object" "The factor object to wrap" } { "wrapper" "A " { $link com-wrapper } " object" } { "wrapped-object" "A COM object referencing " { $snippet "object" } } } diff --git a/basis/xml/syntax/syntax-docs.factor b/basis/xml/syntax/syntax-docs.factor index 0f04f1b7b2..d0e09663e4 100644 --- a/basis/xml/syntax/syntax-docs.factor +++ b/basis/xml/syntax/syntax-docs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax xml.data present multiline ; +USING: help.markup help.syntax xml.data present ; IN: xml.syntax ABOUT: "xml.syntax" @@ -50,11 +50,11 @@ ARTICLE: { "xml.syntax" "interpolation" } "XML interpolation syntax" $nl "These forms can be used where a tag might go, as in " { $snippet "[XML <-> XML]" } " or where an attribute might go, as in " { $snippet "[XML /> XML]" } ". When an attribute is spliced in, it is not included if the value is " { $snippet "f" } " and if the value is not a string, the value is put through " { $link present } ". Here is an example of the fry style of XML interpolation:" { $example -{" USING: splitting xml.writer xml.syntax ; +"""USING: splitting xml.writer xml.syntax ; "one two three" " " split [ [XML <-> XML] ] map -<-> XML> pprint-xml"} -{" +<-> XML> pprint-xml""" +""" one @@ -65,10 +65,10 @@ $nl three -"} } +""" } "Here is an example of the locals version:" { $example -{" USING: locals urls xml.syntax xml.writer ; +"""USING: locals urls xml.syntax xml.writer ; [let | number [ 3 ] false [ f ] @@ -82,11 +82,11 @@ $nl url=<-url-> string=<-string-> word=<-word-> /> - XML> pprint-xml ] "} -{" -"} } + XML> pprint-xml ]""" +""" +""" } "XML interpolation can also be used, in conjunction with " { $vocab-link "inverse" } " in pattern matching. For example:" -{ $example {" USING: xml.syntax inverse ; +{ $example """USING: xml.syntax inverse ; : dispatch ( xml -- string ) { { [ [XML <-> XML] ] [ "a" prepend ] } @@ -94,7 +94,7 @@ $nl { [ [XML XML] ] [ "yes" ] } { [ [XML /> XML] ] [ "no" prepend ] } } switch ; -[XML pple XML] dispatch write "} "apple" } ; +[XML pple XML] dispatch write""" "apple" } ; HELP: XML-NS: { $syntax "XML-NS: name http://url" } diff --git a/basis/xml/syntax/syntax-tests.factor b/basis/xml/syntax/syntax-tests.factor index 06ba2028a6..5c1669adb1 100644 --- a/basis/xml/syntax/syntax-tests.factor +++ b/basis/xml/syntax/syntax-tests.factor @@ -47,13 +47,13 @@ XML-NS: foo http://blah.com [ extract-variables ] tri ] unit-test -[ {" +[ """ one y -"} ] [ +""" ] [ [let* | a [ "one" ] c [ "two" ] x [ "y" ] d [ [XML <-x-> XML] ] | +[ """ one @@ -73,14 +73,14 @@ XML-NS: foo http://blah.com three -"} ] [ +""" ] [ "one two three" " " split [ [XML <-> XML] ] map <-> XML> pprint-xml>string ] unit-test -[ {" -"} ] +[ """ +""" ] [ 3 f "http://factorcode.org/" "hello" \ drop false=<-> url=<-> string=<-> word=<->/> XML> pprint-xml>string ] unit-test diff --git a/basis/xml/traversal/traversal-docs.factor b/basis/xml/traversal/traversal-docs.factor index 9f26774647..091f508fce 100644 --- a/basis/xml/traversal/traversal-docs.factor +++ b/basis/xml/traversal/traversal-docs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax xml.data sequences strings multiline ; +USING: help.markup help.syntax xml.data sequences strings ; IN: xml.traversal ABOUT: "xml.traversal" @@ -22,16 +22,16 @@ ARTICLE: "xml.traversal" "Utilities for traversing XML" ARTICLE: { "xml.traversal" "intro" } "An example of XML processing" "To illustrate how to use the XML library, we develop a simple Atom parser in Factor. Atom is an XML-based syndication format, like RSS. To see the full version of what we develop here, look at " { $snippet "basis/syndication" } " at the " { $snippet "atom1.0" } " word. First, we want to load a file and get a DOM tree for it." -{ $code <" "file.xml" file>xml "> } +{ $code """"file.xml" file>xml""" } "No encoding descriptor is needed, because XML files contain sufficient information to auto-detect the encoding. Next, we want to extract information from the tree. To get the title, we can use the following:" -{ $code <" "title" tag-named children>string "> } +{ $code """"title" tag-named children>string""" } "The " { $link tag-named } " word finds the first tag named " { $snippet "title" } " in the top level (just under the main tag). Then, with a tag on the stack, its children are asserted to be a string, and the string is returned." $nl "For a slightly more complicated example, we can look at how entries are parsed. To get a sequence of tags with the name " { $snippet "entry" } ":" -{ $code <" "entry" tags-named "> } +{ $code """"entry" tags-named""" } "Imagine that, for each of these, we want to get the URL of the entry. In Atom, the URLs are in a " { $snippet "link" } " tag which is contained in the " { $snippet "entry" } " tag. There are multiple " { $snippet "link" } " tags, but one of them contains the attribute " { $snippet "rel=alternate" } ", and the " { $snippet "href" } " attribute has the URL. So, given an element of the sequence produced in the above quotation, we run the code:" -{ $code <" "link" tags-named [ "rel" attr "alternate" = ] find nip "> } +{ $code """"link" tags-named [ "rel" attr "alternate" = ] find nip """ } "to get the link tag on the stack, and" -{ $code <" "href" attr >url "> } +{ $code """"href" attr >url """ } "to extract the URL from it." ; HELP: deep-tag-named diff --git a/basis/xml/writer/writer-docs.factor b/basis/xml/writer/writer-docs.factor index 9971abcdf1..c5a81fb935 100644 --- a/basis/xml/writer/writer-docs.factor +++ b/basis/xml/writer/writer-docs.factor @@ -41,15 +41,15 @@ HELP: pprint-xml HELP: indenter { $var-description "Contains the string which is used for indenting in the XML prettyprinter. For example, to print an XML document using " { $snippet "%%%%" } " for indentation, you can use the following:" } -{ $example {" USING: xml.syntax xml.writer namespaces ; -[XML bar XML] "%%%%" indenter [ pprint-xml ] with-variable "} {" +{ $example """USING: xml.syntax xml.writer namespaces ; +[XML bar XML] "%%%%" indenter [ pprint-xml ] with-variable """ """ %%%%bar -"} } ; +""" } ; HELP: sensitive-tags { $var-description "Contains a sequence of " { $link name } "s where whitespace should be considered significant for prettyprinting purposes. The sequence can contain " { $link string } "s in place of names. For example, to preserve whitespace inside a " { $snippet "pre" } " tag:" } -{ $example {" USING: xml.syntax xml.writer namespaces ; +{ $example """USING: xml.syntax xml.writer namespaces ; [XML something
bing
 bang
    bong
XML] { "pre" } sensitive-tags [ pprint-xml ] with-variable "} {" @@ -64,4 +64,4 @@ bang bang bong -"} } ; +""" } ; diff --git a/basis/xml/writer/writer-tests.factor b/basis/xml/writer/writer-tests.factor index ee09668a53..ad54926a79 100644 --- a/basis/xml/writer/writer-tests.factor +++ b/basis/xml/writer/writer-tests.factor @@ -21,14 +21,14 @@ IN: xml.writer.tests "" reprints-same -{" +""" ]> -bar "} -{" +bar""" +""" ]> -&foo; "} reprints-as +&foo;""" reprints-as -{" +""" @@ -39,15 +39,15 @@ IN: xml.writer.tests ]> bar -"} -{" +""" +""" ]> -&foo;"} pprint-reprints-as +&foo;""" pprint-reprints-as [ t ] [ "" dup string>xml-chunk xml>string = ] unit-test [ "" ] @@ -70,4 +70,4 @@ CONSTANT: test-file "resource:basis/xml/writer/test.xml" [XML <-><-> XML] ] map [XML

Timings

<->
XML] pprint-xml -] unit-test \ No newline at end of file +] unit-test diff --git a/basis/xmode/code2html/code2html-tests.factor b/basis/xmode/code2html/code2html-tests.factor index d57b8ce28d..f00c8a537c 100644 --- a/basis/xmode/code2html/code2html-tests.factor +++ b/basis/xmode/code2html/code2html-tests.factor @@ -6,15 +6,15 @@ kernel io.streams.string xml.writer ; [ ] [ \ (load-mode) reset-memoized ] unit-test [ ] [ - <"