From 91b3b7e8fc5fabfc4592e08db79d78fba5917d8f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 20 Oct 2008 04:13:52 -0500 Subject: [PATCH 01/19] add function --- basis/unix/stat/netbsd/netbsd.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/unix/stat/netbsd/netbsd.factor b/basis/unix/stat/netbsd/netbsd.factor index aefa9fd2cf..0bcb886417 100644 --- a/basis/unix/stat/netbsd/netbsd.factor +++ b/basis/unix/stat/netbsd/netbsd.factor @@ -35,3 +35,4 @@ C-STRUCT: statvfs { { "char" _VFS_NAMELEN } "f_mntonname" } { { "char" _VFS_NAMELEN } "f_mntfromname" } ; +FUNCTION: int statvfs ( char* path, statvfs* buf ) ; From 001dc3b2518d6549b93ff7c493040b84e997f69e Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 22 Dec 2008 06:42:08 -0800 Subject: [PATCH 02/19] Cleanup uuid a bit more, thanks Slava! --- basis/uuid/uuid.factor | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/basis/uuid/uuid.factor b/basis/uuid/uuid.factor index 337ea22df5..209485b3bc 100644 --- a/basis/uuid/uuid.factor +++ b/basis/uuid/uuid.factor @@ -52,13 +52,10 @@ IN: uuid : string>uuid ( string -- n ) [ CHAR: - = not ] filter 16 base> ; -: uuid>byte-array ( n -- byte-array ) - 16 >be ; - PRIVATE> : uuid-parse ( string -- byte-array ) - string>uuid uuid>byte-array ; + string>uuid 16 >be ; : uuid-unparse ( byte-array -- string ) be> uuid>string ; From f31cf8e9a93ba065db0ee4a7725d9375c451f1dd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Jan 2009 15:21:46 -0600 Subject: [PATCH 03/19] fix empty description --- basis/math/bitwise/bitwise-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/math/bitwise/bitwise-docs.factor b/basis/math/bitwise/bitwise-docs.factor index 18ae8e1497..358c984276 100644 --- a/basis/math/bitwise/bitwise-docs.factor +++ b/basis/math/bitwise/bitwise-docs.factor @@ -242,7 +242,7 @@ HELP: shift-mod { "n" integer } { "s" integer } { "w" integer } { "n" integer } } -{ $description "" } ; +{ $description "Calls " { $link shift } " on " { $snippet "n" } " and " { $snippet "s" } ", wrapping the result to " { $snippet "w" } " bits." } ; HELP: unmask { $values From e872eb1e8e1b5f5e2fe81b53d6088048d0eba81d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Jan 2009 15:29:28 -0600 Subject: [PATCH 04/19] fix docs for environment --- basis/environment/environment-docs.factor | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/basis/environment/environment-docs.factor b/basis/environment/environment-docs.factor index e539b446f3..b48a7a01ad 100644 --- a/basis/environment/environment-docs.factor +++ b/basis/environment/environment-docs.factor @@ -7,12 +7,14 @@ HELP: (os-envs) { $values { "seq" sequence } } -{ $description "" } ; +{ $description "Returns a sequence of key/value pairs from the operating system." } +{ $notes "In most cases, use " { $link os-envs } " instead." } ; HELP: (set-os-envs) { $values { "seq" sequence } } -{ $description "" } ; +{ $description "Low-level word for replacing the current set of environment variables." } +{ $notes "In most cases, use " { $link set-os-envs } " instead." } ; HELP: os-env ( key -- value ) From 23d4699d5c59cefffe26b61c1720df927f98a9b3 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Fri, 30 Jan 2009 22:32:20 +0100 Subject: [PATCH 05/19] FUEL: Fix the previous fix. --- misc/fuel/fuel-markup.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el index 3aee2dc912..4844233ae7 100644 --- a/misc/fuel/fuel-markup.el +++ b/misc/fuel/fuel-markup.el @@ -323,7 +323,7 @@ (sort-lines nil start (point)))))) (defun fuel-markup--vocab-link (e) - (fuel-markup--insert-button (cadr e) (car (cddr e)) 'vocab)) + (fuel-markup--insert-button (cadr e) (or (car (cddr e)) (cadr e)) 'vocab)) (defun fuel-markup--vocab-links (e) (dolist (link (cdr e)) From 267e24676602f7d3789cb4dfb0004e869aebbd0f Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 30 Jan 2009 14:17:12 -0800 Subject: [PATCH 06/19] Support "%s" for numbers, and add support for sequences and assocs formatting. --- basis/formatting/formatting-docs.factor | 32 ++++++++++++++++--------- basis/formatting/formatting.factor | 14 +++++++---- 2 files changed, 31 insertions(+), 15 deletions(-) diff --git a/basis/formatting/formatting-docs.factor b/basis/formatting/formatting-docs.factor index cfa322fb53..95b24ae351 100644 --- a/basis/formatting/formatting-docs.factor +++ b/basis/formatting/formatting-docs.factor @@ -12,17 +12,19 @@ HELP: printf "specifying attributes for the result string, including such things as maximum width, " "padding, and decimals.\n" { $table - { "%%" "Single %" "" } - { "%P.Ds" "String format" "string" } - { "%P.DS" "String format uppercase" "string" } - { "%c" "Character format" "char" } - { "%C" "Character format uppercase" "char" } - { "%+Pd" "Integer format" "fixnum" } - { "%+P.De" "Scientific notation" "fixnum, float" } - { "%+P.DE" "Scientific notation" "fixnum, float" } - { "%+P.Df" "Fixed format" "fixnum, float" } - { "%+Px" "Hexadecimal" "hex" } - { "%+PX" "Hexadecimal uppercase" "hex" } + { "%%" "Single %" "" } + { "%P.Ds" "String format" "string" } + { "%P.DS" "String format uppercase" "string" } + { "%c" "Character format" "char" } + { "%C" "Character format uppercase" "char" } + { "%+Pd" "Integer format" "fixnum" } + { "%+P.De" "Scientific notation" "fixnum, float" } + { "%+P.DE" "Scientific notation" "fixnum, float" } + { "%+P.Df" "Fixed format" "fixnum, float" } + { "%+Px" "Hexadecimal" "hex" } + { "%+PX" "Hexadecimal uppercase" "hex" } + { "%[%?, %]" "Sequence format" "sequence" } + { "%[%?: %? %]" "Assocs format" "assocs" } } $nl "A plus sign ('+') is used to optionally specify that the number should be " @@ -72,6 +74,14 @@ HELP: printf "USING: formatting ;" "1234 \"%+d\" printf" "+1234" } + { $example + "USING: formatting ;" + "{ 1 2 3 } \"%[%d, %]\" printf" + "{ 1, 2, 3 }" } + { $example + "USING: formatting ;" + "H{ { 1 2 } { 3 4 } } \"%[%d: %d %]\" printf" + "{ 1:2, 3:4 }" } } ; HELP: sprintf diff --git a/basis/formatting/formatting.factor b/basis/formatting/formatting.factor index a55f0c77c5..5a1e3650fe 100644 --- a/basis/formatting/formatting.factor +++ b/basis/formatting/formatting.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: accessors arrays ascii calendar combinators fry kernel +USING: accessors arrays ascii assocs calendar combinators fry kernel generalizations io io.encodings.ascii io.files io.streams.string macros math math.functions math.parser peg.ebnf quotations sequences splitting strings unicode.case vectors ; @@ -75,8 +75,8 @@ digits = (digits_)? => [[ 6 or ]] fmt-% = "%" => [[ [ "%" ] ]] fmt-c = "c" => [[ [ 1string ] ]] fmt-C = "C" => [[ [ 1string >upper ] ]] -fmt-s = "s" => [[ [ ] ]] -fmt-S = "S" => [[ [ >upper ] ]] +fmt-s = "s" => [[ [ dup number? [ number>string ] when ] ]] +fmt-S = "S" => [[ [ dup number? [ number>string ] when >upper ] ]] fmt-d = "d" => [[ [ >fixnum number>string ] ]] fmt-e = digits "e" => [[ first '[ >exp _ exp>string ] ]] fmt-E = digits "E" => [[ first '[ >exp _ exp>string >upper ] ]] @@ -91,7 +91,13 @@ strings = pad width strings_ => [[ reverse compose-all ]] numbers_ = fmt-d|fmt-e|fmt-E|fmt-f|fmt-x|fmt-X numbers = sign pad numbers_ => [[ unclip-last prefix compose-all [ fix-sign ] append ]] -formats = "%" (strings|numbers|fmt-%|unknown) => [[ second '[ _ dip ] ]] +types = strings|numbers + +lists = "[%" types ", %]" => [[ second '[ _ map ", " join "{ " prepend " }" append ] ]] + +assocs = "[%" types ": %" types " %]" => [[ [ second ] [ fourth ] bi '[ unzip [ _ map ] dip _ map zip [ ":" join ] map ", " join "{ " prepend " }" append ] ]] + +formats = "%" (types|fmt-%|lists|assocs|unknown) => [[ second '[ _ dip ] ]] plain-text = (!("%").)+ => [[ >string '[ _ swap ] ]] From 2b6f9f31ff2f523c34cafb916db57390552d2d9f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Jan 2009 16:17:50 -0600 Subject: [PATCH 07/19] fix help-lint docs for db --- basis/db/db-docs.factor | 2 +- basis/db/types/types-docs.factor | 93 ++++---------------------------- 2 files changed, 10 insertions(+), 85 deletions(-) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index 08544b3367..c392ec6b85 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -173,7 +173,7 @@ HELP: with-db HELP: with-transaction { $values { "quot" quotation } } -{ $description "" } ; +{ $description "Calls the quotation inside a database transaction and commits the result to the database after the quotation finishes. If the quotation throws an error, the transaction is aborted." } ; ARTICLE: "db" "Database library" "Accessing a database:" diff --git a/basis/db/types/types-docs.factor b/basis/db/types/types-docs.factor index b8ccbd976f..4d3be1d592 100644 --- a/basis/db/types/types-docs.factor +++ b/basis/db/types/types-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: classes hashtables help.markup help.syntax io.streams.string -kernel sequences strings math ; +kernel sequences strings math db.tuples db.tuples.private ; IN: db.types HELP: +db-assigned-id+ @@ -27,15 +27,11 @@ HELP: +user-assigned-id+ HELP: { $values { "slot-name" object } { "key" object } { "generator-singleton" object } { "type" object } { "generator-bind" generator-bind } } -{ $description "" } ; +{ $description "An internal constructor for creating objects containing parameters used for binding generated values to a tuple query." } ; HELP: { $values { "key" object } { "type" object } { "value" object } { "literal-bind" literal-bind } } -{ $description "" } ; - -HELP: -{ $values { "value" object } { "low-level-binding" low-level-binding } } -{ $description "" } ; +{ $description "An internal constructor for creating objects containing parameters used for binding literal values to a tuple query." } ; HELP: BIG-INTEGER { $description "A 64-bit integer. Whether this number is signed or unsigned depends on the database backend." } ; @@ -100,18 +96,12 @@ HELP: user-assigned-id-spec? HELP: bind# { $values { "spec" "a sql spec" } { "obj" object } } -{ $description "" } ; +{ $description "A generic word that lets a database construct a literal binding." } ; HELP: bind% { $values { "spec" "a sql spec" } } -{ $description "" } ; - -HELP: compound -{ $values - { "string" string } { "obj" object } - { "hash" hashtable } } -{ $description "" } ; +{ $description "A generic word that lets a database output a binding." } ; HELP: db-assigned-id-spec? { $values @@ -126,45 +116,12 @@ HELP: find-primary-key { $description "Returns the rows from the sql-specs array that are part of the primary key. Composite primary keys are supported, so this word must return a sequence." } { $notes "This is a low-level word." } ; -HELP: generator-bind -{ $description "" } ; - HELP: get-slot-named { $values { "name" "a slot name" } { "tuple" tuple } { "value" "the value stored in the slot" } } { $description "Returns the value stored in a tuple slot, where the tuple slot is a string." } ; -HELP: literal-bind -{ $description "" } ; - -HELP: lookup-create-type -{ $values - { "obj" object } - { "string" string } } -{ $description "" } ; - -HELP: lookup-modifier -{ $values - { "obj" object } - { "string" string } } -{ $description "" } ; - -HELP: lookup-type -{ $values - { "obj" object } - { "string" string } } -{ $description "" } ; - -HELP: low-level-binding -{ $description "" } ; - -HELP: modifiers -{ $values - { "spec" "a sql spec" } - { "string" string } } -{ $description "" } ; - HELP: no-sql-type { $values { "type" "a sql type" } } @@ -173,7 +130,7 @@ HELP: no-sql-type HELP: normalize-spec { $values { "spec" "a sql spec" } } -{ $description "" } ; +{ $description "Normalizes a sql spec." } ; HELP: offset-of-slot { $values @@ -181,52 +138,20 @@ HELP: offset-of-slot { "n" integer } } { $description "Returns the offset of a tuple slot accessed by name." } ; -HELP: persistent-table -{ $values - - { "hash" hashtable } } -{ $description "" } ; - HELP: primary-key? { $values { "spec" "a sql spec" } { "?" "a boolean" } } -{ $description "" } ; +{ $description "Returns true if a sql spec is a primary key." } ; HELP: random-id-generator -{ $description "" } ; +{ $description "Used to tell " { $link eval-generator } " to generate a random number for use as a key." } ; HELP: relation? { $values { "spec" "a sql spec" } { "?" "a boolean" } } -{ $description "" } ; - -HELP: remove-db-assigned-id -{ $values - { "specs" "a sequence of sql specs" } - { "obj" object } } -{ $description "" } ; - -HELP: remove-id -{ $values - { "specs" "a sequence of sql specs" } - { "obj" object } } -{ $description "" } ; - -HELP: set-slot-named -{ $values - { "value" object } { "name" string } { "obj" object } } -{ $description "" } ; - -HELP: spec>tuple -{ $values - { "class" class } { "spec" "a sql spec" } - { "tuple" tuple } } -{ $description "" } ; - -HELP: sql-spec -{ $description "" } ; +{ $description "Returns true if a sql spec is a relation." } ; HELP: unknown-modifier { $values { "modifier" string } } From a60e11b89e328b57b5121f6cc0fd6c0a9a9ae9c8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Jan 2009 16:45:30 -0600 Subject: [PATCH 08/19] add RTLD_GLOBAL to dlopen flags. load atlas before cblas on freebsd --- basis/math/blas/cblas/cblas.factor | 12 +++++++++--- vm/os-unix.c | 2 +- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/basis/math/blas/cblas/cblas.factor b/basis/math/blas/cblas/cblas.factor index 4c0a88f929..3914c5b2ec 100644 --- a/basis/math/blas/cblas/cblas.factor +++ b/basis/math/blas/cblas/cblas.factor @@ -1,13 +1,19 @@ USING: alien alien.c-types alien.syntax kernel system combinators ; IN: math.blas.cblas -<< "cblas" { +<< +: load-atlas ( -- ) + "atlas" "libatlas.so" "cdecl" add-library + "atlas" load-library drop ; + +"cblas" { { [ os macosx? ] [ "libblas.dylib" "cdecl" add-library ] } { [ os windows? ] [ "blas.dll" "cdecl" add-library ] } { [ os openbsd? ] [ "libcblas.so" "cdecl" add-library ] } - { [ os freebsd? ] [ "libcblas.so" "cdecl" add-library ] } + { [ os freebsd? ] [ "libcblas.so" "cdecl" add-library load-atlas ] } [ "libblas.so" "cdecl" add-library ] -} cond >> +} cond +>> LIBRARY: cblas diff --git a/vm/os-unix.c b/vm/os-unix.c index 97c29d8c6e..b49f7637af 100755 --- a/vm/os-unix.c +++ b/vm/os-unix.c @@ -36,7 +36,7 @@ void init_ffi(void) void ffi_dlopen(F_DLL *dll) { - dll->dll = dlopen(alien_offset(dll->path), RTLD_LAZY); + dll->dll = dlopen(alien_offset(dll->path), RTLD_LAZY|RTLD_GLOBAL); } void *ffi_dlsym(F_DLL *dll, F_SYMBOL *symbol) From 7a4b03821b995332cb2a023557f697e9efd36de0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 30 Jan 2009 16:52:03 -0600 Subject: [PATCH 09/19] Fix furnace help lint warning --- basis/furnace/utilities/utilities-docs.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/furnace/utilities/utilities-docs.factor b/basis/furnace/utilities/utilities-docs.factor index 1402e9c0ca..d2291786df 100644 --- a/basis/furnace/utilities/utilities-docs.factor +++ b/basis/furnace/utilities/utilities-docs.factor @@ -57,7 +57,7 @@ HELP: modify-redirect-query HELP: nested-responders { $values { "seq" "a sequence of responders" } } -{ $description "" } ; +{ $description "Outputs a sequence of responders which participated in the processing of the current request, with the main responder first and the innermost responder last." } ; HELP: referrer { $values { "referrer/f" { $maybe string } } } @@ -69,11 +69,11 @@ HELP: request-params HELP: resolve-base-path { $values { "string" string } { "string'" string } } -{ $description "" } ; +{ $description "Resolves a responder-relative URL." } ; HELP: resolve-template-path { $values { "pair" "a pair with shape " { $snippet "{ class string }" } } { "path" "a pathname string" } } -{ $description "" } ; +{ $description "Resolves a responder-relative template path." } ; HELP: same-host? { $values { "url" url } { "?" "a boolean" } } @@ -85,7 +85,7 @@ HELP: user-agent HELP: vocab-path { $values { "vocab" "a vocabulary specifier" } { "path" "a pathname string" } } -{ $description "" } ; +{ $description "Outputs the full pathname of the vocabulary's source directory." } ; HELP: exit-with { $values { "value" object } } From 658743bb00c2a7e5357a4db2e3e7228f107a6d43 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Jan 2009 17:13:12 -0600 Subject: [PATCH 10/19] add missing copyright to svg.factor --- extra/svg/svg.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/extra/svg/svg.factor b/extra/svg/svg.factor index b5c5e96e90..6df7314653 100644 --- a/extra/svg/svg.factor +++ b/extra/svg/svg.factor @@ -1,3 +1,4 @@ +! (c)2009 Joe Groff, see BSD license USING: accessors arrays assocs fry kernel math math.affine-transforms math.constants math.functions math.parser math.vectors memoize peg.ebnf sequences sequences.squish splitting strings xml.data xml.utilities ; From 8b68e80254e35c3b5ef862b0aac9bcb255e8d2db Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Jan 2009 17:13:40 -0600 Subject: [PATCH 11/19] load libblas before libcblas on openbsd --- basis/math/blas/cblas/cblas.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/basis/math/blas/cblas/cblas.factor b/basis/math/blas/cblas/cblas.factor index 3914c5b2ec..54616d42de 100644 --- a/basis/math/blas/cblas/cblas.factor +++ b/basis/math/blas/cblas/cblas.factor @@ -3,13 +3,14 @@ IN: math.blas.cblas << : load-atlas ( -- ) - "atlas" "libatlas.so" "cdecl" add-library - "atlas" load-library drop ; + "atlas" "libatlas.so" "cdecl" add-library ; +: load-blas ( -- ) + "blas" "libblas.so" "cdecl" add-library ; "cblas" { { [ os macosx? ] [ "libblas.dylib" "cdecl" add-library ] } { [ os windows? ] [ "blas.dll" "cdecl" add-library ] } - { [ os openbsd? ] [ "libcblas.so" "cdecl" add-library ] } + { [ os openbsd? ] [ "libcblas.so" "cdecl" add-library load-blas ] } { [ os freebsd? ] [ "libcblas.so" "cdecl" add-library load-atlas ] } [ "libblas.so" "cdecl" add-library ] } cond From f1182ef800c429a68ff9afc370fabff3e161189d Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 30 Jan 2009 17:28:06 -0600 Subject: [PATCH 12/19] use CONSTANT: for cblas constants --- basis/math/blas/cblas/cblas.factor | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/basis/math/blas/cblas/cblas.factor b/basis/math/blas/cblas/cblas.factor index 54616d42de..11552d67bb 100644 --- a/basis/math/blas/cblas/cblas.factor +++ b/basis/math/blas/cblas/cblas.factor @@ -19,25 +19,25 @@ IN: math.blas.cblas LIBRARY: cblas TYPEDEF: int CBLAS_ORDER -: CblasRowMajor 101 ; inline -: CblasColMajor 102 ; inline +CONSTANT: CblasRowMajor 101 +CONSTANT: CblasColMajor 102 TYPEDEF: int CBLAS_TRANSPOSE -: CblasNoTrans 111 ; inline -: CblasTrans 112 ; inline -: CblasConjTrans 113 ; inline +CONSTANT: CblasNoTrans 111 +CONSTANT: CblasTrans 112 +CONSTANT: CblasConjTrans 113 TYPEDEF: int CBLAS_UPLO -: CblasUpper 121 ; inline -: CblasLower 122 ; inline +CONSTANT: CblasUpper 121 +CONSTANT: CblasLower 122 TYPEDEF: int CBLAS_DIAG -: CblasNonUnit 131 ; inline -: CblasUnit 132 ; inline +CONSTANT: CblasNonUnit 131 +CONSTANT: CblasUnit 132 TYPEDEF: int CBLAS_SIDE -: CblasLeft 141 ; inline -: CblasRight 142 ; inline +CONSTANT: CblasLeft 141 +CONSTANT: CblasRight 142 TYPEDEF: int CBLAS_INDEX From f1a1760e6ead33bef83ca823cf0f1e874e7a2aa8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Jan 2009 19:23:04 -0600 Subject: [PATCH 13/19] add csv>file and file>csv words, better docs for csv, a few cleanups --- basis/csv/csv-docs.factor | 48 ++++++++++++++----- basis/csv/csv-tests.factor | 16 ++++++- basis/csv/csv.factor | 95 ++++++++++++++++++++++---------------- 3 files changed, 106 insertions(+), 53 deletions(-) diff --git a/basis/csv/csv-docs.factor b/basis/csv/csv-docs.factor index e4741f4810..6ae75b6b2f 100644 --- a/basis/csv/csv-docs.factor +++ b/basis/csv/csv-docs.factor @@ -1,28 +1,52 @@ -USING: help.syntax help.markup kernel prettyprint sequences ; +USING: help.syntax help.markup kernel prettyprint sequences +io.pathnames ; IN: csv HELP: csv { $values { "stream" "an input stream" } { "rows" "an array of arrays of fields" } } -{ $description "parses a csv stream into an array of row arrays" -} ; +{ $description "Parses a csv stream into an array of row arrays." } ; + +HELP: file>csv +{ $values + { "path" pathname } { "encoding" "an encoding descriptor" } + { "csv" "csv" } +} +{ $description "Opens a file and parses it into a sequence of comma-separated-value fields." } ; + +HELP: csv>file +{ $values + { "rows" "a sequence of sequences of strings" } + { "path" pathname } { "encoding" "an encoding descriptor" } +} +{ $description "Writes a comma-separated-value structure to a file." } ; HELP: csv-row { $values { "stream" "an input stream" } { "row" "an array of fields" } } -{ $description "parses a row from a csv stream" -} ; +{ $description "parses a row from a csv stream" } ; HELP: write-csv -{ $values { "rows" "an sequence of sequences of strings" } +{ $values { "rows" "a sequence of sequences of strings" } { "stream" "an output stream" } } -{ $description "writes csv to the output stream, escaping where necessary" -} ; - +{ $description "Writes a sequence of sequences of comma-separated-values to the output stream, escaping where necessary." } ; HELP: with-delimiter -{ $values { "char" "field delimiter (e.g. CHAR: \t)" } +{ $values { "ch" "field delimiter (e.g. CHAR: \t)" } { "quot" "a quotation" } } -{ $description "Sets the field delimiter for csv or csv-row words " -} ; +{ $description "Sets the field delimiter for csv or csv-row words." } ; +ARTICLE: "csv" "Comma-separated-values parsing and writing" +"The " { $vocab-link "csv" } " vocabulary can read and write CSV (comma-separated-value) files." $nl +"Reading a csv file:" +{ $subsection file>csv } +"Writing a csv file:" +{ $subsection csv>file } +"Changing the delimiter from a comma:" +{ $subsection with-delimiter } +"Reading from a stream:" +{ $subsection csv } +"Writing to a stream:" +{ $subsection write-csv } ; + +ABOUT: "csv" diff --git a/basis/csv/csv-tests.factor b/basis/csv/csv-tests.factor index 8261ae104a..4d78c2af86 100644 --- a/basis/csv/csv-tests.factor +++ b/basis/csv/csv-tests.factor @@ -1,5 +1,7 @@ +USING: io.streams.string csv tools.test shuffle kernel strings +io.pathnames io.files.unique io.encodings.utf8 io.files +io.directories ; IN: csv.tests -USING: io.streams.string csv tools.test shuffle kernel strings ; ! I like to name my unit tests : named-unit-test ( name output input -- ) @@ -76,3 +78,15 @@ USING: io.streams.string csv tools.test shuffle kernel strings ; "escapes quotes commas and newlines when writing" [ "\"fo\"\"o1\",bar1\n\"fo\no2\",\"b,ar2\"\n" ] [ { { "fo\"o1" "bar1" } { "fo\no2" "b,ar2" } } tuck write-csv >string ] named-unit-test ! " + +[ { { "writing" "some" "csv" "tests" } } ] +[ + "writing,some,csv,tests" + "csv-test1-" unique-file utf8 + [ set-file-contents ] [ file>csv ] [ drop delete-file ] 2tri +] unit-test + +[ t ] [ + { { "writing,some,csv,tests" } } dup "csv-test2-" + unique-file utf8 [ csv>file ] [ file>csv ] 2bi = +] unit-test diff --git a/basis/csv/csv.factor b/basis/csv/csv.factor index bc3c25d347..7789f015d9 100755 --- a/basis/csv/csv.factor +++ b/basis/csv/csv.factor @@ -1,89 +1,104 @@ ! Copyright (C) 2007, 2008 Phil Dawes ! See http://factorcode.org/license.txt for BSD license. - -! Simple CSV Parser -! Phil Dawes phil@phildawes.net - -USING: kernel sequences io namespaces make -combinators unicode.categories ; +USING: kernel sequences io namespaces make combinators +unicode.categories io.files combinators.short-circuit ; IN: csv SYMBOL: delimiter CHAR: , delimiter set-global + ( -- delimiter ) delimiter get ; inline DEFER: quoted-field ( -- endchar ) -! trims whitespace from either end of string : trim-whitespace ( str -- str ) - [ blank? ] trim ; inline + [ blank? ] trim ; inline : skip-to-field-end ( -- endchar ) "\n" delimiter> suffix read-until nip ; inline : not-quoted-field ( -- endchar ) - "\"\n" delimiter> suffix read-until ! " - dup - { { CHAR: " [ drop drop quoted-field ] } ! " - { delimiter> [ swap trim-whitespace % ] } - { CHAR: \n [ swap trim-whitespace % ] } - { f [ swap trim-whitespace % ] } ! eof - } case ; + "\"\n" delimiter> suffix read-until + dup { + { CHAR: " [ 2drop quoted-field ] } + { delimiter> [ swap trim-whitespace % ] } + { CHAR: \n [ swap trim-whitespace % ] } + { f [ swap trim-whitespace % ] } + } case ; : maybe-escaped-quote ( -- endchar ) - read1 dup - { { CHAR: " [ , quoted-field ] } ! " is an escaped quote - { delimiter> [ ] } ! end of quoted field - { CHAR: \n [ ] } - [ 2drop skip-to-field-end ] ! end of quoted field + padding - } case ; + read1 dup { + { CHAR: " [ , quoted-field ] } + { delimiter> [ ] } + { CHAR: \n [ ] } + [ 2drop skip-to-field-end ] + } case ; : quoted-field ( -- endchar ) - "\"" read-until ! " - drop % maybe-escaped-quote ; + "\"" read-until + drop % maybe-escaped-quote ; : field ( -- sep string ) - [ not-quoted-field ] "" make ; ! trim-whitespace + [ not-quoted-field ] "" make ; : (row) ( -- sep ) - field , - dup delimiter get = [ drop (row) ] when ; + field , + dup delimiter get = [ drop (row) ] when ; : row ( -- eof? array[string] ) - [ (row) ] { } make ; + [ (row) ] { } make ; : append-if-row-not-empty ( row -- ) - dup { "" } = [ drop ] [ , ] if ; + dup { "" } = [ drop ] [ , ] if ; : (csv) ( -- ) - row append-if-row-not-empty - [ (csv) ] when ; + row append-if-row-not-empty + [ (csv) ] when ; +PRIVATE> + : csv-row ( stream -- row ) - [ row nip ] with-input-stream ; + [ row nip ] with-input-stream ; : csv ( stream -- rows ) - [ [ (csv) ] { } make ] with-input-stream ; + [ [ (csv) ] { } make ] with-input-stream ; -: with-delimiter ( char quot -- ) - delimiter swap with-variable ; inline +: file>csv ( path encoding -- csv ) + csv ; + +: with-delimiter ( ch quot -- ) + [ delimiter ] dip with-variable ; inline + + : write-row ( row -- ) - [ delimiter get write1 ] [ escape-if-required write ] interleave nl ; inline + [ delimiter get write1 ] + [ escape-if-required write ] interleave nl ; inline : write-csv ( rows stream -- ) - [ [ write-row ] each ] with-output-stream ; + [ [ write-row ] each ] with-output-stream ; + +: csv>file ( rows path encoding -- ) write-csv ; From 9c2a476d98751840a31ad3beb855eeafcca6694b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Jan 2009 19:24:35 -0600 Subject: [PATCH 14/19] minor cleanup --- basis/csv/csv.factor | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/basis/csv/csv.factor b/basis/csv/csv.factor index 7789f015d9..152b3dcbba 100755 --- a/basis/csv/csv.factor +++ b/basis/csv/csv.factor @@ -51,12 +51,8 @@ DEFER: quoted-field ( -- endchar ) : row ( -- eof? array[string] ) [ (row) ] { } make ; -: append-if-row-not-empty ( row -- ) - dup { "" } = [ drop ] [ , ] if ; - : (csv) ( -- ) - row append-if-row-not-empty - [ (csv) ] when ; + row harvest [ , ] unless-empty [ (csv) ] when ; PRIVATE> From f8092480a6b1488c397d2c69b616a4342f487c56 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 30 Jan 2009 19:34:31 -0600 Subject: [PATCH 15/19] Fix a couple of bugs in xmode and add a unit test --- basis/xmode/catalog/catalog.factor | 36 +++++++++++--------- basis/xmode/code2html/code2html-tests.factor | 9 ++++- basis/xmode/code2html/code2html.factor | 6 ++-- basis/xmode/loader/loader.factor | 16 ++++----- basis/xmode/loader/syntax/syntax.factor | 13 +++---- basis/xmode/marker/context/context.factor | 4 +-- basis/xmode/marker/marker.factor | 4 +-- 7 files changed, 49 insertions(+), 39 deletions(-) diff --git a/basis/xmode/catalog/catalog.factor b/basis/xmode/catalog/catalog.factor index 8a8e5fad4a..4e3af0af56 100644 --- a/basis/xmode/catalog/catalog.factor +++ b/basis/xmode/catalog/catalog.factor @@ -52,9 +52,15 @@ SYMBOL: rule-sets dup "::" split1 [ swap (load-mode) ] [ rule-sets get ] if* dup -roll at* [ nip ] [ drop no-such-rule-set ] if ; +DEFER: finalize-rule-set + : resolve-delegate ( rule -- ) - dup delegate>> dup string? - [ get-rule-set nip swap (>>delegate) ] [ 2drop ] if ; + dup delegate>> dup string? [ + get-rule-set + dup rule-set? [ "not a rule set" throw ] unless + swap rule-sets [ dup finalize-rule-set ] with-variable + >>delegate drop + ] [ 2drop ] if ; : each-rule ( rule-set quot -- ) [ rules>> values concat ] dip each ; inline @@ -74,26 +80,22 @@ SYMBOL: rule-sets : resolve-imports ( ruleset -- ) dup imports>> [ get-rule-set swap rule-sets [ - dup resolve-delegates - 2dup import-keywords - import-rules + [ nip resolve-delegates ] + [ import-keywords ] + [ import-rules ] + 2tri ] with-variable ] with each ; ERROR: mutually-recursive-rulesets ruleset ; + : finalize-rule-set ( ruleset -- ) - dup finalized?>> { - { f [ - { - [ 1 >>finalized? drop ] - [ resolve-imports ] - [ resolve-delegates ] - [ t >>finalized? drop ] - } cleave - ] } - { t [ drop ] } - { 1 [ mutually-recursive-rulesets ] } - } case ; + dup finalized?>> [ drop ] [ + t >>finalized? + [ resolve-imports ] + [ resolve-delegates ] + bi + ] if ; : finalize-mode ( rulesets -- ) rule-sets [ diff --git a/basis/xmode/code2html/code2html-tests.factor b/basis/xmode/code2html/code2html-tests.factor index cd11ba50d0..c0b8a1b560 100644 --- a/basis/xmode/code2html/code2html-tests.factor +++ b/basis/xmode/code2html/code2html-tests.factor @@ -1,7 +1,7 @@ IN: xmode.code2html.tests USING: xmode.code2html xmode.catalog tools.test multiline splitting memoize -kernel ; +kernel io.streams.string xml.writer ; [ ] [ \ (load-mode) reset-memoized ] unit-test @@ -9,4 +9,11 @@ kernel ; <"