From 763a45cc67377f1c03a5ab348b084eb1f14aab30 Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Mon, 7 Jul 2008 12:14:07 -0500
Subject: [PATCH 01/24] Fix mmap on windows
---
extra/io/windows/privileges/privileges.factor | 8 +++++++-
1 file changed, 7 insertions(+), 1 deletion(-)
diff --git a/extra/io/windows/privileges/privileges.factor b/extra/io/windows/privileges/privileges.factor
index 144c799912..e169bdf12f 100755
--- a/extra/io/windows/privileges/privileges.factor
+++ b/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
From dd8e4651866911e18dbc73c5b589698e5ab9b54f Mon Sep 17 00:00:00 2001
From: Alfredo Beaumont <alfredo.beaumont@gmail.com>
Date: Mon, 7 Jul 2008 23:21:23 +0200
Subject: [PATCH 02/24] Changed ctags-write to use set-file-lines as suggested
---
extra/ctags/ctags-docs.factor | 12 ++++++++++++
extra/ctags/ctags-tests.factor | 9 +++++++--
extra/ctags/ctags.factor | 5 ++++-
3 files changed, 23 insertions(+), 3 deletions(-)
diff --git a/extra/ctags/ctags-docs.factor b/extra/ctags/ctags-docs.factor
index f2dbd8bc2b..2da85bd43d 100644
--- a/extra/ctags/ctags-docs.factor
+++ b/extra/ctags/ctags-docs.factor
@@ -32,6 +32,18 @@ HELP: ctags-write ( seq path -- )
{ $notes
{ $snippet "tags" } " file will contain a single line: if\\t/path/to/factor/extra/unix/unix.factor\\t91" } ;
+HELP: ctag-strings ( alist -- seq )
+{ $values { "alist" alist }
+ { "seq" sequence } }
+{ $description "Converts an " { $snippet "alist" } " with ctag format (a word as key and a sequence whose first element is a resource name and a second element is a line number as value) in a " { $snippet "seq" } " of ctag strings." }
+{ $examples
+ { $example
+ "USING: kernel ctags ;"
+ "{ { if { \"resource:extra/unix/unix.factor\" 91 } } } ctag-strings"
+ "{ \"if\\t/path/to/factor/extra/unix/unix.factor\\t91\" }"
+ }
+} ;
+
HELP: ctag ( seq -- str )
{ $values { "seq" sequence }
{ "str" string } }
diff --git a/extra/ctags/ctags-tests.factor b/extra/ctags/ctags-tests.factor
index dc6e402653..6c73b58ecb 100644
--- a/extra/ctags/ctags-tests.factor
+++ b/extra/ctags/ctags-tests.factor
@@ -1,7 +1,12 @@
-USING: kernel ctags tools.test io.backend sequences ;
-IN: columns.tests
+USING: kernel ctags tools.test io.backend sequences arrays prettyprint ;
+IN: ctags.tests
[ t ] [
"if\t" "resource:extra/unix/unix.factor" normalize-path "\t91" 3append
{ if { "resource:extra/unix/unix.factor" 91 } } ctag =
+] unit-test
+
+[ t ] [
+ "if\t" "resource:extra/unix/unix.factor" normalize-path "\t91" 3append 1array
+ { { if { "resource:extra/unix/unix.factor" 91 } } } ctag-strings =
] unit-test
\ No newline at end of file
diff --git a/extra/ctags/ctags.factor b/extra/ctags/ctags.factor
index 5b9ff90e5c..c8bf2272fb 100644
--- a/extra/ctags/ctags.factor
+++ b/extra/ctags/ctags.factor
@@ -18,8 +18,11 @@ IN: ctags
second number>string %
] "" make ;
+: ctag-strings ( seq1 -- seq2 )
+ { } swap [ ctag suffix ] each ;
+
: ctags-write ( seq path -- )
- ascii [ [ ctag print ] each ] with-file-writer ;
+ >r ctag-strings r> ascii set-file-lines ;
: (ctags) ( -- seq )
{ } all-words [
From 0206babefd46a1605692f38e2b638c8bddcbaf6c Mon Sep 17 00:00:00 2001
From: Alfredo Beaumont <alfredo.beaumont@gmail.com>
Date: Mon, 7 Jul 2008 23:23:44 +0200
Subject: [PATCH 03/24] Small documentation fixes in ctags
---
extra/ctags/ctags-docs.factor | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/extra/ctags/ctags-docs.factor b/extra/ctags/ctags-docs.factor
index 2da85bd43d..9d98cae0b3 100644
--- a/extra/ctags/ctags-docs.factor
+++ b/extra/ctags/ctags-docs.factor
@@ -5,6 +5,7 @@ ARTICLE: "ctags" "Ctags file"
{ $emphasis "ctags" } " generates a index file of every factor word in ctags format as supported by vi and other editors. More information can be found at " { $url "http://en.wikipedia.org/wiki/Ctags" } "."
{ $subsection ctags }
{ $subsection ctags-write }
+{ $subsection ctag-strings }
{ $subsection ctag } ;
HELP: ctags ( path -- )
@@ -19,9 +20,9 @@ HELP: ctags ( path -- )
} ;
HELP: ctags-write ( seq path -- )
-{ $values { "seq" sequence }
+{ $values { "alist" "an association list" }
{ "path" "a pathname string" } }
-{ $description "Stores a " { $snippet "seq" } " in " { $snippet "path" } ". " { $snippet "seq" } " must be an association list with ctags format: key must be a valid word and value a sequence whose first element is a resource name and second element is a line number" }
+{ $description "Stores a " { $snippet "alist" } " in " { $snippet "path" } ". " { $snippet "alist" } " must be an association list with ctags format: key must be a valid word and value a sequence whose first element is a resource name and second element is a line number" }
{ $examples
{ $example
"USING: kernel ctags ;"
@@ -33,7 +34,7 @@ HELP: ctags-write ( seq path -- )
{ $snippet "tags" } " file will contain a single line: if\\t/path/to/factor/extra/unix/unix.factor\\t91" } ;
HELP: ctag-strings ( alist -- seq )
-{ $values { "alist" alist }
+{ $values { "alist" "an association list" }
{ "seq" sequence } }
{ $description "Converts an " { $snippet "alist" } " with ctag format (a word as key and a sequence whose first element is a resource name and a second element is a line number as value) in a " { $snippet "seq" } " of ctag strings." }
{ $examples
From 374d72e953da619357e4c76a44546091303c0f25 Mon Sep 17 00:00:00 2001
From: Alfredo Beaumont <alfredo.beaumont@gmail.com>
Date: Mon, 7 Jul 2008 23:28:22 +0200
Subject: [PATCH 04/24] Fix a small typo in columns documentation
---
extra/columns/columns-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/columns/columns-docs.factor b/extra/columns/columns-docs.factor
index a2f0cccf3b..a5b26e3fd0 100644
--- a/extra/columns/columns-docs.factor
+++ b/extra/columns/columns-docs.factor
@@ -11,7 +11,7 @@ HELP: column
HELP: <column> ( seq n -- column )
{ $values { "seq" sequence } { "n" "a non-negative integer" } { "column" column } }
-{ $description "Outputs a new virtual sequence which presents a fixed column of a matrix represented as a sequence of rows." "The " { $snippet "i" } "th element of a column is the " { $snippet "n" } "th element of the " { $snippet "i" } "th element of" { $snippet "seq" } ". Every element of " { $snippet "seq" } " must be a sequence, and all sequences must have equal length." }
+{ $description "Outputs a new virtual sequence which presents a fixed column of a matrix represented as a sequence of rows." "The " { $snippet "i" } "th element of a column is the " { $snippet "n" } "th element of the " { $snippet "i" } "th element of " { $snippet "seq" } ". Every element of " { $snippet "seq" } " must be a sequence, and all sequences must have equal length." }
{ $examples
{ $example
"USING: arrays prettyprint columns ;"
From 423ad4503b286a1e204e09336cae7b5b75e51f3a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 7 Jul 2008 19:11:49 -0500
Subject: [PATCH 05/24] Minor oversights
---
Makefile | 1 -
core/bootstrap/image/image.factor | 2 ++
2 files changed, 2 insertions(+), 1 deletion(-)
diff --git a/Makefile b/Makefile
index 5f7cdca06d..48d4e214db 100755
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,6 @@ AR = ar
LD = ld
EXECUTABLE = factor
-VERSION = 0.91
IMAGE = factor.image
BUNDLE = Factor.app
diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor
index a8fcc712eb..5812a0f8e7 100755
--- a/core/bootstrap/image/image.factor
+++ b/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>=
From 70e370f69de600c593bc1188e21641d1c66a0ffb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 7 Jul 2008 19:26:58 -0500
Subject: [PATCH 06/24] Fix walker
---
Makefile | 1 +
extra/tools/walker/walker-tests.factor | 6 +++++-
vm/quotations.c | 3 +++
3 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/Makefile b/Makefile
index 48d4e214db..769aeacb8c 100755
--- a/Makefile
+++ b/Makefile
@@ -3,6 +3,7 @@ AR = ar
LD = ld
EXECUTABLE = factor
+VERSION = 0.92
IMAGE = factor.image
BUNDLE = Factor.app
diff --git a/extra/tools/walker/walker-tests.factor b/extra/tools/walker/walker-tests.factor
index 7f154a4dbf..e002af8f6d 100755
--- a/extra/tools/walker/walker-tests.factor
+++ b/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
diff --git a/vm/quotations.c b/vm/quotations.c
index 0f60eea3e1..7eab41688a 100755
--- a/vm/quotations.c
+++ b/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:
From 0051a50b75804799677c286f65e6f3c90f8899ac Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Mon, 7 Jul 2008 19:36:33 -0500
Subject: [PATCH 07/24] Move general shufflers and combinators into
generalizations, move narray there too
---
core/bootstrap/primitives.factor | 2 +-
core/debugger/debugger.factor | 2 +-
core/sequences/sequences-docs.factor | 4 +-
core/sequences/sequences.factor | 12 ++
extra/arrays/lib/authors.txt | 1 -
extra/arrays/lib/lib.factor | 10 --
extra/arrays/lib/summary.txt | 1 -
extra/arrays/lib/tags.txt | 1 -
extra/bake/bake.factor | 2 +-
extra/bake/fry/fry-tests.factor | 2 +-
extra/bitfields/bitfields.factor | 2 +-
extra/combinators/cleave/cleave.factor | 2 +-
extra/combinators/lib/lib-docs.factor | 43 ------
extra/combinators/lib/lib-tests.factor | 8 --
extra/combinators/lib/lib.factor | 22 +--
.../short-circuit/short-circuit.factor | 2 +-
extra/descriptive/descriptive.factor | 2 +-
.../generalizations-docs.factor | 136 ++++++++++++++++++
.../generalizations-tests.factor | 32 +++++
extra/generalizations/generalizations.factor | 56 ++++++++
extra/html/parser/analyzer/analyzer.factor | 4 +-
extra/inverse/inverse.factor | 4 +-
extra/koszul/koszul.factor | 12 +-
extra/logging/logging.factor | 2 +-
extra/math/blas/matrices/matrices.factor | 3 +-
extra/math/blas/vectors/vectors.factor | 2 +-
extra/math/vectors/vectors.factor | 2 +-
extra/mortar/mortar.factor | 2 +-
extra/multi-methods/multi-methods.factor | 2 +-
extra/processing/processing.factor | 2 +-
extra/reports/noise/noise.factor | 4 +-
extra/sequences/lib/lib.factor | 18 +--
extra/shuffle/authors.txt | 2 -
extra/shuffle/shuffle-docs.factor | 84 -----------
extra/shuffle/shuffle-tests.factor | 25 ----
extra/shuffle/shuffle.factor | 39 -----
extra/shuffle/summary.txt | 1 -
extra/shuffle/tags.txt | 1 -
extra/spheres/spheres.factor | 2 +-
extra/springies/springies.factor | 2 +-
extra/tools/memory/memory.factor | 4 +-
extra/unix/unix.factor | 2 +-
extra/windows/com/com-tests.factor | 2 +-
extra/windows/com/syntax/syntax.factor | 4 +-
extra/windows/com/wrapper/wrapper.factor | 2 +-
extra/windows/user32/user32.factor | 2 +-
46 files changed, 279 insertions(+), 292 deletions(-)
delete mode 100755 extra/arrays/lib/authors.txt
delete mode 100644 extra/arrays/lib/lib.factor
delete mode 100644 extra/arrays/lib/summary.txt
delete mode 100644 extra/arrays/lib/tags.txt
mode change 100644 => 100755 extra/bake/bake.factor
mode change 100644 => 100755 extra/bitfields/bitfields.factor
mode change 100644 => 100755 extra/combinators/cleave/cleave.factor
mode change 100644 => 100755 extra/combinators/short-circuit/short-circuit.factor
create mode 100755 extra/generalizations/generalizations-docs.factor
create mode 100755 extra/generalizations/generalizations-tests.factor
create mode 100755 extra/generalizations/generalizations.factor
mode change 100644 => 100755 extra/math/blas/matrices/matrices.factor
mode change 100644 => 100755 extra/math/blas/vectors/vectors.factor
mode change 100644 => 100755 extra/mortar/mortar.factor
mode change 100644 => 100755 extra/processing/processing.factor
delete mode 100644 extra/shuffle/authors.txt
delete mode 100755 extra/shuffle/shuffle-docs.factor
delete mode 100755 extra/shuffle/shuffle-tests.factor
delete mode 100644 extra/shuffle/shuffle.factor
delete mode 100644 extra/shuffle/summary.txt
delete mode 100644 extra/shuffle/tags.txt
mode change 100644 => 100755 extra/spheres/spheres.factor
mode change 100644 => 100755 extra/springies/springies.factor
mode change 100644 => 100755 extra/tools/memory/memory.factor
diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 235f3894a1..6498dfde60 100755
--- a/core/bootstrap/primitives.factor
+++ b/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
diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor
index f5316b0858..6759c43094 100755
--- a/core/debugger/debugger.factor
+++ b/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 -- )
diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index dc8d7b9789..86fd9be3d7 100755
--- a/core/sequences/sequences-docs.factor
+++ b/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 } ":"
-{ $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\"" }
+"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 } "."
+$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"
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 7560c8f73e..1c6b96d0d5 100755
--- a/core/sequences/sequences.factor
+++ b/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 ;
diff --git a/extra/arrays/lib/authors.txt b/extra/arrays/lib/authors.txt
deleted file mode 100755
index 6cfd5da273..0000000000
--- a/extra/arrays/lib/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Eduardo Cavazos
diff --git a/extra/arrays/lib/lib.factor b/extra/arrays/lib/lib.factor
deleted file mode 100644
index 6530e65ed6..0000000000
--- a/extra/arrays/lib/lib.factor
+++ /dev/null
@@ -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 ;
diff --git a/extra/arrays/lib/summary.txt b/extra/arrays/lib/summary.txt
deleted file mode 100644
index 5ecd994103..0000000000
--- a/extra/arrays/lib/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Non-core array words
diff --git a/extra/arrays/lib/tags.txt b/extra/arrays/lib/tags.txt
deleted file mode 100644
index 42d711b32b..0000000000
--- a/extra/arrays/lib/tags.txt
+++ /dev/null
@@ -1 +0,0 @@
-collections
diff --git a/extra/bake/bake.factor b/extra/bake/bake.factor
old mode 100644
new mode 100755
index 4ce7bfb586..db77d92720
--- a/extra/bake/bake.factor
+++ b/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
diff --git a/extra/bake/fry/fry-tests.factor b/extra/bake/fry/fry-tests.factor
index 289e1b12fe..13202a78f5 100755
--- a/extra/bake/fry/fry-tests.factor
+++ b/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
diff --git a/extra/bitfields/bitfields.factor b/extra/bitfields/bitfields.factor
old mode 100644
new mode 100755
index 410fd4bdec..76e8d7883d
--- a/extra/bitfields/bitfields.factor
+++ b/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:
diff --git a/extra/combinators/cleave/cleave.factor b/extra/combinators/cleave/cleave.factor
old mode 100644
new mode 100755
index 9b8a790760..f5aeeff619
--- a/extra/combinators/cleave/cleave.factor
+++ b/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
diff --git a/extra/combinators/lib/lib-docs.factor b/extra/combinators/lib/lib-docs.factor
index ccb1fca9a1..fe2f3556ef 100755
--- a/extra/combinators/lib/lib-docs.factor
+++ b/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." } ;
diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor
index e511e88fcc..89d3ed7f7d 100755
--- a/extra/combinators/lib/lib-tests.factor
+++ b/extra/combinators/lib/lib-tests.factor
@@ -5,14 +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" } ]
diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor
index 3fab4f62ae..4af12a9ad6 100755
--- a/extra/combinators/lib/lib.factor
+++ b/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
diff --git a/extra/combinators/short-circuit/short-circuit.factor b/extra/combinators/short-circuit/short-circuit.factor
old mode 100644
new mode 100755
index c74a2ca4fb..a484e09de1
--- a/extra/combinators/short-circuit/short-circuit.factor
+++ b/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
diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor
index 3b55aa0521..4b40747e9f 100755
--- a/extra/descriptive/descriptive.factor
+++ b/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 ;
diff --git a/extra/generalizations/generalizations-docs.factor b/extra/generalizations/generalizations-docs.factor
new file mode 100755
index 0000000000..decabdc89d
--- /dev/null
+++ b/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 nrev .s" "4\n3\n2\n1\n" }
+}
+{ $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: 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 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: 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 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: 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 } ;
+
+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"
diff --git a/extra/generalizations/generalizations-tests.factor b/extra/generalizations/generalizations-tests.factor
new file mode 100755
index 0000000000..1210143094
--- /dev/null
+++ b/extra/generalizations/generalizations-tests.factor
@@ -0,0 +1,32 @@
+USING: tools.test generalizations kernel math arrays ;
+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
diff --git a/extra/generalizations/generalizations.factor b/extra/generalizations/generalizations.factor
new file mode 100755
index 0000000000..6cbb13518e
--- /dev/null
+++ b/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 ;
diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor
index f6fccd42ec..dca727b9dc 100755
--- a/extra/html/parser/analyzer/analyzer.factor
+++ b/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
-sequences.lib accessors io combinators http.client urls ;
+arrays generalizations shuffle unicode.case namespaces splitting
+http sequences.lib accessors io combinators http.client urls ;
IN: html.parser.analyzer
TUPLE: link attributes clickable ;
diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor
index 4a35fbab24..5a8ef4c787 100755
--- a/extra/inverse/inverse.factor
+++ b/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
diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor
index 188cfaa1cf..37c2137433 100755
--- a/extra/koszul/koszul.factor
+++ b/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
- ] 2each ;
+ ] each-index
+ ] each-index ;
diff --git a/extra/logging/logging.factor b/extra/logging/logging.factor
index 37ea9ac507..78a3002906 100755
--- a/extra/logging/logging.factor
+++ b/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
diff --git a/extra/math/blas/matrices/matrices.factor b/extra/math/blas/matrices/matrices.factor
old mode 100644
new mode 100755
index 99f20b432b..c07dfca76d
--- a/extra/math/blas/matrices/matrices.factor
+++ b/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
diff --git a/extra/math/blas/vectors/vectors.factor b/extra/math/blas/vectors/vectors.factor
old mode 100644
new mode 100755
index 3c927318a6..18370f12c0
--- a/extra/math/blas/vectors/vectors.factor
+++ b/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
diff --git a/extra/math/vectors/vectors.factor b/extra/math/vectors/vectors.factor
index 5572a0cf53..b6ac459123 100755
--- a/extra/math/vectors/vectors.factor
+++ b/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 } ;
diff --git a/extra/mortar/mortar.factor b/extra/mortar/mortar.factor
old mode 100644
new mode 100755
index 1b5b6f2393..5b7f3356c1
--- a/extra/mortar/mortar.factor
+++ b/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
diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor
index c8128c33ee..69dca2affc 100755
--- a/extra/multi-methods/multi-methods.factor
+++ b/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
diff --git a/extra/processing/processing.factor b/extra/processing/processing.factor
old mode 100644
new mode 100755
index e089b15e7e..fb9f321f47
--- a/extra/processing/processing.factor
+++ b/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
diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor
index 32a43a4fb4..ff88abad61 100755
--- a/extra/reports/noise/noise.factor
+++ b/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 )
diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index 1debe3f91b..3b54abfeab 100755
--- a/extra/sequences/lib/lib.factor
+++ b/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 -- )
diff --git a/extra/shuffle/authors.txt b/extra/shuffle/authors.txt
deleted file mode 100644
index 26093b451b..0000000000
--- a/extra/shuffle/authors.txt
+++ /dev/null
@@ -1,2 +0,0 @@
-Chris Double
-Doug Coleman
diff --git a/extra/shuffle/shuffle-docs.factor b/extra/shuffle/shuffle-docs.factor
deleted file mode 100755
index 4caace3b00..0000000000
--- a/extra/shuffle/shuffle-docs.factor
+++ /dev/null
@@ -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" }
\ No newline at end of file
diff --git a/extra/shuffle/shuffle-tests.factor b/extra/shuffle/shuffle-tests.factor
deleted file mode 100755
index 9f2b8e01a9..0000000000
--- a/extra/shuffle/shuffle-tests.factor
+++ /dev/null
@@ -1,25 +0,0 @@
-USING: arrays shuffle kernel math tools.test inference words ;
-
-[ 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
diff --git a/extra/shuffle/shuffle.factor b/extra/shuffle/shuffle.factor
deleted file mode 100644
index 2366d15cff..0000000000
--- a/extra/shuffle/shuffle.factor
+++ /dev/null
@@ -1,39 +0,0 @@
-! Copyright (C) 2007 Chris Double, Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences namespaces math inference.transforms
- 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
-
-: 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
-
-MACRO: nrev ( n -- quot )
- [ 1+ ] map
- reverse
- [ [ -nrot ] curry ] map concat ;
diff --git a/extra/shuffle/summary.txt b/extra/shuffle/summary.txt
deleted file mode 100644
index 12c22b8ae0..0000000000
--- a/extra/shuffle/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Additional shuffle words
diff --git a/extra/shuffle/tags.txt b/extra/shuffle/tags.txt
deleted file mode 100644
index f4274299b1..0000000000
--- a/extra/shuffle/tags.txt
+++ /dev/null
@@ -1 +0,0 @@
-extensions
diff --git a/extra/spheres/spheres.factor b/extra/spheres/spheres.factor
old mode 100644
new mode 100755
index 9d06987bcd..dff7313eec
--- a/extra/spheres/spheres.factor
+++ b/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
diff --git a/extra/springies/springies.factor b/extra/springies/springies.factor
old mode 100644
new mode 100755
index cd6e1a7cfb..1856115863
--- a/extra/springies/springies.factor
+++ b/extra/springies/springies.factor
@@ -1,6 +1,6 @@
USING: kernel combinators sequences arrays math math.vectors
- shuffle vars ;
+ generalizations vars ;
IN: springies
diff --git a/extra/tools/memory/memory.factor b/extra/tools/memory/memory.factor
old mode 100644
new mode 100755
index 83da7f22a8..f61694da78
--- a/extra/tools/memory/memory.factor
+++ b/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 ;
diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor
index 07eb2950fa..083700493d 100755
--- a/extra/unix/unix.factor
+++ b/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
diff --git a/extra/windows/com/com-tests.factor b/extra/windows/com/com-tests.factor
index c04fd8f544..394bec2dfb 100755
--- a/extra/windows/com/com-tests.factor
+++ b/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
diff --git a/extra/windows/com/syntax/syntax.factor b/extra/windows/com/syntax/syntax.factor
index e0ea65e8be..dd7d058a77 100755
--- a/extra/windows/com/syntax/syntax.factor
+++ b/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
-assocs quotations shuffle accessors words macros alien.syntax
+parser lexer splitting grouping sequences namespaces
+assocs quotations generalizations accessors words macros alien.syntax
fry arrays ;
IN: windows.com.syntax
diff --git a/extra/windows/com/wrapper/wrapper.factor b/extra/windows/com/wrapper/wrapper.factor
index 266439ad79..79a945e7de 100755
--- a/extra/windows/com/wrapper/wrapper.factor
+++ b/extra/windows/com/wrapper/wrapper.factor
@@ -1,6 +1,6 @@
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 sequences quotations combinators
math words compiler.units destructors fry
math.parser combinators.lib ;
diff --git a/extra/windows/user32/user32.factor b/extra/windows/user32/user32.factor
index 49a04dcb48..1c1df52da8 100755
--- a/extra/windows/user32/user32.factor
+++ b/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
From 400cde1fe638a380966a6c6751d04a98323d5b64 Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Tue, 8 Jul 2008 10:18:23 -0500
Subject: [PATCH 08/24] Fix load error
---
extra/windows/com/wrapper/wrapper.factor | 7 +++----
1 file changed, 3 insertions(+), 4 deletions(-)
diff --git a/extra/windows/com/wrapper/wrapper.factor b/extra/windows/com/wrapper/wrapper.factor
index 79a945e7de..40c61dfbe7 100755
--- a/extra/windows/com/wrapper/wrapper.factor
+++ b/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
-namespaces windows.ole32 libc vocabs
-assocs accessors arrays sequences quotations combinators
-math words compiler.units destructors fry
-math.parser combinators.lib ;
+namespaces windows.ole32 libc vocabs assocs accessors arrays
+sequences quotations combinators math words compiler.units
+destructors fry math.parser generalizations ;
IN: windows.com.wrapper
TUPLE: com-wrapper vtbls disposed ;
From 267a24c0ded8cb87e7c0824ebbc513d358f674ee Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 12:34:52 -0500
Subject: [PATCH 09/24] Oops
---
extra/shuffle/authors.txt | 2 +
extra/shuffle/shuffle-docs.factor | 84 ++++++++++++++++++++++++++++++
extra/shuffle/shuffle-tests.factor | 25 +++++++++
extra/shuffle/shuffle.factor | 39 ++++++++++++++
extra/shuffle/summary.txt | 1 +
extra/shuffle/tags.txt | 1 +
6 files changed, 152 insertions(+)
create mode 100644 extra/shuffle/authors.txt
create mode 100755 extra/shuffle/shuffle-docs.factor
create mode 100755 extra/shuffle/shuffle-tests.factor
create mode 100644 extra/shuffle/shuffle.factor
create mode 100644 extra/shuffle/summary.txt
create mode 100644 extra/shuffle/tags.txt
diff --git a/extra/shuffle/authors.txt b/extra/shuffle/authors.txt
new file mode 100644
index 0000000000..26093b451b
--- /dev/null
+++ b/extra/shuffle/authors.txt
@@ -0,0 +1,2 @@
+Chris Double
+Doug Coleman
diff --git a/extra/shuffle/shuffle-docs.factor b/extra/shuffle/shuffle-docs.factor
new file mode 100755
index 0000000000..4caace3b00
--- /dev/null
+++ b/extra/shuffle/shuffle-docs.factor
@@ -0,0 +1,84 @@
+! 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" }
\ No newline at end of file
diff --git a/extra/shuffle/shuffle-tests.factor b/extra/shuffle/shuffle-tests.factor
new file mode 100755
index 0000000000..9f2b8e01a9
--- /dev/null
+++ b/extra/shuffle/shuffle-tests.factor
@@ -0,0 +1,25 @@
+USING: arrays shuffle kernel math tools.test inference words ;
+
+[ 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
diff --git a/extra/shuffle/shuffle.factor b/extra/shuffle/shuffle.factor
new file mode 100644
index 0000000000..2366d15cff
--- /dev/null
+++ b/extra/shuffle/shuffle.factor
@@ -0,0 +1,39 @@
+! Copyright (C) 2007 Chris Double, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences namespaces math inference.transforms
+ 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
+
+: 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
+
+MACRO: nrev ( n -- quot )
+ [ 1+ ] map
+ reverse
+ [ [ -nrot ] curry ] map concat ;
diff --git a/extra/shuffle/summary.txt b/extra/shuffle/summary.txt
new file mode 100644
index 0000000000..12c22b8ae0
--- /dev/null
+++ b/extra/shuffle/summary.txt
@@ -0,0 +1 @@
+Additional shuffle words
diff --git a/extra/shuffle/tags.txt b/extra/shuffle/tags.txt
new file mode 100644
index 0000000000..f4274299b1
--- /dev/null
+++ b/extra/shuffle/tags.txt
@@ -0,0 +1 @@
+extensions
From 475ffb17ac9ea096d96cd21dcbb72fa86fe6e2a7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 12:35:42 -0500
Subject: [PATCH 10/24] Update
---
extra/shuffle/shuffle.factor | 22 +---------------------
1 file changed, 1 insertion(+), 21 deletions(-)
diff --git a/extra/shuffle/shuffle.factor b/extra/shuffle/shuffle.factor
index 2366d15cff..9a0dfe0e88 100644
--- a/extra/shuffle/shuffle.factor
+++ b/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
- combinators macros quotations math.ranges fry ;
+USING: kernel generalizations ;
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 ;
From 838bdb9438d7d417704945f105d9c6186fd47e59 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 12:44:25 -0500
Subject: [PATCH 11/24] ugh
---
extra/shuffle/shuffle-docs.factor | 84 ------------------------------
extra/shuffle/shuffle-tests.factor | 23 +-------
2 files changed, 1 insertion(+), 106 deletions(-)
delete mode 100755 extra/shuffle/shuffle-docs.factor
diff --git a/extra/shuffle/shuffle-docs.factor b/extra/shuffle/shuffle-docs.factor
deleted file mode 100755
index 4caace3b00..0000000000
--- a/extra/shuffle/shuffle-docs.factor
+++ /dev/null
@@ -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" }
\ No newline at end of file
diff --git a/extra/shuffle/shuffle-tests.factor b/extra/shuffle/shuffle-tests.factor
index 9f2b8e01a9..b5168b903c 100755
--- a/extra/shuffle/shuffle-tests.factor
+++ b/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
From 776b245c39d5166224578c2f45fbd7411c094dba Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 13:22:57 -0500
Subject: [PATCH 12/24] Cleaning up some usages of -roll
---
core/alien/c-types/c-types.factor | 4 ++--
core/kernel/kernel.factor | 3 +--
extra/unix/process/process.factor | 3 ++-
3 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor
index 92f5211b35..d6d0afcf76 100755
--- a/core/alien/c-types/c-types.factor
+++ b/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>
- [ execute ] 2curry 2each ; inline
+ [ [ dup length ] dip <c-array> ] dip
+ [ [ execute ] 2curry each-index ] 2keep drop ; inline
: >c-array-quot ( type vocab -- quot )
dupd set-nth-word [ >c-array ] 2curry ;
diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 023ded5e9c..6b785a61ba 100755
--- a/core/kernel/kernel.factor
+++ b/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 )
- >r 3dup r> -roll 3slip ; inline
+: 3keep ( x y z quot -- x y z ) >r 3dup r> -roll 3slip ; inline
! Cleavers
: bi ( x p q -- )
diff --git a/extra/unix/process/process.factor b/extra/unix/process/process.factor
index 644276ef7d..7d3d757705 100755
--- a/extra/unix/process/process.factor
+++ b/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
From 1c7d18bcc95e4d0518272976d339cbc0e5b264cb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 13:33:08 -0500
Subject: [PATCH 13/24] Get rid of a -roll usage
---
extra/calendar/calendar.factor | 42 +++++++++--------------------
extra/calendar/format/format.factor | 6 ++---
2 files changed, 16 insertions(+), 32 deletions(-)
diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor
index 6b1f02187d..e7b0b6f43a 100755
--- a/extra/calendar/calendar.factor
+++ b/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 )
- first2 dup 2 = [
- drop leap-year? 29 28 ?
- ] [
- nip day-counts nth
- ] if ;
+: days-in-month ( timestamp -- n )
+ >date< drop (days-in-month) ;
-M: timestamp days-in-month ( timestamp -- n )
- >date< drop 2array days-in-month ;
-
-GENERIC: day-of-week ( obj -- n )
-
-M: timestamp day-of-week ( timestamp -- n )
+: day-of-week ( timestamp -- n )
>date< zeller-congruence ;
-M: array day-of-week ( array -- n )
- first3 zeller-congruence ;
-
-GENERIC: day-of-year ( obj -- n )
-
-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>
+:: (day-of-year) ( year month day -- n )
+ day-counts month head-slice sum day +
+ year leap-year? [
+ year month day <date>
+ year 3 1 <date>
after=? [ 1+ ] when
- ] [
- >r 3drop r>
- ] if ;
+ ] when ;
-M: timestamp day-of-year ( timestamp -- n )
- >date< 3array day-of-year ;
+: day-of-year ( timestamp -- n )
+ >date< (day-of-year) ;
: day-offset ( timestamp m -- timestamp n )
over day-of-week - ; inline
diff --git a/extra/calendar/format/format.factor b/extra/calendar/format/format.factor
index 15dee79006..e2b6a280ef 100755
--- a/extra/calendar/format/format.factor
+++ b/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
- [ 1 zeller-congruence ] 2keep
- 2array days-in-month day-abbreviations2 " " join print
+ [ month-names nth write bl number>string print ]
+ [ 1 zeller-congruence ]
+ [ (days-in-month) day-abbreviations2 " " join print ] 2tri
over " " <repetition> concat write
[
[ 1+ day. ] keep
From 94a613f688605eaa9c4fa0a5bc94efc1d47279cb Mon Sep 17 00:00:00 2001
From: Alfredo Beaumont <alfredo.beaumont@gmail.com>
Date: Tue, 8 Jul 2008 20:40:37 +0200
Subject: [PATCH 14/24] Small change: use a better idiom
---
extra/ctags/ctags.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/ctags/ctags.factor b/extra/ctags/ctags.factor
index c8bf2272fb..23d9aeb90c 100644
--- a/extra/ctags/ctags.factor
+++ b/extra/ctags/ctags.factor
@@ -22,7 +22,7 @@ IN: ctags
{ } swap [ ctag suffix ] each ;
: ctags-write ( seq path -- )
- >r ctag-strings r> ascii set-file-lines ;
+ [ ctag-strings ] dip ascii set-file-lines ;
: (ctags) ( -- seq )
{ } all-words [
From a950924a18d99926d2a0a9c51bcc25d6b0356f52 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 14:20:43 -0500
Subject: [PATCH 15/24] Fixes
---
extra/combinators/lib/lib-tests.factor | 2 --
extra/generalizations/generalizations-docs.factor | 10 +++++-----
extra/generalizations/generalizations-tests.factor | 4 +++-
3 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor
index 89d3ed7f7d..d61674280a 100755
--- a/extra/combinators/lib/lib-tests.factor
+++ b/extra/combinators/lib/lib-tests.factor
@@ -5,8 +5,6 @@ IN: combinators.lib.tests
[ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test
[ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test
-[ { "xyc" "xyd" } ] [ "x" "y" { "c" "d" } [ 3append ] 2 nwith map ] unit-test
-
[ { "foo" "xbarx" } ]
[
{ "oof" "bar" } { [ reverse ] [ "x" swap "x" 3append ] } parallel-call
diff --git a/extra/generalizations/generalizations-docs.factor b/extra/generalizations/generalizations-docs.factor
index decabdc89d..d2af13a9c3 100755
--- a/extra/generalizations/generalizations-docs.factor
+++ b/extra/generalizations/generalizations-docs.factor
@@ -75,7 +75,7 @@ HELP: nrev
{ $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 nrev .s" "4\n3\n2\n1\n" }
+ { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 nrev .s" "4\n3\n2\n1" }
}
{ $see-also rot nrot } ;
@@ -87,8 +87,8 @@ HELP: ndip
"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" }
+ { $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 } ;
@@ -99,7 +99,7 @@ HELP: nslip
"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" }
+ { $example "USING: generalizations prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s" "99\n1\n2\n3\n4\n5" }
}
{ $see-also slip nkeep } ;
@@ -110,7 +110,7 @@ HELP: nkeep
"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" }
+ { $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 } ;
diff --git a/extra/generalizations/generalizations-tests.factor b/extra/generalizations/generalizations-tests.factor
index 1210143094..af010e2026 100755
--- a/extra/generalizations/generalizations-tests.factor
+++ b/extra/generalizations/generalizations-tests.factor
@@ -1,4 +1,4 @@
-USING: tools.test generalizations kernel math arrays ;
+USING: tools.test generalizations kernel math arrays sequences ;
IN: generalizations.tests
{ 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test
@@ -30,3 +30,5 @@ IN: generalizations.tests
[ [ 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
From ed788fa49ca668f39f9112527f371e4d99d29ff8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 14:23:27 -0500
Subject: [PATCH 16/24] Fix stack effect
---
core/alien/c-types/c-types.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor
index d6d0afcf76..602b22881f 100755
--- a/core/alien/c-types/c-types.factor
+++ b/core/alien/c-types/c-types.factor
@@ -198,7 +198,7 @@ M: long-long-type box-return ( type -- )
: c-bool> ( int -- ? )
zero? not ;
-: >c-array ( seq type word -- )
+: >c-array ( seq type word -- byte-array )
[ [ dup length ] dip <c-array> ] dip
[ [ execute ] 2curry each-index ] 2keep drop ; inline
From cb4ce6c4dfca9f6f6a26198a11353895f15f443b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 14:26:37 -0500
Subject: [PATCH 17/24] Fix naming
---
extra/webapps/planet/admin.xml | 8 +++---
extra/webapps/planet/edit-blog.xml | 4 +--
extra/webapps/planet/new-blog.xml | 2 +-
extra/webapps/planet/planet-common.xml | 6 ++--
extra/webapps/planet/planet.factor | 40 +++++++++++++-------------
extra/webapps/planet/planet.xml | 2 +-
6 files changed, 31 insertions(+), 31 deletions(-)
diff --git a/extra/webapps/planet/admin.xml b/extra/webapps/planet/admin.xml
index 192592489e..531332eada 100644
--- a/extra/webapps/planet/admin.xml
+++ b/extra/webapps/planet/admin.xml
@@ -2,12 +2,12 @@
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
- <t:title>Planet Factor Administration</t:title>
+ <t:title>Concatenative Planet: Administration</t:title>
<ul>
<t:bind-each t:name="blogroll">
<li>
- <t:a t:href="$planet-factor/admin/edit-blog" t:query="id">
+ <t:a t:href="$planet/admin/edit-blog" t:query="id">
<t:label t:name="name" />
</t:a>
</li>
@@ -15,8 +15,8 @@
</ul>
<div>
- <t:a t:href="$planet-factor/admin/new-blog">Add Blog</t:a>
- | <t:button t:action="$planet-factor/admin/update" class="link-button link">Update</t:button>
+ <t:a t:href="$planet/admin/new-blog">Add Blog</t:a>
+ | <t:button t:action="$planet/admin/update" class="link-button link">Update</t:button>
</div>
</t:chloe>
diff --git a/extra/webapps/planet/edit-blog.xml b/extra/webapps/planet/edit-blog.xml
index fd9c659f59..d1c7013c68 100644
--- a/extra/webapps/planet/edit-blog.xml
+++ b/extra/webapps/planet/edit-blog.xml
@@ -4,7 +4,7 @@
<t:title>Edit Blog</t:title>
- <t:form t:action="$planet-factor/admin/edit-blog" t:for="id">
+ <t:form t:action="$planet/admin/edit-blog" t:for="id">
<table>
@@ -29,6 +29,6 @@
</t:form>
- <t:button t:action="$planet-factor/admin/delete-blog" t:for="id" class="link-button link">Delete</t:button>
+ <t:button t:action="$planet/admin/delete-blog" t:for="id" class="link-button link">Delete</t:button>
</t:chloe>
diff --git a/extra/webapps/planet/new-blog.xml b/extra/webapps/planet/new-blog.xml
index 4a9638da03..6f75addda5 100644
--- a/extra/webapps/planet/new-blog.xml
+++ b/extra/webapps/planet/new-blog.xml
@@ -4,7 +4,7 @@
<t:title>Edit Blog</t:title>
- <t:form t:action="$planet-factor/admin/new-blog">
+ <t:form t:action="$planet/admin/new-blog">
<table>
diff --git a/extra/webapps/planet/planet-common.xml b/extra/webapps/planet/planet-common.xml
index 6c0affd17f..f4e390056a 100644
--- a/extra/webapps/planet/planet-common.xml
+++ b/extra/webapps/planet/planet-common.xml
@@ -5,9 +5,9 @@
<t:style t:include="resource:extra/webapps/planet/planet.css" />
<div class="navbar">
- <t:a t:href="$planet-factor/list">Front Page</t:a>
- | <t:a t:href="$planet-factor/feed.xml">Atom Feed</t:a>
- | <t:a t:href="$planet-factor/admin">Admin</t:a>
+ <t:a t:href="$planet/list">Front Page</t:a>
+ | <t:a t:href="$planet/feed.xml">Atom Feed</t:a>
+ | <t:a t:href="$planet/admin">Admin</t:a>
<t:if t:code="furnace.auth:logged-in?">
<t:if t:code="furnace.auth.features.edit-profile:allow-edit-profile?">
diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor
index ca74b7e642..10e706598e 100755
--- a/extra/webapps/planet/planet.factor
+++ b/extra/webapps/planet/planet.factor
@@ -17,13 +17,13 @@ furnace.auth
furnace.syndication ;
IN: webapps.planet
-TUPLE: planet-factor < dispatcher ;
+TUPLE: planet < dispatcher ;
-SYMBOL: can-administer-planet-factor?
+SYMBOL: can-administer-planet?
-can-administer-planet-factor? define-capability
+can-administer-planet? define-capability
-TUPLE: planet-factor-admin < dispatcher ;
+TUPLE: planet-admin < dispatcher ;
TUPLE: blog id name www-url feed-url ;
@@ -65,7 +65,7 @@ posting "POSTINGS"
: <edit-blogroll-action> ( -- action )
<page-action>
[ blogroll "blogroll" set-value ] >>init
- { planet-factor "admin" } >>template ;
+ { planet "admin" } >>template ;
: <planet-action> ( -- action )
<page-action>
@@ -74,12 +74,12 @@ posting "POSTINGS"
postings "postings" set-value
] >>init
- { planet-factor "planet" } >>template ;
+ { planet "planet" } >>template ;
: <planet-feed-action> ( -- action )
<feed-action>
[ "Planet Factor" ] >>title
- [ URL" $planet-factor" ] >>url
+ [ URL" $planet" ] >>url
[ postings ] >>entries ;
:: <posting> ( entry name -- entry' )
@@ -111,7 +111,7 @@ posting "POSTINGS"
<action>
[
update-cached-postings
- URL" $planet-factor/admin" <redirect>
+ URL" $planet/admin" <redirect>
] >>submit ;
: <delete-blog-action> ( -- action )
@@ -120,7 +120,7 @@ posting "POSTINGS"
[
"id" value <blog> delete-tuples
- URL" $planet-factor/admin" <redirect>
+ URL" $planet/admin" <redirect>
] >>submit ;
: validate-blog ( -- )
@@ -136,7 +136,7 @@ posting "POSTINGS"
: <new-blog-action> ( -- action )
<page-action>
- { planet-factor "new-blog" } >>template
+ { planet "new-blog" } >>template
[ validate-blog ] >>validate
@@ -146,7 +146,7 @@ posting "POSTINGS"
[ insert-tuple ]
[
<url>
- "$planet-factor/admin/edit-blog" >>path
+ "$planet/admin/edit-blog" >>path
swap id>> "id" set-query-param
<redirect>
]
@@ -161,7 +161,7 @@ posting "POSTINGS"
"id" value <blog> select-tuple from-object
] >>init
- { planet-factor "edit-blog" } >>template
+ { planet "edit-blog" } >>template
[
validate-integer-id
@@ -174,15 +174,15 @@ posting "POSTINGS"
[ update-tuple ]
[
<url>
- "$planet-factor/admin" >>path
+ "$planet/admin" >>path
swap id>> "id" set-query-param
<redirect>
]
tri
] >>submit ;
-: <planet-factor-admin> ( -- responder )
- planet-factor-admin new-dispatcher
+: <planet-admin> ( -- responder )
+ planet-admin new-dispatcher
<edit-blogroll-action> "blogroll" add-main-responder
<update-action> "update" add-responder
<new-blog-action> "new-blog" add-responder
@@ -190,15 +190,15 @@ posting "POSTINGS"
<delete-blog-action> "delete-blog" add-responder
<protected>
"administer Planet Factor" >>description
- { can-administer-planet-factor? } >>capabilities ;
+ { can-administer-planet? } >>capabilities ;
-: <planet-factor> ( -- responder )
- planet-factor new-dispatcher
+: <planet> ( -- responder )
+ planet new-dispatcher
<planet-action> "list" add-main-responder
<planet-feed-action> "feed.xml" add-responder
- <planet-factor-admin> "admin" add-responder
+ <planet-admin> "admin" add-responder
<boilerplate>
- { planet-factor "planet-common" } >>template ;
+ { planet "planet-common" } >>template ;
: start-update-task ( db params -- )
'[ , , [ update-cached-postings ] with-db ] 10 minutes every drop ;
diff --git a/extra/webapps/planet/planet.xml b/extra/webapps/planet/planet.xml
index fe4d23bd3b..340e6c4bee 100644
--- a/extra/webapps/planet/planet.xml
+++ b/extra/webapps/planet/planet.xml
@@ -2,7 +2,7 @@
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
- <t:title>Planet Factor</t:title>
+ <t:title>Concatenative Planet</t:title>
<table width="100%" cellpadding="10">
<tr>
From 3e43c69918aa1c1f6b93359a4593011532d90901 Mon Sep 17 00:00:00 2001
From: Alfredo Beaumont <alfredo.beaumont@gmail.com>
Date: Tue, 8 Jul 2008 21:57:37 +0200
Subject: [PATCH 18/24] Fix examples' code and make them unchecked since they
have side effects
---
extra/ctags/ctags-docs.factor | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/extra/ctags/ctags-docs.factor b/extra/ctags/ctags-docs.factor
index 9d98cae0b3..22d811ad3f 100644
--- a/extra/ctags/ctags-docs.factor
+++ b/extra/ctags/ctags-docs.factor
@@ -12,9 +12,9 @@ HELP: ctags ( path -- )
{ $values { "path" "a pathname string" } }
{ $description "Generates a index file in ctags format and stores in " { $snippet "path" } "." }
{ $examples
- { $example
+ { $unchecked-example
"USING: ctags ;"
- "\"tags\" ctags-write"
+ "\"tags\" ctags"
""
}
} ;
@@ -24,7 +24,7 @@ HELP: ctags-write ( seq path -- )
{ "path" "a pathname string" } }
{ $description "Stores a " { $snippet "alist" } " in " { $snippet "path" } ". " { $snippet "alist" } " must be an association list with ctags format: key must be a valid word and value a sequence whose first element is a resource name and second element is a line number" }
{ $examples
- { $example
+ { $unchecked-example
"USING: kernel ctags ;"
"{ { if { \"resource:extra/unix/unix.factor\" 91 } } } \"tags\" ctags-write"
""
@@ -38,9 +38,9 @@ HELP: ctag-strings ( alist -- seq )
{ "seq" sequence } }
{ $description "Converts an " { $snippet "alist" } " with ctag format (a word as key and a sequence whose first element is a resource name and a second element is a line number as value) in a " { $snippet "seq" } " of ctag strings." }
{ $examples
- { $example
- "USING: kernel ctags ;"
- "{ { if { \"resource:extra/unix/unix.factor\" 91 } } } ctag-strings"
+ { $unchecked-example
+ "USING: kernel ctags prettyprint ;"
+ "{ { if { \"resource:extra/unix/unix.factor\" 91 } } } ctag-strings ."
"{ \"if\\t/path/to/factor/extra/unix/unix.factor\\t91\" }"
}
} ;
@@ -50,8 +50,8 @@ HELP: ctag ( seq -- str )
{ "str" string } }
{ $description "Outputs a string " { $snippet "str" } " in ctag format for sequence with two elements, first one must be a valid word and second one a sequence whose first element is a resource name and second element is a line number" }
{ $examples
- { $example
- "USING: kernel ctags ;"
+ { $unchecked-example
+ "USING: kernel ctags prettyprint ;"
"{ if { \"resource:extra/unix/unix.factor\" 91 } } ctag ."
"\"if\\t/path/to/factor/extra/unix/unix.factor\\t91\""
}
From 3929c1239228e34425301acc8be03bfd2e173f1f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 15:22:03 -0500
Subject: [PATCH 19/24] Add failing unit test for string encoding
---
extra/db/tuples/tuples-tests.factor | 31 ++++++++++++++++++++++++++---
1 file changed, 28 insertions(+), 3 deletions(-)
diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index 36e84187eb..2edf7552cb 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -4,7 +4,7 @@ USING: io.files kernel tools.test db db.tuples classes
db.types continuations namespaces math math.ranges
prettyprint calendar sequences db.sqlite math.intervals
db.postgresql accessors random math.bitfields.lib
-math.ranges strings sequences.lib urls ;
+math.ranges strings sequences.lib urls fry ;
IN: db.tuples.tests
TUPLE: person the-id the-name the-number the-real
@@ -201,10 +201,10 @@ TUPLE: annotation n paste-id summary author mode contents ;
! ] with-db
: test-sqlite ( quot -- )
- >r "tuples-test.db" temp-file sqlite-db r> with-db ;
+ [ ] swap '[ "tuples-test.db" temp-file sqlite-db , with-db ] unit-test ;
: test-postgresql ( quot -- )
- >r { "localhost" "postgres" "foob" "factor-test" } postgresql-db r> with-db ;
+ [ ] swap '[ { "localhost" "postgres" "foob" "factor-test" } postgresql-db , with-db ] unit-test ;
: test-repeated-insert
[ ] [ person ensure-table ] unit-test
@@ -463,6 +463,31 @@ fubbclass "FUBCLASS" { } define-persistent
[ t ] [ fubbclass new select-tuples [ fubbclass? ] all? ] unit-test ;
[ test-db-inheritance ] test-sqlite
+[ test-db-inheritance ] test-postgresql
+
+
+TUPLE: string-encoding-test id string ;
+
+string-encoding-test "STRING_ENCODING_TEST" {
+ { "id" "ID" +db-assigned-id+ }
+ { "string" "STRING" TEXT }
+} define-persistent
+
+: test-string-encoding ( -- )
+ [ ] [ string-encoding-test ensure-table ] unit-test
+
+ [ ] [
+ string-encoding-test new
+ "\u{copyright-sign}\u{bengali-letter-cha}" >>string
+ [ insert-tuple ] [ id>> "id" set ] bi
+ ] unit-test
+
+ [ "\u{copyright-sign}\u{bengali-letter-cha}" ] [
+ string-encoding-test new "id" get >>id select-tuple string>>
+ ] unit-test ;
+
+[ test-string-encoding ] test-sqlite
+[ test-string-encoding ] test-postgresql
! Don't comment these out. These words must infer
\ bind-tuple must-infer
From 7248af54cc88cfd7b2a35cf9a1a203fe9adf6d3d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 15:22:44 -0500
Subject: [PATCH 20/24] Update for planet rename
---
extra/websites/concatenative/concatenative.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor
index 6d65f10783..211dcb3c11 100644
--- a/extra/websites/concatenative/concatenative.factor
+++ b/extra/websites/concatenative/concatenative.factor
@@ -48,7 +48,7 @@ TUPLE: factor-website < dispatcher ;
<blogs> "blogs" add-responder
<todo-list> "todo" add-responder
<pastebin> "pastebin" add-responder
- <planet-factor> "planet" add-responder
+ <planet> "planet" add-responder
<wiki> "wiki" add-responder
<wee-url> "wee-url" add-responder
<user-admin> "user-admin" add-responder
From 6ad09779cc3e20a33aa2d527606d62eb2e82f410 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 15:46:52 -0500
Subject: [PATCH 21/24] Literal aliens in source files are bade bad
---
extra/db/pools/pools-tests.factor | 16 +++++++++++++++-
extra/io/pools/pools.factor | 2 +-
extra/windows/user32/user32.factor | 8 ++++----
3 files changed, 20 insertions(+), 6 deletions(-)
diff --git a/extra/db/pools/pools-tests.factor b/extra/db/pools/pools-tests.factor
index f0534a1d34..34e072c3a5 100644
--- a/extra/db/pools/pools-tests.factor
+++ b/extra/db/pools/pools-tests.factor
@@ -1,8 +1,22 @@
IN: db.pools.tests
-USING: db.pools tools.test ;
+USING: db.pools tools.test continuations io.files namespaces
+accessors kernel math destructors ;
\ <db-pool> must-infer
{ 2 0 } [ [ ] with-db-pool ] must-infer-as
{ 1 0 } [ [ ] with-pooled-db ] must-infer-as
+
+! Test behavior after image save/load
+USE: db.sqlite
+
+[ "pool-test.db" temp-file delete-file ] ignore-errors
+
+[ ] [ "pool-test.db" sqlite-db <db-pool> "pool" set ] unit-test
+
+[ ] [ "pool" get expired>> t >>expired drop ] unit-test
+
+[ ] [ 1000 [ "pool" get [ ] with-pooled-db ] times ] unit-test
+
+[ ] [ "pool" get dispose ] unit-test
diff --git a/extra/io/pools/pools.factor b/extra/io/pools/pools.factor
index 0e37e41a76..aa734e6809 100644
--- a/extra/io/pools/pools.factor
+++ b/extra/io/pools/pools.factor
@@ -9,7 +9,7 @@ TUPLE: pool connections disposed expired ;
: check-pool ( pool -- )
dup check-disposed
dup expired>> expired? [
- ALIEN: 31337 >>expired
+ 31337 <alien> >>expired
connections>> delete-all
] [ drop ] if ;
diff --git a/extra/windows/user32/user32.factor b/extra/windows/user32/user32.factor
index 1c1df52da8..241eddf9f0 100755
--- a/extra/windows/user32/user32.factor
+++ b/extra/windows/user32/user32.factor
@@ -1285,10 +1285,10 @@ FUNCTION: void SetLastErrorEx ( DWORD dwErrCode, DWORD dwType ) ;
! FUNCTION: SetWindowPlacement
FUNCTION: BOOL SetWindowPos ( HWND hWnd, HWND hWndInsertAfter, int X, int Y, int cx, int cy, UINT uFlags ) ;
-: HWND_BOTTOM ALIEN: 1 ;
-: HWND_NOTOPMOST ALIEN: -2 ;
-: HWND_TOP ALIEN: 0 ;
-: HWND_TOPMOST ALIEN: -1 ;
+: HWND_BOTTOM ( -- alien ) 1 <alien> ;
+: HWND_NOTOPMOST ( -- alien ) -2 <alien> ;
+: HWND_TOP ( -- alien ) 0 <alien> ;
+: HWND_TOPMOST ( -- alien ) -1 <alien> ;
! FUNCTION: SetWindowRgn
! FUNCTION: SetWindowsHookA
From 3b2f4d92d2c11e409fe12bae6246a4bf67486e00 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 15:50:12 -0500
Subject: [PATCH 22/24] Check if the handle has been disposed. This can happen
if we close one end of a duplex stream
---
extra/io/unix/backend/backend.factor | 7 +++++--
extra/io/windows/files/files.factor | 1 +
extra/io/windows/nt/backend/backend.factor | 2 +-
3 files changed, 7 insertions(+), 3 deletions(-)
diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor
index 165747084e..b984b1f156 100755
--- a/extra/io/unix/backend/backend.factor
+++ b/extra/io/unix/backend/backend.factor
@@ -125,7 +125,8 @@ M: fd refill
} cond ;
M: unix (wait-to-read) ( port -- )
- dup dup handle>> refill dup
+ dup
+ dup handle>> dup check-disposed refill dup
[ dupd wait-for-port (wait-to-read) ] [ 2drop ] if ;
! Writers
@@ -144,7 +145,9 @@ M: fd drain
} cond ;
M: unix (wait-to-write) ( port -- )
- dup dup handle>> drain dup [ wait-for-port ] [ 2drop ] if ;
+ dup
+ dup handle>> dup check-disposed drain
+ dup [ wait-for-port ] [ 2drop ] if ;
M: unix io-multiplex ( ms/f -- )
mx get-global wait-for-events ;
diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor
index 419509f124..e25be71872 100755
--- a/extra/io/windows/files/files.factor
+++ b/extra/io/windows/files/files.factor
@@ -61,6 +61,7 @@ C: <FileArgs> FileArgs
: make-FileArgs ( port -- <FileArgs> )
{
+ [ handle>> check-disposed ]
[ handle>> handle>> ]
[ buffer>> ]
[ buffer>> buffer-length ]
diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor
index 786275c736..e9df2ddab9 100755
--- a/extra/io/windows/nt/backend/backend.factor
+++ b/extra/io/windows/nt/backend/backend.factor
@@ -74,7 +74,7 @@ M: winnt add-completion ( win32-handle -- )
] if ;
M: win32-handle cancel-operation
- handle>> CancelIo drop ;
+ [ check-disposed ] [ handle>> CancelIo drop ] bi ;
M: winnt io-multiplex ( ms -- )
handle-overlapped [ 0 io-multiplex ] when ;
From 75338b577cb39d836b0da548f6f1d08f9f08daf9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 15:50:38 -0500
Subject: [PATCH 23/24] Rename from-now to hence
---
extra/alarms/alarms-docs.factor | 2 +-
extra/alarms/alarms.factor | 4 ++--
extra/calendar/calendar.factor | 4 ++--
extra/furnace/auth/login/login.factor | 3 +--
extra/furnace/cache/cache.factor | 4 ++--
extra/furnace/sessions/sessions.factor | 1 -
extra/tetris/tetris.factor | 2 +-
extra/ui/gestures/gestures.factor | 2 +-
8 files changed, 10 insertions(+), 12 deletions(-)
diff --git a/extra/alarms/alarms-docs.factor b/extra/alarms/alarms-docs.factor
index b25df236c9..f07a8b9a2d 100755
--- a/extra/alarms/alarms-docs.factor
+++ b/extra/alarms/alarms-docs.factor
@@ -10,7 +10,7 @@ HELP: add-alarm
HELP: later
{ $values { "quot" quotation } { "dt" duration } { "alarm" alarm } }
-{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } { $link from-now } "." } ;
+{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } " from now." } ;
HELP: cancel-alarm
{ $values { "alarm" alarm } }
diff --git a/extra/alarms/alarms.factor b/extra/alarms/alarms.factor
index ddc1d34121..a72960f20f 100755
--- a/extra/alarms/alarms.factor
+++ b/extra/alarms/alarms.factor
@@ -82,10 +82,10 @@ PRIVATE>
<alarm> [ register-alarm ] keep ;
: later ( quot dt -- alarm )
- from-now f add-alarm ;
+ hence f add-alarm ;
: every ( quot dt -- alarm )
- [ from-now ] keep add-alarm ;
+ [ hence ] keep add-alarm ;
: cancel-alarm ( alarm -- )
alarm-entry [ alarms get-global heap-delete ] if-box? ;
diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor
index e7b0b6f43a..0abc00b4a4 100755
--- a/extra/calendar/calendar.factor
+++ b/extra/calendar/calendar.factor
@@ -284,7 +284,7 @@ MEMO: unix-1970 ( -- timestamp )
: now ( -- timestamp ) gmt >local-time ;
-: from-now ( dt -- timestamp ) now swap time+ ;
+: hence ( dt -- timestamp ) now swap time+ ;
: ago ( dt -- timestamp ) now swap time- ;
: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline
@@ -357,7 +357,7 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ;
M: timestamp sleep-until timestamp>millis sleep-until ;
-M: duration sleep from-now sleep-until ;
+M: duration sleep hence sleep-until ;
{
{ [ os unix? ] [ "calendar.unix" ] }
diff --git a/extra/furnace/auth/login/login.factor b/extra/furnace/auth/login/login.factor
index 68161382c1..ce533bce64 100755
--- a/extra/furnace/auth/login/login.factor
+++ b/extra/furnace/auth/login/login.factor
@@ -40,10 +40,9 @@ M: login-realm modify-form ( responder -- )
permit-id get realm get name>> permit-id-key <cookie>
"$login-realm" resolve-base-path >>path
realm get
- [ timeout>> from-now >>expires ]
[ domain>> >>domain ]
[ secure>> >>secure ]
- tri ;
+ bi ;
: put-permit-cookie ( response -- response' )
<permit-cookie> put-cookie ;
diff --git a/extra/furnace/cache/cache.factor b/extra/furnace/cache/cache.factor
index a614a52548..68786a55ab 100644
--- a/extra/furnace/cache/cache.factor
+++ b/extra/furnace/cache/cache.factor
@@ -31,6 +31,6 @@ TUPLE: server-state-manager < filter-responder timeout ;
new
swap >>responder
20 minutes >>timeout ; inline
-
+
: touch-state ( state manager -- )
- timeout>> from-now >>expires drop ;
+ timeout>> hence >>expires drop ;
diff --git a/extra/furnace/sessions/sessions.factor b/extra/furnace/sessions/sessions.factor
index 0ec9648a67..5590a9e55e 100755
--- a/extra/furnace/sessions/sessions.factor
+++ b/extra/furnace/sessions/sessions.factor
@@ -116,7 +116,6 @@ M: session-saver dispose
: <session-cookie> ( -- cookie )
session get id>> session-id-key <cookie>
"$sessions" resolve-base-path >>path
- sessions get timeout>> from-now >>expires
sessions get domain>> >>domain ;
: put-session-cookie ( response -- response' )
diff --git a/extra/tetris/tetris.factor b/extra/tetris/tetris.factor
index 02f8f240d2..c2f874598c 100644
--- a/extra/tetris/tetris.factor
+++ b/extra/tetris/tetris.factor
@@ -45,7 +45,7 @@ tetris-gadget H{
dup tetris-gadget-tetris maybe-update relayout-1 ;
M: tetris-gadget graft* ( gadget -- )
- dup [ tick ] curry 100 milliseconds from-now 100 milliseconds add-alarm
+ dup [ tick ] curry 100 milliseconds every
swap set-tetris-gadget-alarm ;
M: tetris-gadget ungraft* ( gadget -- )
diff --git a/extra/ui/gestures/gestures.factor b/extra/ui/gestures/gestures.factor
index 88bc2bcee7..5c00fbfdb0 100755
--- a/extra/ui/gestures/gestures.factor
+++ b/extra/ui/gestures/gestures.factor
@@ -121,7 +121,7 @@ SYMBOL: drag-timer
: start-drag-timer ( -- )
hand-buttons get-global empty? [
[ drag-gesture ]
- 300 milliseconds from-now
+ 300 milliseconds hence
100 milliseconds
add-alarm drag-timer get-global >box
] when ;
From 7c76046d3b65654306c08a7d0d539ea3e04d5bfd Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Jul 2008 16:15:51 -0500
Subject: [PATCH 24/24] Minor Wiki improvements
---
extra/webapps/planet/mini-planet.xml | 14 -----
extra/webapps/wiki/initial-content/Farkup.txt | 63 +++++++++++++++++++
.../wiki/initial-content/Front Page.txt | 5 ++
extra/webapps/wiki/wiki-common.xml | 11 ++++
extra/webapps/wiki/wiki.factor | 29 +++++++--
.../concatenative/concatenative.factor | 2 +-
6 files changed, 105 insertions(+), 19 deletions(-)
delete mode 100644 extra/webapps/planet/mini-planet.xml
create mode 100644 extra/webapps/wiki/initial-content/Farkup.txt
create mode 100644 extra/webapps/wiki/initial-content/Front Page.txt
diff --git a/extra/webapps/planet/mini-planet.xml b/extra/webapps/planet/mini-planet.xml
deleted file mode 100644
index 661c2dc0f7..0000000000
--- a/extra/webapps/planet/mini-planet.xml
+++ /dev/null
@@ -1,14 +0,0 @@
-<?xml version='1.0' ?>
-
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-
- <t:bind-each t:name="postings">
-
- <p class="news">
- <strong><t:label t:name="title" /></strong> <br/>
- <t:a value="link" class="more">Read More...</t:a>
- </p>
-
- </t:bind-each>
-
-</t:chloe>
diff --git a/extra/webapps/wiki/initial-content/Farkup.txt b/extra/webapps/wiki/initial-content/Farkup.txt
new file mode 100644
index 0000000000..8814af6c0a
--- /dev/null
+++ b/extra/webapps/wiki/initial-content/Farkup.txt
@@ -0,0 +1,63 @@
+Look at the source to this page by clicking *Edit* to compare the farkup language with resulting output.
+
+= level 1 heading =
+
+== level 2 heading ==
+
+=== level 3 heading ===
+
+==== level 4 heading ====
+
+Here is a paragraph of text, with _emphasized_ and *strong* text, together with an inline %code snippet%. Did you know that E=mc^2^, and L~2~ spaces are cool? Of course, if you want to include \_ special \* characters \^ you \~ can \% do that, too.
+
+You can make [[Wiki Links]] just like that, as well as links to external sites: [[http://sbcl.sourceforge.net]]. [[Factor|Custom link text]] can be used [[http://www.apple.com|with both types of links]].
+
+Images can be embedded in the text:
+
+[[image:http://factorcode.org/graphics/logo.png]]
+
+- a list
+- with three
+- items
+
+|a table|with|four|columns|
+|and|two|rows|...|
+
+Here is some code:
+
+[{HAI
+CAN HAS STDIO?
+VISIBLE "HAI WORLD!"
+KTHXBYE}]
+
+There is syntax highlighting various languages, too:
+
+[factor{PEG: parse-request-line ( string -- triple )
+ #! Triple is { method url version }
+ [
+ 'space' ,
+ 'http-method' ,
+ 'space' ,
+ 'url' ,
+ 'space' ,
+ 'http-version' ,
+ 'space' ,
+ ] seq* just ;}]
+
+Some Java:
+
+[java{/**
+ * Returns the extension of the specified filename, or an empty
+ * string if there is none.
+ * @param path The path
+ */
+public static String getFileExtension(String path)
+{
+ int fsIndex = getLastSeparatorIndex(path);
+ int index = path.lastIndexOf('.');
+ // there could be a dot in the path and no file extension
+ if(index == -1 || index < fsIndex )
+ return "";
+ else
+ return path.substring(index);
+}}]
diff --git a/extra/webapps/wiki/initial-content/Front Page.txt b/extra/webapps/wiki/initial-content/Front Page.txt
new file mode 100644
index 0000000000..37351eed38
--- /dev/null
+++ b/extra/webapps/wiki/initial-content/Front Page.txt
@@ -0,0 +1,5 @@
+Congratulations, you are now running your very own Wiki.
+
+You can now click *Edit* below and begin editing the content of the [[Front Page]]. This Wiki uses [[Farkup]] to mark up text.
+
+Two special article names are recognized by the Wiki: [[Sidebar]] and [[Footer]]. They do not exist by default, but if you create them, they will be visible on every page.
diff --git a/extra/webapps/wiki/wiki-common.xml b/extra/webapps/wiki/wiki-common.xml
index 0abd36a7cd..5cddcee628 100644
--- a/extra/webapps/wiki/wiki-common.xml
+++ b/extra/webapps/wiki/wiki-common.xml
@@ -13,6 +13,7 @@
<t:a t:href="$wiki">Front Page</t:a>
| <t:a t:href="$wiki/articles">All Articles</t:a>
| <t:a t:href="$wiki/changes">Recent Changes</t:a>
+ | <t:a t:href="$wiki/random">Random Article</t:a>
<t:if t:code="furnace.auth:logged-in?">
@@ -45,6 +46,16 @@
</td>
</t:if>
</tr>
+
+ <tr>
+ <td>
+ <t:bind t:name="footer">
+ <small>
+ <t:farkup t:name="content" />
+ </small>
+ </t:bind>
+ </td>
+ </tr>
</table>
</t:chloe>
diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor
index 77ee242668..3c87f3cd49 100644
--- a/extra/webapps/wiki/wiki.factor
+++ b/extra/webapps/wiki/wiki.factor
@@ -1,7 +1,8 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel hashtables calendar
+USING: accessors kernel hashtables calendar random assocs
namespaces splitting sequences sorting math.order present
+io.files io.encodings.ascii
syndication
html.components html.forms
http.server
@@ -115,6 +116,14 @@ M: revision feed-entry-url id>> revision-url ;
{ wiki "view" } >>template ;
+: <random-article-action> ( -- action )
+ <action>
+ [
+ article new select-tuples random
+ [ title>> ] [ "Front Page" ] if*
+ view-url <redirect>
+ ] >>display ;
+
: amend-article ( revision article -- )
swap id>> >>revision update-tuple ;
@@ -286,15 +295,15 @@ M: revision feed-entry-url id>> revision-url ;
{ wiki "page-common" } >>template ;
: init-sidebar ( -- )
- "Sidebar" latest-revision [
- "sidebar" [ from-object ] nest-form
- ] when* ;
+ "Sidebar" latest-revision [ "sidebar" [ from-object ] nest-form ] when*
+ "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
: <wiki> ( -- dispatcher )
wiki new-dispatcher
<main-article-action> <article-boilerplate> "" add-responder
<view-article-action> <article-boilerplate> "view" add-responder
<view-revision-action> <article-boilerplate> "revision" add-responder
+ <random-article-action> "random" add-responder
<list-revisions-action> <article-boilerplate> "revisions" add-responder
<list-revisions-feed-action> "revisions.atom" add-responder
<diff-action> <article-boilerplate> "diff" add-responder
@@ -309,3 +318,15 @@ M: revision feed-entry-url id>> revision-url ;
<boilerplate>
[ init-sidebar ] >>init
{ wiki "wiki-common" } >>template ;
+
+: init-wiki ( -- )
+ "resource:extra/webapps/wiki/initial-content" directory* keys
+ [
+ [ ascii file-contents ] [ file-name "." split1 drop ] bi
+ f <revision>
+ swap >>title
+ swap >>content
+ "slava" >>author
+ now >>date
+ add-revision
+ ] each ;
diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor
index 211dcb3c11..1ae7f63a27 100644
--- a/extra/websites/concatenative/concatenative.factor
+++ b/extra/websites/concatenative/concatenative.factor
@@ -25,7 +25,7 @@ webapps.wee-url
webapps.user-admin ;
IN: websites.concatenative
-: test-db ( -- db params ) "resource:test.db" sqlite-db ;
+: test-db ( -- params db ) "resource:test.db" sqlite-db ;
: init-factor-db ( -- )
test-db [