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

basis/generalizations/generalizations.factor

@@ -1,68 +1,73 @@
-! Copyright (C) 2007, 2008 Chris Double, Doug Coleman, Eduardo
+! Copyright (C) 2007, 2008 Chris Double, Doug Coleman, Eduardo
-! Cavazos, Slava Pestov.
+! Cavazos, Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences sequences.private namespaces math
+USING: kernel sequences sequences.private namespaces math
-math.ranges combinators macros quotations fry arrays ;
+math.ranges combinators macros quotations fry arrays ;
-IN: generalizations
+IN: generalizations
-
+
-MACRO: nsequence ( n seq -- quot )
+MACRO: nsequence ( n seq -- quot )
-    [
+    [
-        [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
+        [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
-        [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce
+        [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce
-    ] keep
+    ] keep
-    '[ @ _ like ] ;
+    '[ @ _ like ] ;
-
+
-MACRO: narray ( n -- quot )
+MACRO: narray ( n -- quot )
-    '[ _ { } nsequence ] ;
+    '[ _ { } nsequence ] ;
-
+
-MACRO: firstn ( n -- )
+MACRO: firstn ( n -- )
-    dup zero? [ drop [ drop ] ] [
+    dup zero? [ drop [ drop ] ] [
-        [ [ '[ [ _ ] dip nth-unsafe ] ] map ]
+        [ [ '[ [ _ ] dip nth-unsafe ] ] map ]
-        [ 1- '[ [ _ ] dip bounds-check 2drop ] ]
+        [ 1- '[ [ _ ] dip bounds-check 2drop ] ]
-        bi prefix '[ _ cleave ]
+        bi prefix '[ _ cleave ]
-    ] if ;
+    ] if ;
-
+
-MACRO: npick ( n -- )
+: npick-wrap ( quot n -- quot )
-    1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ;
+    dup 1 >
-
+        [ swap '[ _ dip swap ] swap 1 - npick-wrap ]
-MACRO: ndup ( n -- )
+        [ drop ]
-    dup '[ _ npick ] n*quot ;
+    if ;
-
+
-MACRO: nrot ( n -- )
+MACRO: npick ( n -- quot ) [ dup ] swap npick-wrap ;
-    1- dup saver swap [ r> swap ] n*quot append ;
+
-
+MACRO: ndup ( n -- )
-MACRO: -nrot ( n -- )
+    dup '[ _ npick ] n*quot ;
-    1- dup [ swap >r ] n*quot swap restorer append ;
+
-
+MACRO: nrot ( n -- )
-MACRO: ndrop ( n -- )
+    1- dup saver swap [ r> swap ] n*quot append ;
-    [ drop ] n*quot ;
+
-
+MACRO: -nrot ( n -- )
-: nnip ( n -- )
+    1- dup [ swap >r ] n*quot swap restorer append ;
-    swap >r ndrop r> ; inline
+
-
+MACRO: ndrop ( n -- )
-MACRO: ntuck ( n -- )
+    [ drop ] n*quot ;
-    2 + [ dupd -nrot ] curry ;
+
-
+: nnip ( n -- )
-MACRO: nrev ( n -- quot )
+    swap >r ndrop r> ; inline
-    1 [a,b] [ ] [ '[ @ _ -nrot ] ] reduce ;
+
-
+MACRO: ntuck ( n -- )
-MACRO: ndip ( quot n -- )
+    2 + [ dupd -nrot ] curry ;
-    dup saver -rot restorer 3append ;
+
-
+MACRO: nrev ( n -- quot )
-MACRO: nslip ( n -- )
+    1 [a,b] [ ] [ '[ @ _ -nrot ] ] reduce ;
-    dup saver [ call ] rot restorer 3append ;
+
-
+MACRO: ndip ( quot n -- )
-MACRO: nkeep ( n -- )
+    dup saver -rot restorer 3append ;
-    [ ] [ 1+ ] [ ] tri
+
-    '[ [ _ ndup ] dip _ -nrot _ nslip ] ;
+MACRO: nslip ( n -- )
-
+    dup saver [ call ] rot restorer 3append ;
-MACRO: ncurry ( n -- )
+
-    [ curry ] n*quot ;
+MACRO: nkeep ( n -- )
-
+    [ ] [ 1+ ] [ ] tri
-MACRO: nwith ( n -- )
+    '[ [ _ ndup ] dip _ -nrot _ nslip ] ;
-    [ with ] n*quot ;
+
-
+MACRO: ncurry ( n -- )
-MACRO: napply ( n -- )
+    [ curry ] n*quot ;
-    2 [a,b]
+
-    [ [ 1- ] keep '[ _ ntuck _ nslip ] ]
+MACRO: nwith ( n -- )
-    map concat >quotation [ call ] append ;
+    [ with ] n*quot ;
+
+MACRO: napply ( n -- )
+    2 [a,b]
+    [ [ 1- ] keep '[ _ ntuck _ nslip ] ]
+    map concat >quotation [ call ] append ;

extra/webapps/wee-url/wee-url.factor

@@ -4,7 +4,8 @@
 USING: math.ranges sequences random accessors combinators.lib
 kernel namespaces fry db.types db.tuples urls validators
 html.components html.forms http http.server.dispatchers furnace
-furnace.actions furnace.boilerplate furnace.redirection ;
+furnace.actions furnace.boilerplate furnace.redirection 
+furnace.utilities ;
 IN: webapps.wee-url
 
 TUPLE: wee-url < dispatcher ;