From 34b0fad7046228b53a89133623c11b05b2f274fc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 13 Jul 2008 19:50:37 -0500 Subject: [PATCH] Move firstn to generalizations, clean it up a bit --- .../generalizations-docs.factor | 19 ++++++++++++++++--- .../generalizations-tests.factor | 4 ++++ extra/generalizations/generalizations.factor | 16 +++++++++++----- extra/geo-ip/geo-ip.factor | 4 +++- extra/namespaces/lib/lib.factor | 2 +- extra/sequences/lib/lib-tests.factor | 5 ----- extra/sequences/lib/lib.factor | 5 ----- extra/usa-cities/usa-cities.factor | 2 +- 8 files changed, 36 insertions(+), 21 deletions(-) diff --git a/extra/generalizations/generalizations-docs.factor b/extra/generalizations/generalizations-docs.factor index d2af13a9c3..a702f452da 100755 --- a/extra/generalizations/generalizations-docs.factor +++ b/extra/generalizations/generalizations-docs.factor @@ -1,9 +1,21 @@ -! Copyright (C) 2007 Chris Double. -! See http://factorcode.org/license.txt for BSD license. USING: help.syntax help.markup kernel sequences quotations -math ; +math arrays ; IN: generalizations +HELP: narray +{ $values { "n" integer } } +{ $description "A generalization of " { $link 1array } ", " +{ $link 2array } ", " { $link 3array } " and " { $link 4array } " " +"that constructs an array from the top " { $snippet "n" } " elements of the stack." +} ; + +HELP: firstn +{ $values { "n" integer } } +{ $description "A generalization of " { $link first } ", " +{ $link first2 } ", " { $link first3 } " and " { $link first4 } " " +"that pushes the first " { $snippet "n" } " elements of a sequence on the stack." +} ; + HELP: npick { $values { "n" integer } } { $description "A generalization of " { $link dup } ", " @@ -119,6 +131,7 @@ ARTICLE: "generalizations" "Generalized shuffle words and combinators" "macros where the arity of the input quotations depends on an " "input parameter." { $subsection narray } +{ $subsection firstn } { $subsection ndup } { $subsection npick } { $subsection nrot } diff --git a/extra/generalizations/generalizations-tests.factor b/extra/generalizations/generalizations-tests.factor index af010e2026..75985c9368 100755 --- a/extra/generalizations/generalizations-tests.factor +++ b/extra/generalizations/generalizations-tests.factor @@ -32,3 +32,7 @@ IN: generalizations.tests [ [ dup 2^ 2array ] 5 napply ] must-infer [ { "xyc" "xyd" } ] [ "x" "y" { "c" "d" } [ 3append ] 2 nwith map ] unit-test + +[ 1 2 3 4 ] [ { 1 2 3 4 } 4 firstn ] unit-test +[ ] [ { } 0 firstn ] unit-test +[ "a" ] [ { "a" } 1 firstn ] unit-test diff --git a/extra/generalizations/generalizations.factor b/extra/generalizations/generalizations.factor index 6cbb13518e..99fa8795ae 100755 --- a/extra/generalizations/generalizations.factor +++ b/extra/generalizations/generalizations.factor @@ -1,14 +1,20 @@ -! Copyright (C) 2007, 2008 Chris Double, Doug Coleman. +! Copyright (C) 2007, 2008 Chris Double, Doug Coleman, Eduardo +! Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences sequences.private namespaces math math.ranges combinators macros quotations fry locals arrays ; IN: generalizations MACRO: narray ( n -- quot ) - dup [ f ] curry - swap [ - [ swap [ set-nth-unsafe ] keep ] curry - ] map concat append ; + [ ] [ '[ , f ] ] bi + [ '[ @ [ , swap set-nth-unsafe ] keep ] ] reduce ; + +MACRO: firstn ( n -- ) + dup zero? [ drop [ drop ] ] [ + [ [ '[ , _ nth-unsafe ] ] map ] + [ 1- '[ , _ bounds-check 2drop ] ] + bi prefix '[ , cleave ] + ] if ; MACRO: npick ( n -- ) 1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ; diff --git a/extra/geo-ip/geo-ip.factor b/extra/geo-ip/geo-ip.factor index 62cc659394..aee53f24f5 100644 --- a/extra/geo-ip/geo-ip.factor +++ b/extra/geo-ip/geo-ip.factor @@ -1,5 +1,7 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences io.files io.launcher io.encodings.ascii -io.streams.string http.client sequences.lib combinators +io.streams.string http.client generalizations combinators math.parser math.vectors math.intervals interval-maps memoize csv accessors assocs strings math splitting grouping arrays ; IN: geo-ip diff --git a/extra/namespaces/lib/lib.factor b/extra/namespaces/lib/lib.factor index 9ad8978bf3..4da3935727 100755 --- a/extra/namespaces/lib/lib.factor +++ b/extra/namespaces/lib/lib.factor @@ -2,7 +2,7 @@ ! USING: kernel quotations namespaces sequences assocs.lib ; USING: kernel namespaces namespaces.private quotations sequences - assocs.lib math.parser math sequences.lib locals mirrors ; + assocs.lib math.parser math generalizations locals mirrors ; IN: namespaces.lib diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor index 4b8114f67f..3744a7217a 100755 --- a/extra/sequences/lib/lib-tests.factor +++ b/extra/sequences/lib/lib-tests.factor @@ -67,11 +67,6 @@ IN: sequences.lib.tests { 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test [ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test -[ 1 2 3 4 ] [ { 1 2 3 4 } 4 firstn ] unit-test - -[ ] [ { } 0 firstn ] unit-test -[ "a" ] [ { "a" } 1 firstn ] unit-test - [ "empty" ] [ { } [ "not empty" ] [ "empty" ] if-seq ] unit-test [ { 1 } "not empty" ] [ { 1 } [ "not empty" ] [ "empty" ] if-seq ] unit-test diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 0049320b94..9f8e5be3d5 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -20,11 +20,6 @@ IN: sequences.lib : map-with2 ( obj obj list quot -- newseq ) 2 map-withn ; inline -MACRO: firstn ( n -- ) - [ [ swap nth ] curry [ keep ] curry ] map - concat >quotation - [ drop ] compose ; - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : each-percent ( seq quot -- ) diff --git a/extra/usa-cities/usa-cities.factor b/extra/usa-cities/usa-cities.factor index fb392542f3..968bf9d053 100644 --- a/extra/usa-cities/usa-cities.factor +++ b/extra/usa-cities/usa-cities.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io.files io.encodings.ascii sequences sequences.lib +USING: io.files io.encodings.ascii sequences generalizations math.parser combinators kernel memoize csv symbols summary words accessors math.order sorting ; IN: usa-cities -- 2.34.1