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

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

db4
Doug Coleman 2009-02-09 16:23:47 -06:00
parent 41e0db098c 462b208475
commit c379497599
14 changed files with 250 additions and 155 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
basis/generalizations/generalizations-docs.factor
View File

@ -58,7 +58,7 @@ HELP: npick
"placed on the top of the stack."
}
{ $examples
{ $example "USING: prettyprint generalizations ;" "1 2 3 4 4 npick .s" "1\n2\n3\n4\n1" }
{ $example "USING: kernel prettyprint generalizations ;" "1 2 3 4 4 npick .s clear" "1\n2\n3\n4\n1" }
"Some core words expressed in terms of " { $link npick } ":"
{ $table
{ { $link dup } { $snippet "1 npick" } }
@ -75,7 +75,7 @@ HELP: ndup
"placed on the top of the stack."
}
{ $examples
{ $example "USING: prettyprint generalizations ;" "1 2 3 4 4 ndup .s" "1\n2\n3\n4\n1\n2\n3\n4" }
{ $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 ndup .s clear" "1\n2\n3\n4\n1\n2\n3\n4" }
"Some core words expressed in terms of " { $link ndup } ":"
{ $table
{ { $link dup } { $snippet "1 ndup" } }
@ -91,7 +91,7 @@ HELP: nnip
"for any number of items."
}
{ $examples
{ $example "USING: prettyprint generalizations ;" "1 2 3 4 3 nnip .s" "4" }
{ $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 nnip .s clear" "4" }
"Some core words expressed in terms of " { $link nnip } ":"
{ $table
{ { $link nip } { $snippet "1 nnip" } }
@ -106,7 +106,7 @@ HELP: ndrop
"for any number of items."
}
{ $examples
{ $example "USING: prettyprint generalizations ;" "1 2 3 4 3 ndrop .s" "1" }
{ $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 ndrop .s clear" "1" }
"Some core words expressed in terms of " { $link ndrop } ":"
{ $table
{ { $link drop } { $snippet "1 ndrop" } }
@ -121,7 +121,7 @@ HELP: nrot
"number of items on the stack. "
}
{ $examples
{ $example "USING: prettyprint generalizations ;" "1 2 3 4 4 nrot .s" "2\n3\n4\n1" }
{ $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 nrot .s clear" "2\n3\n4\n1" }
"Some core words expressed in terms of " { $link nrot } ":"
{ $table
{ { $link swap } { $snippet "1 nrot" } }
@ -135,7 +135,7 @@ HELP: -nrot
"number of items on the stack. "
}
{ $examples
{ $example "USING: prettyprint generalizations ;" "1 2 3 4 4 -nrot .s" "4\n1\n2\n3" }
{ $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 -nrot .s clear" "4\n1\n2\n3" }
"Some core words expressed in terms of " { $link -nrot } ":"
{ $table
{ { $link swap } { $snippet "1 -nrot" } }
@ -151,8 +151,8 @@ HELP: ndip
"stack. The quotation can consume and produce any number of items."
}
{ $examples
{ $example "USING: generalizations kernel prettyprint ;" "1 2 [ dup ] 1 ndip .s" "1\n1\n2" }
{ $example "USING: generalizations kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip .s" "2\n3" }
{ $example "USING: generalizations kernel prettyprint kernel ;" "1 2 [ dup ] 1 ndip .s clear" "1\n1\n2" }
{ $example "USING: generalizations kernel prettyprint kernel ;" "1 2 3 [ drop ] 2 ndip .s clear" "2\n3" }
"Some core words expressed in terms of " { $link ndip } ":"
{ $table
{ { $link dip } { $snippet "1 ndip" } }
@ -168,7 +168,7 @@ HELP: nslip
"removed from the stack, the quotation called, and the items restored."
}
{ $examples
{ $example "USING: generalizations prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s" "99\n1\n2\n3\n4\n5" }
{ $example "USING: generalizations kernel prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s clear" "99\n1\n2\n3\n4\n5" }
"Some core words expressed in terms of " { $link nslip } ":"
{ $table
{ { $link slip } { $snippet "1 nslip" } }
@ -184,7 +184,7 @@ HELP: nkeep
"saved, the quotation called, and the items restored."
}
{ $examples
{ $example "USING: generalizations kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s" "99\n1\n2\n3\n4\n5" }
{ $example "USING: generalizations kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s clear" "99\n1\n2\n3\n4\n5" }
"Some core words expressed in terms of " { $link nkeep } ":"
{ $table
{ { $link keep } { $snippet "1 nkeep" } }

4
basis/lists/lazy/lazy.factor
View File

@ -125,7 +125,7 @@ M: lazy-until car ( lazy-until -- car )
cons>> car ;
M: lazy-until cdr ( lazy-until -- cdr )
[ cons>> uncons ] keep quot>> tuck call( elt -- ? )
[ cons>> unswons ] keep quot>> tuck call( elt -- ? )
[ 2drop nil ] [ luntil ] if ;
M: lazy-until nil? ( lazy-until -- bool )
@ -284,7 +284,7 @@ DEFER: lconcat
dup nil? [
drop nil
] [
uncons swap (lconcat)
uncons (lconcat)
] if ;
M: lazy-concat car ( lazy-concat -- car )

133
basis/lists/lists-docs.factor
View File

@ -1,15 +1,68 @@
! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel help.markup help.syntax ;
USING: kernel help.markup help.syntax arrays sequences math quotations ;
IN: lists
{ car cons cdr nil nil? list? uncons } related-words
ABOUT: "lists"
ARTICLE: "lists" "Lists"
"The " { $vocab-link "lists" } " vocabulary implements linked lists. There are simple strict linked lists, but a generic list protocol allows the implementation of lazy lists as well."
{ $subsection { "lists" "protocol" } }
{ $subsection { "lists" "strict" } }
{ $subsection { "lists" "manipulation" } }
{ $subsection { "lists" "combinators" } }
{ $vocab-subsection "Lazy lists" "lists.lazy" } ;
ARTICLE: { "lists" "protocol" } "The list protocol"
"Lists are instances of a mixin class"
{ $subsection list }
"Instances of the mixin must implement the following words:"
{ $subsection car }
{ $subsection cdr }
{ $subsection nil? } ;
ARTICLE: { "lists" "strict" } "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 1list }
{ $subsection 2list }
{ $subsection 3list } ;
ARTICLE: { "lists" "combinators" } "Combinators for lists"
"Several combinators exist for list traversal."
{ $subsection leach }
{ $subsection lmap }
{ $subsection foldl }
{ $subsection foldr }
{ $subsection lmap>array }
{ $subsection lmap-as }
{ $subsection traverse } ;
ARTICLE: { "lists" "manipulation" } "Manipulating lists"
"To get at the contents of a list:"
{ $subsection uncons }
{ $subsection unswons }
{ $subsection lnth }
{ $subsection cadr }
{ $subsection llength }
"To get a new list from an old one:"
{ $subsection lreverse }
{ $subsection lappend }
{ $subsection lcut } ;
HELP: cons
{ $values { "car" "the head of the lazy list" } { "cdr" "the tail of the lazy list" } { "cons" "a cons object" } }
{ $values { "car" "the head of the list cell" } { "cdr" "the tail of the list cell" } { "cons" "a cons object" } }
{ $description "Constructs a cons cell." } ;
HELP: swons
{ $values { "cdr" "the tail of the list cell" } { "car" "the head of the list cell" } { "cons" "a cons object" } }
{ $description "Constructs a cons cell." } ;
{ cons swons uncons unswons } related-words
HELP: car
{ $values { "cons" "a cons object" } { "car" "the first item in the list" } }
{ $description "Returns the first item in the list." } ;
@ -17,7 +70,9 @@ HELP: car
HELP: cdr
{ $values { "cons" "a cons object" } { "cdr" "a cons object" } }
{ $description "Returns the tail of the list." } ;
{ car cdr } related-words
HELP: nil
{ $values { "symbol" "The empty cons (+nil+)" } }
{ $description "Returns a symbol representing the empty list" } ;
@ -26,6 +81,8 @@ HELP: nil?
{ $values { "object" object } { "?" "a boolean" } }
{ $description "Return true if the cons object is the nil cons." } ;
{ nil nil? } related-words
HELP: list? ( object -- ? )
{ $values { "object" "an object" } { "?" "a boolean" } }
{ $description "Returns true if the object conforms to the list protocol." } ;
@ -43,7 +100,7 @@ HELP: 2list
HELP: 3list
{ $values { "a" "an object" } { "b" "an object" } { "c" "an object" } { "cons" "a cons object" } }
{ $description "Create a list with 3 elements." } ;
HELP: lnth
{ $values { "n" "an integer index" } { "list" "a cons object" } { "elt" "the element at the nth index" } }
{ $description "Outputs the nth element of the list." }
@ -55,7 +112,11 @@ HELP: llength
{ $see-also lnth cons car cdr } ;
HELP: uncons
{ $values { "cons" "a cons object" } { "cdr" "the tail of the list" } { "car" "the head of the list" } }
{ $values { "cons" "a cons object" } { "car" "the head of the list" } { "cdr" "the tail of the list" } }
{ $description "Put the head and tail of the list on the stack." } ;
HELP: unswons
{ $values { "cons" "a cons object" } { "car" "the head of the list" } { "cdr" "the tail of the list" } }
{ $description "Put the head and tail of the list on the stack." } ;
{ leach foldl lmap>array } related-words
@ -75,30 +136,52 @@ HELP: foldr
HELP: lmap
{ $values { "list" "a cons object" } { "quot" { $quotation "( old -- new )" } } { "result" "the final result" } }
{ $description "Applies the quotation to each element of the list in order, collecting the new elements into a new list." } ;
HELP: lreverse
{ $values { "list" "a cons object" } { "newlist" "a new cons object" } }
{ $description "Reverses the input list, outputing a new, reversed list" } ;
HELP: list>seq
{ $values { "list" "a cons object" } { "array" "an array object" } }
{ $values { "list" list } { "newlist" list } }
{ $description "Reverses the input list, outputing a new, reversed list. The output is a strict cons list." } ;
HELP: list>array
{ $values { "list" "a cons object" } { "array" array } }
{ $description "Turns the given cons object into an array, maintaing order." } ;
HELP: seq>list
{ $values { "seq" "a sequence" } { "list" "a cons object" } }
HELP: sequence>cons
{ $values { "sequence" sequence } { "list" cons } }
{ $description "Turns the given array into a cons object, maintaing order." } ;
HELP: cons>seq
{ $values { "cons" "a cons object" } { "array" "an array object" } }
HELP: deep-list>array
{ $values { "list" list } { "array" array } }
{ $description "Recursively turns the given cons object into an array, maintaing order and also converting nested lists." } ;
HELP: seq>cons
{ $values { "seq" "a sequence object" } { "cons" "a cons object" } }
HELP: deep-sequence>cons
{ $values { "sequence" sequence } { "cons" cons } }
{ $description "Recursively turns the given sequence into a cons object, maintaing order and also converting nested lists." } ;
HELP: traverse
{ $values { "list" "a cons object" } { "pred" { $quotation "( list/elt -- ? )" } }
{ "quot" { $quotation "( list/elt -- result)" } } { "result" "a new cons object" } }
{ $description "Recursively traverses the list object, replacing any elements (which can themselves be sublists) that pred"
" returns true for with the result of applying quot to." } ;
" returns true for with the result of applying quot to." } ;
HELP: list
{ $class-description "The class of lists. All lists are expected to conform to " { $link { "lists" "protocol" } } "." } ;
HELP: cadr
{ $values { "list" list } { "elt" object } }
{ $description "Returns the second element of the list, ie the car of the cdr." } ;
HELP: lappend
{ $values { "list1" list } { "list2" list } { "newlist" list } }
{ $description "Appends the two lists to form a new list. The first list must be finite. The result is a strict cons cell, and the first list is exausted." } ;
HELP: lcut
{ $values { "list" list } { "index" integer } { "before" cons } { "after" cons } }
{ $description "Analogous to " { $link cut } ", this word cuts a list into two pieces at the given index." } ;
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." } ;

25
basis/lists/lists-tests.factor
View File

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

146
basis/lists/lists.factor
View File

@ -1,15 +1,16 @@
! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences accessors math arrays vectors classes words locals ;
USING: kernel sequences accessors math arrays vectors classes words
combinators.short-circuit combinators locals ;
IN: lists
! List Protocol
MIXIN: list
GENERIC: car ( cons -- car )
GENERIC: cdr ( cons -- cdr )
GENERIC: nil? ( object -- ? )
GENERIC: car ( cons -- car )
GENERIC: cdr ( cons -- cdr )
GENERIC: nil? ( object -- ? )
TUPLE: cons car cdr ;
TUPLE: cons { car read-only } { cdr read-only } ;
C: cons cons
@ -18,41 +19,53 @@ M: cons car ( cons -- car )
M: cons cdr ( cons -- cdr )
cdr>> ;
SYMBOL: +nil+
M: word nil? +nil+ eq? ;
SINGLETON: +nil+
M: +nil+ nil? drop t ;
M: object nil? drop f ;
: atom? ( obj -- ? ) [ list? ] [ nil? ] bi or not ;
: atom? ( obj -- ? )
list? not ;
: nil ( -- symbol ) +nil+ ;
: uncons ( cons -- cdr car )
[ cdr ] [ car ] bi ;
: uncons ( cons -- car cdr )
[ car ] [ cdr ] bi ;
: swons ( cdr car -- cons )
swap cons ;
: unswons ( cons -- cdr car )
uncons swap ;
: 1list ( obj -- cons )
nil cons ;
: 1list? ( list -- ? )
{ [ nil? not ] [ cdr nil? ] } 1&& ;
: 2list ( a b -- cons )
nil cons cons ;
: 3list ( a b c -- cons )
nil cons cons cons ;
: cadr ( cons -- elt )
: cadr ( list -- elt )
cdr car ;
: 2car ( cons -- car caar )
: 2car ( list -- car caar )
[ car ] [ cdr car ] bi ;
: 3car ( cons -- car cadr caddr )
: 3car ( list -- car cadr caddr )
[ car ] [ cdr car ] [ cdr cdr car ] tri ;
: lnth ( n list -- elt )
swap [ cdr ] times car ;
<PRIVATE
: (leach) ( list quot -- cdr quot )
[ [ car ] dip call ] [ [ cdr ] dip ] 2bi ; inline
PRIVATE>
: leach ( list quot: ( elt -- ) -- )
over nil? [ 2drop ] [ (leach) leach ] if ; inline recursive
@ -63,49 +76,72 @@ M: object nil? drop f ;
: foldl ( list identity quot: ( obj1 obj2 -- obj ) -- result )
swapd leach ; inline
: foldr ( list identity quot: ( obj1 obj2 -- obj ) -- result )
pick nil? [ [ drop ] [ ] [ drop ] tri* ] [
[ [ cdr ] 2dip foldr ] [ nip [ car ] dip ] 3bi
call
:: foldr ( list identity quot: ( obj1 obj2 -- obj ) -- result )
list nil? [ identity ] [
list cdr identity quot foldr
list car quot call
] if ; inline recursive
: llength ( list -- n )
0 [ drop 1+ ] foldl ;
: lreverse ( list -- newlist )
nil [ swap cons ] foldl ;
: lappend ( list1 list2 -- newlist )
[ lreverse ] dip [ swap cons ] foldl ;
: seq>list ( seq -- list )
: lcut ( list index -- before after )
[ nil ] dip
[ [ [ cdr ] [ car ] bi ] dip cons ] times
lreverse swap ;
: sequence>cons ( sequence -- list )
<reversed> nil [ swap cons ] reduce ;
<PRIVATE
: same? ( obj1 obj2 -- ? )
[ class ] bi@ = ;
: seq>cons ( seq -- cons )
[ <reversed> ] keep nil [ tuck same? [ seq>cons ] when f cons swap >>cdr ] with reduce ;
: (lmap>array) ( acc cons quot: ( elt -- elt' ) -- newcons )
over nil? [ 2drop ]
[ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap>array) ] if ;
inline recursive
: lmap>array ( cons quot -- newcons )
{ } -rot (lmap>array) ; inline
: lmap-as ( cons quot exemplar -- seq )
[ lmap>array ] dip like ;
: cons>seq ( cons -- array )
[ dup cons? [ cons>seq ] when dup nil? [ drop { } ] when ] lmap>array ;
: list>seq ( list -- array )
PRIVATE>
: deep-sequence>cons ( sequence -- cons )
[ <reversed> ] keep nil
[ tuck same? [ 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
: deep-list>array ( list -- array )
[
{
{ [ dup nil? ] [ drop { } ] }
{ [ dup list? ] [ deep-list>array ] }
[ ]
} cond
] lmap>array ;
: list>array ( list -- array )
[ ] lmap>array ;
: traverse ( list pred quot: ( list/elt -- result ) -- result )
[ 2over call [ tuck [ call ] 2dip ] when
pick list? [ traverse ] [ 2drop ] if ] 2curry lmap ; inline recursive
:: traverse ( list pred quot: ( list/elt -- result ) -- result )
list [| elt |
elt dup pred call [ quot call ] when
dup list? [ pred quot traverse ] when
] lmap ; inline recursive
INSTANCE: cons list
INSTANCE: +nil+ list

2
basis/persistent/deques/deques-docs.factor
View File

@ -1,3 +1,5 @@
! Copyright (C) 2008 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax kernel sequences ;
IN: persistent.deques

47
basis/persistent/deques/deques.factor
View File

@ -1,7 +1,6 @@
! Copyback (C) 2008 Daniel Ehrenberg
! Copyright (C) 2008 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math lists ;
QUALIFIED: sequences
USING: kernel accessors math lists sequences combinators.short-circuit ;
IN: persistent.deques
! Amortized O(1) push/pop on both ends for single-threaded access
@ -9,30 +8,13 @@ IN: persistent.deques
! same source, it could take O(m) amortized time per update.
<PRIVATE
: each ( list quot: ( elt -- ) -- )
over
[ [ [ car ] dip call ] [ [ cdr ] dip ] 2bi each ]
[ 2drop ] if ; inline recursive
: reduce ( list start quot -- end )
swapd each ; inline
: reverse ( list -- reversed )
f [ swap cons ] reduce ;
: length ( list -- length )
0 [ drop 1+ ] reduce ;
: cut ( list index -- back front-reversed )
f swap [ [ [ cdr ] [ car ] bi ] dip cons ] times ;
: split-reverse ( list -- back-reversed front )
dup length 2/ cut [ reverse ] bi@ ;
dup llength 2/ lcut lreverse swap ;
PRIVATE>
TUPLE: deque { front read-only } { back read-only } ;
: <deque> ( -- deque ) T{ deque } ;
: <deque> ( -- deque )
T{ deque f +nil+ +nil+ } ;
<PRIVATE
: flip ( deque -- newdeque )
@ -43,7 +25,7 @@ TUPLE: deque { front read-only } { back read-only } ;
PRIVATE>
: deque-empty? ( deque -- ? )
[ front>> ] [ back>> ] bi or not ;
{ [ front>> nil? ] [ back>> nil? ] } 1&& ;
<PRIVATE
: push ( item deque -- newdeque )
@ -61,11 +43,12 @@ PRIVATE>
[ front>> car ] [ [ front>> cdr ] [ back>> ] bi deque boa ] bi ; inline
: transfer ( deque -- item newdeque )
back>> [ split-reverse deque boa remove ]
[ "Popping from an empty deque" throw ] if* ; inline
back>> dup nil?
[ "Popping from an empty deque" throw ]
[ split-reverse deque boa remove ] if ; inline
: pop ( deque -- item newdeque )
dup front>> [ remove ] [ transfer ] if ; inline
dup front>> nil? [ transfer ] [ remove ] if ; inline
PRIVATE>
: pop-front ( deque -- item newdeque )
@ -74,12 +57,14 @@ PRIVATE>
: pop-back ( deque -- item newdeque )
[ pop ] flipped ;
: peek-front ( deque -- item ) pop-front drop ;
: peek-front ( deque -- item )
pop-front drop ;
: peek-back ( deque -- item ) pop-back drop ;
: peek-back ( deque -- item )
pop-back drop ;
: sequence>deque ( sequence -- deque )
<deque> [ push-back ] sequences:reduce ;
<deque> [ push-back ] reduce ;
: deque>sequence ( deque -- sequence )
[ dup deque-empty? not ] [ pop-front swap ] [ ] sequences:produce nip ;
[ dup deque-empty? not ] [ pop-front swap ] [ ] produce nip ;

4
basis/urls/urls-docs.factor
View File

@ -82,8 +82,8 @@ HELP: parse-host
{ $notes "This word is used by " { $link >url } ". It can also be used directly to parse " { $snippet "host:port" } " strings which are not full URLs." }
{ $examples
{ $example
"USING: prettyprint urls ;"
"\"sbcl.org:80\" parse-host .s"
"USING: prettyprint urls kernel ;"
"\"sbcl.org:80\" parse-host .s 2drop"
"\"sbcl.org\"\n80"
}
} ;

2
basis/wrap/words/words.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: sequences kernel splitting.monotonic accessors wrap grouping ;
USING: sequences kernel splitting.monotonic accessors grouping wrap ;
IN: wrap.words
TUPLE: word key width break? ;

14
basis/wrap/wrap.factor
View File

@ -12,18 +12,6 @@ C: <element> element
: element-length ( element -- n )
[ black>> ] [ white>> ] bi + ;
: swons ( cdr car -- cons )
swap cons ;
: unswons ( cons -- cdr car )
[ cdr ] [ car ] bi ;
: 1list? ( list -- ? )
{ [ ] [ cdr +nil+ = ] } 1&& ;
: lists>arrays ( lists -- arrays )
[ list>seq ] lmap>array ;
TUPLE: paragraph lines head-width tail-cost ;
C: <paragraph> paragraph
@ -78,7 +66,7 @@ SYMBOL: line-ideal
0 <paragraph> ;
: post-process ( paragraph -- array )
lines>> lists>arrays
lines>> deep-list>array
[ [ contents>> ] map ] map ;
: initialize ( elements -- elements paragraph )

2
core/kernel/kernel-docs.factor
View File

@ -658,7 +658,7 @@ HELP: loop
"hi hi hi" }
"A fun loop:"
{ $example "USING: kernel prettyprint math ; "
"3 [ dup . 7 + 11 mod dup 3 = not ] loop"
"3 [ dup . 7 + 11 mod dup 3 = not ] loop drop"
"3\n10\n6\n2\n9\n5\n1\n8\n4\n0\n7" }
} ;

2
core/math/math-docs.factor
View File

@ -254,7 +254,7 @@ HELP: fp-infinity?
{ $description "Tests if " { $snippet "x" } " is an IEEE Infinity value. While " { $snippet "x" } " can be any real number, this word will only ever yield true if " { $snippet "x" } " is a " { $link float } "." }
{ $examples
{ $example "USING: math prettyprint ;" "1/0. fp-infinity? ." "t" }
{ $example "USING: io kernel math ;" "-1/0. [ fp-infinity? ] [ 0 < ] bi [ \"negative infinity\" print ] when" "negative infinity" }
{ $example "USING: io kernel math ;" "-1/0. [ fp-infinity? ] [ 0 < ] bi and [ \"negative infinity\" print ] when" "negative infinity" }
} ;
{ fp-nan? fp-infinity? } related-words

2
extra/parser-combinators/parser-combinators.factor
View File

@ -17,7 +17,7 @@ ERROR: cannot-parse input ;
: parse-1 ( input parser -- result )
dupd parse dup nil? [
rot cannot-parse
swap cannot-parse
] [
nip car parsed>>
] if ;

2
extra/project-euler/134/134.factor
View File

@ -39,7 +39,7 @@ IN: project-euler.134
PRIVATE>
: euler134 ( -- answer )
0 5 lprimes-from uncons swap [ 1000000 > ] luntil
0 5 lprimes-from uncons [ 1000000 > ] luntil
[ [ s + ] keep ] leach drop ;
! [ euler134 ] 10 ave-time