From ea46845ac16fdce6122812b3733a029e9b090dea Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sun, 8 Feb 2009 20:32:11 -0600 Subject: [PATCH 1/9] Slight furnace cleanup --- basis/furnace/chloe-tags/chloe-tags.factor | 13 ++++++++++--- basis/furnace/utilities/utilities-docs.factor | 6 +++--- basis/furnace/utilities/utilities.factor | 12 ++++++------ 3 files changed, 19 insertions(+), 12 deletions(-) diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor index d7d9ae9ebb..8003ab208b 100644 --- a/basis/furnace/chloe-tags/chloe-tags.factor +++ b/basis/furnace/chloe-tags/chloe-tags.factor @@ -81,11 +81,18 @@ CHLOE: a CHLOE: base compile-a-url [ [XML /> XML] ] [xml-code] ; +: hidden-nested-fields ( -- xml ) + nested-forms get " " join f like nested-forms-key + hidden-form-field ; + +: render-hidden ( for -- xml ) + "," split [ hidden render>xml ] map ; + : compile-hidden-form-fields ( for -- ) '[ - _ [ "," split [ hidden render>xml ] map ] [ f ] if* - nested-forms get " " join f like nested-forms-key hidden-form-field>xml - [ [ modify-form ] each-responder ] with-string-writer + _ render-hidden + hidden-nested-fields + form-modifications [XML
<-><-><->
XML] ] [code] ; diff --git a/basis/furnace/utilities/utilities-docs.factor b/basis/furnace/utilities/utilities-docs.factor index d2291786df..62f73d4f09 100644 --- a/basis/furnace/utilities/utilities-docs.factor +++ b/basis/furnace/utilities/utilities-docs.factor @@ -20,8 +20,8 @@ HELP: each-responder { $description "Applies the quotation to each responder involved in processing the current request." } ; HELP: hidden-form-field -{ $values { "value" string } { "name" string } } -{ $description "Renders an HTML hidden form field tag." } +{ $values { "value" string } { "name" string } { "xml" "an XML chunk" } } +{ $description "Renders an HTML hidden form field tag as XML." } { $notes "This word is used by session management, conversation scope and asides." } { $examples { $example @@ -38,7 +38,7 @@ HELP: link-attr { $examples "Conversation scope adds attributes to link tags." } ; HELP: modify-form -{ $values { "responder" "a responder" } } +{ $values { "responder" "a responder" } { "xml/f" "an XML chunk or f" } } { $contract "Emits hidden form fields using " { $link hidden-form-field } "." } { $notes "This word is called by " { $link "html.templates.chloe.tags.form" } "." } { $examples "Session management, conversation scope and asides use hidden form fields to pass state." } ; diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index a2d4c4d996..2f998e039a 100755 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -77,18 +77,18 @@ GENERIC: link-attr ( tag responder -- ) M: object link-attr 2drop ; -GENERIC: modify-form ( responder -- ) +GENERIC: modify-form ( responder -- xml/f ) -M: object modify-form drop ; +M: object modify-form f ; -: hidden-form-field>xml ( value name -- xml ) +: form-modifications ( -- xml ) + [ [ modify-form [ , ] when ] each-responder ] { } make ; + +: hidden-form-field ( value name -- xml ) over [ [XML name=<->/> XML] ] [ drop ] if ; -: hidden-form-field ( value name -- ) - hidden-form-field>xml write-xml ; - : nested-forms-key "__n" ; : request-params ( request -- assoc ) From c3f5dc2e96d52cdc4e361f08ae201540365ce5b2 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sun, 8 Feb 2009 21:17:59 -0600 Subject: [PATCH 2/9] Help-lint edit for furnace.utilities --- basis/furnace/utilities/utilities.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index 2f998e039a..4fc68f7735 100755 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -79,10 +79,10 @@ M: object link-attr 2drop ; GENERIC: modify-form ( responder -- xml/f ) -M: object modify-form f ; +M: object modify-form drop f ; : form-modifications ( -- xml ) - [ [ modify-form [ , ] when ] each-responder ] { } make ; + [ [ modify-form [ , ] when* ] each-responder ] { } make ; : hidden-form-field ( value name -- xml ) over [ From 35b526cc7a034fb945342ab53c247a04abc4791c Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 9 Feb 2009 14:29:09 -0600 Subject: [PATCH 3/9] Docs for lists, consolidating list functionality in lists, minor API changes --- basis/lists/lazy/lazy.factor | 4 +- basis/lists/lists-docs.factor | 133 ++++++++++++++---- basis/lists/lists-tests.factor | 20 +-- basis/lists/lists.factor | 123 ++++++++++------ basis/persistent/deques/deques-docs.factor | 2 + basis/persistent/deques/deques.factor | 47 +++---- basis/urls/urls-docs.factor | 4 +- basis/wrap/wrap.factor | 14 +- core/math/math-docs.factor | 2 +- .../parser-combinators.factor | 2 +- extra/project-euler/134/134.factor | 2 +- 11 files changed, 221 insertions(+), 132 deletions(-) diff --git a/basis/lists/lazy/lazy.factor b/basis/lists/lazy/lazy.factor index 213285e643..5adb7a8be5 100644 --- a/basis/lists/lazy/lazy.factor +++ b/basis/lists/lazy/lazy.factor @@ -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 ) diff --git a/basis/lists/lists-docs.factor b/basis/lists/lists-docs.factor index 8807c8cf8a..8494d7c352 100644 --- a/basis/lists/lists-docs.factor +++ b/basis/lists/lists-docs.factor @@ -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." } ; diff --git a/basis/lists/lists-tests.factor b/basis/lists/lists-tests.factor index 4a08a4d1e3..404a776505 100644 --- a/basis/lists/lists-tests.factor +++ b/basis/lists/lists-tests.factor @@ -5,7 +5,7 @@ USING: tools.test lists math ; 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 +38,33 @@ 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 \ No newline at end of file + { 1 2 3 } sequence>cons { 4 5 6 } sequence>cons lappend list>array +] unit-test diff --git a/basis/lists/lists.factor b/basis/lists/lists.factor index 5568b9d53e..784bc95bfe 100644 --- a/basis/lists/lists.factor +++ b/basis/lists/lists.factor @@ -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 ; 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? ] [ nil? ] } 1|| 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 ; - + + : leach ( list quot: ( elt -- ) -- ) over nil? [ 2drop ] [ (leach) leach ] if ; inline recursive @@ -71,41 +84,59 @@ M: object nil? drop f ; : 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 ) nil [ swap cons ] reduce ; - + +cons ( seq -- cons ) - [ ] keep nil [ tuck same? [ seq>cons ] when f cons swap >>cdr ] with reduce ; - +PRIVATE> + +: deep-sequence>cons ( sequence -- cons ) + [ ] keep nil + [ tuck same? [ deep-sequence>cons ] when swons ] with reduce ; + +array) ( acc cons quot: ( elt -- elt' ) -- newcons ) over nil? [ 2drop ] - [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap>array) ] if ; + [ [ unswons ] 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 ) +PRIVATE> + +: lmap>array ( list quot -- array ) + [ { } ] 2dip (lmap>array) ; inline + +: lmap-as ( list quot exemplar -- sequence ) [ lmap>array ] dip like ; - -: cons>seq ( cons -- array ) - [ dup cons? [ cons>seq ] when dup nil? [ drop { } ] when ] lmap>array ; - -: list>seq ( list -- array ) + +: deep-list>array ( list -- array ) + [ + { + { [ dup list? ] [ deep-list>array ] } + { [ dup nil? ] [ drop { } ] } + [ ] + } 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 - + [ + 2over call [ tuck [ call ] 2dip ] when + pick list? [ traverse ] [ 2drop ] if + ] 2curry lmap ; inline recursive + INSTANCE: cons list diff --git a/basis/persistent/deques/deques-docs.factor b/basis/persistent/deques/deques-docs.factor index 43018bed16..f1027d107b 100644 --- a/basis/persistent/deques/deques-docs.factor +++ b/basis/persistent/deques/deques-docs.factor @@ -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 diff --git a/basis/persistent/deques/deques.factor b/basis/persistent/deques/deques.factor index ece1cda772..8f93ae1ab8 100644 --- a/basis/persistent/deques/deques.factor +++ b/basis/persistent/deques/deques.factor @@ -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. TUPLE: deque { front read-only } { back read-only } ; -: ( -- deque ) T{ deque } ; +: ( -- deque ) + T{ deque f +nil+ +nil+ } ; : deque-empty? ( deque -- ? ) - [ front>> ] [ back>> ] bi or not ; + { [ front>> nil? ] [ back>> nil? ] } 1&& ; [ 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 ) - [ push-back ] sequences:reduce ; + [ 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 ; diff --git a/basis/urls/urls-docs.factor b/basis/urls/urls-docs.factor index f6c25980ea..437a9419e3 100644 --- a/basis/urls/urls-docs.factor +++ b/basis/urls/urls-docs.factor @@ -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" } } ; diff --git a/basis/wrap/wrap.factor b/basis/wrap/wrap.factor index 55fe10283a..6e5bf31075 100644 --- a/basis/wrap/wrap.factor +++ b/basis/wrap/wrap.factor @@ -12,18 +12,6 @@ C: 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 @@ -78,7 +66,7 @@ SYMBOL: line-ideal 0 ; : post-process ( paragraph -- array ) - lines>> lists>arrays + lines>> deep-list>array [ [ contents>> ] map ] map ; : initialize ( elements -- elements paragraph ) diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index 7d0666328f..94ff2c1f29 100644 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -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 diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor index 8afbb2d03b..347ab638ff 100755 --- a/extra/parser-combinators/parser-combinators.factor +++ b/extra/parser-combinators/parser-combinators.factor @@ -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 ; diff --git a/extra/project-euler/134/134.factor b/extra/project-euler/134/134.factor index e00e86865d..0f009919d9 100644 --- a/extra/project-euler/134/134.factor +++ b/extra/project-euler/134/134.factor @@ -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 From 975f197558c5efc49e43c87477b50bcaea64d962 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 9 Feb 2009 14:37:22 -0600 Subject: [PATCH 4/9] Fixing help-lint bugs --- .../generalizations-docs.factor | 20 +++++++++---------- core/kernel/kernel-docs.factor | 2 +- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index ac8e14c05a..376ae5bed2 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -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" } } diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 71183093ee..b8191004db 100644 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -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" } } ; From 462b208475382fc240648a92a296c95be90d8520 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 9 Feb 2009 15:31:57 -0600 Subject: [PATCH 5/9] Cleaning up strict list combinators --- basis/lists/lists-tests.factor | 5 ++-- basis/lists/lists.factor | 47 +++++++++++++++++++--------------- basis/wrap/words/words.factor | 2 +- 3 files changed, 30 insertions(+), 24 deletions(-) diff --git a/basis/lists/lists-tests.factor b/basis/lists/lists-tests.factor index 404a776505..13d2e03e0f 100644 --- a/basis/lists/lists-tests.factor +++ b/basis/lists/lists-tests.factor @@ -1,7 +1,6 @@ ! 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 } } [ @@ -68,3 +67,5 @@ IN: lists.tests { { 1 2 3 4 5 6 } } [ { 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 diff --git a/basis/lists/lists.factor b/basis/lists/lists.factor index 784bc95bfe..4b0abb7f2d 100644 --- a/basis/lists/lists.factor +++ b/basis/lists/lists.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences accessors math arrays vectors classes words -combinators.short-circuit combinators ; +combinators.short-circuit combinators locals ; IN: lists ! List Protocol @@ -25,7 +25,7 @@ M: +nil+ nil? drop t ; M: object nil? drop f ; : atom? ( obj -- ? ) - { [ list? ] [ nil? ] } 1|| not ; + list? not ; : nil ( -- symbol ) +nil+ ; @@ -76,10 +76,10 @@ PRIVATE> : 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 ) @@ -92,7 +92,7 @@ PRIVATE> [ lreverse ] dip [ swap cons ] foldl ; : lcut ( list index -- before after ) - [ +nil+ ] dip + [ nil ] dip [ [ [ cdr ] [ car ] bi ] dip cons ] times lreverse swap ; @@ -109,23 +109,27 @@ PRIVATE> [ tuck same? [ deep-sequence>cons ] when swons ] with reduce ; array) ( acc cons quot: ( elt -- elt' ) -- newcons ) - over nil? [ 2drop ] - [ [ unswons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap>array) ] if ; - inline recursive +:: (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>array ( list quot -- array ) - [ { } ] 2dip (lmap>array) ; inline - : lmap-as ( list quot exemplar -- sequence ) - [ lmap>array ] dip like ; + [ lmap>vector ] dip like ; inline + +: lmap>array ( list quot -- array ) + { } lmap-as ; inline : deep-list>array ( list -- array ) [ { - { [ dup list? ] [ deep-list>array ] } { [ dup nil? ] [ drop { } ] } + { [ dup list? ] [ deep-list>array ] } [ ] } cond ] lmap>array ; @@ -133,10 +137,11 @@ PRIVATE> : 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 diff --git a/basis/wrap/words/words.factor b/basis/wrap/words/words.factor index 00f257a5cf..bcf4460170 100644 --- a/basis/wrap/words/words.factor +++ b/basis/wrap/words/words.factor @@ -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? ; From 0c589061ad895c6a3e8d1914ddc29cd49659cdbf Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 9 Feb 2009 16:18:24 -0600 Subject: [PATCH 6/9] More docs for lazy lists, getting rid of lazy-map-with --- basis/lists/lazy/lazy-docs.factor | 55 ++++++++++++++++--- basis/lists/lazy/lazy-tests.factor | 2 +- basis/lists/lazy/lazy.factor | 7 +-- .../parser-combinators.factor | 8 +-- 4 files changed, 54 insertions(+), 18 deletions(-) diff --git a/basis/lists/lazy/lazy-docs.factor b/basis/lists/lazy/lazy-docs.factor index c402cdf15b..08fe3bbcba 100644 --- a/basis/lists/lazy/lazy-docs.factor +++ b/basis/lists/lazy/lazy-docs.factor @@ -1,11 +1,54 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. - USING: help.markup help.syntax sequences strings lists ; IN: lists.lazy +ABOUT: "lists.lazy" + +ARTICLE: "lists.lazy" "Lazy lists" +"The " { $vocab-link "lists.lazy" } " vocabulary implements lazy lists and standard operations to manipulate them." +{ $subsection { "lists.lazy" "construction" } } +{ $subsection { "lists.lazy" "manipulation" } } +{ $subsection { "lists.lazy" "combinators" } } +{ $subsection { "lists.lazy" "io" } } ; + +ARTICLE: { "lists.lazy" "combinators" } "Combinators for manipulating lazy lists" +"The following combinators create lazy lists from other lazy lists:" +{ $subsection lmap } +{ $subsection lfilter } +{ $subsection luntil } +{ $subsection lwhile } +{ $subsection lfrom-by } +{ $subsection lcomp } +{ $subsection lcomp* } ; + +ARTICLE: { "lists.lazy" "io" } "Lazy list I/O" +"Input from a stream can be read through a lazy list, using the following words:" +{ $subsection lcontents } +{ $subsection llines } ; + +ARTICLE: { "lists.lazy" "construction" } "Constructing lazy lists" +"Words for constructing lazy lists:" +{ $subsection lazy-cons } +{ $subsection 1lazy-list } +{ $subsection 2lazy-list } +{ $subsection 3lazy-list } +{ $subsection seq>list } +{ $subsection >list } +{ $subsection lfrom } ; + +ARTICLE: { "lists.lazy" "manipulation" } "Manipulating lazy lists" +"To make new lazy lists from old ones:" +{ $subsection } +{ $subsection lappend } +{ $subsection lconcat } +{ $subsection lcartesian-product } +{ $subsection lcartesian-product* } +{ $subsection lmerge } +{ $subsection ltake } ; + HELP: lazy-cons -{ $values { "car" { $quotation "( -- X )" } } { "cdr" { $quotation "( -- cons )" } } { "promise" "the resulting cons object" } } +{ $values { "car" { $quotation "( -- elt )" } } { "cdr" { $quotation "( -- cons )" } } { "promise" "the resulting cons object" } } { $description "Constructs a cons object for a lazy list from two quotations. The " { $snippet "car" } " quotation should return the head of the list, and the " { $snippet "cons" } " quotation the tail when called. When " { $link cons } " or " { $link cdr } " are called on the lazy-cons object then the appropriate quotation is called." } { $see-also cons car cdr nil nil? } ; @@ -28,16 +71,12 @@ HELP: { $description "Constructs a cons object that wraps an existing cons object. Requests for the car, cdr and nil? will be remembered after the first call, and the previous result returned on subsequent calls." } { $see-also cons car cdr nil nil? } ; -{ lazy-map lazy-map-with ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words +{ lazy-map ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words HELP: lazy-map { $values { "list" "a cons object" } { "quot" { $quotation "( obj -- X )" } } { "result" "resulting cons object" } } { $description "Perform a similar functionality to that of the " { $link map } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } ; -HELP: lazy-map-with -{ $values { "value" "an object" } { "list" "a cons object" } { "quot" { $quotation "( obj elt -- X )" } } { "result" "resulting cons object" } } -{ $description "Variant of " { $link lazy-map } " which pushes a retained object on each invocation of the quotation." } ; - HELP: ltake { $values { "n" "a non negative integer" } { "list" "a cons object" } { "result" "resulting cons object" } } { $description "Outputs a lazy list containing the first n items in the list. This is done a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } ; @@ -86,7 +125,7 @@ HELP: >list { $description "Convert the object into a list. Existing lists are passed through intact, sequences are converted using " { $link seq>list } " and other objects cause an error to be thrown." } { $see-also seq>list } ; -{ leach foldl lazy-map lazy-map-with ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words +{ leach foldl lazy-map ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words HELP: lconcat { $values { "list" "a list of lists" } { "result" "a list" } } diff --git a/basis/lists/lazy/lazy-tests.factor b/basis/lists/lazy/lazy-tests.factor index 03221841c1..f4e55cba19 100644 --- a/basis/lists/lazy/lazy-tests.factor +++ b/basis/lists/lazy/lazy-tests.factor @@ -24,7 +24,7 @@ IN: lists.lazy.tests ] unit-test [ { 4 5 6 } ] [ - 3 { 1 2 3 } >list [ + ] lazy-map-with list>array + 3 { 1 2 3 } >list [ + ] with lazy-map list>array ] unit-test [ [ ] lmap ] must-infer diff --git a/basis/lists/lazy/lazy.factor b/basis/lists/lazy/lazy.factor index 5adb7a8be5..d3b08a11fb 100644 --- a/basis/lists/lazy/lazy.factor +++ b/basis/lists/lazy/lazy.factor @@ -90,9 +90,6 @@ M: lazy-map cdr ( lazy-map -- cdr ) M: lazy-map nil? ( lazy-map -- bool ) cons>> nil? ; -: lazy-map-with ( value list quot -- result ) - with lazy-map ; - TUPLE: lazy-take n cons ; C: lazy-take @@ -301,14 +298,14 @@ M: lazy-concat nil? ( lazy-concat -- bool ) ] if ; : lcartesian-product ( list1 list2 -- result ) - swap [ swap [ 2array ] lazy-map-with ] lazy-map-with lconcat ; + swap [ swap [ 2array ] with lazy-map ] with lazy-map lconcat ; : lcartesian-product* ( lists -- result ) dup nil? [ drop nil ] [ [ car ] keep cdr [ car lcartesian-product ] keep cdr list>array swap [ - swap [ swap [ suffix ] lazy-map-with ] lazy-map-with lconcat + swap [ swap [ suffix ] with lazy-map ] with lazy-map lconcat ] reduce ] if ; diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor index 347ab638ff..99e8099f38 100755 --- a/extra/parser-combinators/parser-combinators.factor +++ b/extra/parser-combinators/parser-combinators.factor @@ -149,8 +149,8 @@ TUPLE: and-parser parsers ; [ parsed>> ] dip [ parsed>> 2array ] keep unparsed>> - ] lazy-map-with - ] lazy-map-with lconcat ; + ] with lazy-map + ] with lazy-map lconcat ; M: and-parser parse ( input parser -- list ) #! Parse 'input' by sequentially combining the @@ -173,7 +173,7 @@ M: or-parser parse ( input parser1 -- list ) #! of parser1 and parser2 being applied to the same #! input. This implements the choice parsing operator. parsers>> 0 swap seq>list - [ parse ] lazy-map-with lconcat ; + [ parse ] with lazy-map lconcat ; : trim-head-slice ( string -- string ) #! Return a new string without any leading whitespace @@ -218,7 +218,7 @@ M: apply-parser parse ( input parser -- result ) -rot parse [ [ parsed>> swap call ] keep unparsed>> - ] lazy-map-with ; + ] with lazy-map ; TUPLE: some-parser p1 ; From 5a90a0aae5aeb1646eebddb5d4231b534cd0b797 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 9 Feb 2009 16:41:23 -0600 Subject: [PATCH 7/9] Fixing bug in render-hidden --- basis/furnace/chloe-tags/chloe-tags.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor index 8003ab208b..562fe5a614 100644 --- a/basis/furnace/chloe-tags/chloe-tags.factor +++ b/basis/furnace/chloe-tags/chloe-tags.factor @@ -86,7 +86,7 @@ CHLOE: base hidden-form-field ; : render-hidden ( for -- xml ) - "," split [ hidden render>xml ] map ; + [ "," split [ hidden render>xml ] map ] [ f ] if* ; : compile-hidden-form-fields ( for -- ) '[ From 1279d6e8ea2fff622ca556c6f7fa4b266a923ca9 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 9 Feb 2009 16:46:02 -0600 Subject: [PATCH 8/9] Fixing furnace test/docs --- basis/furnace/furnace-tests.factor | 4 ++-- basis/furnace/utilities/utilities-docs.factor | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/furnace/furnace-tests.factor b/basis/furnace/furnace-tests.factor index f01260c68b..c591b848ec 100644 --- a/basis/furnace/furnace-tests.factor +++ b/basis/furnace/furnace-tests.factor @@ -1,7 +1,7 @@ IN: furnace.tests USING: http http.server.dispatchers http.server.responses http.server furnace furnace.utilities tools.test kernel -namespaces accessors io.streams.string urls ; +namespaces accessors io.streams.string urls xml.writer ; TUPLE: funny-dispatcher < dispatcher ; : funny-dispatcher new-dispatcher ; @@ -31,7 +31,7 @@ M: base-path-check-responder call-responder* ] unit-test [ "" ] -[ [ "&&&" "foo" hidden-form-field ] with-string-writer ] +[ "&&&" "foo" hidden-form-field xml>string ] unit-test [ f ] [ request [ referrer ] with-variable ] unit-test diff --git a/basis/furnace/utilities/utilities-docs.factor b/basis/furnace/utilities/utilities-docs.factor index db44963f6e..e7fdaf64d6 100644 --- a/basis/furnace/utilities/utilities-docs.factor +++ b/basis/furnace/utilities/utilities-docs.factor @@ -25,8 +25,8 @@ HELP: hidden-form-field { $notes "This word is used by session management, conversation scope and asides." } { $examples { $example - "USING: furnace.utilities io ;" - "\"bar\" \"foo\" hidden-form-field nl" + "USING: furnace.utilities io xml.writer ;" + "\"bar\" \"foo\" hidden-form-field write-xml nl" "" } } ; From efc88c5b696f070916cbdd835f01a175f08b3c01 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 9 Feb 2009 18:11:42 -0600 Subject: [PATCH 9/9] Remove nipd, 3nip, 4nip and tuckd from basis/shuffle --- basis/csv/csv-tests.factor | 4 ++-- basis/db/postgresql/lib/lib.factor | 6 +++--- basis/math/polynomials/polynomials.factor | 4 ++-- basis/regexp/traversal/traversal.factor | 5 ++--- basis/shuffle/shuffle-tests.factor | 2 -- basis/shuffle/shuffle.factor | 8 -------- extra/project-euler/002/002.factor | 4 ++-- extra/reports/noise/noise.factor | 3 --- 8 files changed, 11 insertions(+), 25 deletions(-) diff --git a/basis/csv/csv-tests.factor b/basis/csv/csv-tests.factor index 4d78c2af86..50bc3836f5 100644 --- a/basis/csv/csv-tests.factor +++ b/basis/csv/csv-tests.factor @@ -1,11 +1,11 @@ -USING: io.streams.string csv tools.test shuffle kernel strings +USING: io.streams.string csv tools.test kernel strings io.pathnames io.files.unique io.encodings.utf8 io.files io.directories ; IN: csv.tests ! I like to name my unit tests : named-unit-test ( name output input -- ) - nipd unit-test ; inline + unit-test drop ; inline ! tests nicked from the wikipedia csv article ! http://en.wikipedia.org/wiki/Comma-separated_values diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor index 05114a4deb..0d50d1ab2c 100644 --- a/basis/db/postgresql/lib/lib.factor +++ b/basis/db/postgresql/lib/lib.factor @@ -3,7 +3,7 @@ USING: arrays continuations db io kernel math namespaces quotations sequences db.postgresql.ffi alien alien.c-types db.types tools.walker ascii splitting math.parser combinators -libc shuffle calendar.format byte-arrays destructors prettyprint +libc calendar.format byte-arrays destructors prettyprint accessors strings serialize io.encodings.binary io.encodings.utf8 alien.strings io.streams.byte-array summary present urls specialized-arrays.uint specialized-arrays.alien db.private ; @@ -117,7 +117,7 @@ M: postgresql-result-null summary ( obj -- str ) : pq-get-string ( handle row column -- obj ) 3dup PQgetvalue utf8 alien>string - dup empty? [ [ pq-get-is-null f ] dip ? ] [ 3nip ] if ; + dup empty? [ [ pq-get-is-null f ] dip ? ] [ [ 3drop ] dip ] if ; : pq-get-number ( handle row column -- obj ) pq-get-string dup [ string>number ] when ; @@ -134,7 +134,7 @@ M: postgresql-malloc-destructor dispose ( obj -- ) : pq-get-blob ( handle row column -- obj/f ) [ PQgetvalue ] 3keep 3dup PQgetlength dup 0 > [ - 3nip + [ 3drop ] dip [ memory>byte-array >string 0 diff --git a/basis/math/polynomials/polynomials.factor b/basis/math/polynomials/polynomials.factor index 1ece3d915e..749bde3a10 100644 --- a/basis/math/polynomials/polynomials.factor +++ b/basis/math/polynomials/polynomials.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel make math math.order math.vectors sequences shuffle +USING: arrays kernel make math math.order math.vectors sequences splitting vectors ; IN: math.polynomials @@ -75,7 +75,7 @@ PRIVATE> PRIVATE> : pgcd ( p q -- a d ) - swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) [ >array ] bi@ ; + [ V{ 0 } clone V{ 1 } clone ] 2dip swap (pgcd) [ >array ] bi@ ; : pdiff ( p -- p' ) dup length v* { 0 } ?head drop ; diff --git a/basis/regexp/traversal/traversal.factor b/basis/regexp/traversal/traversal.factor index d8c25eda18..104a6c2ce1 100644 --- a/basis/regexp/traversal/traversal.factor +++ b/basis/regexp/traversal/traversal.factor @@ -2,8 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs combinators kernel math quotations sequences regexp.parser regexp.classes fry arrays -combinators.short-circuit regexp.utils prettyprint regexp.nfa -shuffle ; +combinators.short-circuit regexp.utils prettyprint regexp.nfa ; IN: regexp.traversal TUPLE: dfa-traverser @@ -170,7 +169,7 @@ M: capture-group-off flag-action ( dfa-traverser flag -- ) ] [ drop ] if ; : match-default ( transition from-state table -- to-state/f ) - nipd transitions>> at t swap at ; + [ drop ] 2dip transitions>> at t swap at ; : match-transition ( obj from-state dfa -- to-state/f ) { [ match-literal ] [ match-class ] [ match-default ] } 3|| ; diff --git a/basis/shuffle/shuffle-tests.factor b/basis/shuffle/shuffle-tests.factor index f190544e19..f8f83a9c08 100644 --- a/basis/shuffle/shuffle-tests.factor +++ b/basis/shuffle/shuffle-tests.factor @@ -1,5 +1,3 @@ USING: shuffle tools.test ; -[ 8 ] [ 5 6 7 8 3nip ] unit-test -[ 3 1 2 3 ] [ 1 2 3 tuckd ] unit-test [ 1 2 3 4 ] [ 3 4 1 2 2swap ] unit-test diff --git a/basis/shuffle/shuffle.factor b/basis/shuffle/shuffle.factor index b195e4abf9..10fb8b01dd 100644 --- a/basis/shuffle/shuffle.factor +++ b/basis/shuffle/shuffle.factor @@ -6,14 +6,6 @@ IN: shuffle : 2swap ( x y z t -- z t x y ) 2 2 mnswap ; inline -: nipd ( a b c -- b c ) rot drop ; inline - -: 3nip ( a b c d -- d ) 3 nnip ; inline - -: 4nip ( a b c d e -- e ) 4 nnip ; inline - : 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline : 4drop ( a b c d -- ) 3drop drop ; inline - -: tuckd ( x y z -- z x y z ) 2 ntuck ; inline diff --git a/extra/project-euler/002/002.factor b/extra/project-euler/002/002.factor index da20c874b5..9c462b6b2e 100644 --- a/extra/project-euler/002/002.factor +++ b/extra/project-euler/002/002.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007, 2008 Aaron Schaefer, Alexander Solovyov, Vishal Talwar. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math sequences shuffle ; +USING: kernel math sequences ; IN: project-euler.002 ! http://projecteuler.net/index.php?section=problems&id=2 @@ -41,7 +41,7 @@ PRIVATE> ! ------------------- : fib-upto* ( n -- seq ) - 0 1 [ pick over >= ] [ tuck + dup ] [ ] produce 3nip + 0 1 [ pick over >= ] [ tuck + dup ] [ ] produce [ 3drop ] dip but-last-slice { 0 1 } prepend ; : euler002a ( -- answer ) diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor index 3e47adac0b..89e00f88c5 100755 --- a/extra/reports/noise/noise.factor +++ b/extra/reports/noise/noise.factor @@ -25,7 +25,6 @@ IN: reports.noise { 3drop 1 } { 3dup 2 } { 3keep 3 } - { 3nip 4 } { 3slip 3 } { 4drop 2 } { 4dup 3 } @@ -50,7 +49,6 @@ IN: reports.noise { ndrop 2 } { ndup 3 } { nip 2 } - { nipd 3 } { nkeep 5 } { npick 6 } { nrot 5 } @@ -66,7 +64,6 @@ IN: reports.noise { swap 1 } { swapd 3 } { tuck 2 } - { tuckd 4 } { with 1/2 } { bi 1/2 }