Merge branch 'master' into new_ui

.gitignore

@@ -24,3 +24,4 @@ build-support/wordsize
 *.bak
 .#*
 *.swo
+checksums.txt

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 

basis/combinators/smart/smart-tests.factor

@@ -45,3 +45,5 @@ IN: combinators.smart.tests
 \ nested-smart-combo-test must-infer
 
 [ { { 1 2 } { 3 4 } } ] [ nested-smart-combo-test ] unit-test
+
+[ 14 ] [ [ 1 2 3 ] [ sq ] [ + ] map-reduce-outputs ] unit-test

basis/combinators/smart/smart.factor

@@ -21,6 +21,12 @@ MACRO: reduce-outputs ( quot operation -- newquot )
 : sum-outputs ( quot -- n )
     [ + ] reduce-outputs ; inline
 
+MACRO: map-reduce-outputs ( quot mapper reducer -- newquot )
+    [ dup infer out>> ] 2dip
+    [ swap '[ _ _ napply ] ]
+    [ [ 1 [-] ] dip n*quot ] bi-curry* bi
+    '[ @ @ @ ] ;
+
 MACRO: append-outputs-as ( quot exemplar -- newquot )
     [ dup infer out>> ] dip '[ @ _ _ nappend-as ] ;
 

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

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 ;

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

basis/db/sqlite/sqlite.factor

@@ -138,11 +138,13 @@ M: sqlite-db-connection create-sql-statement ( class -- statement )
             modifiers 0%
         ] interleave
 
-        ", " 0%
+        find-primary-key [
-        find-primary-key
+            ", " 0%
-        "primary key(" 0%
+            "primary key(" 0%
-        [ "," 0% ] [ column-name>> 0% ] interleave
+            [ "," 0% ] [ column-name>> 0% ] interleave
-        "));" 0%
+            ")" 0%
+        ] unless-empty
+        ");" 0%
     ] query-make ;
 
 M: sqlite-db-connection drop-sql-statement ( class -- statement )

basis/editors/editors.factor

@@ -1,9 +1,10 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: parser lexer kernel namespaces sequences definitions
 io.files io.backend io.pathnames io summary continuations
 tools.crossref tools.vocabs prettyprint source-files assocs
-vocabs vocabs.loader splitting accessors ;
+vocabs vocabs.loader splitting accessors debugger prettyprint
+help.topics ;
 IN: editors
 
 TUPLE: no-edit-hook ;
@@ -29,11 +30,21 @@ SYMBOL: edit-hook
     [ (normalize-path) ] dip edit-hook get-global
     [ call ] [ no-edit-hook edit-location ] if* ;
 
+ERROR: cannot-find-source definition ;
+
+M: cannot-find-source error.
+    "Cannot find source for ``" write
+    definition>> pprint-short
+    "''" print ;
+
 : edit ( defspec -- )
-    where [ first2 edit-location ] when* ;
+    dup where
+    [ first2 edit-location ]
+    [ dup word-link? [ name>> edit ] [ cannot-find-source ] if ]
+    ?if ;
 
 : edit-vocab ( name -- )
-    vocab-source-path 1 edit-location ;
+    >vocab-link edit ;
 
 GENERIC: error-file ( error -- file )
 

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 }

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 ;

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." } ;

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 } }

basis/html/templates/chloe/chloe.factor

@@ -95,6 +95,7 @@ COMPONENT: password
 COMPONENT: choice
 COMPONENT: checkbox
 COMPONENT: code
+COMPONENT: xml
 
 SYMBOL: template-cache
 

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
 

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
+[ t ] [ svector{ 3.0 4.0 } Vnorm 5.0 0.000001 ~ ] unit-test
-[ 5.0 ] [ dvector{ 3.0 4.0 } Vnorm ] 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
+[ t ] [ cvector{ C{ 3.0 4.0 } 12.0 } Vnorm 13.0 0.000001 ~ ] unit-test
-[ 13.0 ] [ zvector{ C{ 3.0 4.0 } 12.0 } Vnorm ] unit-test
+[ t ] [ zvector{ C{ 3.0 4.0 } 12.0 } Vnorm 13.0 0.000001 ~ ] unit-test
 
 ! Vasum
 

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

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

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
+
+>>
+

extra/annotations/authors.txt

@@ -0,0 +1,2 @@
+Joe Groff
+Doug Coleman

extra/annotations/summary.txt

@@ -0,0 +1 @@
+Code annotation comment syntax

extra/annotations/tags.txt

@@ -0,0 +1,2 @@
+comments
+annotation

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 ;

extra/infix/authors.txt

@@ -0,0 +1 @@
+Philipp Brüschweiler

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"

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

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

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
 

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

extra/infix/summary.txt

@@ -0,0 +1 @@
+Support for infix notation in Factor programs

extra/infix/tags.txt

@@ -0,0 +1 @@
+extensions

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
 

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