Merge branch 'master' of git://factorcode.org/git/factor

2009-02-12 02:19:53 -06:00 · 2009-02-12 02:19:53 -06:00 · 793fe45fd6
parent 13af3b4801 ccfd9f9c52
commit 793fe45fd6
30 changed files with 251 additions and 26 deletions
--- a/.gitignore
+++ b/.gitignore
@ -24,3 +24,4 @@ build-support/wordsize
 *.bak
 .#*
 *.swo
+checksums.txt
--- a/basis/alien/fortran/fortran.factor
+++ b/basis/alien/fortran/fortran.factor
@ -423,7 +423,6 @@ PRIVATE>

 : (fortran-invoke) ( return library function parameters -- quot )
    {
-        [ 2drop nip set-fortran-abi ]
        [ 2nip [<fortran-result>] ]
        [ nip nip nip [fortran-args>c-args] ]
        [ [fortran-invoke] ]
@ -431,7 +430,7 @@ PRIVATE>
    } 4 ncleave 4 nappend ;

 MACRO: fortran-invoke ( return library function parameters -- )
-    (fortran-invoke) ;
+    { [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ;

 :: define-fortran-function ( return library function parameters -- )
    function create-in dup reset-generic 
--- a/basis/csv/csv-tests.factor
+++ b/basis/csv/csv-tests.factor
@ -7,9 +7,6 @@ IN: csv.tests
 : named-unit-test ( name output input -- ) 
  unit-test drop ; inline

-! tests nicked from the wikipedia csv article
-! http://en.wikipedia.org/wiki/Comma-separated_values
-
 "Fields are separated by commas"
 [ { { "1997" "Ford" "E350" } } ] 
 [ "1997,Ford,E350" <string-reader> csv ] named-unit-test
@ -90,3 +87,5 @@ IN: csv.tests
    { { "writing,some,csv,tests" } } dup "csv-test2-"
    unique-file utf8 [ csv>file ] [ file>csv ] 2bi =
 ] unit-test
+
+[ { { "hello" "" "" "" "goodbye" "" } } ] [ "hello,,\"\",,goodbye," <string-reader> csv ] unit-test
--- a/basis/csv/csv.factor
+++ b/basis/csv/csv.factor
@ -46,13 +46,15 @@ DEFER: quoted-field ( -- endchar )

 : (row) ( -- sep )
    field , 
-    dup delimiter get = [ drop (row) ] when ;
+    dup delimiter> = [ drop (row) ] when ;

 : row ( -- eof? array[string] )
    [ (row) ] { } make ;

 : (csv) ( -- )
-    row harvest [ , ] unless-empty [ (csv) ] when ;
+    row
+    dup [ empty? ] all? [ drop ] [ , ] if
+    [ (csv) ] when ;
  
 PRIVATE>

@ -60,7 +62,8 @@ PRIVATE>
    [ row nip ] with-input-stream ;

 : csv ( stream -- rows )
-    [ [ (csv) ] { } make ] with-input-stream ;
+    [ [ (csv) ] { } make ] with-input-stream
+    dup peek { "" } = [ but-last ] when ;

 : file>csv ( path encoding -- csv )
    <file-reader> csv ;
--- a/basis/db/sqlite/sqlite-tests.factor
+++ b/basis/db/sqlite/sqlite-tests.factor
@ -73,3 +73,25 @@ IN: db.sqlite.tests
        "select * from person" sql-query length
    ] with-db
 ] unit-test
+
+! You don't need a primary key
+USING: accessors arrays sorting ;
+TUPLE: things one two ;
+
+things "THINGS" {
+    { "one" "ONE" INTEGER +not-null+ }
+    { "two" "TWO" INTEGER +not-null+ }
+} define-persistent
+
+[ { { 0 0 } { 0 1 } { 1 0 } { 1 1 } } ] [
+    test.db [
+       things create-table
+        0 0 things boa insert-tuple
+        0 1 things boa insert-tuple
+        1 1 things boa insert-tuple
+        1 0 things boa insert-tuple
+        f f things boa select-tuples
+        [ [ one>> ] [ two>> ] bi 2array ] map natural-sort
+       things drop-table
+    ] with-db
+] unit-test
--- a/basis/db/sqlite/sqlite.factor
+++ b/basis/db/sqlite/sqlite.factor
@ -138,11 +138,13 @@ M: sqlite-db-connection create-sql-statement ( class -- statement )
            modifiers 0%
        ] interleave

+        find-primary-key [
            ", " 0%
-        find-primary-key
            "primary key(" 0%
            [ "," 0% ] [ column-name>> 0% ] interleave
-        "));" 0%
+            ")" 0%
+        ] unless-empty
+        ");" 0%
    ] query-make ;

 M: sqlite-db-connection drop-sql-statement ( class -- statement )
--- a/basis/html/components/components-docs.factor
+++ b/basis/html/components/components-docs.factor
@ -57,7 +57,10 @@ HELP: hidden
 { $description "Hidden components render as a hidden form field. For example, a page for editing a weblog post might contain a hidden field with the post ID." } ;

 HELP: html
-{ $description "HTML components render HTML verbatim, without any escaping. Care must be taken to only render trusted input, to avoid cross-site scripting attacks." } ;
+{ $description "HTML components render HTML verbatim from a string, without any escaping. Care must be taken to only render trusted input, to avoid cross-site scripting attacks." } ;
+
+HELP: xml
+{ $description "XML components render XML verbatim, from an XML chunk. Care must be taken to only render trusted input, to avoid cross-site scripting attacks." } ;

 HELP: inspector
 { $description "Inspector components render an arbitrary object by passing it to the " { $link describe } " word." } ;
@ -90,6 +93,7 @@ $nl
 { $subsection inspector }
 { $subsection comparison }
 { $subsection html }
+{ $subsection xml }
 "Tuple components:"
 { $subsection field }
 { $subsection password }
--- a/basis/html/components/components.factor
+++ b/basis/html/components/components.factor
@ -171,3 +171,8 @@ M: comparison render*
 SINGLETON: html

 M: html render* 2drop <unescaped> ;
+
+! XML component
+SINGLETON: xml
+
+M: xml render* 2drop ;
--- a/basis/html/html-docs.factor
+++ b/basis/html/html-docs.factor
@ -1,6 +1,7 @@
+USING: help.markup help.syntax strings xml.data ;
 IN: html
-USING: help.markup help.syntax strings ;

 HELP: simple-page
-{ $values { "title" string } { "head" "XML data" } { "body" "XML data" } }
+{ $values { "title" string } { "head" "XML data" } { "body" "XML data" }
+{ "xml" xml } }
 { $description "Constructs a simple XHTML page with a " { $snippet "head" } " and " { $snippet "body" } " tag. The given XML data is spliced into the two child tags, and a title is also added to the head tag." } ;
--- a/basis/html/templates/chloe/chloe-docs.factor
+++ b/basis/html/templates/chloe/chloe-docs.factor
@ -1,8 +1,8 @@
 IN: html.templates.chloe
-USING: help.markup help.syntax html.components html.forms
+USING: xml.data help.markup help.syntax html.components html.forms
 html.templates html.templates.chloe.syntax
 html.templates.chloe.compiler html.templates.chloe.components
-math xml.data strings quotations namespaces ;
+math strings quotations namespaces ;

 HELP: <chloe>
 { $values { "path" "a pathname string without the trailing " { $snippet ".xml" } " extension" } { "chloe" chloe } }
@ -70,6 +70,7 @@ ARTICLE: "html.templates.chloe.tags.component" "Component Chloe tags"
    { { $snippet "t:field" }      { $link field } }
    { { $snippet "t:hidden" }     { $link hidden } }
    { { $snippet "t:html" }       { $link html } }
+    { { $snippet "t:xml" }        { $link xml } }
    { { $snippet "t:inspector" }  { $link inspector } }
    { { $snippet "t:label" }      { $link label } }
    { { $snippet "t:link" }       { $link link } }
--- a/basis/html/templates/chloe/chloe.factor
+++ b/basis/html/templates/chloe/chloe.factor
@ -95,6 +95,7 @@ COMPONENT: password
 COMPONENT: choice
 COMPONENT: checkbox
 COMPONENT: code
+COMPONENT: xml

 SYMBOL: template-cache

--- a/basis/math/blas/vectors/vectors-docs.factor
+++ b/basis/math/blas/vectors/vectors-docs.factor
@ -93,7 +93,7 @@ HELP: Viamax

 HELP: Vamax
 { $values { "x" blas-vector-base } { "max" number } }
-{ $description "Return the value of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the first element. Corresponds to the IxAMAX routines in BLAS." } ;
+{ $description "Return the value of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the element closest to the beginning. Corresponds to the IxAMAX routines in BLAS." } ;

 { Viamax Vamax } related-words

--- a/basis/math/blas/vectors/vectors-tests.factor
+++ b/basis/math/blas/vectors/vectors-tests.factor
@ -1,4 +1,4 @@
-USING: kernel math.blas.vectors sequences tools.test ;
+USING: kernel math.blas.vectors math.functions sequences tools.test ;
 IN: math.blas.vectors.tests

 ! clone
@ -126,11 +126,11 @@ unit-test

 ! Vnorm

-[ 5.0 ] [ svector{ 3.0 4.0 } Vnorm ] unit-test
-[ 5.0 ] [ dvector{ 3.0 4.0 } Vnorm ] unit-test
+[ t ] [ svector{ 3.0 4.0 } Vnorm 5.0 0.000001 ~ ] unit-test
+[ t ] [ dvector{ 3.0 4.0 } Vnorm 5.0 0.000001 ~ ] unit-test

-[ 13.0 ] [ cvector{ C{ 3.0 4.0 } 12.0 } Vnorm ] unit-test
-[ 13.0 ] [ zvector{ C{ 3.0 4.0 } 12.0 } Vnorm ] unit-test
+[ t ] [ cvector{ C{ 3.0 4.0 } 12.0 } Vnorm 13.0 0.000001 ~ ] unit-test
+[ t ] [ zvector{ C{ 3.0 4.0 } 12.0 } Vnorm 13.0 0.000001 ~ ] unit-test

 ! Vasum

--- a/extra/annotations/annotations-docs.factor
+++ b/extra/annotations/annotations-docs.factor
@ -0,0 +1,42 @@
+USING: accessors arrays combinators definitions generalizations
+help help.markup help.topics kernel sequences sorting vocabs
+words ;
+IN: annotations
+
+<PRIVATE
+: comment-word ( base -- word ) "!" prepend "annotations" lookup ; 
+: comment-usage-word ( base -- word ) "s" append "annotations" lookup ; 
+: comment-usage.-word ( base -- word ) "s." append "annotations" lookup ; 
+PRIVATE>
+
+"Code annotations"
+{
+    "The " { $vocab-link "annotations" } " vocabulary provides syntax for comment-like annotations that can be looked up with Factor's " { $link usage } " mechanism."
+}
+annotation-tags natural-sort
+[
+    [ \ $subsection swap comment-word 2array ] map append
+    "To look up annotations:" suffix
+] [
+    [ \ $subsection swap comment-usage.-word 2array ] map append
+] bi
+<article> "annotations" add-article
+
+"annotations" vocab "annotations" >>help drop
+
+annotation-tags [
+    {
+        [ [ \ $syntax ] dip "!" " your comment here" surround 2array ]
+        [ [ \ $description "Treats the rest of the line after the exclamation point as a code annotation that can be looked up with the " \ $link ] dip comment-usage.-word 2array " word." 4array ]
+        [ [ \ $unchecked-example ] dip ": foo ( x y z -- w )\n    !" " --w-ó()ò-w-- kilroy was here\n    + * ;" surround 2array 3array ]
+        [ comment-word set-word-help ]
+
+        [ [ \ $description "Displays a list of words, help articles, and vocabularies that contain " \ $link ] dip comment-word 2array " annotations." 4array 1array ]
+        [ comment-usage.-word set-word-help ]
+
+        [ [ { $values { "usages" sequence } } \ $description "Returns a list of words, help articles, and vocabularies that contain " \ $link ] dip [ comment-word 2array " annotations. For a more user-friendly display, use the " \ $link ] [ comment-usage.-word 2array " word." 6 narray 2array ] bi ]
+        [ comment-usage-word set-word-help ]
+
+        [ [ comment-word ] [ comment-usage-word ] [ comment-usage.-word ] tri 3array related-words ]
+    } cleave
+] each
--- a/extra/annotations/annotations-tests.factor
+++ b/extra/annotations/annotations-tests.factor
@ -0,0 +1,27 @@
+USING: accessors annotations combinators.short-circuit
+io.pathnames kernel math sequences sorting tools.test ;
+IN: annotations.tests
+
+!NOTE testing toplevel form 
+
+: three ( -- x )
+    !BROKEN english plz
+    "þrij" ;
+
+: four ( -- x )
+    !BROKEN this code is broken
+    2 2 + 1+ ;
+
+: five ( -- x )
+    !TODO return 5
+    f ;
+
+[ t ] [
+    NOTEs {
+        [ length 1 = ]
+        [ first string>> file-name "annotations-tests.factor" = ]
+    } 1&&
+] unit-test
+
+[ { four three } ] [ BROKENs natural-sort ] unit-test
+[ { five } ] [ TODOs ] unit-test
--- a/extra/annotations/annotations.factor
+++ b/extra/annotations/annotations.factor
@ -0,0 +1,43 @@
+! (c)2009 Joe Groff, Doug Coleman. see BSD license
+USING: accessors combinators.short-circuit definitions functors
+kernel lexer namespaces parser prettyprint sequences words ;
+IN: annotations
+
+<<
+
+: (parse-annotation) ( accum -- accum )
+    lexer get [ line-text>> parsed ] [ next-line ] bi ;
+
+: (non-annotation-usage) ( word -- usages )
+    smart-usage
+    [ { [ word? ] [ vocabulary>> "annotations" = ] } 1&& not ]
+    filter ;
+
+FUNCTOR: define-annotation ( NAME -- )
+
+(NAME) DEFINES (${NAME})
+!NAME  DEFINES !${NAME}
+NAMEs  DEFINES ${NAME}s
+NAMEs. DEFINES ${NAME}s.
+
+WHERE
+
+: (NAME) ( str -- ) drop ; inline
+: !NAME (parse-annotation) \ (NAME) parsed ; parsing
+
+: NAMEs ( -- usages )
+    \ (NAME) (non-annotation-usage) ;
+: NAMEs. ( -- )
+    NAMEs sorted-definitions. ;
+
+;FUNCTOR
+
+CONSTANT: annotation-tags {
+    "XXX" "TODO" "FIXME" "BUG" "REVIEW" "LICENSE"
+    "AUTHOR" "BROKEN" "HACK" "LOL" "NOTE"
+}
+
+annotation-tags [ define-annotation ] each
+
+>>
+
--- a/extra/annotations/authors.txt
+++ b/extra/annotations/authors.txt
@ -0,0 +1,2 @@
+Joe Groff
+Doug Coleman
--- a/extra/annotations/summary.txt
+++ b/extra/annotations/summary.txt
@ -0,0 +1 @@
+Code annotation comment syntax
--- a/extra/annotations/tags.txt
+++ b/extra/annotations/tags.txt
@ -0,0 +1,2 @@
+comments
+annotation
--- a/extra/infix/ast/ast.factor
+++ b/extra/infix/ast/ast.factor
@ -1,3 +1,5 @@
+! Copyright (C) 2009 Philipp Brüschweiler
+! See http://factorcode.org/license.txt for BSD license.
 IN: infix.ast

 TUPLE: ast-number value ;
--- a/extra/infix/authors.txt
+++ b/extra/infix/authors.txt
@ -0,0 +1 @@
+Philipp Brüschweiler
--- a/extra/infix/infix-docs.factor
+++ b/extra/infix/infix-docs.factor
@ -1,4 +1,6 @@
-USING: help.syntax help.markup prettyprint locals ;
+! Copyright (C) 2009 Philipp Brüschweiler
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup math prettyprint locals sequences ;
 IN: infix

 HELP: [infix
@ -36,3 +38,54 @@ HELP: [infix|
 } ;

 { POSTPONE: [infix POSTPONE: [infix| } related-words
+
+ARTICLE: "infix" "Infix notation"
+"The " { $vocab-link "infix" } " vocabulary implements support for infix notation in Factor source code."
+{ $subsection POSTPONE: [infix }
+{ $subsection POSTPONE: [infix| }
+$nl
+"The usual infix math operators are supported:"
+{ $list
+    { $link + }
+    { $link - }
+    { $link * }
+    { $link / }
+    { { $snippet "%" } ", which is the infix operator for " { $link mod } "." }
+}
+"The standard precedence rules apply: Grouping with parentheses before " { $snippet "*" } ", " { $snippet "/" } "and " { $snippet "%" } " before " { $snippet "+" } " and " { $snippet "-" } "."
+{ $example
+    "USING: infix prettyprint ;"
+    "[infix 5-40/10*2 infix] ."
+    "-3"
+}
+$nl
+"You can call Factor words in infix expressions just as you would in C. There are some restrictions on which words are legal to use though:"
+{ $list
+    "The word must return exactly one value."
+    "The word name must consist of the letters a-z, A-Z, _ or 0-9, and the first character can't be a number."
+}
+{ $example
+    "USING: infix locals math math.functions prettyprint ;"
+    ":: binary_entropy ( p -- h )"
+    "    [infix -(p*log(p) + (1-p)*log(1-p)) / log(2) infix] ;"
+    "[infix binary_entropy( sqrt(0.25) ) infix] ."
+    "1.0"
+}
+$nl
+"You can access " { $vocab-link "sequences" } " inside infix expressions with the familiar " { $snippet "arr[index]" } " notation."
+{ $example
+    "USING: arrays infix prettyprint ;"
+    "[infix| myarr [ { 1 2 3 4 } ] | myarr[4/2]*3 infix] ."
+    "9"
+}
+"Please note: in Factor " { $emphasis "fixnums are sequences too." } " If you are not careful with sequence accesses you may introduce subtle bugs:"
+{ $example
+    "USING: arrays infix locals prettyprint ;"
+    ":: add-2nd-element ( x y -- res )"
+    "    [infix x[1] + y[1] infix] ;"
+    "{ 1 2 3 } 5 add-2nd-element ."
+    "3"
+}
+;
+
+ABOUT: "infix"
--- a/extra/infix/infix-tests.factor
+++ b/extra/infix/infix-tests.factor
@ -1,3 +1,5 @@
+! Copyright (C) 2009 Philipp Brüschweiler
+! See http://factorcode.org/license.txt for BSD license.
 USING: infix infix.private kernel locals math math.functions
 tools.test ;
 IN: infix.tests
--- a/extra/infix/infix.factor
+++ b/extra/infix/infix.factor
@ -1,3 +1,5 @@
+! Copyright (C) 2009 Philipp Brüschweiler
+! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators combinators.short-circuit
 effects fry infix.parser infix.ast kernel locals.parser
 locals.types math multiline namespaces parser quotations
--- a/extra/infix/parser/parser-tests.factor
+++ b/extra/infix/parser/parser-tests.factor
@ -1,3 +1,5 @@
+! Copyright (C) 2009 Philipp Brüschweiler
+! See http://factorcode.org/license.txt for BSD license.
 USING: infix.ast infix.parser infix.tokenizer tools.test ;
 IN: infix.parser.tests

--- a/extra/infix/parser/parser.factor
+++ b/extra/infix/parser/parser.factor
@ -1,3 +1,5 @@
+! Copyright (C) 2009 Philipp Brüschweiler
+! See http://factorcode.org/license.txt for BSD license.
 USING: infix.ast infix.tokenizer kernel math peg.ebnf sequences
 strings vectors ;
 IN: infix.parser
--- a/extra/infix/summary.txt
+++ b/extra/infix/summary.txt
@ -0,0 +1 @@
+Support for infix notation in Factor programs
--- a/extra/infix/tags.txt
+++ b/extra/infix/tags.txt
@ -0,0 +1 @@
+extensions
--- a/extra/infix/tokenizer/tokenizer-tests.factor
+++ b/extra/infix/tokenizer/tokenizer-tests.factor
@ -1,3 +1,5 @@
+! Copyright (C) 2009 Philipp Brüschweiler
+! See http://factorcode.org/license.txt for BSD license.
 USING: infix.ast infix.tokenizer tools.test ;
 IN: infix.tokenizer.tests

--- a/extra/infix/tokenizer/tokenizer.factor
+++ b/extra/infix/tokenizer/tokenizer.factor
@ -1,3 +1,5 @@
+! Copyright (C) 2009 Philipp Brüschweiler
+! See http://factorcode.org/license.txt for BSD license.
 USING: infix.ast kernel peg peg.ebnf math.parser sequences
 strings ;
 IN: infix.tokenizer
				`@ -0,0 +1 @@`
				`Support for infix notation in Factor programs`