From dceae3df93ccaecb84f67d17444acd756933a2d6 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 27 Jan 2009 23:15:08 +0100 Subject: [PATCH 1/7] FUEL: Better handling of scaped characters inside strings. --- misc/fuel/fuel-syntax.el | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 7f3e0c46f5..ad5a025a88 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -233,16 +233,11 @@ ;; Default is word constituent (dotimes (i 256) (modify-syntax-entry i "w" table)) - ;; Whitespace (TAB is not whitespace) (modify-syntax-entry ?\f " " table) (modify-syntax-entry ?\r " " table) (modify-syntax-entry ?\ " " table) (modify-syntax-entry ?\n " " table) - - ;; Char quote - (modify-syntax-entry ?\\ "/" table) - table)) (defconst fuel-syntax--syntactic-keywords @@ -254,9 +249,9 @@ (" \\((\\)( \\([^\n]*\\) )\\()\\)\\( \\|\n\\)" (1 "b")) (" \\((\\) \\([^\n]*\\) \\()\\)\\( \\|\n\\)" (1 "b")) ;; Strings - ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)\\(\"\\)[^\n\r\f]*?\\(\"\\)\\( \\|\n\\)" - (3 "\"") (4 "\"")) - ("\\(\"\\)[^\n\r\f]*?\\(\"\\)\\( \\|\n\\|$\\)" (1 "\"") (2 "\"")) + ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)" + (3 "\"") (5 "\"")) + ("\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)" (1 "\"") (3 "\"")) ("\\_<<\\(\"\\)\\_>" (1 "\\_>" (1 ">b")) ;; Multiline constructs From 69c509a29f32aed9040516f9a893d55e35b4641b Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 27 Jan 2009 18:16:35 -0600 Subject: [PATCH 2/7] Removing outdated comments in xml.utilities --- basis/xml/utilities/utilities.factor | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/basis/xml/utilities/utilities.factor b/basis/xml/utilities/utilities.factor index 60460e3f46..48cbeceb22 100644 --- a/basis/xml/utilities/utilities.factor +++ b/basis/xml/utilities/utilities.factor @@ -19,10 +19,6 @@ IN: xml.utilities : first-child-tag ( tag -- tag ) children>> [ tag? ] find nip ; -! * Accessing part of an XML document -! for tag- words, a start means that it searches all children -! and no star searches only direct children - : tag-named? ( name elem -- ? ) dup tag? [ names-match? ] [ 2drop f ] if ; @@ -36,8 +32,6 @@ IN: xml.utilities tags@ '[ _ swap tag-named? ] deep-filter ; : tag-named ( tag name/string -- matching-tag ) - ! like get-name-tag but only looks at direct children, - ! not all the children down the tree. assure-name swap [ tag-named? ] with find nip ; : tags-named ( tag name/string -- tags-seq ) @@ -58,7 +52,7 @@ IN: xml.utilities : deep-tags-with-attr ( tag attr-value attr-name -- tags-seq ) tags@ '[ _ _ tag-with-attr? ] deep-filter ; -: get-id ( tag id -- elem ) ! elem=tag.getElementById(id) +: get-id ( tag id -- elem ) "id" deep-tag-with-attr ; : deep-tags-named-with-attr ( tag tag-name attr-value attr-name -- tags ) From fcb56cf6dbe80832c7ae47350f883529196c8790 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 27 Jan 2009 18:42:17 -0600 Subject: [PATCH 3/7] Factored out io.crlf --- basis/base64/base64.factor | 4 ++-- basis/http/http.factor | 8 +------- basis/io/crlf/crlf-docs.factor | 12 ++++++++++++ basis/io/crlf/crlf.factor | 11 +++++++++++ basis/smtp/server/server.factor | 2 +- basis/smtp/smtp.factor | 8 +------- 6 files changed, 28 insertions(+), 17 deletions(-) create mode 100644 basis/io/crlf/crlf-docs.factor create mode 100644 basis/io/crlf/crlf.factor diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor index e5972991e5..a1668e7ce9 100644 --- a/basis/base64/base64.factor +++ b/basis/base64/base64.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: combinators io io.binary io.encodings.binary io.streams.byte-array io.streams.string kernel math namespaces -sequences strings ; +sequences strings io.crlf ; IN: base64 , ; IN: http -: crlf ( -- ) "\r\n" write ; - -: read-crlf ( -- bytes ) - "\r" read-until - [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ; - : (read-header) ( -- alist ) [ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ; diff --git a/basis/io/crlf/crlf-docs.factor b/basis/io/crlf/crlf-docs.factor new file mode 100644 index 0000000000..ac7c8c324e --- /dev/null +++ b/basis/io/crlf/crlf-docs.factor @@ -0,0 +1,12 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup sequences ; +IN: io.crlf + +HELP: crlf +{ $values } +{ $description "Prints a carriage return and line feed to the current output stream, used to indicate a newline for certain network protocols." } ; + +HELP: read-crlf +{ $values { "seq" sequence } } +{ $description "Reads until the next CRLF (carriage return followed by line feed) from the current input stream, throwing an error if there is not a CRLF remaining, or if CR is present without immediately being followed by LF." } ; diff --git a/basis/io/crlf/crlf.factor b/basis/io/crlf/crlf.factor new file mode 100644 index 0000000000..53dddce199 --- /dev/null +++ b/basis/io/crlf/crlf.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: io kernel ; +IN: io.crlf + +: crlf ( -- ) + "\r\n" write ; + +: read-crlf ( -- seq ) + "\r" read-until + [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ; diff --git a/basis/smtp/server/server.factor b/basis/smtp/server/server.factor index f986404404..5d7791292b 100644 --- a/basis/smtp/server/server.factor +++ b/basis/smtp/server/server.factor @@ -4,7 +4,7 @@ USING: combinators kernel prettyprint io io.timeouts sequences namespaces io.sockets io.sockets.secure continuations calendar io.encodings.ascii io.streams.duplex destructors locals concurrency.promises threads accessors smtp.private -io.sockets.secure.unix.debug ; +io.sockets.secure.unix.debug io.crlf ; IN: smtp.server ! Mock SMTP server for testing purposes. diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index 2ffc2e6db3..03b9d8af11 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -6,7 +6,7 @@ io.encodings.utf8 io.timeouts io.sockets io.sockets.secure io.encodings.ascii kernel logging sequences combinators splitting assocs strings math.order math.parser random system calendar summary calendar.format accessors sets hashtables -base64 debugger classes prettyprint ; +base64 debugger classes prettyprint io.crlf ; IN: smtp SYMBOL: smtp-domain @@ -50,12 +50,6 @@ TUPLE: email Date: Tue, 27 Jan 2009 18:43:20 -0600 Subject: [PATCH 4/7] Summary and author for io.crlf --- basis/io/crlf/authors.txt | 2 ++ basis/io/crlf/summary.txt | 1 + 2 files changed, 3 insertions(+) create mode 100644 basis/io/crlf/authors.txt create mode 100644 basis/io/crlf/summary.txt diff --git a/basis/io/crlf/authors.txt b/basis/io/crlf/authors.txt new file mode 100644 index 0000000000..33616a2d6a --- /dev/null +++ b/basis/io/crlf/authors.txt @@ -0,0 +1,2 @@ +Daniel Ehrenberg +Slava Pestov diff --git a/basis/io/crlf/summary.txt b/basis/io/crlf/summary.txt new file mode 100644 index 0000000000..2fa6a6e2c1 --- /dev/null +++ b/basis/io/crlf/summary.txt @@ -0,0 +1 @@ +Writing and reading until \r\n From 371b919abc8fc5b174fd0922970d38c831d1f346 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 28 Jan 2009 12:29:25 -0600 Subject: [PATCH 5/7] Quoted printable vocab --- basis/base64/tags.txt | 2 + basis/quoted-printable/authors.txt | 1 + .../quoted-printable-docs.factor | 27 ++++++++ .../quoted-printable-tests.factor | 30 +++++++++ .../quoted-printable/quoted-printable.factor | 62 +++++++++++++++++++ basis/quoted-printable/summary.txt | 1 + basis/quoted-printable/tags.txt | 2 + 7 files changed, 125 insertions(+) create mode 100644 basis/base64/tags.txt create mode 100644 basis/quoted-printable/authors.txt create mode 100644 basis/quoted-printable/quoted-printable-docs.factor create mode 100644 basis/quoted-printable/quoted-printable-tests.factor create mode 100644 basis/quoted-printable/quoted-printable.factor create mode 100644 basis/quoted-printable/summary.txt create mode 100644 basis/quoted-printable/tags.txt diff --git a/basis/base64/tags.txt b/basis/base64/tags.txt new file mode 100644 index 0000000000..8fd3eccc9a --- /dev/null +++ b/basis/base64/tags.txt @@ -0,0 +1,2 @@ +parsing +web diff --git a/basis/quoted-printable/authors.txt b/basis/quoted-printable/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/basis/quoted-printable/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/basis/quoted-printable/quoted-printable-docs.factor b/basis/quoted-printable/quoted-printable-docs.factor new file mode 100644 index 0000000000..81219a3f84 --- /dev/null +++ b/basis/quoted-printable/quoted-printable-docs.factor @@ -0,0 +1,27 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax strings byte-arrays io.encodings.string ; +IN: quoted-printable + +ABOUT: "quoted-printable" + +ARTICLE: "quoted-printable" "Quoted printable encoding" +"The " { $vocab-link "quoted-printable" } " vocabulary implements RFC 2045 part 6.7, providing words for reading and generating quotable printed text." +{ $subsection >quoted } +{ $subsection >quoted-lines } +{ $subsection quoted> } ; + +HELP: >quoted +{ $values { "byte-array" byte-array } { "string" string } } +{ $description "Encodes a byte array as quoted printable, on a single line." } +{ $warning "To encode a string in quoted printable, first use the " { $link encode } " word." } ; + +HELP: >quoted-lines +{ $values { "byte-array" byte-array } { "string" string } } +{ $description "Encodes a byte array as quoted printable, with soft line breaks inserted so the output lines are no longer than 76 characters." } +{ $warning "To encode a string in quoted printable, first use the " { $link encode } " word with a specific encoding." } ; + +HELP: quoted> +{ $values { "string" string } { "byte-array" byte-array } } +{ $description "Decodes a quoted printable string into an array of the bytes represented." } +{ $warning "When decoding something in quoted printable form and using it as a string, be sure to use the " { $link decode } " word rather than simply converting the byte array to a string." } ; diff --git a/basis/quoted-printable/quoted-printable-tests.factor b/basis/quoted-printable/quoted-printable-tests.factor new file mode 100644 index 0000000000..6f42a48b37 --- /dev/null +++ b/basis/quoted-printable/quoted-printable-tests.factor @@ -0,0 +1,30 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test quoted-printable multiline io.encodings.string +sequences io.encodings.8-bit splitting kernel ; +IN: quoted-printable.tests + +[ <" 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 +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 + +[ <" 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 + +: message ( -- str ) + 55 [ "hello" ] replicate concat ; + +[ f ] [ message >quoted "=\r\n" swap subseq? ] unit-test +[ 1 ] [ message >quoted string-lines length ] unit-test +[ t ] [ message >quoted-lines "=\r\n" swap subseq? ] unit-test +[ 4 ] [ message >quoted-lines string-lines length ] unit-test +[ "===o" ] [ message >quoted-lines string-lines [ peek ] "" map-as ] unit-test diff --git a/basis/quoted-printable/quoted-printable.factor b/basis/quoted-printable/quoted-printable.factor new file mode 100644 index 0000000000..83fee523a0 --- /dev/null +++ b/basis/quoted-printable/quoted-printable.factor @@ -0,0 +1,62 @@ +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: sequences strings kernel io.encodings.string +math.order ascii math io io.encodings.utf8 io.streams.string +combinators.short-circuit math.parser arrays ; +IN: quoted-printable + +! This implements RFC 2045 section 6.7 + + CHAR: ~ between? ] + [ CHAR: \t = ] + } 1|| ; + +: char>quoted ( ch -- str ) + dup printable? [ 1string ] [ + assure-small >hex >upper + 2 CHAR: 0 pad-left + CHAR: = prefix + ] if ; + +: take-some ( seqs -- seqs seq ) + 0 over [ length + dup 76 >= ] find drop nip + [ 1- cut-slice swap ] [ f swap ] if* concat ; + +: divide-lines ( strings -- strings ) + [ dup ] [ take-some ] [ ] produce nip ; + +PRIVATE> + +: >quoted ( byte-array -- string ) + [ char>quoted ] { } map-as concat "" like ; + +: >quoted-lines ( byte-array -- string ) + [ char>quoted ] { } map-as + divide-lines "=\r\n" join ; + + ] if + ] when ; + +: read-quoted ( -- bytes ) + [ read1 dup ] [ read-char ] [ drop ] B{ } produce-as ; + +PRIVATE> + +: quoted> ( string -- byte-array ) + ! Input should already be normalized to make \r\n into \n + [ read-quoted ] with-string-reader ; diff --git a/basis/quoted-printable/summary.txt b/basis/quoted-printable/summary.txt new file mode 100644 index 0000000000..c32ac1fc80 --- /dev/null +++ b/basis/quoted-printable/summary.txt @@ -0,0 +1 @@ +Quoted printable encoding/decoding diff --git a/basis/quoted-printable/tags.txt b/basis/quoted-printable/tags.txt new file mode 100644 index 0000000000..8fd3eccc9a --- /dev/null +++ b/basis/quoted-printable/tags.txt @@ -0,0 +1,2 @@ +parsing +web From f438bd5157f32c4dea0d6c5220ae9492fc3a1fb4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 28 Jan 2009 15:04:36 -0600 Subject: [PATCH 6/7] Better handling of wrappers in locals --- basis/locals/locals-tests.factor | 4 +++- basis/locals/rewrite/sugar/sugar.factor | 11 ++++++----- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index 982674694a..e3aa504fbc 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -494,4 +494,6 @@ M:: integer lambda-method-forget-test ( a -- b ) ; ! Discovered by littledan [ "bar" ] [ [let | a [ [let | foo [ "bar" ] | foo ] ] | a ] ] unit-test -[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test \ No newline at end of file +[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test + +[ { \ + } ] [ [let | x [ \ + ] | { \ x } ] ] unit-test \ No newline at end of file diff --git a/basis/locals/rewrite/sugar/sugar.factor b/basis/locals/rewrite/sugar/sugar.factor index 835fa6e421..6e7e156ced 100644 --- a/basis/locals/rewrite/sugar/sugar.factor +++ b/basis/locals/rewrite/sugar/sugar.factor @@ -37,7 +37,7 @@ M: array rewrite-literal? [ rewrite-literal? ] contains? ; M: quotation rewrite-literal? [ rewrite-literal? ] contains? ; -M: wrapper rewrite-literal? drop t ; +M: wrapper rewrite-literal? wrapped>> rewrite-literal? ; M: hashtable rewrite-literal? drop t ; @@ -53,7 +53,7 @@ GENERIC: rewrite-element ( obj -- ) [ rewrite-element ] each ; : rewrite-sequence ( seq -- ) - [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ; + [ rewrite-elements ] [ length ] [ 0 head ] tri '[ _ _ nsequence ] % ; M: array rewrite-element dup rewrite-literal? [ rewrite-sequence ] [ , ] if ; @@ -63,7 +63,7 @@ M: vector rewrite-element rewrite-sequence ; M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ; M: tuple rewrite-element - [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ; + [ tuple-slots rewrite-elements ] [ class ] bi '[ _ boa ] % ; M: quotation rewrite-element rewrite-sugar* ; @@ -84,7 +84,7 @@ M: local-word rewrite-element M: word rewrite-element literalize , ; M: wrapper rewrite-element - dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ; + dup rewrite-literal? [ wrapped>> rewrite-element \ literalize , ] [ , ] if ; M: object rewrite-element , ; @@ -98,7 +98,8 @@ M: def rewrite-sugar* , ; M: hashtable rewrite-sugar* rewrite-element ; -M: wrapper rewrite-sugar* rewrite-element ; +M: wrapper rewrite-sugar* + dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ; M: word rewrite-sugar* dup { load-locals get-local drop-locals } memq? From 16181f818b5ad90dade709e8c48f2bcf2b5641bb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 28 Jan 2009 15:07:16 -0600 Subject: [PATCH 7/7] Clean up functors so that the generated code looks sane with 'see' --- basis/functors/functors-tests.factor | 2 +- basis/functors/functors.factor | 33 ++++++++++-- basis/io/mmap/functor/functor.factor | 4 +- basis/math/blas/cblas/tags.txt | 1 - basis/math/blas/matrices/matrices.factor | 26 +++++----- basis/math/blas/matrices/tags.txt | 1 - basis/math/blas/syntax/syntax.factor | 2 +- basis/math/blas/syntax/tags.txt | 1 - basis/math/blas/vectors/tags.txt | 1 - basis/math/blas/vectors/vectors.factor | 52 +++++++++---------- .../specialized-arrays/functor/functor.factor | 6 +-- .../functor/functor.factor | 10 ++-- 12 files changed, 80 insertions(+), 59 deletions(-) diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor index 39923afee7..577debd398 100644 --- a/basis/functors/functors-tests.factor +++ b/basis/functors/functors-tests.factor @@ -34,7 +34,7 @@ WW DEFINES ${W}${W} WHERE -: WW W twice ; inline +: WW ( a -- b ) \ W twice ; inline ;FUNCTOR diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index 28bedc8360..b13ee8ff7c 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -1,17 +1,42 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel quotations classes.tuple make combinators generic words interpolate namespaces sequences io.streams.string fry classes.mixin effects lexer parser classes.tuple.parser effects.parser locals.types locals.parser -locals.rewrite.closures vocabs.parser ; +locals.rewrite.closures vocabs.parser arrays accessors ; IN: functors +! This is a hack + : scan-param ( -- obj ) scan-object dup special? [ literalize ] unless ; : define* ( word def effect -- ) pick set-word define-declared ; +TUPLE: fake-quotation seq ; + +GENERIC: >fake-quotations ( quot -- fake ) + +M: callable >fake-quotations + >array >fake-quotations fake-quotation boa ; + +M: array >fake-quotations [ >fake-quotations ] { } map-as ; + +M: object >fake-quotations ; + +GENERIC: fake-quotations> ( fake -- quot ) + +M: fake-quotation fake-quotations> + seq>> [ fake-quotations> ] map >quotation ; + +M: array fake-quotations> [ fake-quotations> ] map ; + +M: object fake-quotations> ; + +: parse-definition* ( -- ) + parse-definition >fake-quotations parsed \ fake-quotations> parsed ; + : DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ; : `TUPLE: @@ -32,7 +57,7 @@ IN: functors scan-param parsed scan-param parsed \ create-method parsed - parse-definition parsed + parse-definition* DEFINE* ; parsing : `C: @@ -45,7 +70,7 @@ IN: functors : `: effect off scan-param parsed - parse-definition parsed + parse-definition* DEFINE* ; parsing : `INSTANCE: diff --git a/basis/io/mmap/functor/functor.factor b/basis/io/mmap/functor/functor.factor index 4587a75fd9..954d8b43c7 100644 --- a/basis/io/mmap/functor/functor.factor +++ b/basis/io/mmap/functor/functor.factor @@ -20,9 +20,9 @@ with-mapped-A-file DEFINES with-mapped-${T}-file WHERE : ( mapped-file -- direct-array ) - T mapped-file>direct execute ; inline + T mapped-file>direct ; inline : with-mapped-A-file ( path length quot -- ) - '[ execute @ ] with-mapped-file ; inline + '[ @ ] with-mapped-file ; inline ;FUNCTOR diff --git a/basis/math/blas/cblas/tags.txt b/basis/math/blas/cblas/tags.txt index 5118958180..241ec1ecda 100644 --- a/basis/math/blas/cblas/tags.txt +++ b/basis/math/blas/cblas/tags.txt @@ -1,3 +1,2 @@ math bindings -unportable diff --git a/basis/math/blas/matrices/matrices.factor b/basis/math/blas/matrices/matrices.factor index 75ab07709a..f6b98e3ae2 100755 --- a/basis/math/blas/matrices/matrices.factor +++ b/basis/math/blas/matrices/matrices.factor @@ -268,28 +268,28 @@ TUPLE: MATRIX < blas-matrix-base ; M: MATRIX element-type drop TYPE ; M: MATRIX (blas-matrix-like) - drop execute ; + drop ; M: VECTOR (blas-matrix-like) - drop execute ; + drop ; M: MATRIX (blas-vector-like) - drop execute ; + drop ; : >MATRIX ( arrays -- matrix ) - [ >ARRAY execute underlying>> ] (>matrix) - execute ; + [ >ARRAY underlying>> ] (>matrix) + ; M: VECTOR n*M.V+n*V! - [ TYPE>ARG execute ] (prepare-gemv) - [ XGEMV execute ] dip ; + [ TYPE>ARG ] (prepare-gemv) + [ XGEMV ] dip ; M: MATRIX n*M.M+n*M! - [ TYPE>ARG execute ] (prepare-gemm) - [ XGEMM execute ] dip ; + [ TYPE>ARG ] (prepare-gemm) + [ XGEMM ] dip ; M: MATRIX n*V(*)V+M! - [ TYPE>ARG execute ] (prepare-ger) - [ XGERU execute ] dip ; + [ TYPE>ARG ] (prepare-ger) + [ XGERU ] dip ; M: MATRIX n*V(*)Vconj+M! - [ TYPE>ARG execute ] (prepare-ger) - [ XGERC execute ] dip ; + [ TYPE>ARG ] (prepare-ger) + [ XGERC ] dip ; ;FUNCTOR diff --git a/basis/math/blas/matrices/tags.txt b/basis/math/blas/matrices/tags.txt index 5118958180..241ec1ecda 100644 --- a/basis/math/blas/matrices/tags.txt +++ b/basis/math/blas/matrices/tags.txt @@ -1,3 +1,2 @@ math bindings -unportable diff --git a/basis/math/blas/syntax/syntax.factor b/basis/math/blas/syntax/syntax.factor index 95f9f7bd08..2d171a801b 100644 --- a/basis/math/blas/syntax/syntax.factor +++ b/basis/math/blas/syntax/syntax.factor @@ -1,5 +1,5 @@ USING: kernel math.blas.vectors math.blas.matrices parser -arrays prettyprint.backend sequences ; +arrays prettyprint.backend prettyprint.custom sequences ; IN: math.blas.syntax : svector{ diff --git a/basis/math/blas/syntax/tags.txt b/basis/math/blas/syntax/tags.txt index 6a932d96d2..ede10ab61b 100644 --- a/basis/math/blas/syntax/tags.txt +++ b/basis/math/blas/syntax/tags.txt @@ -1,2 +1 @@ math -unportable diff --git a/basis/math/blas/vectors/tags.txt b/basis/math/blas/vectors/tags.txt index 6a932d96d2..ede10ab61b 100644 --- a/basis/math/blas/vectors/tags.txt +++ b/basis/math/blas/vectors/tags.txt @@ -1,2 +1 @@ math -unportable diff --git a/basis/math/blas/vectors/vectors.factor b/basis/math/blas/vectors/vectors.factor index db027b0ffd..c86fa30115 100755 --- a/basis/math/blas/vectors/vectors.factor +++ b/basis/math/blas/vectors/vectors.factor @@ -144,26 +144,26 @@ TUPLE: VECTOR < blas-vector-base ; : ( underlying length inc -- vector ) VECTOR boa ; inline : >VECTOR ( seq -- v ) - [ >ARRAY execute underlying>> ] [ length ] bi 1 execute ; + [ >ARRAY underlying>> ] [ length ] bi 1 ; M: VECTOR clone TYPE heap-size (prepare-copy) - [ XCOPY execute ] 3dip execute ; + [ XCOPY ] 3dip ; M: VECTOR element-type drop TYPE ; M: VECTOR Vswap - (prepare-swap) [ XSWAP execute ] 2dip ; + (prepare-swap) [ XSWAP ] 2dip ; M: VECTOR Viamax - (prepare-nrm2) IXAMAX execute ; + (prepare-nrm2) IXAMAX ; M: VECTOR (blas-vector-like) - drop execute ; + drop ; M: VECTOR (blas-direct-array) [ underlying>> ] [ [ length>> ] [ inc>> ] bi * ] bi - execute ; + ; ;FUNCTOR @@ -180,17 +180,17 @@ XSCAL IS cblas_${T}scal WHERE M: VECTOR V. - (prepare-dot) XDOT execute ; + (prepare-dot) XDOT ; M: VECTOR V.conj - (prepare-dot) XDOT execute ; + (prepare-dot) XDOT ; M: VECTOR Vnorm - (prepare-nrm2) XNRM2 execute ; + (prepare-nrm2) XNRM2 ; M: VECTOR Vasum - (prepare-nrm2) XASUM execute ; + (prepare-nrm2) XASUM ; M: VECTOR n*V+V! - (prepare-axpy) [ XAXPY execute ] dip ; + (prepare-axpy) [ XAXPY ] dip ; M: VECTOR n*V! - (prepare-scal) [ XSCAL execute ] dip ; + (prepare-scal) [ XSCAL ] dip ; ;FUNCTOR @@ -207,13 +207,13 @@ COMPLEX>ARG DEFINES ${TYPE}-complex>arg WHERE : ( alien len -- sequence ) - 1 shift execute ; + 1 shift ; : >COMPLEX-ARRAY ( sequence -- sequence ) - >ARRAY execute ; + >ARRAY ; : COMPLEX>ARG ( complex -- alien ) - >rect 2array >ARRAY execute underlying>> ; + >rect 2array >ARRAY underlying>> ; : ARG>COMPLEX ( alien -- complex ) - 2 execute first2 rect> ; + 2 first2 rect> ; ;FUNCTOR @@ -234,22 +234,22 @@ WHERE M: VECTOR V. (prepare-dot) TYPE - [ XDOTU_SUB execute ] keep - ARG>TYPE execute ; + [ XDOTU_SUB ] keep + ARG>TYPE ; M: VECTOR V.conj (prepare-dot) TYPE - [ XDOTC_SUB execute ] keep - ARG>TYPE execute ; + [ XDOTC_SUB ] keep + ARG>TYPE ; M: VECTOR Vnorm - (prepare-nrm2) XXNRM2 execute ; + (prepare-nrm2) XXNRM2 ; M: VECTOR Vasum - (prepare-nrm2) XXASUM execute ; + (prepare-nrm2) XXASUM ; M: VECTOR n*V+V! - [ TYPE>ARG execute ] 2dip - (prepare-axpy) [ XAXPY execute ] dip ; + [ TYPE>ARG ] 2dip + (prepare-axpy) [ XAXPY ] dip ; M: VECTOR n*V! - [ TYPE>ARG execute ] dip - (prepare-scal) [ XSCAL execute ] dip ; + [ TYPE>ARG ] dip + (prepare-scal) [ XSCAL ] dip ; ;FUNCTOR diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor index 579da5b84a..718a1a7aa1 100644 --- a/basis/specialized-arrays/functor/functor.factor +++ b/basis/specialized-arrays/functor/functor.factor @@ -49,9 +49,9 @@ M: A set-nth-unsafe underlying>> SET-NTH call ; : >A ( seq -- specialized-array ) A new clone-like ; inline -M: A like drop dup A instance? [ >A execute ] unless ; +M: A like drop dup A instance? [ >A ] unless ; -M: A new-sequence drop (A) execute ; +M: A new-sequence drop (A) ; M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ; @@ -70,7 +70,7 @@ M: A >pprint-sequence ; M: A pprint* pprint-object ; -: A{ \ } [ >A execute ] parse-literal ; parsing +: A{ \ } [ >A ] parse-literal ; parsing INSTANCE: A sequence diff --git a/basis/specialized-vectors/functor/functor.factor b/basis/specialized-vectors/functor/functor.factor index 6069a4cb4a..e6f1986874 100644 --- a/basis/specialized-vectors/functor/functor.factor +++ b/basis/specialized-vectors/functor/functor.factor @@ -18,16 +18,16 @@ WHERE TUPLE: V { underlying A } { length array-capacity } ; -: ( capacity -- vector ) execute 0 V boa ; inline +: ( capacity -- vector ) 0 V boa ; inline M: V like drop dup V instance? [ - dup A instance? [ dup length V boa ] [ >V execute ] if + dup A instance? [ dup length V boa ] [ >V ] if ] unless ; -M: V new-sequence drop [ execute ] [ >fixnum ] bi V boa ; +M: V new-sequence drop [ ] [ >fixnum ] bi V boa ; -M: A new-resizable drop execute ; +M: A new-resizable drop ; M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ; @@ -39,7 +39,7 @@ M: V >pprint-sequence ; M: V pprint* pprint-object ; -: V{ \ } [ >V execute ] parse-literal ; parsing +: V{ \ } [ >V ] parse-literal ; parsing INSTANCE: V growable