From 3a1bb22618147bf2dfa7cc9cf21ad5d6fb342b5e Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 7 Oct 2009 19:30:06 -0500
Subject: [PATCH 01/20] delete malloc-file-contents 'cause it sucks and nobody
 likes it

---
 basis/alien/data/data-docs.factor | 1 -
 basis/alien/data/data.factor      | 4 +---
 2 files changed, 1 insertion(+), 4 deletions(-)

diff --git a/basis/alien/data/data-docs.factor b/basis/alien/data/data-docs.factor
index 68d5022630..0536d15736 100644
--- a/basis/alien/data/data-docs.factor
+++ b/basis/alien/data/data-docs.factor
@@ -56,7 +56,6 @@ $nl
 { $subsections
     malloc-object
     malloc-byte-array
-    malloc-file-contents
 }
 "The " { $vocab-link "libc" } " vocabulary defines several words which directly call C standard library memory management functions:"
 { $subsections
diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor
index 372f3e5f98..fc18921ef1 100644
--- a/basis/alien/data/data.factor
+++ b/basis/alien/data/data.factor
@@ -56,9 +56,6 @@ M: word <c-direct-array>
 : malloc-string ( string encoding -- alien )
     string>alien malloc-byte-array ;
 
-: malloc-file-contents ( path -- alien len )
-    binary file-contents [ malloc-byte-array ] [ length ] bi ;
-
 M: memory-stream stream-read
     [
         [ index>> ] [ alien>> ] bi <displaced-alien>
@@ -81,3 +78,4 @@ M: value-type c-type-setter ( type -- quot )
     [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
     '[ @ swap @ _ memcpy ] ;
 
+

From 1f8495a62f2da319d158764b05f4f94848ec84ef Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 7 Oct 2009 21:49:04 -0500
Subject: [PATCH 02/20] vm/os-netbsd.cpp: fix double-free error

---
 vm/os-netbsd.cpp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vm/os-netbsd.cpp b/vm/os-netbsd.cpp
index e280d99a80..e1bdc30460 100644
--- a/vm/os-netbsd.cpp
+++ b/vm/os-netbsd.cpp
@@ -10,7 +10,7 @@ const char *vm_executable_path()
 	static Dl_info info = {0};
 	if (!info.dli_fname)
 		dladdr((void *)main, &info);
-	return info.dli_fname;
+	return safe_strdup(info.dli_fname);
 }
 
 }

From 9357ee378e4ff3a88cbd71d6a385cc71ed33f7dc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Thu, 8 Oct 2009 03:48:03 -0500
Subject: [PATCH 03/20] cpu.architecture: move dummy -reps words here, from
 cpu.ppc

---
 basis/cpu/architecture/architecture.factor | 40 ++++++++++++++++++++++
 basis/cpu/ppc/ppc.factor                   | 39 ---------------------
 2 files changed, 40 insertions(+), 39 deletions(-)

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index c7a7f0c5ef..8bf84f6670 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -324,6 +324,46 @@ HOOK: %shr-vector-reps cpu ( -- reps )
 HOOK: %horizontal-shl-vector-reps cpu ( -- reps )
 HOOK: %horizontal-shr-vector-reps cpu ( -- reps )
 
+M: object %zero-vector-reps { } ;
+M: object %fill-vector-reps { } ;
+M: object %gather-vector-2-reps { } ;
+M: object %gather-vector-4-reps { } ;
+M: object %shuffle-vector-reps { } ;
+M: object %merge-vector-reps { } ;
+M: object %signed-pack-vector-reps { } ;
+M: object %unsigned-pack-vector-reps { } ;
+M: object %unpack-vector-head-reps { } ;
+M: object %unpack-vector-tail-reps { } ;
+M: object %integer>float-vector-reps { } ;
+M: object %float>integer-vector-reps { } ;
+M: object %compare-vector-reps drop { } ;
+M: object %compare-vector-ccs 2drop { } f ;
+M: object %test-vector-reps { } ;
+M: object %add-vector-reps { } ;
+M: object %saturated-add-vector-reps { } ;
+M: object %add-sub-vector-reps { } ;
+M: object %sub-vector-reps { } ;
+M: object %saturated-sub-vector-reps { } ;
+M: object %mul-vector-reps { } ;
+M: object %saturated-mul-vector-reps { } ;
+M: object %div-vector-reps { } ;
+M: object %min-vector-reps { } ;
+M: object %max-vector-reps { } ;
+M: object %dot-vector-reps { } ;
+M: object %sqrt-vector-reps { } ;
+M: object %horizontal-add-vector-reps { } ;
+M: object %horizontal-sub-vector-reps { } ;
+M: object %abs-vector-reps { } ;
+M: object %and-vector-reps { } ;
+M: object %andn-vector-reps { } ;
+M: object %or-vector-reps { } ;
+M: object %xor-vector-reps { } ;
+M: object %not-vector-reps { } ;
+M: object %shl-vector-reps { } ;
+M: object %shr-vector-reps { } ;
+M: object %horizontal-shl-vector-reps { } ;
+M: object %horizontal-shr-vector-reps { } ;
+
 HOOK: %unbox-alien cpu ( dst src -- )
 HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
 HOOK: %box-alien cpu ( dst src temp -- )
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 32c92a8da0..9237d320f3 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -256,45 +256,6 @@ M:: ppc %binary-float-function ( dst src1 src2 func -- )
 M: ppc %single>double-float double-rep %copy ;
 M: ppc %double>single-float double-rep %copy ;
 
-! VMX/AltiVec not supported yet
-M: ppc %zero-vector-reps { } ;
-M: ppc %fill-vector-reps { } ;
-M: ppc %gather-vector-2-reps { } ;
-M: ppc %gather-vector-4-reps { } ;
-M: ppc %shuffle-vector-reps { } ;
-M: ppc %merge-vector-reps { } ;
-M: ppc %signed-pack-vector-reps { } ;
-M: ppc %unsigned-pack-vector-reps { } ;
-M: ppc %unpack-vector-reps { } ;
-M: ppc %integer>float-vector-reps { } ;
-M: ppc %float>integer-vector-reps { } ;
-M: ppc %compare-vector-reps drop { } ;
-M: ppc %test-vector-reps { } ;
-M: ppc %add-vector-reps { } ;
-M: ppc %saturated-add-vector-reps { } ;
-M: ppc %add-sub-vector-reps { } ;
-M: ppc %sub-vector-reps { } ;
-M: ppc %saturated-sub-vector-reps { } ;
-M: ppc %mul-vector-reps { } ;
-M: ppc %saturated-mul-vector-reps { } ;
-M: ppc %div-vector-reps { } ;
-M: ppc %min-vector-reps { } ;
-M: ppc %max-vector-reps { } ;
-M: ppc %dot-vector-reps { } ;
-M: ppc %sqrt-vector-reps { } ;
-M: ppc %horizontal-add-vector-reps { } ;
-M: ppc %horizontal-sub-vector-reps { } ;
-M: ppc %abs-vector-reps { } ;
-M: ppc %and-vector-reps { } ;
-M: ppc %andn-vector-reps { } ;
-M: ppc %or-vector-reps { } ;
-M: ppc %xor-vector-reps { } ;
-M: ppc %not-vector-reps { } ;
-M: ppc %shl-vector-reps { } ;
-M: ppc %shr-vector-reps { } ;
-M: ppc %horizontal-shl-vector-reps { } ;
-M: ppc %horizontal-shr-vector-reps { } ;
-
 M: ppc %unbox-alien ( dst src -- )
     alien-offset LWZ ;
 

From 09e8484777c4df7fe0fe1550f0707e1e58abc177 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Oct 2009 05:03:40 -0500
Subject: [PATCH 04/20] fix using

---
 basis/game/input/input-docs.factor | 2 +-
 extra/gpu/util/wasd/wasd.factor    | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/basis/game/input/input-docs.factor b/basis/game/input/input-docs.factor
index bef08c4d2f..29b74ff570 100755
--- a/basis/game/input/input-docs.factor
+++ b/basis/game/input/input-docs.factor
@@ -3,7 +3,7 @@ sequences strings math ;
 IN: game.input
 
 ARTICLE: "game-input" "Game controller input"
-"The " { $vocab-link "game-input" } " vocabulary provides cross-platform access to game controller devices such as joysticks and gamepads. It also provides an interface for polling raw keyboard and mouse input." $nl
+"The " { $vocab-link "game.input" } " vocabulary provides cross-platform access to game controller devices such as joysticks and gamepads. It also provides an interface for polling raw keyboard and mouse input." $nl
 "The game input interface must be initialized before being used:"
 { $subsections
     open-game-input
diff --git a/extra/gpu/util/wasd/wasd.factor b/extra/gpu/util/wasd/wasd.factor
index 1f1187fd21..bee05463af 100644
--- a/extra/gpu/util/wasd/wasd.factor
+++ b/extra/gpu/util/wasd/wasd.factor
@@ -1,5 +1,5 @@
 ! (c)2009 Joe Groff bsd license
-USING: accessors arrays combinators.smart game-input
+USING: accessors arrays combinators.smart game.input
 game.input.scancodes game.loop game.worlds
 gpu.render gpu.state kernel literals
 locals math math.constants math.functions math.matrices

From 5a2a99128bbc7ba7f54a0da4b03426dbb83bd91e Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 8 Oct 2009 11:34:20 -0500
Subject: [PATCH 05/20] add an "nspin" generalization

---
 basis/generalizations/generalizations-docs.factor  | 7 +++++++
 basis/generalizations/generalizations-tests.factor | 2 ++
 basis/generalizations/generalizations.factor       | 3 +++
 3 files changed, 12 insertions(+)

diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor
index e05d871323..e3a7c2d7e4 100644
--- a/basis/generalizations/generalizations-docs.factor
+++ b/basis/generalizations/generalizations-docs.factor
@@ -303,6 +303,12 @@ HELP: ntuck
 }
 { $description "A generalization of " { $link tuck } " that can work for any stack depth. The top item will be copied and placed " { $snippet "n" } " items down on the stack." } ;
 
+HELP: nspin
+{ $values
+    { "n" integer }
+}
+{ $description "A generalization of " { $link spin } " that can work for any stack depth. The top " { $snippet "n" } " items will be reversed in order." } ;
+
 ARTICLE: "sequence-generalizations" "Generalized sequence operations"
 { $subsections
     narray
@@ -321,6 +327,7 @@ ARTICLE: "shuffle-generalizations" "Generalized shuffle words"
     nnip
     ndrop
     ntuck
+    nspin
     mnswap
     nweave
 } ;
diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor
index ec5c1ecc2d..f95ba63228 100644
--- a/basis/generalizations/generalizations-tests.factor
+++ b/basis/generalizations/generalizations-tests.factor
@@ -26,6 +26,8 @@ IN: generalizations.tests
 { 0 } [ 0 1 2 3 4 4 ndrop ] unit-test
 [ [ 1 ] 5 ndip ] must-infer
 [ 1 2 3 4 ] [ 2 3 4 [ 1 ] 3 ndip ] unit-test
+[ 5 nspin ] must-infer
+[ 1 5 4 3 2 ] [ 1 2 3 4 5 4 nspin ] 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
diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 03d4512196..a39d549d3b 100644
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -104,3 +104,6 @@ MACRO: nbi-curry ( n -- )
     [ narray concat ] dip like ; inline
 
 : nappend ( n -- seq ) narray concat ; inline
+
+MACRO: nspin ( n -- )
+    [ [ ] ] swap [ swap [ ] curry compose ] n*quot [ call ] 3append ;

From 531cfa1c33d657fc28b45d2da7e72f59629f5ff5 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 8 Oct 2009 11:35:40 -0500
Subject: [PATCH 06/20] refactor math.vectors.conversion

---
 .../math/vectors/conversion/conversion.factor | 31 +++++++++++++------
 1 file changed, 22 insertions(+), 9 deletions(-)

diff --git a/basis/math/vectors/conversion/conversion.factor b/basis/math/vectors/conversion/conversion.factor
index 863cb9fea5..f70dfc9b27 100644
--- a/basis/math/vectors/conversion/conversion.factor
+++ b/basis/math/vectors/conversion/conversion.factor
@@ -39,32 +39,45 @@ ERROR: bad-vconvert-input value expected-type ;
     } cond
     [ from-type check-vconvert-type ] prepose ;
 
-:: [vpack] ( from-element to-element from-size to-size from-type to-type -- quot )
-    from-size to-size /i log2 :> steps
-
+:: check-vpack ( from-element to-element from-type to-type steps -- )
     {
         [ steps 1 = not ]
         [ from-element to-element [ float-type? ] bi@ xor ]
         [ from-element unsigned-type? to-element unsigned-type? not and ]
-    } 0|| [ from-type to-type bad-vconvert ] when
+    } 0|| [ from-type to-type bad-vconvert ] when ;
 
-    to-element unsigned-type? [ to-type (vpack-unsigned) ] [ to-type (vpack-signed) ] ?
-    [ [ from-type check-vconvert-type ] bi@ ] prepose ;
+:: [[vpack-unsigned]] ( from-type to-type -- quot )
+    [ [ from-type check-vconvert-type ] bi@ to-type (vpack-unsigned) ] ;
 
-:: [vunpack] ( from-element to-element from-size to-size from-type to-type -- quot )
-    to-size from-size /i log2 :> steps
+:: [[vpack-signed]] ( from-type to-type -- quot )
+    [ [ from-type check-vconvert-type ] bi@ to-type (vpack-signed) ] ;
 
+:: [vpack] ( from-element to-element from-size to-size from-type to-type -- quot )
+    from-size to-size /i log2 :> steps
+
+    from-element to-element from-type to-type steps check-vpack
+
+    from-type to-type to-element unsigned-type?
+    [ [[vpack-unsigned]] ] [ [[vpack-signed]] ] if ;
+
+:: check-vunpack ( from-element to-element from-type to-type steps -- )
     {
         [ steps 1 = not ]
         [ from-element to-element [ float-type? ] bi@ xor ]
         [ from-element unsigned-type? not to-element unsigned-type? and ]
-    } 0|| [ from-type to-type bad-vconvert ] when
+    } 0|| [ from-type to-type bad-vconvert ] when ;
 
+:: [[vunpack]] ( from-type to-type -- quot )
     [
         from-type check-vconvert-type
         [ to-type (vunpack-head) ] [ to-type (vunpack-tail) ] bi
     ] ;
 
+:: [vunpack] ( from-element to-element from-size to-size from-type to-type -- quot )
+    to-size from-size /i log2 :> steps
+    from-element to-element from-type to-type steps check-vunpack
+    from-type to-type [[vunpack]] ; 
+
 PRIVATE>
 
 MACRO:: vconvert ( from-type to-type -- )

From 27c5ab9cc37e16cde8cc7b77259fa66631bf6e30 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 8 Oct 2009 12:24:07 -0500
Subject: [PATCH 07/20] shatter the four-argument barrier in memoize

---
 basis/memoize/memoize-docs.factor  | 10 ++++-----
 basis/memoize/memoize-tests.factor | 11 +++++++++-
 basis/memoize/memoize.factor       | 34 +++++++++++++++++++-----------
 3 files changed, 36 insertions(+), 19 deletions(-)

diff --git a/basis/memoize/memoize-docs.factor b/basis/memoize/memoize-docs.factor
index 674fa005c2..58ba60af7c 100644
--- a/basis/memoize/memoize-docs.factor
+++ b/basis/memoize/memoize-docs.factor
@@ -19,12 +19,10 @@ ABOUT: "memoize"
 
 HELP: define-memoized
 { $values { "word" word } { "quot" quotation } { "effect" effect } }
-{ $description "defines the given word at runtime as one which memoizes its output given a particular input" }
-{ $notes "A maximum of four input and four output arguments can be used" }
-{ $see-also POSTPONE: MEMO: } ;
+{ $description "Defines the given word at run time as one which memoizes its outputs given a particular input." } ;
 
 HELP: MEMO:
 { $syntax "MEMO: word ( stack -- effect ) definition ;" }
-{ $description "defines the given word at parsetime as one which memoizes its output given a particular input. The stack effect is mandatory." }
-{ $notes "A maximum of four input and four output arguments can be used" }
-{ $see-also define-memoized } ;
+{ $description "Defines the given word at parse time as one which memoizes its output given a particular input. The stack effect is mandatory." } ;
+
+{ define-memoized POSTPONE: MEMO: } related-words
diff --git a/basis/memoize/memoize-tests.factor b/basis/memoize/memoize-tests.factor
index 771c11c130..11dfd705c2 100644
--- a/basis/memoize/memoize-tests.factor
+++ b/basis/memoize/memoize-tests.factor
@@ -7,9 +7,18 @@ IN: memoize.tests
 MEMO: fib ( m -- n )
     dup 1 <= [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ;
 
+MEMO: x ( a b c d e -- f g h i j )
+    [ 1 + ] 4 ndip ;
+
 [ 89 ] [ 10 fib ] unit-test
 
-[ "USING: kernel math memoize generalizations ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) [ 1 + ] 4 ndip ;" eval( -- ) ] must-fail
+[
+    1 0 0 0 0
+    1 0 0 0 0
+] [
+    0 0 0 0 0 x
+    0 0 0 0 0 x
+] unit-test
 
 MEMO: see-test ( a -- b ) reverse ;
 
diff --git a/basis/memoize/memoize.factor b/basis/memoize/memoize.factor
index 74ca07cda3..21291318b1 100644
--- a/basis/memoize/memoize.factor
+++ b/basis/memoize/memoize.factor
@@ -5,18 +5,32 @@ parser math assocs effects definitions quotations summary
 accessors fry ;
 IN: memoize
 
-ERROR: too-many-arguments ;
-
-M: too-many-arguments summary
-    drop "There must be no more than 4 input and 4 output arguments" ;
-
 <PRIVATE
 
+! We can't use n*quot, narray and firstn from generalizations because
+! they're macros, and macros use memoize!
+: (n*quot) ( n quot -- quotquot )
+    <repetition> concat >quotation ;
+
+: [narray] ( length -- quot )
+    [ [ 1 - ] keep '[ _ _ f <array> ] ]
+    [ [ [ set-nth ] 2keep [ 1 - ] dip ] (n*quot) ] bi
+    [ nip ] 3append ; 
+
+: [firstn] ( length -- quot )
+    [ 0 swap ] swap
+    [ [ nth ] 2keep [ 1 + ] dip ] (n*quot)
+    [ 2drop ] 3append ;
+
 : packer ( seq -- quot )
-    length { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ;
+    length dup 4 <=
+    [ { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ]
+    [ [narray] ] if ;
 
 : unpacker ( seq -- quot )
-    length { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ;
+    length dup 4 <=
+    [ { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ]
+    [ [firstn] ] if ;
 
 : pack/unpack ( quot effect -- newquot )
     [ in>> packer ] [ out>> unpacker ] bi surround ;
@@ -24,11 +38,7 @@ M: too-many-arguments summary
 : unpack/pack ( quot effect -- newquot )
     [ in>> unpacker ] [ out>> packer ] bi surround ;
 
-: check-memoized ( effect -- )
-    [ in>> ] [ out>> ] bi [ length 4 > ] either? [ too-many-arguments ] when ;
-
 : make-memoizer ( table quot effect -- quot )
-    [ check-memoized ] keep
     [ unpack/pack '[ _ _ cache ] ] keep
     pack/unpack ;
 
@@ -62,4 +72,4 @@ M: memoized reset-word
 : invalidate-memoized ( inputs... word -- )
     [ stack-effect in>> packer call ] [ "memoize" word-prop delete-at ] bi ;
 
-\ invalidate-memoized t "no-compile" set-word-prop
\ No newline at end of file
+\ invalidate-memoized t "no-compile" set-word-prop

From 9a09c3ced862980f276c6008b77e091f2229202b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Oct 2009 12:30:43 -0500
Subject: [PATCH 08/20] fix using

---
 basis/tools/deploy/test/8/8.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/basis/tools/deploy/test/8/8.factor b/basis/tools/deploy/test/8/8.factor
index ddf08d3654..6bbb85f9fc 100644
--- a/basis/tools/deploy/test/8/8.factor
+++ b/basis/tools/deploy/test/8/8.factor
@@ -1,4 +1,4 @@
-USING: calendar game-input threads ui ui.gadgets.worlds kernel
+USING: calendar game.input threads ui ui.gadgets.worlds kernel
 method-chains system ;
 IN: tools.deploy.test.8
 
@@ -18,4 +18,4 @@ AFTER: my-world end-world drop close-game-input ;
         0 exit
     ] with-ui ;
 
-MAIN: test-game-input
\ No newline at end of file
+MAIN: test-game-input

From b150deeb11cc006cc966d301f6a05a704b6fe46a Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 8 Oct 2009 12:55:52 -0500
Subject: [PATCH 09/20] refactor so that generalizations reuses the stub
 versions of nsequence, firstn, and n*quot needed by memoize

---
 basis/alien/parser/parser.factor             |  2 +-
 basis/generalizations/generalizations.factor | 11 ++++-------
 basis/memoize/memoize.factor                 | 16 ++++++++--------
 3 files changed, 13 insertions(+), 16 deletions(-)

diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index 59607fa781..67f1d4e5fd 100644
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@ -10,7 +10,7 @@ IN: alien.parser
 : parse-c-type-name ( name -- word )
     dup search [ nip ] [ no-word ] if* ;
 
-: parse-c-type ( string -- array )
+: parse-c-type ( string -- type )
     {
         { [ dup "void" =            ] [ drop void ] }
         { [ CHAR: ] over member?    ] [ parse-array-type parse-c-type-name prefix ] }
diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index a39d549d3b..5ca00018a2 100644
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -2,22 +2,19 @@
 ! Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences sequences.private math combinators
-macros quotations fry effects ;
+macros quotations fry effects memoize.private ;
 IN: generalizations
 
 <<
 
-: n*quot ( n quot -- quot' ) <repetition> concat >quotation ;
+ALIAS: n*quot (n*quot)
 
 : repeat ( n obj quot -- ) swapd times ; inline
 
 >>
 
 MACRO: nsequence ( n seq -- )
-    [
-        [ drop iota <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
-        [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce
-    ] keep
+    [ [nsequence] ] keep
     '[ @ _ like ] ;
 
 MACRO: narray ( n -- )
@@ -27,7 +24,7 @@ MACRO: nsum ( n -- )
     1 - [ + ] n*quot ;
 
 MACRO: firstn-unsafe ( n -- )
-    iota [ '[ [ _ ] dip nth-unsafe ] ] map '[ _ cleave ] ;
+    [firstn] ;
 
 MACRO: firstn ( n -- )
     dup zero? [ drop [ drop ] ] [
diff --git a/basis/memoize/memoize.factor b/basis/memoize/memoize.factor
index 21291318b1..c949c34684 100644
--- a/basis/memoize/memoize.factor
+++ b/basis/memoize/memoize.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel hashtables sequences arrays words namespaces make
-parser math assocs effects definitions quotations summary
-accessors fry ;
+USING: kernel hashtables sequences sequences.private arrays
+words namespaces make parser math assocs effects definitions
+quotations summary accessors fry ;
 IN: memoize
 
 <PRIVATE
@@ -12,20 +12,20 @@ IN: memoize
 : (n*quot) ( n quot -- quotquot )
     <repetition> concat >quotation ;
 
-: [narray] ( length -- quot )
-    [ [ 1 - ] keep '[ _ _ f <array> ] ]
-    [ [ [ set-nth ] 2keep [ 1 - ] dip ] (n*quot) ] bi
+: [nsequence] ( length exemplar -- quot )
+    [ [ [ 1 - ] keep ] dip '[ _ _ _ new-sequence ] ]
+    [ drop [ [ set-nth-unsafe ] 2keep [ 1 - ] dip ] (n*quot) ] 2bi
     [ nip ] 3append ; 
 
 : [firstn] ( length -- quot )
     [ 0 swap ] swap
-    [ [ nth ] 2keep [ 1 + ] dip ] (n*quot)
+    [ [ nth-unsafe ] 2keep [ 1 + ] dip ] (n*quot)
     [ 2drop ] 3append ;
 
 : packer ( seq -- quot )
     length dup 4 <=
     [ { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ]
-    [ [narray] ] if ;
+    [ { } [nsequence] ] if ;
 
 : unpacker ( seq -- quot )
     length dup 4 <=

From 18b3c120a7cd578865637f5834e6312747e92644 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 8 Oct 2009 14:42:59 -0500
Subject: [PATCH 10/20] add a set-firstn generalization

---
 basis/generalizations/generalizations-docs.factor  |  8 +++++++-
 basis/generalizations/generalizations-tests.factor |  2 ++
 basis/generalizations/generalizations.factor       | 12 ++++++++++++
 3 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor
index e3a7c2d7e4..de74dd1ead 100644
--- a/basis/generalizations/generalizations-docs.factor
+++ b/basis/generalizations/generalizations-docs.factor
@@ -50,6 +50,11 @@ HELP: firstn
     }
 } ;
 
+HELP: set-firstn
+{ $values { "n" integer } }
+{ $description "A generalization of " { $link set-first } " "
+"that sets the first " { $snippet "n" } " elements of a sequence from the top " { $snippet "n" } " elements of the stack." } ;
+
 HELP: npick
 { $values { "n" integer } }
 { $description "A generalization of " { $link dup } ", "
@@ -257,7 +262,7 @@ HELP: nweave
 HELP: n*quot
 { $values
      { "n" integer } { "quot" quotation }
-     { "quot'" quotation }
+     { "quotquot" quotation }
 }
 { $examples
     { $example "USING: generalizations prettyprint math ;"
@@ -314,6 +319,7 @@ ARTICLE: "sequence-generalizations" "Generalized sequence operations"
     narray
     nsequence
     firstn
+    set-firstn
     nappend
     nappend-as
 } ;
diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor
index f95ba63228..d466d56251 100644
--- a/basis/generalizations/generalizations-tests.factor
+++ b/basis/generalizations/generalizations-tests.factor
@@ -40,6 +40,8 @@ IN: generalizations.tests
 [ { "xyc" "xyd" } ] [ "x" "y" { "c" "d" } [ 3append ] 2 nwith map ] unit-test
 
 [ 1 2 3 4 ] [ { 1 2 3 4 } 4 firstn ] unit-test
+[ { 1 2 3 4 } ] [ 1 2 3 4 { f f f f } [ 4 set-firstn ] keep ] unit-test
+[ 1 2 3 4 { f f f } [ 4 set-firstn ] keep ] must-fail
 [ ] [ { } 0 firstn ] unit-test
 [ "a" ] [ { "a" } 1 firstn ] unit-test
 
diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 5ca00018a2..2e9d560ae6 100644
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -48,6 +48,18 @@ MACRO: nrot ( n -- )
 MACRO: -nrot ( n -- )
     1 - [ ] [ '[ swap _ dip ] ] repeat ;
 
+MACRO: set-firstn-unsafe ( n -- )
+    [ 1 + ]
+    [ iota [ '[ _ rot [ set-nth-unsafe ] keep ] ] map ] bi
+    '[ _ -nrot _ spread drop ] ;
+
+MACRO: set-firstn ( n -- )
+    dup zero? [ drop [ drop ] ] [
+        [ 1 - swap bounds-check 2drop ]
+        [ set-firstn-unsafe ]
+        bi-curry '[ _ _ bi ]
+    ] if ;
+
 MACRO: ndrop ( n -- )
     [ drop ] n*quot ;
 

From 37d0f29e4b1c3ecfe8f3d04afd977d61c889e527 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Oct 2009 16:07:36 -0500
Subject: [PATCH 11/20] add a couple of combinators to mmap that take a c-type
 to reduce conceptual overhead and boilerplate, more docs

---
 basis/io/mmap/mmap-docs.factor       | 55 +++++++++++++++++++++++-----
 basis/io/mmap/mmap.factor            | 19 ++++++++--
 basis/io/mmap/unix/unix.factor       |  4 +-
 basis/io/mmap/windows/windows.factor |  2 +-
 4 files changed, 65 insertions(+), 15 deletions(-)

diff --git a/basis/io/mmap/mmap-docs.factor b/basis/io/mmap/mmap-docs.factor
index c87a3552e4..3379a2879b 100644
--- a/basis/io/mmap/mmap-docs.factor
+++ b/basis/io/mmap/mmap-docs.factor
@@ -1,5 +1,6 @@
-USING: help.markup help.syntax alien math continuations
-destructors specialized-arrays ;
+USING: alien alien.c-types continuations destructors
+help.markup help.syntax kernel math quotations
+specialized-arrays ;
 IN: io.mmap
 
 HELP: mapped-file
@@ -33,9 +34,42 @@ HELP: close-mapped-file
 { $contract "Releases system resources associated with the mapped file. This word should not be called by user code; use " { $link dispose } " instead." }
 { $errors "Throws an error if a memory mapping could not be established." } ;
 
+HELP: <mapped-file-reader>
+{ $values { "path" "a pathname string" }  { "mmap" mapped-file } }
+{ $contract "Opens a file for reading only and maps its contents into memory. The length is permitted to exceed the length of the file on disk, in which case the remaining space is padded with zero bytes." }
+{ $notes "You must call " { $link dispose } " when you are finished working with the returned object, to reclaim resources. The " { $link with-mapped-file } " provides an abstraction which can close the mapped file for you." }
+{ $errors "Throws an error if a memory mapping could not be established." } ;
+
+HELP: with-mapped-array
+{ $values
+    { "path" "a pathname string" } { "c-type" c-type } { "quot" quotation }
+}
+{ $description "Memory-maps a file for reading and writing as a mapped-array of the given c-type. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
+{ $examples
+    { $unchecked-example
+        "USING: io.mmap prettyprint specialized-arrays ;"
+        "SPECIALIZED-ARRAY: uint"
+""""resource:license.txt" uint [
+    [ . ] each
+] with-mapped-array"""
+        ""
+    }
+}
+{ $errors "Throws an error if a memory mapping could not be established." } ;
+
+HELP: with-mapped-array-reader
+{ $values
+    { "path" "a pathname string" } { "c-type" c-type } { "quot" quotation }
+}
+{ $description "Memory-maps a file for reading as a mapped-array of the given c-type. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
+{ $errors "Throws an error if a memory mapping could not be established." } ;
+
 ARTICLE: "io.mmap.arrays" "Working with memory-mapped data"
 "The " { $link <mapped-file> } " word returns an instance of " { $link mapped-file } ", which doesn't directly support the sequence protocol. Instead, it needs to be wrapped in a specialized array of the appropriate C type:"
 { $subsections <mapped-array> }
+"Additionally, files may be opened with two combinators which take a c-type as input:"
+{ $subsections with-mapped-array }
+{ $subsections with-mapped-array-reader }
 "The appropriate specialized array type must first be generated with " { $link POSTPONE: SPECIALIZED-ARRAY: } "."
 $nl
 "Data can also be read and written from the " { $link mapped-file } " by applying low-level alien words to the " { $slot "address" } " slot. This approach is not recommended, though, since in most cases the compiler will generate efficient code for specialized array usage. See " { $link "reading-writing-memory" } " for a description of low-level memory access primitives." ;
@@ -46,10 +80,10 @@ ARTICLE: "io.mmap.examples" "Memory-mapped file examples"
     "USING: alien.c-types grouping io.mmap sequences" "specialized-arrays ;"
     "SPECIALIZED-ARRAY: char"
     ""
-    "\"mydata.dat\" ["
-    "    char <mapped-array> 4 <sliced-groups>"
+    "\"mydata.dat\" char ["
+    "    4 <sliced-groups>"
     "    [ reverse-here ] change-each"
-    "] with-mapped-file"
+    "] with-mapped-array"
 }
 "Normalize a file containing packed quadrupes of floats:"
 { $code
@@ -57,17 +91,20 @@ ARTICLE: "io.mmap.examples" "Memory-mapped file examples"
     "SIMD: float"
     "SPECIALIZED-ARRAY: float-4"
     ""
-    "\"mydata.dat\" ["
-    "    float-4 <mapped-array>"
+    "\"mydata.dat\" float-4 ["
     "    [ normalize ] change-each"
-    "] with-mapped-file"
+    "] with-mapped-array"
 } ;
 
 ARTICLE: "io.mmap" "Memory-mapped files"
 "The " { $vocab-link "io.mmap" } " vocabulary implements support for memory-mapped files."
 { $subsections <mapped-file> }
-"Memory-mapped files are disposable and can be closed with " { $link dispose } " or " { $link with-disposal } ". A utility combinator which wraps the above:"
+"Memory-mapped files are disposable and can be closed with " { $link dispose } " or " { $link with-disposal } "." $nl
+"Utility combinators which wrap the above:"
 { $subsections with-mapped-file }
+{ $subsections with-mapped-file-reader }
+{ $subsections with-mapped-array }
+{ $subsections with-mapped-array-reader }
 "Instances of " { $link mapped-file } " don't support any interesting operations in themselves. There are two facilities for accessing their contents:"
 { $subsections
     "io.mmap.arrays"
diff --git a/basis/io/mmap/mmap.factor b/basis/io/mmap/mmap.factor
index 19587cda34..5f35278b05 100644
--- a/basis/io/mmap/mmap.factor
+++ b/basis/io/mmap/mmap.factor
@@ -8,13 +8,13 @@ IN: io.mmap
 
 TUPLE: mapped-file < disposable address handle length ;
 
-HOOK: (mapped-file-reader) os ( path length -- address handle )
-HOOK: (mapped-file-r/w) os ( path length -- address handle )
-
 ERROR: bad-mmap-size n ;
 
 <PRIVATE
 
+HOOK: (mapped-file-reader) os ( path length -- address handle )
+HOOK: (mapped-file-r/w) os ( path length -- address handle )
+
 : prepare-mapped-file ( path quot -- mapped-file path' length )
     [
         [ normalize-path ] [ file-info size>> ] bi
@@ -45,6 +45,19 @@ M: mapped-file dispose* ( mmap -- ) close-mapped-file ;
 : with-mapped-file-reader ( path quot -- )
     [ <mapped-file-reader> ] dip with-disposal ; inline
 
+<PRIVATE
+
+: (with-mapped-array) ( c-type quot -- )
+    [ [ <mapped-array> ] curry ] dip compose with-disposal ; inline
+
+PRIVATE>
+
+: with-mapped-array ( path c-type quot -- )
+    [ <mapped-file> ] 2dip (with-mapped-array) ; inline
+
+: with-mapped-array-reader ( path c-type quot -- )
+    [ <mapped-file-reader> ] 2dip (with-mapped-array) ; inline
+
 {
     { [ os unix? ] [ "io.mmap.unix" require ] }
     { [ os winnt? ] [ "io.mmap.windows" require ] }
diff --git a/basis/io/mmap/unix/unix.factor b/basis/io/mmap/unix/unix.factor
index 7d12d52361..559417d2b9 100644
--- a/basis/io/mmap/unix/unix.factor
+++ b/basis/io/mmap/unix/unix.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien io io.files kernel math math.bitwise system unix
-io.backend.unix io.ports io.mmap destructors locals accessors ;
+USING: accessors destructors io.backend.unix io.mmap
+io.mmap.private kernel locals math.bitwise system unix ;
 IN: io.mmap.unix
 
 :: mmap-open ( path length prot flags open-mode -- alien fd )
diff --git a/basis/io/mmap/windows/windows.factor b/basis/io/mmap/windows/windows.factor
index 8fdc7fefd9..a2c1f972a6 100644
--- a/basis/io/mmap/windows/windows.factor
+++ b/basis/io/mmap/windows/windows.factor
@@ -1,6 +1,6 @@
 USING: alien alien.c-types arrays destructors generic io.mmap
 io.ports io.backend.windows io.files.windows io.backend.windows.privileges
-kernel libc math math.bitwise namespaces quotations sequences
+io.mmap.private kernel libc math math.bitwise namespaces quotations sequences
 windows windows.advapi32 windows.kernel32 io.backend system
 accessors locals windows.errors ;
 IN: io.mmap.windows

From 7403bcef0ce2f0116ed8780de0580f9e09528614 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Oct 2009 16:58:24 -0500
Subject: [PATCH 12/20] make pngs read scanlines in terms of bits instead of
 bytes

---
 basis/compression/inflate/inflate.factor |  6 +--
 basis/images/png/png.factor              | 47 +++++++++++++++++-------
 2 files changed, 36 insertions(+), 17 deletions(-)

diff --git a/basis/compression/inflate/inflate.factor b/basis/compression/inflate/inflate.factor
index ab27c70ac0..567c435c2e 100644
--- a/basis/compression/inflate/inflate.factor
+++ b/basis/compression/inflate/inflate.factor
@@ -3,7 +3,7 @@
 USING: accessors arrays assocs byte-vectors combinators
 combinators.smart compression.huffman fry hashtables io.binary
 kernel literals locals math math.bitwise math.order math.ranges
-sequences sorting memoize combinators.short-circuit ;
+sequences sorting memoize combinators.short-circuit byte-arrays ;
 QUALIFIED-WITH: bitstreams bs
 IN: compression.inflate
 
@@ -88,14 +88,14 @@ CONSTANT: dist-table
 : nth* ( n seq -- elt )
     [ length 1 - swap - ] [ nth ] bi ; inline
 
-:: inflate-lz77 ( seq -- bytes )
+:: inflate-lz77 ( seq -- byte-array )
     1000 <byte-vector> :> bytes
     seq [
         dup array?
         [ first2 '[ _ 1 - bytes nth* bytes push ] times ]
         [ bytes push ] if
     ] each
-    bytes ;
+    bytes >byte-array ;
 
 :: inflate-huffman ( bitstream tables -- bytes )
     bitstream tables [ <huffman-decoder> ] with map :> tables
diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index 08d8c56667..74c40d1291 100755
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -4,6 +4,7 @@ USING: accessors arrays checksums checksums.crc32 combinators
 compression.inflate fry grouping images images.loader io
 io.binary io.encodings.ascii io.encodings.string kernel locals
 math math.bitwise math.ranges sequences sorting ;
+QUALIFIED-WITH: bitstreams bs
 IN: images.png
 
 SINGLETON: png-image
@@ -85,18 +86,17 @@ ERROR: unimplemented-color-type image ;
 : inflate-data ( loading-png -- bytes )
     find-compressed-bytes zlib-inflate ; 
 
-: scale-bit-depth ( loading-png -- n ) bit-depth>> 8 / ; inline
-
-: png-bytes-per-pixel ( loading-png -- n )
-    dup color-type>> {
-        { truecolor [ scale-bit-depth 3 * ] }
-        { truecolor-alpha [ scale-bit-depth 4 * ] }
+: png-components-per-pixel ( loading-png -- n )
+    color-type>> {
+        { truecolor [ 3 ] }
+        { truecolor-alpha [ 4 ] }
         [ unknown-color-type ]
     } case ; inline
 
 : png-group-width ( loading-png -- n )
     ! 1 + is for the filter type, 1 byte preceding each line
-    [ png-bytes-per-pixel ] [ width>> ] bi * 1 + ;
+    [ [ png-components-per-pixel ] [ bit-depth>> ] bi * ]
+    [ width>> ] bi * 1 + ;
 
 :: paeth ( a b c -- p ) 
     a b + c - { a b c } [ [ - abs ] keep 2array ] with map 
@@ -117,7 +117,7 @@ ERROR: unimplemented-color-type image ;
     } case 
     curr width tail ;
 
-:: reverse-png-filter ( n lines -- byte-array )
+:: reverse-png-filter ( lines n -- byte-array )
     lines dup first length 0 <array> prefix
     [ n 1 - 0 <array> prepend ] map
     2 clump [
@@ -130,17 +130,36 @@ ERROR: unimplemented-color-type image ;
 
 ERROR: unimplemented-interlace ;
 
-: reverse-interlace ( byte-array loading-png -- byte-array )
+: reverse-interlace ( byte-array loading-png -- bitstream )
     {
         { interlace-none [ ] }
         { interlace-adam7 [ unimplemented-interlace ] }
         [ unimplemented-interlace ]
-    } case ;
+    } case bs:<lsb0-bit-reader> ;
 
-: png-image-bytes ( loading-png -- byte-array )
-    [ png-bytes-per-pixel ]
-    [ [ inflate-data ] [ interlace-method>> ] bi reverse-interlace ]
-    [ png-group-width ] tri group reverse-png-filter ;
+: uncompress-bytes ( loading-png -- bitstream )
+    [ inflate-data ] [ interlace-method>> ] bi reverse-interlace ;
+
+:: png-image-bytes ( loading-png -- byte-array )
+    loading-png uncompress-bytes :> bs
+    loading-png width>> :> width
+    loading-png height>> :> height
+    loading-png png-components-per-pixel :> #components
+    loading-png bit-depth>> :> bit-depth
+    bit-depth :> depth!
+    #components width * :> count!
+
+    ! Only read up to 8 bits at a time
+    bit-depth 16 = [
+        8 depth!
+        count 2 * count!
+    ] when
+
+    height [
+        8 bs bs:read
+        count [ depth bs bs:read ] replicate swap prefix
+    ] replicate
+    #components bit-depth 16 = [ 2 * ] when reverse-png-filter ;
 
 ERROR: unknown-component-type n ;
 

From 77f968fad6fa529086631e1ed9f5b28012764b96 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Oct 2009 18:18:33 -0500
Subject: [PATCH 13/20] load greyscale png images, refactor some code

---
 basis/images/png/png.factor | 95 ++++++++++++++++++++++++-------------
 1 file changed, 61 insertions(+), 34 deletions(-)

diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index 74c40d1291..469c060776 100755
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -58,7 +58,7 @@ ERROR: bad-checksum ;
     4 read = [ bad-checksum ] unless
     4 cut-slice
     [ ascii decode >>type ] [ B{ } like >>data ] bi*
-    [ over chunks>> push ] 
+    [ over chunks>> push ]
     [ type>> ] bi "IEND" =
     [ read-png-chunks ] unless ;
 
@@ -84,11 +84,13 @@ ERROR: unknown-color-type n ;
 ERROR: unimplemented-color-type image ;
 
 : inflate-data ( loading-png -- bytes )
-    find-compressed-bytes zlib-inflate ; 
+    find-compressed-bytes zlib-inflate ;
 
 : png-components-per-pixel ( loading-png -- n )
     color-type>> {
+        { greyscale [ 1 ] }
         { truecolor [ 3 ] }
+        { greyscale-alpha [ 2 ] }
         { truecolor-alpha [ 4 ] }
         [ unknown-color-type ]
     } case ; inline
@@ -98,8 +100,8 @@ ERROR: unimplemented-color-type image ;
     [ [ png-components-per-pixel ] [ bit-depth>> ] bi * ]
     [ width>> ] bi * 1 + ;
 
-:: paeth ( a b c -- p ) 
-    a b + c - { a b c } [ [ - abs ] keep 2array ] with map 
+:: paeth ( a b c -- p )
+    a b + c - { a b c } [ [ - abs ] keep 2array ] with map
     sort-keys first second ;
 
 :: png-unfilter-line ( width prev curr filter -- curr' )
@@ -114,7 +116,7 @@ ERROR: unimplemented-color-type image ;
         { filter-up [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
         { filter-average [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
         { filter-paeth [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
-    } case 
+    } case
     curr width tail ;
 
 :: reverse-png-filter ( lines n -- byte-array )
@@ -135,12 +137,12 @@ ERROR: unimplemented-interlace ;
         { interlace-none [ ] }
         { interlace-adam7 [ unimplemented-interlace ] }
         [ unimplemented-interlace ]
-    } case bs:<lsb0-bit-reader> ;
+    } case bs:<msb0-bit-reader> ;
 
 : uncompress-bytes ( loading-png -- bitstream )
     [ inflate-data ] [ interlace-method>> ] bi reverse-interlace ;
 
-:: png-image-bytes ( loading-png -- byte-array )
+:: raw-bytes ( loading-png -- array )
     loading-png uncompress-bytes :> bs
     loading-png width>> :> width
     loading-png height>> :> height
@@ -165,33 +167,41 @@ ERROR: unknown-component-type n ;
 
 : png-component ( loading-png -- obj )
     bit-depth>> {
+        { 1 [ ubyte-components ] }
+        { 2 [ ubyte-components ] }
+        { 4 [ ubyte-components ] }
         { 8 [ ubyte-components ] }
         { 16 [ ushort-components ] }
         [ unknown-component-type ]
     } case ;
 
-: loading-png>image ( loading-png -- image )
-    [ image new ] dip {
-        [ png-image-bytes >>bitmap ]
-        [ [ width>> ] [ height>> ] bi 2array >>dim ]
-        [ png-component >>component-type ]
-    } cleave ;
+: scale-factor ( n -- n' )
+    {
+        { 1 [ 255 ] }
+        { 2 [ 127 ] }
+        { 4 [ 17 ] }
+        { 8 [ 1 ] }
+    } case ;
 
-: decode-greyscale ( loading-png -- image )
-    unimplemented-color-type ;
-
-: decode-truecolor ( loading-png -- image )
-    loading-png>image RGB >>component-order ;
-    
-: decode-indexed-color ( loading-png -- image )
-    unimplemented-color-type ;
-
-: decode-greyscale-alpha ( loading-png -- image )
-    unimplemented-color-type ;
-
-: decode-truecolor-alpha ( loading-png -- image )
-    loading-png>image RGBA >>component-order ;
+: scale-greyscale ( byte-array loading-png -- byte-array' )
+    [ bit-depth>> ] [ color-type>> ] bi {
+        { greyscale [
+            dup 16 = [
+                drop
+            ] [
+                scale-factor '[ _ * ] B{ } map-as
+            ] if
+        ] }
+        { greyscale-alpha [
+            [ 8 group ] dip '[
+                [ [ 0 5 ] dip <slice> [ _ * ] change-each ] keep
+            ] map B{ } concat-as
+        ] }
+    } case ;
 
+: decode-greyscale ( loading-png -- byte-array )
+    [ raw-bytes ] keep scale-greyscale ;
+ 
 ERROR: invalid-color-type/bit-depth loading-png ;
 
 : validate-bit-depth ( loading-png seq -- loading-png )
@@ -213,16 +223,33 @@ ERROR: invalid-color-type/bit-depth loading-png ;
 : validate-truecolor-alpha ( loading-png -- loading-png )
     { 8 16 } validate-bit-depth ;
 
-: png>image ( loading-png -- image )
+: loading-png>bitmap ( loading-png -- bytes component-order )
     dup color-type>> {
-        { greyscale [ validate-greyscale decode-greyscale ] }
-        { truecolor [ validate-truecolor decode-truecolor ] }
-        { indexed-color [ validate-indexed-color decode-indexed-color ] }
-        { greyscale-alpha [ validate-greyscale-alpha decode-greyscale-alpha ] }
-        { truecolor-alpha [ validate-truecolor-alpha decode-truecolor-alpha ] }
+        { greyscale [
+            validate-greyscale decode-greyscale L
+        ] }
+        { truecolor [
+            validate-truecolor raw-bytes RGB
+        ] }
+        { indexed-color [
+            validate-indexed-color unimplemented-color-type
+        ] }
+        { greyscale-alpha [
+            validate-greyscale-alpha decode-greyscale LA
+        ] }
+        { truecolor-alpha [
+            validate-truecolor-alpha raw-bytes RGBA
+        ] }
         [ unknown-color-type ]
     } case ;
 
+: loading-png>image ( loading-png -- image )
+    [ image new ] dip {
+        [ loading-png>bitmap [ >>bitmap ] [ >>component-order ] bi* ]
+        [ [ width>> ] [ height>> ] bi 2array >>dim ]
+        [ png-component >>component-type ]
+    } cleave ;
+
 : load-png ( stream -- loading-png )
     [
         <loading-png>
@@ -232,4 +259,4 @@ ERROR: invalid-color-type/bit-depth loading-png ;
     ] with-input-stream ;
 
 M: png-image stream>image
-    drop load-png png>image ;
+    drop load-png loading-png>image ;

From 2945393965491c23d614a43d531639a8f5be4fa4 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Oct 2009 19:37:14 -0500
Subject: [PATCH 14/20] dont scale 8,16 bit greyscale pngs.  greyscale-alpha
 pngs are 8,16 bit already, so don't scale them either.

---
 basis/images/png/png.factor | 22 ++++++----------------
 1 file changed, 6 insertions(+), 16 deletions(-)

diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index 469c060776..254ec40f51 100755
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -180,24 +180,14 @@ ERROR: unknown-component-type n ;
         { 1 [ 255 ] }
         { 2 [ 127 ] }
         { 4 [ 17 ] }
-        { 8 [ 1 ] }
     } case ;
 
 : scale-greyscale ( byte-array loading-png -- byte-array' )
-    [ bit-depth>> ] [ color-type>> ] bi {
-        { greyscale [
-            dup 16 = [
-                drop
-            ] [
-                scale-factor '[ _ * ] B{ } map-as
-            ] if
-        ] }
-        { greyscale-alpha [
-            [ 8 group ] dip '[
-                [ [ 0 5 ] dip <slice> [ _ * ] change-each ] keep
-            ] map B{ } concat-as
-        ] }
-    } case ;
+    bit-depth>> dup 8 >= [
+        drop
+    ] [
+        scale-factor '[ _ * ] B{ } map-as
+    ] if ;
 
 : decode-greyscale ( loading-png -- byte-array )
     [ raw-bytes ] keep scale-greyscale ;
@@ -235,7 +225,7 @@ ERROR: invalid-color-type/bit-depth loading-png ;
             validate-indexed-color unimplemented-color-type
         ] }
         { greyscale-alpha [
-            validate-greyscale-alpha decode-greyscale LA
+            validate-greyscale-alpha raw-bytes LA
         ] }
         { truecolor-alpha [
             validate-truecolor-alpha raw-bytes RGBA

From fd4c6b73bb0401e3c3138de890569865b1220952 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Oct 2009 20:33:15 -0500
Subject: [PATCH 15/20] ushort pngs are byte-reversed from how i'm reading them
 -- fixed.

---
 basis/images/png/png.factor | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index 254ec40f51..c41a1956cd 100755
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -3,7 +3,7 @@
 USING: accessors arrays checksums checksums.crc32 combinators
 compression.inflate fry grouping images images.loader io
 io.binary io.encodings.ascii io.encodings.string kernel locals
-math math.bitwise math.ranges sequences sorting ;
+math math.bitwise math.ranges sequences sorting assocs ;
 QUALIFIED-WITH: bitstreams bs
 IN: images.png
 
@@ -183,11 +183,11 @@ ERROR: unknown-component-type n ;
     } case ;
 
 : scale-greyscale ( byte-array loading-png -- byte-array' )
-    bit-depth>> dup 8 >= [
-        drop
-    ] [
-        scale-factor '[ _ * ] B{ } map-as
-    ] if ;
+    bit-depth>> {
+        { 8 [ ] }
+        { 16 [ 2 group [ swap ] assoc-map B{ } concat-as ] }
+        [ scale-factor '[ _ * ] B{ } map-as ]
+    } case ;
 
 : decode-greyscale ( loading-png -- byte-array )
     [ raw-bytes ] keep scale-greyscale ;
@@ -213,6 +213,11 @@ ERROR: invalid-color-type/bit-depth loading-png ;
 : validate-truecolor-alpha ( loading-png -- loading-png )
     { 8 16 } validate-bit-depth ;
 
+: decode-greyscale-alpha ( loading-image -- byte-array' )
+    [ raw-bytes ] [ bit-depth>> ] bi 16 = [
+        3 group [ first3 swapd 3array ] map B{ } concat-as
+    ] when ;
+
 : loading-png>bitmap ( loading-png -- bytes component-order )
     dup color-type>> {
         { greyscale [
@@ -225,7 +230,7 @@ ERROR: invalid-color-type/bit-depth loading-png ;
             validate-indexed-color unimplemented-color-type
         ] }
         { greyscale-alpha [
-            validate-greyscale-alpha raw-bytes LA
+            validate-greyscale-alpha decode-greyscale-alpha LA
         ] }
         { truecolor-alpha [
             validate-truecolor-alpha raw-bytes RGBA

From 796b1c8977b26c63f06c4866e99aad32d4657c39 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Oct 2009 20:37:00 -0500
Subject: [PATCH 16/20] fix byte swapping on greyscale-alpha

---
 basis/images/png/png.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index c41a1956cd..595bb62ed4 100755
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -215,7 +215,7 @@ ERROR: invalid-color-type/bit-depth loading-png ;
 
 : decode-greyscale-alpha ( loading-image -- byte-array' )
     [ raw-bytes ] [ bit-depth>> ] bi 16 = [
-        3 group [ first3 swapd 3array ] map B{ } concat-as
+        4 group [ first4 [ swap ] 2dip 4array ] map B{ } concat-as
     ] when ;
 
 : loading-png>bitmap ( loading-png -- bytes component-order )

From 8556476b76aabbcc84dcbf9a7709cbacd958595f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Oct 2009 20:55:53 -0500
Subject: [PATCH 17/20] handle indexed color pngs

---
 basis/images/png/png.factor | 32 +++++++++++++++++++++++---------
 1 file changed, 23 insertions(+), 9 deletions(-)

diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index 595bb62ed4..5ac3ee7103 100755
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -3,7 +3,8 @@
 USING: accessors arrays checksums checksums.crc32 combinators
 compression.inflate fry grouping images images.loader io
 io.binary io.encodings.ascii io.encodings.string kernel locals
-math math.bitwise math.ranges sequences sorting assocs ;
+math math.bitwise math.ranges sequences sorting assocs
+math.functions ;
 QUALIFIED-WITH: bitstreams bs
 IN: images.png
 
@@ -65,6 +66,9 @@ ERROR: bad-checksum ;
 : find-chunk ( loading-png string -- chunk )
     [ chunks>> ] dip '[ type>> _ = ] find nip ;
 
+: find-chunks ( loading-png string -- chunk )
+    [ chunks>> ] dip '[ type>> _ = ] filter ;
+
 : parse-ihdr-chunk ( loading-png -- loading-png )
     dup "IHDR" find-chunk data>> {
         [ [ 0 4 ] dip subseq be> >>width ]
@@ -77,8 +81,7 @@ ERROR: bad-checksum ;
     } cleave ;
 
 : find-compressed-bytes ( loading-png -- bytes )
-    chunks>> [ type>> "IDAT" = ] filter
-    [ data>> ] map concat ;
+    "IDAT" find-chunks [ data>> ] map concat ;
 
 ERROR: unknown-color-type n ;
 ERROR: unimplemented-color-type image ;
@@ -91,6 +94,7 @@ ERROR: unimplemented-color-type image ;
         { greyscale [ 1 ] }
         { truecolor [ 3 ] }
         { greyscale-alpha [ 2 ] }
+        { indexed-color [ 1 ] }
         { truecolor-alpha [ 4 ] }
         [ unknown-color-type ]
     } case ; inline
@@ -160,6 +164,7 @@ ERROR: unimplemented-interlace ;
     height [
         8 bs bs:read
         count [ depth bs bs:read ] replicate swap prefix
+        8 bs bs:align
     ] replicate
     #components bit-depth 16 = [ 2 * ] when reverse-png-filter ;
 
@@ -191,6 +196,20 @@ ERROR: unknown-component-type n ;
 
 : decode-greyscale ( loading-png -- byte-array )
     [ raw-bytes ] keep scale-greyscale ;
+
+: decode-greyscale-alpha ( loading-image -- byte-array )
+    [ raw-bytes ] [ bit-depth>> ] bi 16 = [
+        4 group [ first4 [ swap ] 2dip 4array ] map B{ } concat-as
+    ] when ;
+
+ERROR: invalid-PLTE array ;
+
+: verify-PLTE ( seq -- seq )
+    dup length 3 divisor? [ invalid-PLTE ] unless ;
+
+: decode-indexed-color ( loading-image -- byte-array )
+    [ raw-bytes ] keep "PLTE" find-chunk data>> verify-PLTE
+    3 group '[ _ nth ] { } map-as B{ } concat-as ; inline
  
 ERROR: invalid-color-type/bit-depth loading-png ;
 
@@ -213,11 +232,6 @@ ERROR: invalid-color-type/bit-depth loading-png ;
 : validate-truecolor-alpha ( loading-png -- loading-png )
     { 8 16 } validate-bit-depth ;
 
-: decode-greyscale-alpha ( loading-image -- byte-array' )
-    [ raw-bytes ] [ bit-depth>> ] bi 16 = [
-        4 group [ first4 [ swap ] 2dip 4array ] map B{ } concat-as
-    ] when ;
-
 : loading-png>bitmap ( loading-png -- bytes component-order )
     dup color-type>> {
         { greyscale [
@@ -227,7 +241,7 @@ ERROR: invalid-color-type/bit-depth loading-png ;
             validate-truecolor raw-bytes RGB
         ] }
         { indexed-color [
-            validate-indexed-color unimplemented-color-type
+            validate-indexed-color decode-indexed-color RGB
         ] }
         { greyscale-alpha [
             validate-greyscale-alpha decode-greyscale-alpha LA

From 36775661a94d873d3963e368260aa219405a0275 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Oct 2009 21:37:30 -0500
Subject: [PATCH 18/20] fix unit test

---
 basis/compression/inflate/inflate-tests.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/compression/inflate/inflate-tests.factor b/basis/compression/inflate/inflate-tests.factor
index e2beefb9b2..7bda94a999 100644
--- a/basis/compression/inflate/inflate-tests.factor
+++ b/basis/compression/inflate/inflate-tests.factor
@@ -4,7 +4,7 @@ USING: tools.test compression.inflate ;
 IN: compression.inflate.tests
 
 [
-BV{
+B{
     1 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 122 121 94 119
     239 237 227 88 16 16 10 5 16 17 26 172 3 20 19 245 22 54 55

From 7d39e51d9a2d80fed7dac815e1b85f8e51370f3b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Oct 2009 23:06:40 -0500
Subject: [PATCH 19/20] add using and unit tests for mmap

---
 basis/io/mmap/mmap-docs.factor  |  2 +-
 basis/io/mmap/mmap-tests.factor | 21 +++++++++++++++++----
 2 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/basis/io/mmap/mmap-docs.factor b/basis/io/mmap/mmap-docs.factor
index 3379a2879b..fe16e08467 100644
--- a/basis/io/mmap/mmap-docs.factor
+++ b/basis/io/mmap/mmap-docs.factor
@@ -47,7 +47,7 @@ HELP: with-mapped-array
 { $description "Memory-maps a file for reading and writing as a mapped-array of the given c-type. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
 { $examples
     { $unchecked-example
-        "USING: io.mmap prettyprint specialized-arrays ;"
+        "USING: alien.c-types io.mmap prettyprint specialized-arrays ;"
         "SPECIALIZED-ARRAY: uint"
 """"resource:license.txt" uint [
     [ . ] each
diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor
index 3ed3447603..94f8c77883 100644
--- a/basis/io/mmap/mmap-tests.factor
+++ b/basis/io/mmap/mmap-tests.factor
@@ -1,7 +1,7 @@
-USING: io io.mmap io.files io.files.temp io.directories kernel
-tools.test continuations sequences io.encodings.ascii accessors
-math compiler.tree.debugger alien.data alien.c-types
-sequences.private ;
+USING: alien.c-types alien.data compiler.tree.debugger
+continuations io.directories io.encodings.ascii io.files
+io.files.temp io.mmap kernel math sequences sequences.private
+specialized-arrays specialized-arrays.instances.uint tools.test ;
 IN: io.mmap.tests
 
 [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
@@ -10,6 +10,19 @@ IN: io.mmap.tests
 [ 5 ] [ "mmap-test-file.txt" temp-file [ char <mapped-array> length ] with-mapped-file ] unit-test
 [ 5 ] [ "mmap-test-file.txt" temp-file [ char <mapped-array> length ] with-mapped-file-reader ] unit-test
 [ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test
+
+SPECIALIZED-ARRAY: uint
+
+[ t ] [
+    "mmap-test-file.txt" temp-file uint [ sum ] with-mapped-array
+    integer?
+] unit-test
+
+[ t ] [
+    "mmap-test-file.txt" temp-file uint [ sum ] with-mapped-array-reader
+    integer?
+] unit-test
+
 [ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
 
 

From 4a8be006f08101b2300cef50966cf9ea92839d48 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 9 Oct 2009 01:25:20 -0500
Subject: [PATCH 20/20] extra error checking in images.png

---
 basis/images/png/png.factor | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index 5ac3ee7103..6ebc0f9147 100755
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -4,7 +4,7 @@ USING: accessors arrays checksums checksums.crc32 combinators
 compression.inflate fry grouping images images.loader io
 io.binary io.encodings.ascii io.encodings.string kernel locals
 math math.bitwise math.ranges sequences sorting assocs
-math.functions ;
+math.functions math.order ;
 QUALIFIED-WITH: bitstreams bs
 IN: images.png
 
@@ -146,6 +146,8 @@ ERROR: unimplemented-interlace ;
 : uncompress-bytes ( loading-png -- bitstream )
     [ inflate-data ] [ interlace-method>> ] bi reverse-interlace ;
 
+ERROR: bad-filter n ;
+
 :: raw-bytes ( loading-png -- array )
     loading-png uncompress-bytes :> bs
     loading-png width>> :> width
@@ -162,7 +164,7 @@ ERROR: unimplemented-interlace ;
     ] when
 
     height [
-        8 bs bs:read
+        8 bs bs:read dup 0 4 between? [ bad-filter ] unless
         count [ depth bs bs:read ] replicate swap prefix
         8 bs bs:align
     ] replicate
@@ -210,7 +212,7 @@ ERROR: invalid-PLTE array ;
 : decode-indexed-color ( loading-image -- byte-array )
     [ raw-bytes ] keep "PLTE" find-chunk data>> verify-PLTE
     3 group '[ _ nth ] { } map-as B{ } concat-as ; inline
- 
+
 ERROR: invalid-color-type/bit-depth loading-png ;
 
 : validate-bit-depth ( loading-png seq -- loading-png )