steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix conflict

release
Slava Pestov 2007-12-08 15:13:59 -05:00
parent 6beab4c06f 4a29e2e707
commit cce5b733a6
4 changed files with 73 additions and 46 deletions

64
extra/rss/rss.factor
View File

@ -9,6 +9,9 @@ USING: xml.utilities kernel assocs
: ?children>string ( tag/f -- string/f )
[ children>string ] [ f ] if* ;
: any-tag-named ( tag names -- tag-inside )
f -rot [ tag-named nip dup ] curry* find 2drop ;
TUPLE: feed title link entries ;
C: <feed> feed
@ -17,50 +20,51 @@ TUPLE: entry title link description pub-date ;
C: <entry> entry
: rss1.0-entry ( tag -- entry )
[ "title" tag-named children>string ] keep
[ "link" tag-named children>string ] keep
[ "description" tag-named children>string ] keep
f "date" "http://purl.org/dc/elements/1.1/" <name>
tag-named ?children>string
<entry> ;
: rss1.0 ( xml -- feed )
[
"channel" tag-named
[ "title" tag-named children>string ] keep
"link" tag-named children>string
] keep
"item" tags-named [
[ "title" tag-named children>string ] keep
[ "link" tag-named children>string ] keep
[ "description" tag-named children>string ] keep
f "date" "http://purl.org/dc/elements/1.1/" <name>
tag-named ?children>string
<entry>
] map <feed> ;
"item" tags-named [ rss1.0-entry ] map <feed> ;
: rss2.0-entry ( tag -- entry )
[ "title" tag-named children>string ] keep
[ "link" tag-named ] keep
[ "guid" tag-named dupd ? children>string ] keep
[ "description" tag-named children>string ] keep
"pubDate" tag-named children>string <entry> ;
: rss2.0 ( xml -- feed )
"channel" tag-named
[ "title" tag-named children>string ] keep
[ "link" tag-named children>string ] keep
"item" tags-named [
[ "title" tag-named children>string ] keep
[ "link" tag-named ] keep
[ "guid" tag-named dupd ? children>string ] keep
[ "description" tag-named children>string ] keep
"pubDate" tag-named children>string <entry>
] map <feed> ;
"item" tags-named [ rss2.0-entry ] map <feed> ;
: atom1.0-entry ( tag -- entry )
[ "title" tag-named children>string ] keep
[ "link" tag-named "href" swap at ] keep
[
{ "content" "summary" } any-tag-named
dup tag-children [ string? not ] contains?
[ tag-children [ write-chunk ] string-out ]
[ children>string ] if
] keep
{ "published" "updated" "issued" "modified" } any-tag-named
children>string <entry> ;
: atom1.0 ( xml -- feed )
[ "title" tag-named children>string ] keep
[ "link" tag-named "href" swap at ] keep
"entry" tags-named [
[ "title" tag-named children>string ] keep
[ "link" tag-named "href" swap at ] keep
[
dup "content" tag-named
[ nip ] [ "summary" tag-named ] if*
dup tag-children [ tag? ] contains?
[ tag-children [ write-chunk ] string-out ]
[ children>string ] if
] keep
dup "published" tag-named
[ nip ] [ "updated" tag-named ] if*
children>string <entry>
] map <feed> ;
"entry" tags-named [ atom1.0-entry ] map <feed> ;
: xml>feed ( xml -- feed )
dup name-tag {
@ -92,7 +96,7 @@ C: <entry> entry
dup entry-title "title" { { "type" "html" } } simple-tag*,
"link" over entry-link "href" associate contained*,
dup entry-pub-date "published" simple-tag,
entry-description "content" { { "type" "html" } } simple-tag*,
entry-description [ "content" { { "type" "html" } } simple-tag*, ] when*
] tag, ;
: feed>xml ( feed -- xml )

6
extra/sequences/lib/lib-tests.factor
View File

@ -1,5 +1,5 @@
USING: arrays kernel sequences sequences.lib math
math.functions tools.test ;
math.functions tools.test strings ;
[ 4 ] [ { 1 2 } [ sq ] [ * ] map-reduce ] unit-test
[ 36 ] [ { 2 3 } [ sq ] [ * ] map-reduce ] unit-test
@ -42,3 +42,7 @@ math.functions tools.test ;
[ { 1 9 25 } ] [ { 1 3 5 6 } [ sq ] [ even? ] map-until ] unit-test
[ { 2 4 } ] [ { 2 4 1 3 } [ even? ] take-while ] unit-test
[ { { 0 0 } { 1 0 } { 0 1 } { 1 1 } } ] [ 2 2 exact-strings ] unit-test
[ t ] [ "ab" 4 strings [ >string ] map "abab" swap member? ] unit-test
[ { { } { 1 } { 2 } { 1 2 } } ] [ { 1 2 } power-set ] unit-test

34
extra/sequences/lib/lib.factor
View File

@ -1,5 +1,5 @@
USING: combinators.lib kernel sequences math namespaces
random sequences.private shuffle ;
USING: combinators.lib kernel sequences math namespaces assocs
random sequences.private shuffle math.functions mirrors ;
IN: sequences.lib
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -74,3 +74,33 @@ IN: sequences.lib
[ not ] compose
[ find drop [ head-slice ] when* ] curry
[ dup ] swap compose keep like ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
<PRIVATE
: translate-string ( n alphabet out-len -- seq )
[ drop /mod ] curry* map nip ;
: map-alphabet ( alphabet seq[seq] -- seq[seq] )
[ [ swap nth ] curry* map ] curry* map ;
: exact-number-strings ( n out-len -- seqs )
[ ^ ] 2keep [ translate-string ] 2curry map ;
: number-strings ( n max-length -- seqs )
1+ [ exact-number-strings ] curry* map concat ;
PRIVATE>
: exact-strings ( alphabet length -- seqs )
>r dup length r> exact-number-strings map-alphabet ;
: strings ( alphabet length -- seqs )
>r dup length r> number-strings map-alphabet ;
: nths ( nths seq -- subseq )
! nths is a sequence of ones and zeroes
>r [ length ] keep [ nth 1 = ] curry subset r>
[ nth ] curry { } map-as ;
: power-set ( seq -- subsets )
2 over length exact-number-strings swap [ nths ] curry map ;

15
extra/shufflers/shufflers.factor
View File

@ -1,25 +1,14 @@
USING: kernel sequences words math math.functions arrays
shuffle quotations parser math.parser strings namespaces
splitting effects ;
splitting effects sequences.lib ;
IN: shufflers
: shuffle>string ( names shuffle -- string )
swap [ [ nth ] curry map ] curry map
first2 "-" swap 3append >string ;
: translate ( n alphabet out-len -- seq )
[ drop /mod ] curry* map nip ;
: (combinations) ( alphabet out-len -- seq[seq] )
[ ^ ] 2keep [ translate ] 2curry map ;
: combinations ( n max-out -- seq[seq] )
! This returns a seq of length O(n^m)
! where and m is max-out
1+ [ (combinations) ] curry* map concat ;
: make-shuffles ( max-out max-in -- shuffles )
[ 1+ dup rot combinations [ 2array ] curry* map ]
[ 1+ dup rot strings [ 2array ] curry* map ]
curry* map concat ;
: shuffle>quot ( shuffle -- quot )