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

db4
Slava Pestov 2009-05-16 16:28:32 -05:00
commit a852f89d37
24 changed files with 72 additions and 144 deletions

View File

@ -96,7 +96,7 @@ link-no-follow? off
[ "<pre><span class=\"KEYWORD3\">int</span> <span class=\"FUNCTION\">main</span><span class=\"OPERATOR\">(</span><span class=\"OPERATOR\">)</span></pre>" ]
[ "[c{int main()}]" convert-farkup ] unit-test
[ "<p><img src=\"lol.jpg\" alt=\"image:lol.jpg\"/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test
[ "<p><img src=\"lol.jpg\" alt=\"lol.jpg\"/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test
[ "<p><img src=\"lol.jpg\" alt=\"teh lol\"/></p>" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test
[ "<p><a href=\"http://lol.com\">http://lol.com</a></p>" ] [ "[[http://lol.com]]" convert-farkup ] unit-test
[ "<p><a href=\"http://lol.com\">haha</a></p>" ] [ "[[http://lol.com|haha]]" convert-farkup ] unit-test
@ -207,3 +207,5 @@ link-no-follow? off
[ convert-farkup drop t ] [ drop print f ] recover
] all?
] unit-test
[ "<p><a href=\"http://foo.com/~foo\">http://foo.com/~foo</a></p>" ] [ "[[http://foo.com/~foo]]" convert-farkup ] unit-test

View File

@ -70,11 +70,15 @@ DEFER: (parse-paragraph)
{ CHAR: % inline-code }
} at ;
: or-simple-title ( url title/f quot: ( title -- title' ) -- url title' )
[ "" like dup simple-link-title ] if* ; inline
: parse-link ( string -- paragraph-list )
rest-slice "]]" split1-slice [
"|" split1
[ "" like dup simple-link-title ] unless*
[ "image:" ?head ] dip swap [ image boa ] [ parse-paragraph link boa ] if
[ "image:" ?head ] dip swap
[ [ ] or-simple-title image boa ]
[ [ parse-paragraph ] or-simple-title link boa ] if
] dip [ (parse-paragraph) cons ] [ 1list ] if* ;
: ?first ( seq -- elt ) 0 swap ?nth ;

View File

@ -2,3 +2,5 @@ IN: help.html.tests
USING: help.html tools.test help.topics kernel ;
[ ] [ "xml" >link help>html drop ] unit-test
[ "article-foobar.html" ] [ "foobar" >link topic>filename ] unit-test

View File

@ -1,11 +1,13 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary
USING: io.encodings.utf8 io.encodings.binary
io.files io.files.temp io.directories html.streams help kernel
assocs sequences make words accessors arrays help.topics vocabs
vocabs.hierarchy help.vocabs namespaces prettyprint io
vocabs.loader serialize fry memoize unicode.case math.order
sorting debugger html xml.syntax xml.writer math.parser ;
FROM: io.encodings.ascii => ascii ;
FROM: ascii => ascii? ;
IN: help.html
: escape-char ( ch -- )

View File

@ -3,7 +3,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: continuations sequences kernel namespaces debugger
combinators math quotations generic strings splitting accessors
assocs fry vocabs.parser parser lexer io io.files
assocs fry vocabs.parser parser parser.notes lexer io io.files
io.streams.string io.encodings.utf8 html.templates ;
IN: html.templates.fhtml

2
basis/io/sockets/windows/nt/nt.factor Normal file → Executable file
View File

@ -1,6 +1,6 @@
USING: alien alien.accessors alien.c-types byte-arrays
continuations destructors io.ports io.timeouts io.sockets
io.sockets io namespaces io.streams.duplex io.backend.windows
io namespaces io.streams.duplex io.backend.windows
io.sockets.windows io.backend.windows.nt windows.winsock kernel
libc math sequences threads system combinators accessors ;
IN: io.sockets.windows.nt

View File

@ -2,7 +2,7 @@
! Copyright (C) 2004 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: lists.lazy math kernel sequences quotations ;
USING: lists lists.lazy math kernel sequences quotations ;
IN: lists.lazy.examples
: naturals ( -- list ) 0 lfrom ;

View File

@ -14,7 +14,7 @@ ARTICLE: "lists.lazy" "Lazy lists"
ARTICLE: { "lists.lazy" "combinators" } "Combinators for manipulating lazy lists"
"The following combinators create lazy lists from other lazy lists:"
{ $subsection lmap }
{ $subsection lazy-map }
{ $subsection lfilter }
{ $subsection luntil }
{ $subsection lwhile }

View File

@ -14,7 +14,7 @@ ARTICLE: "lists" "Lists"
{ $vocab-subsection "Lazy lists" "lists.lazy" } ;
ARTICLE: { "lists" "protocol" } "The list protocol"
"Lists are instances of a mixin class"
"Lists are instances of a mixin class:"
{ $subsection list }
"Instances of the mixin must implement the following words:"
{ $subsection car }
@ -25,8 +25,7 @@ ARTICLE: { "lists" "strict" } "Constructing strict lists"
"Strict lists are simply cons cells where the car and cdr have already been evaluated. These are the lists of Lisp. To construct a strict list, the following words are provided:"
{ $subsection cons }
{ $subsection swons }
{ $subsection sequence>cons }
{ $subsection deep-sequence>cons }
{ $subsection sequence>list }
{ $subsection 1list }
{ $subsection 2list }
{ $subsection 3list } ;
@ -38,7 +37,6 @@ ARTICLE: { "lists" "combinators" } "Combinators for lists"
{ $subsection foldl }
{ $subsection foldr }
{ $subsection lmap>array }
{ $subsection lmap-as }
{ $subsection traverse } ;
ARTICLE: { "lists" "manipulation" } "Manipulating lists"
@ -141,10 +139,6 @@ HELP: list>array
{ $values { "list" list } { "array" array } }
{ $description "Convert a list into an array." } ;
HELP: deep-list>array
{ $values { "list" list } { "array" array } }
{ $description "Recursively turns the given cons object into an array, maintaining order and also converting nested lists." } ;
HELP: traverse
{ $values { "list" list } { "pred" { $quotation "( list/elt -- ? )" } }
{ "quot" { $quotation "( list/elt -- result)" } } { "result" "a new cons object" } }
@ -170,6 +164,3 @@ HELP: lmap>array
{ $values { "list" list } { "quot" quotation } { "array" array } }
{ $description "Executes the quotation on each element of the list, collecting the results in an array." } ;
HELP: lmap-as
{ $values { "list" list } { "quot" quotation } { "exemplar" sequence } { "sequence" sequence } }
{ $description "Executes the quotation on each element of the list, collecting the results in a sequence of the type given by the exemplar." } ;

View File

@ -1,10 +1,10 @@
! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test lists lists.lazy math kernel ;
USING: tools.test lists math kernel ;
IN: lists.tests
{ { 3 4 5 6 7 } } [
{ 1 2 3 4 5 } sequence>cons [ 2 + ] lmap list>array
{ 1 2 3 4 5 } sequence>list [ 2 + ] lmap list>array
] unit-test
{ { 3 4 5 6 } } [
@ -24,23 +24,23 @@ IN: lists.tests
] unit-test
{ T{ cons f 2 T{ cons f 3 T{ cons f 4 T{ cons f 5 +nil+ } } } } } [
{ 1 2 3 4 } seq>list [ 1+ ] lmap
{ 1 2 3 4 } sequence>list [ 1+ ] lmap
] unit-test
{ 15 } [
{ 1 2 3 4 5 } seq>list 0 [ + ] foldr
{ 1 2 3 4 5 } sequence>list 0 [ + ] foldr
] unit-test
{ { 5 4 3 2 1 } } [
{ 1 2 3 4 5 } seq>list lreverse list>array
{ 1 2 3 4 5 } sequence>list lreverse list>array
] unit-test
{ 5 } [
{ 1 2 3 4 5 } seq>list llength
{ 1 2 3 4 5 } sequence>list llength
] unit-test
{ { 1 2 3 4 5 6 } } [
{ 1 2 3 } seq>list { 4 5 6 } seq>list lappend list>array
{ 1 2 3 } sequence>list { 4 5 6 } sequence>list lappend list>array
] unit-test
[ { 1 } { 2 } ] [ { 1 2 } seq>list 1 lcut [ list>array ] bi@ ] unit-test
[ { 1 } { 2 } ] [ { 1 2 } sequence>list 1 lcut [ list>array ] bi@ ] unit-test

View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 James Cash
! Copyright (C) 2008 James Cash, Daniel Ehrenberg, Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences accessors math arrays vectors classes words
combinators.short-circuit combinators locals ;
@ -14,57 +14,45 @@ TUPLE: cons { car read-only } { cdr read-only } ;
C: cons cons
M: cons car ( cons -- car )
car>> ;
M: cons car ( cons -- car ) car>> ;
M: cons cdr ( cons -- cdr )
cdr>> ;
M: cons cdr ( cons -- cdr ) cdr>> ;
SINGLETON: +nil+
M: +nil+ nil? drop t ;
M: object nil? drop f ;
: atom? ( obj -- ? )
list? not ;
: atom? ( obj -- ? ) list? not ; inline
: nil ( -- symbol ) +nil+ ;
: nil ( -- symbol ) +nil+ ; inline
: uncons ( cons -- car cdr )
[ car ] [ cdr ] bi ;
: uncons ( cons -- car cdr ) [ car ] [ cdr ] bi ; inline
: swons ( cdr car -- cons )
swap cons ;
: swons ( cdr car -- cons ) swap cons ; inline
: unswons ( cons -- cdr car )
uncons swap ;
: unswons ( cons -- cdr car ) uncons swap ; inline
: 1list ( obj -- cons )
nil cons ;
: 1list ( obj -- cons ) nil cons ; inline
: 1list? ( list -- ? )
{ [ nil? not ] [ cdr nil? ] } 1&& ;
: 1list? ( list -- ? ) { [ nil? not ] [ cdr nil? ] } 1&& ; inline
: 2list ( a b -- cons )
nil cons cons ;
: 2list ( a b -- cons ) nil cons cons ; inline
: 3list ( a b c -- cons )
nil cons cons cons ;
: 3list ( a b c -- cons ) nil cons cons cons ; inline
: cadr ( list -- elt )
cdr car ;
: cadr ( list -- elt ) cdr car ; inline
: 2car ( list -- car caar )
[ car ] [ cdr car ] bi ;
: 2car ( list -- car caar ) [ car ] [ cdr car ] bi ; inline
: 3car ( list -- car cadr caddr )
[ car ] [ cdr car ] [ cdr cdr car ] tri ;
: 3car ( list -- car cadr caddr ) [ car ] [ cdr car ] [ cdr cdr car ] tri ; inline
: lnth ( n list -- elt )
swap [ cdr ] times car ;
: lnth ( n list -- elt ) swap [ cdr ] times car ; inline
<PRIVATE
: (leach) ( list quot -- cdr quot )
[ [ car ] dip call ] [ [ cdr ] dip ] 2bi ; inline
PRIVATE>
: leach ( list quot: ( elt -- ) -- )
@ -93,47 +81,14 @@ PRIVATE>
: lcut ( list index -- before after )
[ nil ] dip
[ [ [ cdr ] [ car ] bi ] dip cons ] times
[ [ unswons ] dip cons ] times
lreverse swap ;
: sequence>cons ( sequence -- list )
<reversed> nil [ swap cons ] reduce ;
<PRIVATE
: same? ( obj1 obj2 -- ? )
[ class ] bi@ = ;
PRIVATE>
: deep-sequence>cons ( sequence -- cons )
[ <reversed> ] keep nil
[ [ nip ] [ same? ] 2bi [ deep-sequence>cons ] when swons ]
with reduce ;
<PRIVATE
:: (lmap>vector) ( acc list quot: ( elt -- elt' ) -- acc )
list nil? [ acc ] [
list car quot call acc push
acc list cdr quot (lmap>vector)
] if ; inline recursive
: lmap>vector ( list quot -- array )
[ V{ } clone ] 2dip (lmap>vector) ; inline
PRIVATE>
: lmap-as ( list quot exemplar -- sequence )
[ lmap>vector ] dip like ; inline
: sequence>list ( sequence -- list )
<reversed> nil [ swons ] reduce ;
: lmap>array ( list quot -- array )
{ } lmap-as ; inline
: deep-list>array ( list -- array )
[
{
{ [ dup nil? ] [ drop { } ] }
{ [ dup list? ] [ deep-list>array ] }
[ ]
} cond
] lmap>array ;
accumulator [ leach ] dip { } like ; inline
: list>array ( list -- array )
[ ] lmap>array ;

View File

@ -1,5 +1,5 @@
IN: see.tests
USING: see tools.test io.streams.string math ;
USING: see tools.test io.streams.string math words ;
CONSTANT: test-const 10
[ "IN: see.tests\nCONSTANT: test-const 10 inline\n" ]
@ -9,3 +9,5 @@ ALIAS: test-alias +
[ "USING: math ;\nIN: see.tests\nALIAS: test-alias + inline\n" ]
[ [ \ test-alias see ] with-string-writer ] unit-test
[ ] [ gensym see ] unit-test

View File

@ -44,7 +44,7 @@ M: word print-stack-effect? drop t ;
<PRIVATE
: seeing-word ( word -- )
vocabulary>> vocab pprinter-in set ;
vocabulary>> dup [ vocab ] when pprinter-in set ;
: word-synopsis ( word -- )
{

View File

@ -1,12 +1,12 @@
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays accessors io.backend io.streams.c init fry namespaces
math make assocs kernel parser lexer strings.parser vocabs sequences
sequences.private words memory kernel.private continuations io
vocabs.loader system strings sets vectors quotations byte-arrays
sorting compiler.units definitions generic generic.standard
generic.single tools.deploy.config combinators classes
slots.private ;
math make assocs kernel parser parser.notes lexer strings.parser
vocabs sequences sequences.private words memory kernel.private
continuations io vocabs.loader system strings sets vectors quotations
byte-arrays sorting compiler.units definitions generic
generic.standard generic.single tools.deploy.config combinators
classes slots.private ;
QUALIFIED: bootstrap.stage2
QUALIFIED: command-line
QUALIFIED: compiler.errors

View File

@ -8,8 +8,8 @@ math.vectors namespaces make sequences strings vectors words
windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
windows.messages windows.types windows.offscreen windows.nt
threads libc combinators fry combinators.short-circuit continuations
command-line shuffle opengl ui.render ascii math.bitwise locals
accessors math.rectangles math.order ascii calendar
command-line shuffle opengl ui.render math.bitwise locals
accessors math.rectangles math.order calendar ascii
io.encodings.utf16n windows.errors literals ui.pixel-formats
ui.pixel-formats.private memoize classes struct-arrays ;
IN: ui.backend.windows

View File

@ -233,6 +233,7 @@ CONSTANT: PFD_DRAW_TO_WINDOW 4
CONSTANT: PFD_DRAW_TO_BITMAP 8
CONSTANT: PFD_SUPPORT_GDI 16
CONSTANT: PFD_SUPPORT_OPENGL 32
CONSTANT: PFD_SUPPORT_DIRECTDRAW 8192
CONSTANT: PFD_GENERIC_FORMAT 64
CONSTANT: PFD_NEED_PALETTE 128
CONSTANT: PFD_NEED_SYSTEM_PALETTE HEX: 00000100

View File

@ -180,8 +180,6 @@ CONSTANT: SEC_COMMIT HEX: 08000000
CONSTANT: SEC_NOCACHE HEX: 10000000
ALIAS: MEM_IMAGE SEC_IMAGE
CONSTANT: ERROR_ALREADY_EXISTS 183
CONSTANT: FILE_MAP_ALL_ACCESS HEX: f001f
CONSTANT: FILE_MAP_READ 4
CONSTANT: FILE_MAP_WRITE 2

View File

@ -5,36 +5,6 @@ math math.bitwise windows.types init assocs splitting
sequences libc opengl.gl opengl.gl.extensions opengl.gl.windows ;
IN: windows.opengl32
! PIXELFORMATDESCRIPTOR flags
CONSTANT: PFD_DOUBLEBUFFER HEX: 00000001
CONSTANT: PFD_STEREO HEX: 00000002
CONSTANT: PFD_DRAW_TO_WINDOW HEX: 00000004
CONSTANT: PFD_DRAW_TO_BITMAP HEX: 00000008
CONSTANT: PFD_SUPPORT_GDI HEX: 00000010
CONSTANT: PFD_SUPPORT_OPENGL HEX: 00000020
CONSTANT: PFD_GENERIC_FORMAT HEX: 00000040
CONSTANT: PFD_NEED_PALETTE HEX: 00000080
CONSTANT: PFD_NEED_SYSTEM_PALETTE HEX: 00000100
CONSTANT: PFD_SWAP_EXCHANGE HEX: 00000200
CONSTANT: PFD_SWAP_COPY HEX: 00000400
CONSTANT: PFD_SWAP_LAYER_BUFFERS HEX: 00000800
CONSTANT: PFD_GENERIC_ACCELERATED HEX: 00001000
CONSTANT: PFD_SUPPORT_DIRECTDRAW HEX: 00002000
! PIXELFORMATDESCRIPTOR flags for use in ChoosePixelFormat only
CONSTANT: PFD_DEPTH_DONTCARE HEX: 20000000
CONSTANT: PFD_DOUBLEBUFFER_DONTCARE HEX: 40000000
CONSTANT: PFD_STEREO_DONTCARE HEX: 80000000
! pixel types
CONSTANT: PFD_TYPE_RGBA 0
CONSTANT: PFD_TYPE_COLORINDEX 1
! layer types
CONSTANT: PFD_MAIN_PLANE 0
CONSTANT: PFD_OVERLAY_PLANE 1
CONSTANT: PFD_UNDERLAY_PLANE -1
CONSTANT: LPD_TYPE_RGBA 0
CONSTANT: LPD_TYPE_COLORINDEX 1

View File

@ -68,8 +68,7 @@ SYMBOL: line-ideal
0 <paragraph> ;
: post-process ( paragraph -- array )
lines>> deep-list>array
[ [ contents>> ] map ] map ;
lines>> [ [ contents>> ] lmap>array ] lmap>array ;
: initialize ( elements -- elements paragraph )
<reversed> unclip-slice 1paragraph 1array ;

View File

@ -5,7 +5,7 @@ generic.standard effects classes.tuple classes.tuple.private arrays
vectors strings compiler.units accessors classes.algebra calendar
prettyprint io.streams.string splitting summary columns math.order
classes.private slots slots.private eval see words.symbol
compiler.errors ;
compiler.errors parser.notes ;
IN: classes.tuple.tests
TUPLE: rect x y w h ;

View File

@ -0,0 +1,4 @@
USING: lexer namespaces parser.notes source-files tools.test ;
IN: parser.notes.tests
[ ] [ f lexer set f file set "Hello world" note. ] unit-test

View File

@ -481,8 +481,6 @@ DEFER: blahy
[ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ( -- ) ; TUPLE: blahy < tuple ; : blahy ( -- ) ;" eval( -- ) ]
[ error>> error>> def>> \ blahy eq? ] must-fail-with
[ ] [ f lexer set f file set "Hello world" note. ] unit-test
[ "CHAR: \\u9999999999999" eval( -- n ) ] must-fail
SYMBOLS: a b c ;

View File

@ -1,4 +1,4 @@
USING: lists.lazy math.primes.lists tools.test ;
USING: lists lists.lazy math.primes.lists tools.test ;
{ { 2 3 5 7 11 13 17 19 23 29 } } [ 10 lprimes ltake list>array ] unit-test
{ { 101 103 107 109 113 } } [ 5 100 lprimes-from ltake list>array ] unit-test

View File

@ -1,6 +1,6 @@
! Copyright (C) 2005 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel lists.lazy tools.test strings math
USING: kernel lists lists.lazy tools.test strings math
sequences parser-combinators arrays math.parser unicode.categories ;
IN: parser-combinators.tests