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

basis/farkup/farkup-tests.factor

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

basis/farkup/farkup.factor

@@ -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:" ?head ] dip swap [ image boa ] [ parse-paragraph link boa ] if
+        [ [ ] 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 ;

basis/help/html/html-tests.factor

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

basis/help/html/html.factor

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

basis/html/templates/fhtml/fhtml.factor

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

basis/io/sockets/windows/nt/nt.factor

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

basis/lists/lazy/examples/examples.factor

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

basis/lists/lazy/lazy-docs.factor

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

basis/lists/lists-docs.factor

@@ -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 sequence>list }
-{ $subsection deep-sequence>cons }
 { $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." } ;

basis/lists/lists-tests.factor

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

basis/lists/lists.factor

@@ -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 )
+M: cons car ( cons -- car ) car>> ;
-    car>> ;
 
-M: cons cdr ( cons -- cdr )
+M: cons cdr ( cons -- cdr ) cdr>> ;
-    cdr>> ;
 
 SINGLETON: +nil+
 M: +nil+ nil? drop t ;
 M: object nil? drop f ;
 
-: atom? ( obj -- ? )
+: atom? ( obj -- ? ) list? not ; inline
-    list? not ;
 
-: nil ( -- symbol ) +nil+ ; 
+: nil ( -- symbol ) +nil+ ; inline
 
-: uncons ( cons -- car cdr )
+: uncons ( cons -- car cdr ) [ car ] [ cdr ] bi ; inline
-    [ car ] [ cdr ] bi ;
 
-: swons ( cdr car -- cons )
+: swons ( cdr car -- cons ) swap cons ; inline
-    swap cons ;
 
-: unswons ( cons -- cdr car )
+: unswons ( cons -- cdr car ) uncons swap ; inline
-    uncons swap ;
 
-: 1list ( obj -- cons )
+: 1list ( obj -- cons ) nil cons ; inline
-    nil cons ;
 
-: 1list? ( list -- ? )
+: 1list? ( list -- ? ) { [ nil? not ] [ cdr nil? ] } 1&& ; inline
-    { [ nil? not ] [ cdr nil? ] } 1&& ;
 
-: 2list ( a b -- cons )
+: 2list ( a b -- cons ) nil cons cons ; inline
-    nil cons cons ;
 
-: 3list ( a b c -- cons )
+: 3list ( a b c -- cons ) nil cons cons cons ; inline
-    nil cons cons cons ;
 
-: cadr ( list -- elt )    
+: cadr ( list -- elt ) cdr car ; inline
-    cdr car ;
  
-: 2car ( list -- car caar )    
+: 2car ( list -- car caar ) [ car ] [ cdr car ] bi ; inline
-    [ car ] [ cdr car ] bi ;
  
-: 3car ( list -- car cadr caddr )    
+: 3car ( list -- car cadr caddr ) [ car ] [ cdr car ] [ cdr cdr car ] tri ; inline
-    [ car ] [ cdr car ] [ cdr cdr car ] tri ;
 
-: lnth ( n list -- elt )
+: lnth ( n list -- elt ) swap [ cdr ] times car ; inline
-    swap [ cdr ] times car ;
 
 <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 )    
+: sequence>list ( sequence -- list )    
-    <reversed> nil [ swap cons ] reduce ;
+    <reversed> nil [ swons ] 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
 
 : lmap>array ( list quot -- array )
-    { } lmap-as ; inline
+    accumulator [ leach ] dip { } like ; inline
-
-: deep-list>array ( list -- array )    
-    [
-        {
-            { [ dup nil? ] [ drop { } ] }
-            { [ dup list? ] [ deep-list>array ] }
-            [ ]
-        } cond
-    ] lmap>array ;
 
 : list>array ( list -- array )  
     [ ] lmap>array ;

basis/see/see-tests.factor

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

basis/see/see.factor

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

basis/tools/deploy/shaker/shaker.factor

@@ -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
+math make assocs kernel parser parser.notes lexer strings.parser
-sequences.private words memory kernel.private continuations io
+vocabs sequences sequences.private words memory kernel.private
-vocabs.loader system strings sets vectors quotations byte-arrays
+continuations io vocabs.loader system strings sets vectors quotations
-sorting compiler.units definitions generic generic.standard
+byte-arrays sorting compiler.units definitions generic
-generic.single tools.deploy.config combinators classes
+generic.standard generic.single tools.deploy.config combinators
-slots.private ;
+classes slots.private ;
 QUALIFIED: bootstrap.stage2
 QUALIFIED: command-line
 QUALIFIED: compiler.errors

basis/ui/backend/windows/windows.factor

@@ -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
+command-line shuffle opengl ui.render math.bitwise locals
-accessors math.rectangles math.order ascii calendar
+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

basis/windows/gdi32/gdi32.factor

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

basis/windows/kernel32/kernel32.factor

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

basis/windows/opengl32/opengl32.factor

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

basis/wrap/wrap.factor

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

core/classes/tuple/tuple-tests.factor

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

core/parser/notes/notes-tests.factor

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

core/parser/parser-tests.factor

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

extra/math/primes/lists/lists-tests.factor

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

extra/parser-combinators/parser-combinators-tests.factor

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