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

Makefile

@@ -3,7 +3,7 @@ AR = ar
 LD = ld
 
 EXECUTABLE = factor
-VERSION = 0.91
+VERSION = 0.92
 
 IMAGE = factor.image
 BUNDLE = Factor.app

core/alien/c-types/c-types.factor

@@ -199,8 +199,8 @@ M: long-long-type box-return ( type -- )
     zero? not ;
 
 : >c-array ( seq type word -- )
-    >r >r dup length dup r> <c-array> dup -roll r>
+    [ [ dup length ] dip <c-array> ] dip
-    [ execute ] 2curry 2each ; inline
+    [ [ execute ] 2curry each-index ] 2keep drop ; inline
 
 : >c-array-quot ( type vocab -- quot )
     dupd set-nth-word [ >c-array ] 2curry ;

core/bootstrap/image/image.factor

@@ -505,6 +505,8 @@ M: quotation '
         jit-r>-word
         jit-swap
         jit-swap-word
+        jit-over
+        jit-over-word
         jit-fixnum-fast
         jit-fixnum-fast-word
         jit-fixnum>=

core/bootstrap/primitives.factor

@@ -512,7 +512,7 @@ tuple
     { "unimplemented" "kernel.private" }
     { "gc-reset" "memory" }
 }
-dup length [ >r first2 r> make-primitive ] 2each
+[ >r first2 r> make-primitive ] each-index
 
 ! Bump build number
 "build" "kernel" create build 1+ 1quotation define

core/debugger/debugger.factor

@@ -52,7 +52,7 @@ M: string error. print ;
         nl
         "The following restarts are available:" print
         nl
-        dup length [ restart. ] 2each
+        [ restart. ] each-index
     ] if ;
 
 : print-error ( error -- )

core/kernel/kernel.factor

@@ -64,8 +64,7 @@ DEFER: if
 
 : 2keep ( x y quot -- x y ) 2over 2slip ; inline
 
-: 3keep ( x y z quot -- x y z )
+: 3keep ( x y z quot -- x y z ) >r 3dup r> -roll 3slip ; inline
-    >r 3dup r> -roll 3slip ; inline
 
 ! Cleavers
 : bi ( x p q -- )

core/sequences/sequences-docs.factor

@@ -43,8 +43,8 @@ ARTICLE: "sequences-integers" "Integer sequences and counted loops"
 $nl
 "For example, the " { $link each } " combinator, given an integer, simply calls a quotation that number of times, pushing a counter on each iteration that ranges from 0 up to that integer:"
 { $example "3 [ . ] each" "0\n1\n2" }
-"A common idiom is to iterate over a sequence, while also maintaining a loop counter. This can be done using " { $link 2each } ":"
+"A common idiom is to iterate over a sequence, while also maintaining a loop counter. This can be done using " { $link each-index } ", " { $link map-index } " and " { $link reduce-index } "."
-{ $example "{ \"a\" \"b\" \"c\" } dup length [\n    \"Index: \" write . \"Element: \" write .\n] 2each" "Index: 0\nElement: \"a\"\nIndex: 1\nElement: \"b\"\nIndex: 2\nElement: \"c\"" }
+$nl
 "Combinators that produce new sequences, such as " { $link map } ", will output an array if the input is an integer." ;
 
 ARTICLE: "sequences-access" "Accessing sequence elements"

core/sequences/sequences.factor

@@ -426,6 +426,18 @@ PRIVATE>
 : follow ( obj quot -- seq )
     >r [ dup ] r> [ keep ] curry [ ] unfold nip ; inline
 
+: prepare-index ( seq quot -- seq n quot )
+    >r dup length r> ; inline
+
+: each-index ( seq quot -- )
+    prepare-index 2each ; inline
+
+: map-index ( seq quot -- )
+    prepare-index 2map ; inline
+
+: reduce-index ( seq identity quot -- )
+    swapd each-index ; inline
+
 : index ( obj seq -- n )
     [ = ] with find drop ;
 

extra/arrays/lib/authors.txt

@@ -1 +0,0 @@
-Eduardo Cavazos

extra/arrays/lib/lib.factor

@@ -1,10 +0,0 @@
-
-USING: kernel arrays sequences sequences.private macros ;
-
-IN: arrays.lib
-
-MACRO: narray ( n -- quot )
-    dup [ f <array> ] curry
-    swap <reversed> [
-        [ swap [ set-nth-unsafe ] keep ] curry
-    ] map concat append ;

extra/arrays/lib/summary.txt

@@ -1 +0,0 @@
-Non-core array words

extra/arrays/lib/tags.txt

@@ -1 +0,0 @@
-collections

extra/bake/bake.factor

@@ -1,7 +1,7 @@
 
 USING: kernel parser namespaces sequences quotations arrays vectors splitting
        words math
-       macros arrays.lib combinators.lib combinators.conditional newfx ;
+       macros generalizations combinators.lib combinators.conditional newfx ;
 
 IN: bake
 

extra/bake/fry/fry-tests.factor

@@ -1,6 +1,6 @@
 
 USING: tools.test math prettyprint kernel io arrays vectors sequences
-       arrays.lib bake bake.fry ;
+       generalizations bake bake.fry ;
 
 IN: bake.fry.tests
 

extra/bitfields/bitfields.factor

@@ -1,6 +1,6 @@
 USING: parser lexer kernel math sequences namespaces assocs summary
 words splitting math.parser arrays sequences.next mirrors
-shuffle compiler.units ;
+generalizations compiler.units ;
 IN: bitfields
 
 ! Example:

extra/calendar/calendar.factor

@@ -303,41 +303,25 @@ GENERIC: days-in-year ( obj -- n )
 M: integer days-in-year ( year -- n ) leap-year? 366 365 ? ;
 M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ;
 
-GENERIC: days-in-month ( obj -- n )
+: (days-in-month) ( year month -- n )
+    dup 2 = [ drop leap-year? 29 28 ? ] [ nip day-counts nth ] if ;
 
-M: array days-in-month ( obj -- n )
+: days-in-month ( timestamp -- n )
-    first2 dup 2 = [
+    >date< drop (days-in-month) ;
-        drop leap-year? 29 28 ?
-    ] [
-        nip day-counts nth
-    ] if ;
 
-M: timestamp days-in-month ( timestamp -- n )
+: day-of-week ( timestamp -- n )
-    >date< drop 2array days-in-month ;
-
-GENERIC: day-of-week ( obj -- n )
-
-M: timestamp day-of-week ( timestamp -- n )
     >date< zeller-congruence ;
 
-M: array day-of-week ( array -- n )
+:: (day-of-year) ( year month day -- n )
-    first3 zeller-congruence ;
+    day-counts month head-slice sum day +
-
+    year leap-year? [
-GENERIC: day-of-year ( obj -- n )
+        year month day <date>
-
+        year 3 1 <date>
-M: array day-of-year ( array -- n )
-    first3
-    3dup day-counts rot head-slice sum +
-    swap leap-year? [
-        -roll
-        pick 3 1 <date> >r <date> r>
         after=? [ 1+ ] when
-    ] [
+    ] when ;
-        >r 3drop r>
-    ] if ;
 
-M: timestamp day-of-year ( timestamp -- n )
+: day-of-year ( timestamp -- n )
-    >date< 3array day-of-year ;
+    >date< (day-of-year) ;
 
 : day-offset ( timestamp m -- timestamp n )
     over day-of-week - ; inline

extra/calendar/format/format.factor

@@ -57,9 +57,9 @@ GENERIC: month. ( obj -- )
 
 M: array month. ( pair -- )
     first2
-    [ month-names nth write bl number>string print ] 2keep
+    [ month-names nth write bl number>string print ]
-    [ 1 zeller-congruence ] 2keep
+    [ 1 zeller-congruence ]
-    2array days-in-month day-abbreviations2 " " join print
+    [ (days-in-month) day-abbreviations2 " " join print ] 2tri
     over "   " <repetition> concat write
     [
         [ 1+ day. ] keep

extra/combinators/cleave/cleave.factor

@@ -1,6 +1,6 @@
 
 USING: kernel combinators words quotations arrays sequences locals macros
-       shuffle combinators.lib arrays.lib fry ;
+       shuffle combinators.lib generalizations fry ;
 
 IN: combinators.cleave
 

extra/combinators/lib/lib-docs.factor

@@ -11,46 +11,3 @@ HELP: generate
     "[ 20 random-prime ] [ 4 mod 3 = ] generate ."
     "526367"
 } ;
-
-HELP: ndip
-{ $values { "quot" quotation } { "n" number } }
-{ $description "A generalisation of " { $link dip } " that can work " 
-"for any stack depth. The quotation will be called with a stack that "
-"has 'n' items removed first. The 'n' items are then put back on the "
-"stack. The quotation can consume and produce any number of items."
-} 
-{ $examples
-  { $example "USING: combinators.lib kernel prettyprint ;" "1 2 [ dup ] 1 ndip .s" "1\n1\n2" }
-  { $example "USING: combinators.lib kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip .s" "2\n3" }
-}
-{ $see-also dip 2dip } ;
-
-HELP: nslip
-{ $values { "n" number } }
-{ $description "A generalisation of " { $link slip } " that can work " 
-"for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
-"removed from the stack, the quotation called, and the items restored."
-} 
-{ $examples
-  { $example "USING: combinators.lib prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s" "99\n1\n2\n3\n4\n5" }
-}
-{ $see-also slip nkeep } ;
-
-HELP: nkeep
-{ $values { "quot" quotation } { "n" number } }
-{ $description "A generalisation of " { $link keep } " that can work " 
-"for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
-"saved, the quotation called, and the items restored."
-} 
-{ $examples
-  { $example "USING: combinators.lib kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s" "99\n1\n2\n3\n4\n5" }
-}
-{ $see-also keep nslip } ;
-
-! HELP: &&
-! { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } }
-! { $description "Calls each quotation in turn; outputs " { $link f } " if one of the quotations output " { $link f } ", otherwise outputs " { $link t } ". As soon as a quotation outputs " { $link f } ", evaluation stops and subsequent quotations are not called." } ;
-
-! HELP: ||
-! { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } }
-! { $description "Calls each quotation in turn; outputs " { $link t } " if one of the quotations output " { $link t } ", otherwise outputs " { $link f } ". As soon as a quotation outputs " { $link t } ", evaluation stops and subsequent quotations are not called." } ;

extra/combinators/lib/lib-tests.factor

@@ -5,16 +5,6 @@ IN: combinators.lib.tests
 [ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test
 [ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test
 
-[ [ 99 ] 1 2 3 4 5 5 nslip ] must-infer
-{ 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test
-[ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer
-{ 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test
-[ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test
-[ { 1 2 } { 2 4 } { 3 8 } { 4 16 } { 5 32 } ] [ 1 2 3 4 5 [ dup 2^ 2array ] 5 napply ] unit-test
-[ [ dup 2^ 2array ] 5 napply ] must-infer
-
-[ { "xyc" "xyd" } ] [ "x" "y" { "c" "d" } [ 3append ] 2 nwith map ] unit-test
-
 [ { "foo" "xbarx" } ]
 [
     { "oof" "bar" } { [ reverse ] [ "x" swap "x" 3append ] } parallel-call

extra/combinators/lib/lib.factor

@@ -4,7 +4,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel combinators fry namespaces quotations hashtables
 sequences assocs arrays inference effects math math.ranges
-arrays.lib shuffle macros continuations locals ;
+generalizations macros continuations locals ;
 
 IN: combinators.lib
 
@@ -12,30 +12,10 @@ IN: combinators.lib
 ! Generalized versions of core combinators
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-MACRO: ndip ( quot n -- ) dup saver -rot restorer 3append ;
-
-MACRO: nslip ( n -- ) dup saver [ call ] rot restorer 3append ;
-
 : 4slip ( quot a b c d -- a b c d ) 4 nslip ; inline
 
-MACRO: nkeep ( n -- )
-  [ ] [ 1+ ] [ ] tri
-  '[ [ , ndup ] dip , -nrot , nslip ] ;
-
 : 4keep ( w x y z quot -- w x y z ) 4 nkeep ; inline 
 
-MACRO: ncurry ( n -- ) [ curry ] n*quot ;
-
-MACRO:: nwith ( quot n -- )
-  [let | n' [ n 1+ ] |
-    [ n' -nrot [ n' nrot quot call ] n ncurry ] ] ;
-
-MACRO: napply ( n -- )
-  2 [a,b]
-  [ [ 1- ] [ ] bi
-    '[ , ntuck , nslip ] ]
-  map concat >quotation [ call ] append ;
-
 : 2with ( param1 param2 obj quot -- obj curry )
     with with ; inline
 

extra/combinators/short-circuit/short-circuit.factor

@@ -1,6 +1,6 @@
 
 USING: kernel combinators quotations arrays sequences assocs
-       locals shuffle macros fry ;
+       locals generalizations macros fry ;
 
 IN: combinators.short-circuit
 

extra/descriptive/descriptive.factor

@@ -1,6 +1,6 @@
 USING: words kernel sequences combinators.lib locals
 locals.private accessors parser namespaces continuations
-summary definitions arrays.lib arrays ;
+summary definitions generalizations arrays ;
 IN: descriptive
 
 ERROR: descriptive-error args underlying word ;

extra/generalizations/generalizations-docs.factor

@@ -0,0 +1,136 @@
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup kernel sequences quotations
+math ;
+IN: generalizations
+
+HELP: npick
+{ $values { "n" integer } }
+{ $description "A generalization of " { $link dup } ", "
+{ $link over } " and " { $link pick } " that can work "
+"for any stack depth. The nth item down the stack will be copied and "
+"placed on the top of the stack."
+}
+{ $examples
+  { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 npick .s" "1\n2\n3\n4\n1" }
+}
+{ $see-also dup over pick } ;
+
+HELP: ndup
+{ $values { "n" integer } }
+{ $description "A generalization of " { $link dup } ", "
+{ $link 2dup } " and " { $link 3dup } " that can work "
+"for any number of items. The n topmost items on the stack will be copied and "
+"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" }
+}
+{ $see-also dup 2dup 3dup } ;
+
+HELP: nnip
+{ $values { "n" integer } }
+{ $description "A generalization of " { $link nip } " and " { $link 2nip }
+" that can work "
+"for any number of items."
+}
+{ $examples
+  { $example "USING: prettyprint generalizations ;" "1 2 3 4 3 nnip .s" "4" }
+}
+{ $see-also nip 2nip } ;
+
+HELP: ndrop
+{ $values { "n" integer } }
+{ $description "A generalization of " { $link drop }
+" that can work "
+"for any number of items."
+}
+{ $examples
+  { $example "USING: prettyprint generalizations ;" "1 2 3 4 3 ndrop .s" "1" }
+}
+{ $see-also drop 2drop 3drop } ;
+
+HELP: nrot
+{ $values { "n" integer } }
+{ $description "A generalization of " { $link rot } " that works for any "
+"number of items on the stack. "
+}
+{ $examples
+  { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 nrot .s" "2\n3\n4\n1" }
+}
+{ $see-also rot -nrot } ;
+
+HELP: -nrot
+{ $values { "n" integer } }
+{ $description "A generalization of " { $link -rot } " that works for any "
+"number of items on the stack. "
+}
+{ $examples
+  { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 -nrot .s" "4\n1\n2\n3" }
+}
+{ $see-also rot nrot } ;
+
+HELP: nrev
+{ $values { "n" integer } }
+{ $description "A generalization of " { $link spin } " that reverses any number of items at the top of the stack."
+}
+{ $examples
+  { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 nrev .s" "4\n3\n2\n1" }
+}
+{ $see-also rot nrot } ;
+
+HELP: ndip
+{ $values { "quot" quotation } { "n" number } }
+{ $description "A generalization of " { $link dip } " that can work " 
+"for any stack depth. The quotation will be called with a stack that "
+"has 'n' items removed first. The 'n' items are then put back on the "
+"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" }
+}
+{ $see-also dip 2dip } ;
+
+HELP: nslip
+{ $values { "n" number } }
+{ $description "A generalization of " { $link slip } " that can work " 
+"for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
+"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" }
+}
+{ $see-also slip nkeep } ;
+
+HELP: nkeep
+{ $values { "quot" quotation } { "n" number } }
+{ $description "A generalization of " { $link keep } " that can work " 
+"for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
+"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" }
+}
+{ $see-also keep nslip } ;
+
+ARTICLE: "generalizations" "Generalized shuffle words and combinators"
+"A number of stack shuffling words and combinators for use in "
+"macros where the arity of the input quotations depends on an "
+"input parameter."
+{ $subsection narray }
+{ $subsection ndup }
+{ $subsection npick }
+{ $subsection nrot }
+{ $subsection -nrot }
+{ $subsection nnip }
+{ $subsection ndrop }
+{ $subsection nrev }
+{ $subsection ndip }
+{ $subsection nslip }
+{ $subsection nkeep }
+{ $subsection ncurry } 
+{ $subsection nwith } 
+{ $subsection napply } ;
+
+ABOUT: "generalizations"

extra/generalizations/generalizations-tests.factor

@@ -0,0 +1,34 @@
+USING: tools.test generalizations kernel math arrays sequences ;
+IN: generalizations.tests
+
+{ 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test
+{ 1 2 3 4 2 } [ 1 2 3 4 3 npick ] unit-test
+{ 1 2 3 4 3 } [ 1 2 3 4 2 npick ] unit-test
+{ 1 2 3 4 4 } [ 1 2 3 4 1 npick ] unit-test
+[ 1 1 ndup ] must-infer
+{ 1 1 } [ 1 1 ndup ] unit-test
+{ 1 2 1 2 } [ 1 2 2 ndup ] unit-test
+{ 1 2 3 1 2 3 } [ 1 2 3 3 ndup ] unit-test
+{ 1 2 3 4 1 2 3 4 } [ 1 2 3 4 4 ndup ] unit-test
+[ 1 2 2 nrot ] must-infer
+{ 2 1 } [ 1 2 2 nrot ] unit-test
+{ 2 3 1 } [ 1 2 3 3 nrot ] unit-test
+{ 2 3 4 1 } [ 1 2 3 4 4 nrot ] unit-test
+[ 1 2 2 -nrot ] must-infer
+{ 2 1 } [ 1 2 2 -nrot ] unit-test
+{ 3 1 2 } [ 1 2 3 3 -nrot ] unit-test
+{ 4 1 2 3 } [ 1 2 3 4 4 -nrot ] unit-test
+[ 1 2 3 4 3 nnip ] must-infer
+{ 4 } [ 1 2 3 4 3 nnip ] unit-test
+[ 1 2 3 4 4 ndrop ] must-infer
+{ 0 } [ 0 1 2 3 4 4 ndrop ] unit-test
+
+[ [ 99 ] 1 2 3 4 5 5 nslip ] must-infer
+{ 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test
+[ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer
+{ 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test
+[ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test
+[ { 1 2 } { 2 4 } { 3 8 } { 4 16 } { 5 32 } ] [ 1 2 3 4 5 [ dup 2^ 2array ] 5 napply ] unit-test
+[ [ dup 2^ 2array ] 5 napply ] must-infer
+
+[ { "xyc" "xyd" } ] [ "x" "y" { "c" "d" } [ 3append ] 2 nwith map ] unit-test

extra/generalizations/generalizations.factor

@@ -0,0 +1,56 @@
+! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
+! 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 <array> ] curry
+    swap <reversed> [
+        [ swap [ set-nth-unsafe ] keep ] curry
+    ] map concat append ;
+
+MACRO: npick ( n -- )
+    1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ;
+
+MACRO: ndup ( n -- )
+    dup '[ , npick ] n*quot ;
+
+MACRO: nrot ( n -- )
+    1- dup saver swap [ r> swap ] n*quot append ;
+
+MACRO: -nrot ( n -- )
+    1- dup [ swap >r ] n*quot swap restorer append ;
+
+MACRO: ndrop ( n -- )
+    [ drop ] n*quot ;
+
+: nnip ( n -- )
+    swap >r ndrop r> ; inline
+
+MACRO: ntuck ( n -- )
+    2 + [ dupd -nrot ] curry ;
+
+MACRO: nrev ( n -- quot )
+    1 [a,b] [ '[ , -nrot ] ] map concat ;
+
+MACRO: ndip ( quot n -- )
+    dup saver -rot restorer 3append ;
+
+MACRO: nslip ( n -- )
+    dup saver [ call ] rot restorer 3append ;
+
+MACRO: nkeep ( n -- )
+    [ ] [ 1+ ] [ ] tri
+    '[ [ , ndup ] dip , -nrot , nslip ] ;
+
+MACRO: ncurry ( n -- ) [ curry ] n*quot ;
+
+MACRO:: nwith ( quot n -- )
+    [let | n' [ n 1+ ] |
+        [ n' -nrot [ n' nrot quot call ] n ncurry ] ] ;
+
+MACRO: napply ( n -- )
+    2 [a,b]
+    [ [ 1- ] keep '[ , ntuck , nslip ] ]
+    map concat >quotation [ call ] append ;

extra/html/parser/analyzer/analyzer.factor

@@ -1,6 +1,6 @@
 USING: assocs html.parser kernel math sequences strings ascii
-arrays shuffle unicode.case namespaces splitting http
+arrays generalizations shuffle unicode.case namespaces splitting
-sequences.lib accessors io combinators http.client urls ;
+http sequences.lib accessors io combinators http.client urls ;
 IN: html.parser.analyzer
 
 TUPLE: link attributes clickable ;

extra/inverse/inverse.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2007, 2008 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel words summary slots quotations
-sequences assocs math arrays inference effects shuffle
+sequences assocs math arrays inference effects generalizations
 continuations debugger classes.tuple namespaces vectors
 bit-arrays byte-arrays strings sbufs math.functions macros
-sequences.private combinators mirrors combinators.lib
+sequences.private combinators mirrors
 combinators.short-circuit ;
 IN: inverse
 

extra/io/windows/privileges/privileges.factor

@@ -1,4 +1,5 @@
-USING: io.backend kernel continuations sequences ;
+USING: io.backend kernel continuations sequences
+system vocabs.loader combinators ;
 IN: io.windows.privileges
 
 HOOK: set-privilege io-backend ( name ? -- ) inline
@@ -6,3 +7,8 @@ HOOK: set-privilege io-backend ( name ? -- ) inline
 : with-privileges ( seq quot -- )
     over [ [ t set-privilege ] each ] curry compose
     swap [ [ f set-privilege ] each ] curry [ ] cleanup ; inline
+
+{
+    { [ os winnt? ] [ "io.windows.nt.privileges" require ] }
+    { [ os wince? ] [ "io.windows.ce.privileges" require ] }
+} cond

extra/koszul/koszul.factor

@@ -257,11 +257,11 @@ DEFER: (d)
     [ laplacian-kernel ] graded-laplacian ;
 
 : graded-basis. ( seq -- )
-    dup length [
+    [
         "=== Degree " write pprint
         ": dimension " write dup length .
         [ alt. ] each
-    ] 2each ;
+    ] each-index ;
 
 : bigraded-triple ( u-deg z-deg bigraded-basis -- triple )
     #! d: C(u,z) ---> C(u+2,z-1)
@@ -289,11 +289,11 @@ DEFER: (d)
     [ laplacian-kernel ] bigraded-laplacian ;
 
 : bigraded-basis. ( seq -- )
-    dup length [
+    [
         "=== U-degree " write .
-        dup length [
+        [
             "  === Z-degree " write pprint
             ": dimension " write dup length .
             [ "  " write alt. ] each
-        ] 2each
+        ] each-index
-    ] 2each ;
+    ] each-index ;

extra/logging/logging.factor

@@ -3,7 +3,7 @@
 USING: logging.server sequences namespaces concurrency.messaging
 words kernel arrays shuffle tools.annotations
 prettyprint.config prettyprint debugger io.streams.string
-splitting continuations effects arrays.lib parser strings
+splitting continuations effects generalizations parser strings
 quotations fry symbols accessors ;
 IN: logging
 

extra/math/blas/matrices/matrices.factor

@@ -2,7 +2,8 @@ USING: accessors alien alien.c-types arrays byte-arrays combinators
 combinators.lib combinators.short-circuit fry kernel locals macros
 math math.blas.cblas math.blas.vectors math.blas.vectors.private
 math.complex math.functions math.order multi-methods qualified
-sequences sequences.merged sequences.private shuffle symbols ;
+sequences sequences.merged sequences.private generalizations
+shuffle symbols ;
 QUALIFIED: syntax
 IN: math.blas.matrices
 

extra/math/blas/vectors/vectors.factor

@@ -1,7 +1,7 @@
 USING: accessors alien alien.c-types arrays byte-arrays combinators
 combinators.short-circuit fry kernel macros math math.blas.cblas
 math.complex math.functions math.order multi-methods qualified
-sequences sequences.private shuffle ;
+sequences sequences.private generalizations ;
 QUALIFIED: syntax
 IN: math.blas.vectors
 

extra/math/vectors/vectors.factor

@@ -25,7 +25,7 @@ IN: math.vectors
 : normalize ( u -- v ) dup norm v/n ;
 
 : set-axis ( u v axis -- w )
-    dup length [ >r zero? 2over ? r> swap nth ] 2map 2nip ;
+    [ >r zero? 2over ? r> swap nth ] map-index 2nip ;
 
 HINTS: vneg { array } ;
 HINTS: norm-sq { array } ;

extra/mortar/mortar.factor

@@ -1,6 +1,6 @@
 
 USING: kernel io parser lexer words namespaces quotations arrays assocs sequences
-       splitting grouping math shuffle ;
+       splitting grouping math generalizations ;
 
 IN: mortar
 

extra/multi-methods/multi-methods.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math sequences vectors classes classes.algebra
 combinators arrays words assocs parser namespaces definitions
-prettyprint prettyprint.backend quotations arrays.lib
+prettyprint prettyprint.backend quotations generalizations
 debugger io compiler.units kernel.private effects accessors
 hashtables sorting shuffle math.order sets ;
 IN: multi-methods

extra/processing/processing.factor

@@ -1,7 +1,7 @@
 
 USING: kernel namespaces threads combinators sequences arrays
        math math.functions math.ranges random
-       opengl.gl opengl.glu vars multi-methods shuffle
+       opengl.gl opengl.glu vars multi-methods generalizations shuffle
        ui
        ui.gestures
        ui.gadgets

extra/reports/noise/noise.factor

@@ -1,7 +1,7 @@
-USING: accessors assocs math kernel shuffle combinators.lib
+USING: accessors assocs math kernel shuffle generalizations
 words quotations arrays combinators sequences math.vectors
 io.styles prettyprint vocabs sorting io generic locals.private
-math.statistics math.order ;
+math.statistics math.order combinators.lib ;
 IN: reports.noise
 
 : badness ( word -- n )

extra/sequences/lib/lib.factor

@@ -4,7 +4,8 @@
 USING: combinators.lib kernel sequences math namespaces assocs 
 random sequences.private shuffle math.functions
 arrays math.parser math.private sorting strings ascii macros
-assocs.lib quotations hashtables math.order locals ;
+assocs.lib quotations hashtables math.order locals
+generalizations ;
 IN: sequences.lib
 
 : each-withn ( seq quot n -- ) nwith each ; inline
@@ -24,21 +25,6 @@ MACRO: firstn ( n -- )
     concat >quotation
     [ drop ] compose ;
 
-: prepare-index ( seq quot -- seq n quot )
-    >r dup length r> ; inline
-
-: each-index ( seq quot -- )
-    #! quot: ( elt index -- )
-    prepare-index 2each ; inline
-
-: map-index ( seq quot -- )
-    #! quot: ( elt index -- obj )
-    prepare-index 2map ; inline
-
-: reduce-index ( seq identity quot -- )
-    #! quot: ( prev elt index -- next )
-    swapd each-index ; inline
-
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : each-percent ( seq quot -- )

extra/shuffle/shuffle-docs.factor

@@ -1,84 +0,0 @@
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup kernel sequences ;
-IN: shuffle
-
-HELP: npick
-{ $values { "n" "a number" } }
-{ $description "A generalisation of " { $link dup } ", "
-{ $link over } " and " { $link pick } " that can work "
-"for any stack depth. The nth item down the stack will be copied and "
-"placed on the top of the stack."
-}
-{ $examples
-  { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 npick .s" "1\n2\n3\n4\n1" }
-}
-{ $see-also dup over pick } ;
-
-HELP: ndup
-{ $values { "n" "a number" } }
-{ $description "A generalisation of " { $link dup } ", "
-{ $link 2dup } " and " { $link 3dup } " that can work "
-"for any number of items. The n topmost items on the stack will be copied and "
-"placed on the top of the stack."
-}
-{ $examples
-  { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 ndup .s" "1\n2\n3\n4\n1\n2\n3\n4" }
-}
-{ $see-also dup 2dup 3dup } ;
-
-HELP: nnip
-{ $values { "n" "a number" } }
-{ $description "A generalisation of " { $link nip } " and " { $link 2nip }
-" that can work "
-"for any number of items."
-}
-{ $examples
-  { $example "USING: prettyprint shuffle ;" "1 2 3 4 3 nnip .s" "4" }
-}
-{ $see-also nip 2nip } ;
-
-HELP: ndrop
-{ $values { "n" "a number" } }
-{ $description "A generalisation of " { $link drop }
-" that can work "
-"for any number of items."
-}
-{ $examples
-  { $example "USING: prettyprint shuffle ;" "1 2 3 4 3 ndrop .s" "1" }
-}
-{ $see-also drop 2drop 3drop } ;
-
-HELP: nrot
-{ $values { "n" "a number" } }
-{ $description "A generalisation of " { $link rot } " that works for any "
-"number of items on the stack. "
-}
-{ $examples
-  { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 nrot .s" "2\n3\n4\n1" }
-}
-{ $see-also rot -nrot } ;
-
-HELP: -nrot
-{ $values { "n" "a number" } }
-{ $description "A generalisation of " { $link -rot } " that works for any "
-"number of items on the stack. "
-}
-{ $examples
-  { $example "USING: prettyprint shuffle ;" "1 2 3 4 4 -nrot .s" "4\n1\n2\n3" }
-}
-{ $see-also rot nrot } ;
-
-ARTICLE: { "shuffle" "overview" } "Extra shuffle words"
-"A number of stack shuffling words for those rare times when you "
-"need to deal with tricky stack situations and can't refactor the "
-"code to work around it."
-{ $subsection ndup }
-{ $subsection npick }
-{ $subsection nrot }
-{ $subsection -nrot }
-{ $subsection nnip }
-{ $subsection ndrop }  ;
-
-IN: shuffle
-ABOUT: { "shuffle" "overview" }

extra/shuffle/shuffle-tests.factor

@@ -1,25 +1,4 @@
-USING: arrays shuffle kernel math tools.test inference words ;
+USING: shuffle tools.test ;
 
 [ 8 ] [ 5 6 7 8 3nip ] unit-test
-{ 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test
-{ 1 2 3 4 2 } [ 1 2 3 4 3 npick ] unit-test
-{ 1 2 3 4 3 } [ 1 2 3 4 2 npick ] unit-test
-{ 1 2 3 4 4 } [ 1 2 3 4 1 npick ] unit-test
-{ t } [ [ 1 1 ndup ] infer >boolean ] unit-test
-{ 1 1 } [ 1 1 ndup ] unit-test
-{ 1 2 1 2 } [ 1 2 2 ndup ] unit-test
-{ 1 2 3 1 2 3 } [ 1 2 3 3 ndup ] unit-test
-{ 1 2 3 4 1 2 3 4 } [ 1 2 3 4 4 ndup ] unit-test
-{ t } [ [ 1 2 2 nrot ] infer >boolean ] unit-test
-{ 2 1 } [ 1 2 2 nrot ] unit-test
-{ 2 3 1 } [ 1 2 3 3 nrot ] unit-test
-{ 2 3 4 1 } [ 1 2 3 4 4 nrot ] unit-test
-{ t } [ [ 1 2 2 -nrot ] infer >boolean ] unit-test
-{ 2 1 } [ 1 2 2 -nrot ] unit-test
-{ 3 1 2 } [ 1 2 3 3 -nrot ] unit-test
-{ 4 1 2 3 } [ 1 2 3 4 4 -nrot ] unit-test
-{ t } [ [ 1 2 3 4 3 nnip ] infer >boolean ] unit-test
-{ 4 } [ 1 2 3 4 3 nnip ] unit-test
-{ t } [ [ 1 2 3 4 4 ndrop ] infer >boolean ] unit-test
-{ 0 } [ 0 1 2 3 4 4 ndrop ] unit-test
 [ 3 1 2 3 ] [ 1 2 3 tuckd ] unit-test

extra/shuffle/shuffle.factor

@@ -1,24 +1,9 @@
 ! Copyright (C) 2007 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences namespaces math inference.transforms
+USING: kernel generalizations ;
-       combinators macros quotations math.ranges fry ;
 
 IN: shuffle
 
-MACRO: npick ( n -- ) 1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ;
-
-MACRO: ndup ( n -- ) dup [ npick ] curry n*quot ;
-
-MACRO: nrot ( n -- ) 1- dup saver swap [ r> swap ] n*quot append ;
-
-MACRO: -nrot ( n -- ) 1- dup [ swap >r ] n*quot swap restorer append ;
-
-MACRO: ndrop ( n -- ) [ drop ] n*quot ;
-
-: nnip ( n -- ) swap >r ndrop r> ; inline
-
-MACRO: ntuck ( n -- ) 2 + '[ dup , -nrot ] ;
-
 : 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline
 
 : nipd ( a b c -- b c ) rot drop ; inline
@@ -32,8 +17,3 @@ MACRO: ntuck ( n -- ) 2 + '[ dup , -nrot ] ;
 : 4drop ( a b c d -- ) 3drop drop ; inline
 
 : tuckd ( x y z -- z x y z ) 2 ntuck ; inline
-
-MACRO: nrev ( n -- quot )
-  [ 1+ ] map
-  reverse
-  [ [ -nrot ] curry ] map concat ;

extra/spheres/spheres.factor

@@ -1,6 +1,6 @@
 USING: kernel opengl.demo-support opengl.gl opengl.shaders opengl.framebuffers
 opengl multiline ui.gadgets accessors sequences ui.render ui math 
-arrays arrays.lib combinators ;
+arrays generalizations combinators ;
 IN: spheres
 
 STRING: plane-vertex-shader

extra/springies/springies.factor

@@ -1,6 +1,6 @@
 
 USING: kernel combinators sequences arrays math math.vectors
-       shuffle vars ;
+       generalizations vars ;
 
 IN: springies
 

extra/tools/memory/memory.factor

@@ -33,10 +33,10 @@ IN: tools.memory
     [ [ write-cell ] each ] with-row ;
 
 : (data-room.) ( -- )
-    data-room 2 <groups> dup length [
+    data-room 2 <groups> [
         [ first2 ] [ number>string "Generation " prepend ] bi*
         write-total/used/free
-    ] 2each
+    ] each-index
     "Decks" write-total
     "Cards" write-total ;
 

extra/tools/walker/walker-tests.factor

@@ -1,7 +1,7 @@
 USING: tools.walker io io.streams.string kernel math
 math.private namespaces prettyprint sequences tools.test
 continuations math.parser threads arrays tools.walker.debug
-generic.standard ;
+generic.standard sequences.private kernel.private ;
 IN: tools.walker.tests
 
 [ { } ] [
@@ -50,6 +50,10 @@ IN: tools.walker.tests
     [ 5 6 number= ] test-walker
 ] unit-test
 
+[ { 0 } ] [
+    [ 0 { array-capacity } declare ] test-walker
+] unit-test
+
 [ { f } ] [
     [ "XYZ" "XYZ" mismatch ] test-walker
 ] unit-test

extra/unix/process/process.factor

@@ -37,7 +37,8 @@ FUNCTION: int execve ( char* path, char** argv, char** envp ) ;
     >r [ first ] [ ] bi r> exec-with-env ;
 
 : with-fork ( child parent -- )
-    fork-process dup zero? -roll swap curry if ; inline
+    [ [ fork-process dup zero? ] dip [ drop ] prepose ] dip
+    if ; inline
 
 : SIGKILL 9 ; inline
 : SIGTERM 15 ; inline

extra/unix/unix.factor

@@ -4,7 +4,7 @@
 USING: alien alien.c-types alien.syntax kernel libc structs sequences
        continuations byte-arrays strings
        math namespaces system combinators vocabs.loader qualified
-       accessors inference macros locals shuffle arrays.lib 
+       accessors inference macros locals generalizations 
        unix.types debugger io prettyprint ;
 
 IN: unix

extra/windows/com/com-tests.factor

@@ -1,5 +1,5 @@
 USING: kernel windows.com windows.com.syntax windows.ole32
-alien alien.syntax tools.test libc alien.c-types arrays.lib 
+alien alien.syntax tools.test libc alien.c-types 
 namespaces arrays continuations accessors math windows.com.wrapper
 windows.com.wrapper.private destructors effects ;
 IN: windows.com.tests

extra/windows/com/syntax/syntax.factor

@@ -1,6 +1,6 @@
 USING: alien alien.c-types effects kernel windows.ole32
-parser lexer splitting grouping sequences.lib sequences namespaces
+parser lexer splitting grouping sequences namespaces
-assocs quotations shuffle accessors words macros alien.syntax
+assocs quotations generalizations accessors words macros alien.syntax
 fry arrays ;
 IN: windows.com.syntax
 

extra/windows/com/wrapper/wrapper.factor

@@ -1,9 +1,8 @@
 USING: alien alien.c-types windows.com.syntax
 windows.com.syntax.private windows.com continuations kernel
-sequences.lib namespaces windows.ole32 libc vocabs
+namespaces windows.ole32 libc vocabs assocs accessors arrays
-assocs accessors arrays sequences quotations combinators
+sequences quotations combinators math words compiler.units
-math words compiler.units destructors fry
+destructors fry math.parser generalizations ;
-math.parser combinators.lib ;
 IN: windows.com.wrapper
 
 TUPLE: com-wrapper vtbls disposed ;

extra/windows/user32/user32.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.syntax parser namespaces kernel math
-windows.types shuffle math.bitfields alias ;
+windows.types generalizations math.bitfields alias ;
 IN: windows.user32
 
 ! HKL for ActivateKeyboardLayout

vm/quotations.c

@@ -422,7 +422,10 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
 			}
 			if(jit_ignore_declare_p(untag_object(array),i))
 			{
+				if(offset == 0) return i;
+
 				i++;
+
 				break;
 			}
 		default: