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

db4
Slava Pestov 2009-02-12 02:19:53 -06:00
commit 793fe45fd6
30 changed files with 251 additions and 26 deletions

1
.gitignore vendored
View File

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

View File

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

View File

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

View File

@ -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 ;

View File

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

View File

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

View File

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

View File

@ -171,3 +171,8 @@ M: comparison render*
SINGLETON: html
M: html render* 2drop <unescaped> ;
! XML component
SINGLETON: xml
M: xml render* 2drop ;

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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 ;

1
extra/infix/authors.txt Normal file
View File

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

View File

@ -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"

View File

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

View File

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

View File

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

View File

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

1
extra/infix/summary.txt Normal file
View File

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

1
extra/infix/tags.txt Normal file
View File

@ -0,0 +1 @@
extensions

View File

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

View File

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