Merge branch 'master' into new_ui
Slava Pestov
commit
e090c6ed92
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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" } } <string-writer> 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
|
||||
|
|
|
|||
|
|
@ -1,89 +1,100 @@
|
|||
! 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
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: delimiter> ( -- 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 ;
|
||||
|
||||
: append-if-row-not-empty ( row -- )
|
||||
dup { "" } = [ drop ] [ , ] if ;
|
||||
[ (row) ] { } make ;
|
||||
|
||||
: (csv) ( -- )
|
||||
row append-if-row-not-empty
|
||||
[ (csv) ] when ;
|
||||
row harvest [ , ] unless-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 )
|
||||
<file-reader> csv ;
|
||||
|
||||
: with-delimiter ( ch quot -- )
|
||||
[ delimiter ] dip with-variable ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: needs-escaping? ( cell -- ? )
|
||||
[ [ "\n\"" member? ] [ delimiter get = ] bi or ] any? ; inline
|
||||
[ { [ "\n\"" member? ] [ delimiter get = ] } 1|| ] any? ; inline
|
||||
|
||||
: escape-quotes ( cell -- cell' )
|
||||
[ [ dup , CHAR: " = [ CHAR: " , ] when ] each ] "" make ; inline
|
||||
[
|
||||
[
|
||||
[ , ]
|
||||
[ dup CHAR: " = [ , ] [ drop ] if ] bi
|
||||
] each
|
||||
] "" make ; inline
|
||||
|
||||
: enclose-in-quotes ( cell -- cell' )
|
||||
CHAR: " [ prefix ] [ suffix ] bi ; inline ! "
|
||||
"\"" dup surround ; inline
|
||||
|
||||
: escape-if-required ( cell -- cell' )
|
||||
dup needs-escaping? [ escape-quotes enclose-in-quotes ] when ; inline
|
||||
dup needs-escaping?
|
||||
[ escape-quotes enclose-in-quotes ] when ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: 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 -- ) <file-writer> write-csv ;
|
||||
|
|
|
|||
|
|
@ -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:"
|
||||
|
|
|
|||
|
|
@ -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: <generator-bind>
|
||||
{ $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: <literal-bind>
|
||||
{ $values { "key" object } { "type" object } { "value" object } { "literal-bind" literal-bind } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: <low-level-binding>
|
||||
{ $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 } }
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ] ]]
|
||||
|
||||
|
|
|
|||
|
|
@ -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 } }
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,36 +1,51 @@
|
|||
USING: alien alien.c-types alien.syntax kernel system combinators ;
|
||||
USING: alien alien.c-types alien.syntax kernel system
|
||||
combinators ;
|
||||
IN: math.blas.cblas
|
||||
|
||||
<< "cblas" {
|
||||
<<
|
||||
: load-atlas ( -- )
|
||||
"atlas" "libatlas.so" "cdecl" add-library ;
|
||||
: load-fortran ( -- )
|
||||
"I77" "libI77.so" "cdecl" add-library
|
||||
"F77" "libF77.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 freebsd? ] [ "libcblas.so" "cdecl" add-library ] }
|
||||
{ [ os openbsd? ] [ "libcblas.so" "cdecl" add-library load-blas ] }
|
||||
{ [ os netbsd? ] [
|
||||
load-fortran load-blas
|
||||
"/usr/local/lib/libcblas.so" "cdecl" add-library
|
||||
] }
|
||||
{ [ os freebsd? ] [ "libcblas.so" "cdecl" add-library load-atlas ] }
|
||||
[ "libblas.so" "cdecl" add-library ]
|
||||
} cond >>
|
||||
} cond
|
||||
>>
|
||||
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -5,3 +5,34 @@ cell-bits {
|
|||
{ 32 [ "unix.stat.netbsd.32" require ] }
|
||||
{ 64 [ "unix.stat.netbsd.64" require ] }
|
||||
} case
|
||||
|
||||
: _VFS_NAMELEN 32 ; inline
|
||||
: _VFS_MNAMELEN 1024 ; inline
|
||||
|
||||
C-STRUCT: statvfs
|
||||
{ "ulong" "f_flag" }
|
||||
{ "ulong" "f_bsize" }
|
||||
{ "ulong" "f_frsize" }
|
||||
{ "ulong" "f_iosize" }
|
||||
{ "fsblkcnt_t" "f_blocks" }
|
||||
{ "fsblkcnt_t" "f_bfree" }
|
||||
{ "fsblkcnt_t" "f_bavail" }
|
||||
{ "fsblkcnt_t" "f_bresvd" }
|
||||
{ "fsfilcnt_t" "f_files" }
|
||||
{ "fsfilcnt_t" "f_ffree" }
|
||||
{ "fsfilcnt_t" "f_favail" }
|
||||
{ "fsfilcnt_t" "f_fresvd" }
|
||||
{ "uint64_t" "f_syncreads" }
|
||||
{ "uint64_t" "f_syncwrites" }
|
||||
{ "uint64_t" "f_asyncreads" }
|
||||
{ "uint64_t" "f_asyncwrites" }
|
||||
{ "fsid_t" "f_fsidx" }
|
||||
{ "ulong" "f_fsid" }
|
||||
{ "ulong" "f_namemax" }
|
||||
{ "uid_t" "f_owner" }
|
||||
{ { "uint32_t" 4 } "f_spare" }
|
||||
{ { "char" _VFS_NAMELEN } "f_fstypename" }
|
||||
{ { "char" _VFS_NAMELEN } "f_mntonname" }
|
||||
{ { "char" _VFS_NAMELEN } "f_mntfromname" } ;
|
||||
|
||||
FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 [
|
||||
|
|
|
|||
|
|
@ -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 ;
|
|||
<" <style type="text/css" media="screen" >
|
||||
* {margin:0; padding:0; border:0;} ">
|
||||
string-lines "html" htmlize-lines drop
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"test.c"
|
||||
<" int x = "hi";
|
||||
/* a comment */ "> <string-reader> htmlize-stream
|
||||
write-xml
|
||||
] unit-test
|
||||
|
|
@ -8,14 +8,14 @@ IN: xmode.code2html
|
|||
[ str>> ] [ id>> ] bi [
|
||||
name>> swap
|
||||
[XML <span class=<->><-></span> XML]
|
||||
] [ ] if*
|
||||
] when*
|
||||
] map ;
|
||||
|
||||
: htmlize-line ( line-context line rules -- line-context' xml )
|
||||
tokenize-line htmlize-tokens ;
|
||||
|
||||
: htmlize-lines ( lines mode -- xml )
|
||||
[ f ] 2dip load-mode [ htmlize-line ] curry map nip ;
|
||||
[ f ] 2dip load-mode [ htmlize-line "\n" suffix ] curry map nip ;
|
||||
|
||||
: default-stylesheet ( -- xml )
|
||||
"resource:basis/xmode/code2html/stylesheet.css"
|
||||
|
|
@ -24,7 +24,7 @@ IN: xmode.code2html
|
|||
|
||||
:: htmlize-stream ( path stream -- xml )
|
||||
stream lines
|
||||
[ "" ] [ first find-mode path swap htmlize-lines ]
|
||||
[ "" ] [ path over first find-mode htmlize-lines ]
|
||||
if-empty :> input
|
||||
default-stylesheet :> stylesheet
|
||||
<XML <html>
|
||||
|
|
|
|||
|
|
@ -43,17 +43,17 @@ RULE: MARK_PREVIOUS mark-previous-rule
|
|||
shared-tag-attrs match-type-attr literal-start ;
|
||||
|
||||
TAG: KEYWORDS ( rule-set tag -- key value )
|
||||
ignore-case? get <keyword-map>
|
||||
rule-set get ignore-case?>> <keyword-map>
|
||||
swap child-tags [ over parse-keyword-tag ] each
|
||||
swap (>>keywords) ;
|
||||
|
||||
TAGS>
|
||||
|
||||
: ?<regexp> ( string/f -- regexp/f )
|
||||
dup [ ignore-case? get <regexp> ] when ;
|
||||
dup [ rule-set get ignore-case?>> <regexp> ] when ;
|
||||
|
||||
: (parse-rules-tag) ( tag -- rule-set )
|
||||
<rule-set>
|
||||
<rule-set> dup rule-set set
|
||||
{
|
||||
{ "SET" string>rule-set-name (>>name) }
|
||||
{ "IGNORE_CASE" string>boolean (>>ignore-case?) }
|
||||
|
|
@ -65,11 +65,11 @@ TAGS>
|
|||
} init-from-tag ;
|
||||
|
||||
: parse-rules-tag ( tag -- rule-set )
|
||||
dup (parse-rules-tag) [
|
||||
dup ignore-case?>> ignore-case? [
|
||||
swap child-tags [ parse-rule-tag ] with each
|
||||
] with-variable
|
||||
] keep ;
|
||||
[
|
||||
[ (parse-rules-tag) ] [ child-tags ] bi
|
||||
[ parse-rule-tag ] with each
|
||||
rule-set get
|
||||
] with-scope ;
|
||||
|
||||
: merge-rule-set-props ( props rule-set -- )
|
||||
[ assoc-union ] change-props drop ;
|
||||
|
|
|
|||
|
|
@ -1,13 +1,11 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors xmode.tokens xmode.rules xmode.keyword-map
|
||||
xml.data xml.utilities xml assocs kernel combinators sequences
|
||||
math.parser namespaces make parser lexer xmode.utilities
|
||||
parser-combinators.regexp io.files ;
|
||||
parser-combinators.regexp io.files splitting arrays ;
|
||||
IN: xmode.loader.syntax
|
||||
|
||||
SYMBOL: ignore-case?
|
||||
|
||||
! Rule tag parsing utilities
|
||||
: (parse-rule-tag) ( rule-set tag specs class -- )
|
||||
new swap init-from-tag swap add-rule ; inline
|
||||
|
|
@ -44,16 +42,19 @@ SYMBOL: ignore-case?
|
|||
|
||||
: parse-literal-matcher ( tag -- matcher )
|
||||
dup children>string
|
||||
ignore-case? get <string-matcher>
|
||||
rule-set get ignore-case?>> <string-matcher>
|
||||
swap position-attrs <matcher> ;
|
||||
|
||||
: parse-regexp-matcher ( tag -- matcher )
|
||||
dup children>string ignore-case? get <regexp>
|
||||
dup children>string rule-set get ignore-case?>> <regexp>
|
||||
swap position-attrs <matcher> ;
|
||||
|
||||
: shared-tag-attrs ( -- )
|
||||
{ "TYPE" string>token (>>body-token) } , ; inline
|
||||
|
||||
: parse-delegate ( string -- pair )
|
||||
"::" split1 [ rule-set get swap ] unless* 2array ;
|
||||
|
||||
: delegate-attr ( -- )
|
||||
{ "DELEGATE" f (>>delegate) } , ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: accessors kernel ;
|
||||
USING: accessors kernel xmode.rules ;
|
||||
IN: xmode.marker.context
|
||||
|
||||
! Based on org.gjt.sp.jedit.syntax.TokenMarker.LineContext
|
||||
|
|
@ -10,7 +10,7 @@ end
|
|||
;
|
||||
|
||||
: <line-context> ( ruleset parent -- line-context )
|
||||
over [ "no context" throw ] unless
|
||||
over rule-set? [ "not a rule-set" throw ] unless
|
||||
line-context new
|
||||
swap >>parent
|
||||
swap >>in-rule-set ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ sbufs math ;
|
|||
IN: strings
|
||||
|
||||
ARTICLE: "strings" "Strings"
|
||||
"A string is a fixed-size mutable sequence of Unicode 5.0 code points."
|
||||
"A string is a fixed-size mutable sequence of Unicode 5.1 code points."
|
||||
$nl
|
||||
"Characters are not a first-class type; they are simply represented as integers between 0 and 16777216 (2^24). Only characters up to 2097152 (2^21) have a defined meaning in Unicode."
|
||||
$nl
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue