Merge branch 'master' into checksums

db4
Doug Coleman 2009-05-16 15:37:03 -05:00
commit 51dde01fac
11 changed files with 43 additions and 96 deletions

View File

@ -3,7 +3,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: continuations sequences kernel namespaces debugger USING: continuations sequences kernel namespaces debugger
combinators math quotations generic strings splitting accessors 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 ; io.streams.string io.encodings.utf8 html.templates ;
IN: html.templates.fhtml IN: html.templates.fhtml

View File

@ -2,7 +2,7 @@
! Copyright (C) 2004 Chris Double. ! Copyright (C) 2004 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: lists.lazy.examples
: naturals ( -- list ) 0 lfrom ; : naturals ( -- list ) 0 lfrom ;

View File

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

View File

@ -14,7 +14,7 @@ ARTICLE: "lists" "Lists"
{ $vocab-subsection "Lazy lists" "lists.lazy" } ; { $vocab-subsection "Lazy lists" "lists.lazy" } ;
ARTICLE: { "lists" "protocol" } "The list protocol" ARTICLE: { "lists" "protocol" } "The list protocol"
"Lists are instances of a mixin class" "Lists are instances of a mixin class:"
{ $subsection list } { $subsection list }
"Instances of the mixin must implement the following words:" "Instances of the mixin must implement the following words:"
{ $subsection car } { $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:" "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 cons }
{ $subsection swons } { $subsection swons }
{ $subsection sequence>cons } { $subsection sequence>list }
{ $subsection deep-sequence>cons }
{ $subsection 1list } { $subsection 1list }
{ $subsection 2list } { $subsection 2list }
{ $subsection 3list } ; { $subsection 3list } ;
@ -38,7 +37,6 @@ ARTICLE: { "lists" "combinators" } "Combinators for lists"
{ $subsection foldl } { $subsection foldl }
{ $subsection foldr } { $subsection foldr }
{ $subsection lmap>array } { $subsection lmap>array }
{ $subsection lmap-as }
{ $subsection traverse } ; { $subsection traverse } ;
ARTICLE: { "lists" "manipulation" } "Manipulating lists" ARTICLE: { "lists" "manipulation" } "Manipulating lists"
@ -141,10 +139,6 @@ HELP: list>array
{ $values { "list" list } { "array" array } } { $values { "list" list } { "array" array } }
{ $description "Convert a list into an 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 HELP: traverse
{ $values { "list" list } { "pred" { $quotation "( list/elt -- ? )" } } { $values { "list" list } { "pred" { $quotation "( list/elt -- ? )" } }
{ "quot" { $quotation "( list/elt -- result)" } } { "result" "a new cons object" } } { "quot" { $quotation "( list/elt -- result)" } } { "result" "a new cons object" } }
@ -170,6 +164,3 @@ HELP: lmap>array
{ $values { "list" list } { "quot" quotation } { "array" array } } { $values { "list" list } { "quot" quotation } { "array" array } }
{ $description "Executes the quotation on each element of the list, collecting the results in an 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 ! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: lists.tests
{ { 3 4 5 6 7 } } [ { { 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 ] unit-test
{ { 3 4 5 6 } } [ { { 3 4 5 6 } } [
@ -24,23 +24,23 @@ IN: lists.tests
] unit-test ] unit-test
{ T{ cons f 2 T{ cons f 3 T{ cons f 4 T{ cons f 5 +nil+ } } } } } [ { 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 ] unit-test
{ 15 } [ { 15 } [
{ 1 2 3 4 5 } seq>list 0 [ + ] foldr { 1 2 3 4 5 } sequence>list 0 [ + ] foldr
] unit-test ] unit-test
{ { 5 4 3 2 1 } } [ { { 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 ] unit-test
{ 5 } [ { 5 } [
{ 1 2 3 4 5 } seq>list llength { 1 2 3 4 5 } sequence>list llength
] unit-test ] unit-test
{ { 1 2 3 4 5 6 } } [ { { 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 ] 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. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences accessors math arrays vectors classes words USING: kernel sequences accessors math arrays vectors classes words
combinators.short-circuit combinators locals ; combinators.short-circuit combinators locals ;
@ -14,57 +14,45 @@ TUPLE: cons { car read-only } { cdr read-only } ;
C: cons cons 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+ SINGLETON: +nil+
M: +nil+ nil? drop t ; M: +nil+ nil? drop t ;
M: object nil? drop f ; 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 <PRIVATE
: (leach) ( list quot -- cdr quot ) : (leach) ( list quot -- cdr quot )
[ [ car ] dip call ] [ [ cdr ] dip ] 2bi ; inline [ [ car ] dip call ] [ [ cdr ] dip ] 2bi ; inline
PRIVATE> PRIVATE>
: leach ( list quot: ( elt -- ) -- ) : leach ( list quot: ( elt -- ) -- )
@ -93,47 +81,14 @@ PRIVATE>
: lcut ( list index -- before after ) : lcut ( list index -- before after )
[ nil ] dip [ nil ] dip
[ [ [ cdr ] [ car ] bi ] dip cons ] times [ [ unswons ] dip cons ] times
lreverse swap ; 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>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 ) : list>array ( list -- array )
[ ] lmap>array ; [ ] lmap>array ;

View File

@ -68,8 +68,7 @@ SYMBOL: line-ideal
0 <paragraph> ; 0 <paragraph> ;
: post-process ( paragraph -- array ) : post-process ( paragraph -- array )
lines>> deep-list>array lines>> [ [ contents>> ] lmap>array ] lmap>array ;
[ [ contents>> ] map ] map ;
: initialize ( elements -- elements paragraph ) : initialize ( elements -- elements paragraph )
<reversed> unclip-slice 1paragraph 1array ; <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 vectors strings compiler.units accessors classes.algebra calendar
prettyprint io.streams.string splitting summary columns math.order prettyprint io.streams.string splitting summary columns math.order
classes.private slots slots.private eval see words.symbol classes.private slots slots.private eval see words.symbol
compiler.errors ; compiler.errors parser.notes ;
IN: classes.tuple.tests IN: classes.tuple.tests
TUPLE: rect x y w h ; 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( -- ) ] [ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ( -- ) ; TUPLE: blahy < tuple ; : blahy ( -- ) ;" eval( -- ) ]
[ error>> error>> def>> \ blahy eq? ] must-fail-with [ 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 [ "CHAR: \\u9999999999999" eval( -- n ) ] must-fail
SYMBOLS: a b c ; SYMBOLS: a b c ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2005 Chris Double. ! Copyright (C) 2005 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! 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 ; sequences parser-combinators arrays math.parser unicode.categories ;
IN: parser-combinators.tests IN: parser-combinators.tests