From 9fd675a632db492958366bc85e4e99e1646691c5 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Thu, 5 Feb 2009 10:28:57 +0100
Subject: [PATCH 01/42] FUEL: Accept '?' in prompts for word and vocabs.

---
 misc/fuel/fuel-completion.el | 33 ++++++++++++++++++++++++++-------
 misc/fuel/fuel-edit.el       |  9 +--------
 misc/fuel/fuel-help.el       |  2 +-
 misc/fuel/fuel-markup.el     |  3 ++-
 misc/fuel/fuel-scaffold.el   |  2 +-
 misc/fuel/fuel-xref.el       |  2 +-
 6 files changed, 32 insertions(+), 19 deletions(-)

diff --git a/misc/fuel/fuel-completion.el b/misc/fuel/fuel-completion.el
index e6ec8b2dc9..165a9d9b66 100644
--- a/misc/fuel/fuel-completion.el
+++ b/misc/fuel/fuel-completion.el
@@ -18,6 +18,15 @@
 (require 'fuel-eval)
 (require 'fuel-log)
 
+
+;;; Aux:
+
+(defvar fuel-completion--minibuffer-map
+  (let ((map (make-keymap)))
+    (set-keymap-parent map minibuffer-local-completion-map)
+    (define-key map "?" 'self-insert-command)
+    map))
+
 
 ;;; Vocabs dictionary:
 
@@ -33,7 +42,8 @@
   fuel-completion--vocabs)
 
 (defun fuel-completion--read-vocab (&optional reload init-input history)
-  (let ((vocabs (fuel-completion--vocabs reload)))
+  (let ((minibuffer-local-completion-map fuel-completion--minibuffer-map)
+        (vocabs (fuel-completion--vocabs reload)))
     (completing-read "Vocab name: " vocabs nil nil init-input history)))
 
 (defsubst fuel-completion--vocab-list (prefix)
@@ -170,12 +180,21 @@ terminates a current completion."
     (cons completions partial)))
 
 (defun fuel-completion--read-word (prompt &optional default history all)
-  (completing-read prompt
-                   (if all fuel-completion--all-words-list-func
-                     fuel-completion--word-list-func)
-                   nil nil nil
-                   history
-                   (or default (fuel-syntax-symbol-at-point))))
+  (let ((minibuffer-local-completion-map fuel-completion--minibuffer-map))
+    (completing-read prompt
+                     (if all fuel-completion--all-words-list-func
+                       fuel-completion--word-list-func)
+                     nil nil nil
+                     history
+                     (or default (fuel-syntax-symbol-at-point)))))
+
+(defun fuel-completion--read-vocab (refresh)
+  (let* ((minibuffer-local-completion-map fuel-completion--minibuffer-map)
+         (vocabs (fuel-completion--vocabs refresh))
+         (prompt "Vocabulary name: "))
+    (if vocabs
+        (completing-read prompt vocabs nil nil nil fuel-edit--vocab-history)
+      (read-string prompt nil fuel-edit--vocab-history))))
 
 (defun fuel-completion--complete-symbol ()
   "Complete the symbol at point.
diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el
index e5f0ffd26f..5860fb998a 100644
--- a/misc/fuel/fuel-edit.el
+++ b/misc/fuel/fuel-edit.el
@@ -57,13 +57,6 @@
     (fuel-edit--visit-file (car loc) fuel-edit-word-method)
     (goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
 
-(defun fuel-edit--read-vocabulary-name (refresh)
-  (let* ((vocabs (fuel-completion--vocabs refresh))
-         (prompt "Vocabulary name: "))
-    (if vocabs
-        (completing-read prompt vocabs nil nil nil fuel-edit--vocab-history)
-      (read-string prompt nil fuel-edit--vocab-history))))
-
 (defun fuel-edit--edit-article (name)
   (let ((cmd `(:fuel* (,name fuel-get-article-location) "fuel" t)))
     (fuel-edit--try-edit (fuel-eval--send/wait cmd))))
@@ -80,7 +73,7 @@
 When called interactively, asks for vocabulary with completion.
 With prefix argument, refreshes cached vocabulary list."
   (interactive "P")
-  (let* ((vocab (or vocab (fuel-edit--read-vocabulary-name refresh)))
+  (let* ((vocab (or vocab (fuel-completion--read-vocab refresh)))
          (cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
     (fuel-edit--try-edit (fuel-eval--send/wait cmd))))
 
diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el
index a82de388da..cfc8cab7f1 100644
--- a/misc/fuel/fuel-help.el
+++ b/misc/fuel/fuel-help.el
@@ -257,7 +257,7 @@ buffer."
 
 (defun fuel-help-vocab (vocab)
   "Ask for a vocabulary name and show its help page."
-  (interactive (list (fuel-edit--read-vocabulary-name nil)))
+  (interactive (list (fuel-completion--read-vocab nil)))
   (fuel-help--get-vocab vocab))
 
 (defun fuel-help-next (&optional forget-current)
diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el
index 4844233ae7..980ea111a6 100644
--- a/misc/fuel/fuel-markup.el
+++ b/misc/fuel/fuel-markup.el
@@ -282,7 +282,8 @@
   (fuel-markup--insert-newline)
   (dolist (s (cdr e))
     (fuel-markup--snippet (list '$snippet s))
-    (newline)))
+    (newline))
+  (newline))
 
 (defun fuel-markup--markup-example (e)
   (fuel-markup--insert-newline)
diff --git a/misc/fuel/fuel-scaffold.el b/misc/fuel/fuel-scaffold.el
index 05d825593c..ac400c5622 100644
--- a/misc/fuel/fuel-scaffold.el
+++ b/misc/fuel/fuel-scaffold.el
@@ -71,7 +71,7 @@ You can configure `fuel-scaffold-developer-name' (set by default to
 `user-full-name') for the name to be inserted in the generated file."
   (interactive "P")
   (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
-                   (fuel-edit--read-vocabulary-name nil)))
+                    (fuel-completion--read-vocab nil)))
          (cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-help)
                        "fuel"))
          (ret (fuel-eval--send/wait cmd))
diff --git a/misc/fuel/fuel-xref.el b/misc/fuel/fuel-xref.el
index 4d444ebe3e..faf1897304 100644
--- a/misc/fuel/fuel-xref.el
+++ b/misc/fuel/fuel-xref.el
@@ -244,7 +244,7 @@ With prefix argument, force reload of vocabulary list."
 With prefix argument, ask for the vocab."
   (interactive "P")
   (let ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
-                   (fuel-edit--read-vocabulary-name))))
+                   (fuel-completion--read-vocab nil))))
     (when vocab
       (fuel-xref--show-vocab-words vocab
                                    (fuel-syntax--file-has-private)))))

From 84846e21d840c7d6cc74db4d6e04c1062c640baf Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Thu, 5 Feb 2009 10:45:44 +0100
Subject: [PATCH 02/42] FUEL: Small nits.

---
 misc/fuel/fuel-completion.el | 12 +++++++-----
 misc/fuel/fuel-edit.el       |  1 -
 2 files changed, 7 insertions(+), 6 deletions(-)

diff --git a/misc/fuel/fuel-completion.el b/misc/fuel/fuel-completion.el
index 165a9d9b66..c21d25901f 100644
--- a/misc/fuel/fuel-completion.el
+++ b/misc/fuel/fuel-completion.el
@@ -188,13 +188,15 @@ terminates a current completion."
                      history
                      (or default (fuel-syntax-symbol-at-point)))))
 
+(defvar fuel-completion--vocab-history nil)
+
 (defun fuel-completion--read-vocab (refresh)
-  (let* ((minibuffer-local-completion-map fuel-completion--minibuffer-map)
-         (vocabs (fuel-completion--vocabs refresh))
-         (prompt "Vocabulary name: "))
+  (let ((minibuffer-local-completion-map fuel-completion--minibuffer-map)
+        (vocabs (fuel-completion--vocabs refresh))
+        (prompt "Vocabulary name: "))
     (if vocabs
-        (completing-read prompt vocabs nil nil nil fuel-edit--vocab-history)
-      (read-string prompt nil fuel-edit--vocab-history))))
+        (completing-read prompt vocabs nil nil nil fuel-completion--vocab-history)
+      (read-string prompt nil fuel-completion--vocab-history))))
 
 (defun fuel-completion--complete-symbol ()
   "Complete the symbol at point.
diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el
index 5860fb998a..941f57140e 100644
--- a/misc/fuel/fuel-edit.el
+++ b/misc/fuel/fuel-edit.el
@@ -65,7 +65,6 @@
 ;;; Editing commands:
 
 (defvar fuel-edit--word-history nil)
-(defvar fuel-edit--vocab-history nil)
 (defvar fuel-edit--previous-location nil)
 
 (defun fuel-edit-vocabulary (&optional refresh vocab)

From c45b188581a2bcbff8a4d929e82e307bff66d72f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 22:43:11 -0600
Subject: [PATCH 03/42] fix furnace.utilities

---
 basis/furnace/utilities/utilities-docs.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/furnace/utilities/utilities-docs.factor b/basis/furnace/utilities/utilities-docs.factor
index 6defba54d2..3a0d8804ef 100644
--- a/basis/furnace/utilities/utilities-docs.factor
+++ b/basis/furnace/utilities/utilities-docs.factor
@@ -27,7 +27,7 @@ HELP: hidden-form-field
     { $example
         "USING: furnace.utilities io ;"
         "\"bar\" \"foo\" hidden-form-field nl"
-        "<input type=\"hidden\" name=\"foo\" value=\"bar\"/>"
+        "<input type=\"hidden\" value=\"bar\" name=\"foo\"/>"
     }
 } ;
 

From 0fc6dde17877ff2ff2194339197b7882e382308e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 22:56:46 -0600
Subject: [PATCH 04/42] make sure multipart parsing has enough bytes to compare
 against

---
 basis/mime/multipart/multipart.factor | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/basis/mime/multipart/multipart.factor b/basis/mime/multipart/multipart.factor
index eda7849a73..37d5e13129 100755
--- a/basis/mime/multipart/multipart.factor
+++ b/basis/mime/multipart/multipart.factor
@@ -42,7 +42,7 @@ ERROR: end-of-stream multipart ;
     [ t >>end-of-stream? ] if* ;
 
 : maybe-fill-bytes ( multipart -- multipart )
-    dup bytes>> [ fill-bytes ] unless  ;
+    dup bytes>> length 256 < [ fill-bytes ] when ;
 
 : split-bytes ( bytes separator -- leftover-bytes safe-to-dump )
     dupd [ length ] bi@ 1- - short cut-slice swap ;
@@ -65,6 +65,7 @@ ERROR: end-of-stream multipart ;
     [ dump-until-separator ] with-string-writer ;
 
 : read-header ( multipart -- multipart )
+    maybe-fill-bytes
     dup bytes>> "--\r\n" sequence= [
         t >>end-of-stream?
     ] [

From b073fe5eeebb803a4af2ac01f31b9db15dba7cbf Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 23:37:18 -0600
Subject: [PATCH 05/42] the start of an endianness library, used by pack

---
 basis/endian/authors.txt         |  1 +
 basis/endian/endian-tests.factor |  7 ++++
 basis/endian/endian.factor       | 67 ++++++++++++++++++++++++++++++++
 3 files changed, 75 insertions(+)
 create mode 100755 basis/endian/authors.txt
 create mode 100755 basis/endian/endian-tests.factor
 create mode 100755 basis/endian/endian.factor

diff --git a/basis/endian/authors.txt b/basis/endian/authors.txt
new file mode 100755
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/basis/endian/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/basis/endian/endian-tests.factor b/basis/endian/endian-tests.factor
new file mode 100755
index 0000000000..b066ce6995
--- /dev/null
+++ b/basis/endian/endian-tests.factor
@@ -0,0 +1,7 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces tools.test endian ;
+IN: endian.tests
+
+[ t ] [ [ endianness get big-endian = ] with-big-endian ] unit-test
+[ t ] [ [ endianness get little-endian = ] with-little-endian ] unit-test
diff --git a/basis/endian/endian.factor b/basis/endian/endian.factor
new file mode 100755
index 0000000000..a832d6c0a2
--- /dev/null
+++ b/basis/endian/endian.factor
@@ -0,0 +1,67 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types namespaces io.binary fry
+kernel math ;
+IN: endian
+
+SINGLETONS: big-endian little-endian ;
+
+: native-endianness ( -- class )
+    1 <int> *char 0 = big-endian little-endian ? ;
+
+: >signed ( x n -- y )
+    2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;
+
+native-endianness \ native-endianness set-global
+
+SYMBOL: endianness
+
+\ native-endianness get-global endianness set-global
+
+HOOK: >native-endian native-endianness ( obj n -- str )
+
+M: big-endian >native-endian >be ;
+
+M: little-endian >native-endian >le ;
+
+HOOK: unsigned-native-endian> native-endianness ( obj -- str )
+
+M: big-endian unsigned-native-endian> be> ;
+
+M: little-endian unsigned-native-endian> le> ;
+
+: signed-native-endian> ( obj n -- str )
+    [ unsigned-native-endian> ] dip >signed ;
+
+HOOK: >endian endianness ( obj n -- str )
+
+M: big-endian >endian >be ;
+
+M: little-endian >endian >le ;
+
+HOOK: endian> endianness ( seq -- n )
+
+M: big-endian endian> be> ;
+
+M: little-endian endian> le> ;
+
+HOOK: unsigned-endian> endianness ( obj -- str )
+
+M: big-endian unsigned-endian> be> ;
+
+M: little-endian unsigned-endian> le> ;
+
+: signed-endian> ( obj n -- str )
+    [ unsigned-endian> ] dip >signed ;
+
+: with-endianness ( endian quot -- )
+    [ endianness ] dip with-variable ; inline
+
+: with-big-endian ( quot -- )
+    big-endian swap with-endianness ; inline
+
+: with-little-endian ( quot -- )
+    little-endian swap with-endianness ; inline
+
+: with-native-endian ( quot -- )
+    \ native-endianness get-global swap with-endianness ; inline

From 1979fbc61a1c5edb95b69c3cfd56b6f34fbebff8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 23:37:38 -0600
Subject: [PATCH 06/42] pack uses endian library now

---
 basis/pack/pack.factor | 38 +++++++-------------------------------
 1 file changed, 7 insertions(+), 31 deletions(-)

diff --git a/basis/pack/pack.factor b/basis/pack/pack.factor
index 3cf7dbab4c..9078817206 100755
--- a/basis/pack/pack.factor
+++ b/basis/pack/pack.factor
@@ -5,33 +5,9 @@ io.binary io.streams.string kernel math math.parser namespaces
 make parser prettyprint quotations sequences strings vectors
 words macros math.functions math.bitwise fry generalizations
 combinators.smart io.streams.byte-array io.encodings.binary
-math.vectors combinators multiline ;
+math.vectors combinators multiline endian ;
 IN: pack
 
-SYMBOL: big-endian
-
-: big-endian? ( -- ? )
-    1 <int> *char zero? ;
-
-<PRIVATE
-
-: set-big-endian ( -- )
-    big-endian? big-endian set ; inline
-
-PRIVATE>
-
-: >signed ( x n -- y )
-    2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;
-
-: >endian ( obj n -- str )
-    big-endian get [ >be ] [ >le ] if ; inline
-
-: unsigned-endian> ( obj -- str )
-    big-endian get [ be> ] [ le> ] if ; inline
-
-: signed-endian> ( obj n -- str )
-    [ unsigned-endian> ] dip >signed ;
-
 GENERIC: >n-byte-array ( obj n -- byte-array )
 
 M: integer >n-byte-array ( m n -- byte-array ) >endian ;
@@ -124,13 +100,13 @@ PRIVATE>
     [ ch>packed-length ] sigma ;
  
 : pack-native ( seq str -- seq )
-    [ set-big-endian pack ] with-scope ; inline
+    '[ _ _ pack ] with-native-endian ; inline
 
 : pack-be ( seq str -- seq )
-    [ big-endian on pack ] with-scope ; inline
+    '[ _ _ pack ] with-big-endian ; inline
 
 : pack-le ( seq str -- seq )
-    [ big-endian off pack ] with-scope ; inline
+    '[ _ _ pack ] with-little-endian ; inline
 
 <PRIVATE
 
@@ -146,13 +122,13 @@ MACRO: unpack ( str -- quot )
 PRIVATE>
 
 : unpack-native ( seq str -- seq )
-    [ set-big-endian unpack ] with-scope ; inline
+    '[ _ _ unpack ] with-native-endian ; inline
 
 : unpack-be ( seq str -- seq )
-    [ big-endian on unpack ] with-scope ; inline
+    '[ _ _ unpack ] with-big-endian ; inline
 
 : unpack-le ( seq str -- seq )
-    [ big-endian off unpack ] with-scope ; inline
+    '[ _ _ unpack ] with-little-endian ; inline
 
 ERROR: packed-read-fail str bytes ;
 

From 26f9df982d372c9e628112ba030bca1cd1514ec0 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 6 Feb 2009 23:41:59 -0600
Subject: [PATCH 07/42] the start of a tiff library

---
 extra/graphics/tiff/authors.txt       |   1 +
 extra/graphics/tiff/rgb.tiff          | Bin 0 -> 7916 bytes
 extra/graphics/tiff/tiff-tests.factor |   9 +++++++
 extra/graphics/tiff/tiff.factor       |  37 ++++++++++++++++++++++++++
 4 files changed, 47 insertions(+)
 create mode 100755 extra/graphics/tiff/authors.txt
 create mode 100755 extra/graphics/tiff/rgb.tiff
 create mode 100755 extra/graphics/tiff/tiff-tests.factor
 create mode 100755 extra/graphics/tiff/tiff.factor

diff --git a/extra/graphics/tiff/authors.txt b/extra/graphics/tiff/authors.txt
new file mode 100755
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/extra/graphics/tiff/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/extra/graphics/tiff/rgb.tiff b/extra/graphics/tiff/rgb.tiff
new file mode 100755
index 0000000000000000000000000000000000000000..71cbaa9d6e807156f7da39a5b116c9edb3b0c9e1
GIT binary patch
literal 7916
zcmeHMcT^MWw+#r=t3X6RRC<#hYUoXR4bnxLK!S7xL9Q1Cgh&@qz)BGldhfkA=^#Z!
zK)@iqNqZASuUB2~z4iWmzr{LhhA%Uj$#>4#XP<qpT;T=@od<#blAY2OXQd+}xTj#P
zTWSkoq6k&Gt|y)f;{zjAZ1hTJyrIldYPR|ktnpeLaq4#ZWwyl@{E3?O1`?@52(e^s
z2ZOSitpM5Qx;G3Z+2|gsrs_KymfJy6bY2@e8A+zWvW(F%XQT32?<%X@t8kbUTYQ&8
zp(z4ZVOKnHv(((hSSoF3$*0otrg6pW)<IzHHP@@s>|nBx#_MiZEA7RYB3o_UO{CL}
z`4T$qJq*th{=a--LJ$twGab&~cKEvCxzs}f`5@Q@BhyF!+F=vt__71{97L%+4=m~D
z9hNH{W8PYvFe3@79lyErV~3@*N%(>r?VZKZG6v9RZ*Ra8q*7{>GX|VIe3PpS&ivIS
z?^&LeK8z>{n<{)a0r?nEQ~udCf$vVwgS=r^3G-_E+gF<A-EWOgX23$~hZpylE=S~K
zy<fTIXi>v%6EeNwXFF*rvu!upuv%ip*n(QxuB?^&#g&vGP+-HfAYmMg3;dw@dhhE-
z7lwbw-s{xt<Ji+p99JiR+*N&X<|<~3LOew0`2bPMFR`buj<+UZjDp=TNW8C&jlCOg
z^i?q)_W8zeScPq{mprN+vFVuRB8>Pa_7r)H!eP`Og6gK+u9n01s3Mwe9YxK(>9joB
zKdeLc<9)C@<7q0Hep4&BWl`vzmVJm$=HO><-HG59e(!f5if>oVZ3om$S$LU4yFUfB
z6l=gYlP)(zSA5i*kFB}`&gj8--?pg!q=9lx+FljysPXB#G^_Z^{Jl=egHLZQq*MH?
zz&b1YcLJ@dTns|TBqR4c*JPu(iMM5XZYP`);$PR#kngFaC#sJ^^AU;>)~n*xtyJ8_
zgN8LKgf-rzkuIv|$0MT6L^gz+X{JKj(Z6uh5RYky!n@H76=YN&;B{jqFI3Gn_ns->
zAw9#=76VV-Z^ral&R6F99bBr?r|#!f?Gx%}&eFp}zpivgw~@)XYqp4XMaSU&;ws2#
z5J+~KQY~4Mk2<t*I+t_6o(22^CPGwSQE~d`gX!a2W@EXO=&VJLVS?4gnCV#;M+`AO
zosr6mzF%O1|5f{o&CJ0|cZ~s<&~@r8cd&b*&POL@SA5(2`PlQ#o!R;l_kUca%m;Qv
zf30$?opwFro7`-JOqpSchsX2qIh9&mhLA!i#1gQsg0d%Qv2>5G((Th^x1stmt|j!3
zn3?TIU2Z-`Rj)OL3|sh^%W!}nw#+C9n_&)Zl6+=1yy&%BG_v5cbKZ3439PDsAoe%t
z#*CG4U{?J7rL!l)Kkw*nibUKm4yda4545WJw0(U_=79*PN46{W?3mDv0TTSwoF_Nt
zxRx}mPAdSeBB}1~A4rySZO}MX9%TrnO5;^xeO)D}(L=2q4Yweb`9fnuR;$x_5sY@j
zQ)X19O2);=MaLPRSBv3At~M_k2GX}KCVLjO<;}!oDr>#$;OwC8y!F>#zxagnd-|N?
zAq#GNxhg*6bn)yDpWIWv)H`bKr1t~5&qp+|tUHoU6EOS^ED7D5XUbBvC3Mj+M}tgT
zIwMoSCx+alb2+#uJ*T1aw1|J8o1<8s#a*iNu<TC76g-;#klMgL^IG23a<4DFflo}`
zw%??wk0Al*HmRKRfeKd6qK7-HFO}K#EP8J44Y8119>93(r(8azoEr2oKdCal2S^{+
zTjmlfAs3;83uWe75d|hW_ttk4Iz?d>S?^XMyU-Hm3i6NdZ>Pv|By@e+xVlL%YZatw
zxv~`?29;Gs<t+FfiA%hfireK|cH-TsTKX6>A*Q`gy;~OrXCkO44(Fc9B|6nOThCLl
zSSY(_wv|;q->`NBA?wKAmtFaq-^-h;L;<eNv$Y2EE_(_yv`}?=&dFWjwH>dedY4C^
zmx~eaXwoylG@^P*wdfSO(GHh*^!AFk)mQgvag}qE@AG$_A#LnZiP$fp>4cL)>eaZB
zz3f^s2H_lRd8}&lS8_0EVqG3FAv`K)pg8B=dI*0I>7~)4RnE)eEs(2<yMMO4dyzGL
zSZz&H`+j$S>iVhj*g*nLt|BIWMV+WdGTc5dgoSZ-=&yzFhx<>^Gg0Jc^bAq5qa103
z5%49dqze)%6&njDY1!!S8WOt+Jy)5FDT5LRsyx@2U;k>v9-#R0PnBC&T{-@-PKF6L
zHYJNB9_da$Dz`Z8YyY&>1uU^Schk4p+-19*{PcuV{q)VVWf9CjS8hGQ#3yjSUaih~
zPXm;N{pX|vE6;pV$Q#wHAdEl)*QAYJM!`FqBEtB{Z|(<DlBJ}{2Ei~X20^*jEjjN+
z#6MkTTJZXCo9xc1g6!!@5&A<b18C^_dX;63L&?PQj=BV6By-Es#5*UqF<CM9@_CsB
zp2Wfe#8^y(bdG``=$rc~!%}y%bA><S)Vjw0b(qr`yR%rkWSV`XsD<QyQs=7CM60yQ
zYXJt()AoIRlmQh<nO@Sp+D2rM?XrvuQkjXDvH`XZ1cxGHYYaSvqn#S5#h~n-B*m_-
znR@3y+-*i~K!dN)fUQ01W4}Px8O=e_vV39jHTg6CSrEP`+&1#khyue`-QjR&*%E=y
zJ^8nBd}NnOxP+of<n)=y;|lXIK0=&^{sF?8o_HTM4C0ogb1z)@CDD)T<cD6MPF^HK
zDm{05P2<jRK2nACgrh05QJ2}Kv(O}J%;}lHk2#vPpks2g?}hL>hxJ9)cCX(!T9V?^
zzEn}CS#JvN`#q>Zb-wFCHif3val~CudYtpe5kGOXqVk6dCBr;EoovJo451$!=twn>
zXd{cvSW7VRipLzyq;j@z^jYFNp^{yZb*Z$*59v?*Q%a~%LvUMD!sJLU<xv+OGi;rV
zE`te;h))tY*C0Ra(jLMf9UYTXJJC<cgQbS%kL#q*#lq<Y{z`btvy7TNRo^Od@*4Wd
z&V^h?U$(u5Pdh-JtogJB>#f!~Q@tj+*kO;6TGBYT4MnWKI}*+*BwowPYUChPr0f(W
zt0t@D9%<;QB%)~4z|fxN<o9PBhU#hRkn{03%*8kK##tXH`f9^cD!f`;w_IkiF#78Y
zf)~9uo<Qv!3&zNCRn&2)$Dp%#Q2MMdM<sQY?q6s@#p1I`d>ME$+(E*~`c<TWhJ-~+
z7&$AEdE?jYWc&`!FfPjAW-PB3VmlYEG^0<?YN^T|(Qd8p$odB0Hu9IEBy79!A&K3`
zyqbaSu{wt#G2YkTc=fplqR~dqx=$*fR$094XNy(epDxirD_<LOh89oI=Z;$UhTrci
z5JQ_S|HG@L9{CU%Ms@Ltmy<)1kT0$0-OkNKvL)nMpy^SCLG)o2b0WtDGh^V|y4RA{
zD=GZJaYvX$HQ0>16|rq_5YS_CE8#;aL-ldNbVrOlWyY25n$?}ZY972532(Q(wWr;q
zTIKb&^VZeLz(4?;{Q^uMMtBTEx5o2!wX%Z3#lM&yK0VZlC|xLfxL1ED7sX3<s*Y%E
zdaaJ@9_}dDa>pV@^m4<SgSsqMx@|t!@{gw#1xb~u8Y2wFsO!4(Q4|W1Hhe_Iy^4n0
z@~f#=7v<dIyqH>|G4^YcZtKcK?CN`73|acryP!g9=M+|zHN!Nn_81g1t$JtN3sMo3
z#zwhvetY_A!`fH}yQTq<otbLCdg|v6=mCg%ig3VPj44WWM(?$fw;;#;R-3*u!zU+Y
zRI^wW60bEC`*`M^;~zU9>w>V<2m)?Y^K|~ggp&d6t}(CC;y`wqLm_OjV06%O*r;&)
zUmZ|inMv^#-r`bi>YBfU%rFV#cI=}Mny%SG7U;xIvI{7q&z{Y=(uR}89HrH13qnZG
zCs||;FKjS~+ur7iNpXP;F{<?cz)^Xdr%srWfcTh>S3@_RS6qhpd6cwnxmQ_!@;Rn9
zmX}o(t?$mdmp_RVV<G$4^W{@OR<pr}Z7d4~vg_|{F+Ky`O;oli1uj&}X1`NRGszcJ
z;S2{Kvrv)-atz^iSr(EOr{RmgP;*^Q@`XJmH%%kjrf9f%d99j3@+SeR+y1+fEB*+q
zrvjK;i4CbPw8rp0WN9OG|BYDwr~mv<!~B1jB=m7`ME+Njgr5CdzX_LupCt*WNAtAa
zH{nG;NfNph_hQD6Y9?2HND{hchmf16s+(3vNbbmt#V6Rh`C@r3&=w+0(7`qwX`!|o
zy8+tQnO*ywA?FtCn;D9GPs*KYEhfKAt+?mG>%r9z4B>Nq9Cc&s&quQ%sF0!eTiCYH
zr;29YNrH)U*&t_T{;R)1g!Wk8$nyRjE7^=80-Rr10EFqZ+=YvJ;C+2Q>M%tXfzV27
zDW*`RRDqq1uq(94E2%4-<Jo%rQ5tLlxAwc8FaHnQBEdRI!1qvdaV^t)GLIzj?dJ^=
zCKqe-zek+=P!{_C(Eaa9jW1u386UOD5N?rBLIb8aS%zBGq_G8fl)WlbXx?DX=*hNx
zYr!&_M)E!VyL0%6a%b6N;fNB%!~QSdSimvem!8bH7&dJErsBcYd#lEIPd^Kp4CAa}
zpj(EKc|B2WUfS`u{6_cv0#5jz{~gO^f}W-A$$&s+pat8X7R^dJ!l@0j#hsPa<)y{1
zi*kAfLci5yBC1ESQofT|L5q^r{Tc18=kf3$T-3kmUFXBwujgm%Tk8C1ntteAXTs{z
zV!s~iU3zJ67tN`Y6dt|3W;kjGd&P$u%oP1e@8V9g!|Gk7d@{l=K|^n7!&BKaO;EM-
z-W}idE{R7SM1bCPeaH`gD8r%D)-7=_ZJ8&wqdy;<3_H;ru#Id$#a!M<Wv7opeAzg^
z@k7gJh?4P>;9~25XFjg7Z@8QI(WzLX>qso6XWr9e{AmJgG#KgXn-c2a{0K2~%i1*M
zX>4qL|5wS$8i(TOnQecEr|67$`HiQacT&cilPcG0ND3PFWk@?%ODhnsUhm3B!5Ks4
z1pHZ(<Z`9SA1H9W>cy4Knl8jBJ~ZoImFYoiuGR?%I}%~henp-PZbe_Kh1MZ!$Rs5>
zCy>`EPg9Rcm1UN5HH3w>y6pS1<^I_N*VXXw)PGVO?=~^7acaikUy4(<6SyK0!E^di
zEBiOaF+tnTgI@YgfaJ4QyY&(2H4oDG-qeEK3856#<lp-iLq`!w{P-l@m;DPc2D{=a
zhf)*HzR~;bZ5r_w^9f-z+#l^T#&S>68<w4zY%fM+Q#mDMLXtAZl+bDFF1B~D)g#pY
zPS97n*gfcW=c1Qsm3@iDlUC;~Gw~D@;^o-<R#K&Ql2}>)`%=M&NL4TV?nSZWY6rjr
zU7nKWU0Vis?W#BSj3Q*zKSyW#+!j~{U)mf4n2}}qd$T&sj@gbsdfRe%b^nG)RUq@H
z{i9k+QoP{OTt?DNXx9b>{wo(0-)RL(BpXqY08a<8BB7bW+XjKf^SyQa(om|#XkN`V
zae+#mGfI^H#^6%zMr-=!XtV<@RHtH(QIh|j7+9r`q~@Yp3=idRiowrR=k9Y#ik<IN
zXMxpT_2S>E)@!e6@(oy!n)bSFp55QYUVS~$r*D4|d-0zeEUfQBVOI=MgK3nGUfx;k
z2?ObapK0T1%?eE69z=*cga3%V$)@}?VNF{_F1Z8F3HxOE+d)B7x$7014&cb<>Ac+&
zvG+z9??ATLwdQ$&$Bd9zru25pJo?eCNE~$9sE|olFd#)@gTErU!y=;h3ZjxYI4~rA
z&~{P!ad+QveeiPO*MnJtv}=pskkz2MaYu^j3%^cRYrU&8BlG!>dMzt{3(_^<1jUtg
zUycgdoX_93{z2JWhUfWE9gX0v7yKXBI;$v%8&22cD%>OykBXfosBH^hCU2y|lG5li
z$=m4V&j*A#+BWm^q6j$K+1wl{9Nfliq!HsW)ydAby?gN$l}#XxLe%<n12orD@X{r{
z#uor71saJ0w{aAUO7A_ogSN;<NA?c=#xCJ5O58tEA}mBve}^at|EchnDSb{1Aj#iX
z!$MTP$>|uiO9e#cLwv%q8tHwzN?1u=F(YQQ>GZFygKdnBAzJUX$D1zi`%<}j7dCHg
z(%H%88)v~v?P4bEbH*<DkkF>jeh2zt?;6WD{cy4Z0<U_tFNx;%kd&KA(?Ssc(~3AA
zc`CUZ(%#=7N;kPWVmtZo1<wKE39ue&1nw^3Ol}M&88lgkF%4x{l#BwpjtmD~OHt$M
z8#5Q9(`7xA9)70WbKAmH!(ZI=lhSX-zFoiqJv&21+ghJwb>d_RTh5lhQ^kI~LG<v~
ztwZK)f_Lrv(&QaqcY)S{bfd~uGOnRcEw*yI))mf*l#l$lQe4mPu}v(!60{Cd5J<*)
ziI<2>Ngxh)zJ682yi=NDgZpDccfJmN-73-wOGy3uRUA`q<F)ARKcrDyqhX>GT){-M
zs8b_TUsdQ!-Q})#Gk50dKn4l2p}K9$1nd6{VAi2{c;~<S=Q=+)qSaPk9CL?<J+Pfk
z&xG~c$V9JA>6|=nQs<|Ck4%)4dlw8PwJxVzeAI5cDftMNqyvmhbQjRmnZ{WoKSn0j
z5aLZ3kVU3WVv=diOFk*uH}yN3PDUmYhyo({2J24=>P2@xhqYQP?n=$6es9N7Tq(~i
zSIf!RLe3!ijsdLr?#uqquSPBC+LiOhT-@j_hOn}=gLfrUwG3b7w7W0NqJ<w@LR>4f
zRn=*cMVo#T)iaSv6Mz<KdHzT?1aEEUz#P3lR`hwt|BfkfWcLJO{h-F8eEI#>Q7y6L
zpJN!<BWf<Xu%_u%&f~F?%9P$~^xyv)E7`1ZO843QD6_{+l>{>SNF_;+OK&0V9Kn^e
zf#b1Kh<0?Fvxwio^{jt5Tt+j(sKZX7*EqZHvglX<cC4h$RU&0KcQRID^P9D-?_LB~
zs&D|}ly2@OGUD4<2{vYFAa=R!lgr}+_5|S<-A;&i2ms`BMwGnHb|Dp^W&;QSY0md3
z2TWpPm>o>f6uewyDx)fvA~0(w>VJqOD{<4i$%hd~86zvVtfBA0SZxw^a9*n>W8%Y>
z>A{g~#_-aECHEuPvzl%1og)4Xe4Gr<|E~EAdrnEI)_*9){IKPkJK=_l;LqbXyR|E+
z!3efw&5VD?5+LnZyK~YCxv@sKWqupKrD-{?`wd?IY5bNt^oC}%>Lr%c*~8w<7XQfg
z1Dgyhfa|hpFPJ5NI2pe+Uqd85u-CW<jNhzB{D)3*y&VJAc<{)s(67p_!w3jcZ!>7x
z`Qg_MUz|)sA(OA-+Lo}nj@8xOZ&bXV9i!6jc6Ib$3gkH^br#ig;1^y~9$%lzxU6%$
zU)lan>eQi(oh3rTQ<Lj2pv;lm03wrf|1p-njVSTuE-<eqjyp-5icquZ6UR_1vqd(u
z=swnrH{l7pGSxSVSI__NSo(ED>F7QhN33HUV`N=$#ju>p{27dm_HmK=?<2}j*Am*$
z1xbyTdp1EMXk+*<Bgz|RB{4%)e`VPg9P8XbKVTh2c?|>t;Q;piNC?9I<pC>LI|qD(
z0xS-&Bfu5`D+KHfV0QrfejWA*2L4w8>~Fws1C|chbHG>u<2*T*0oM@%hCMm~Yxi(L
zAbva$r~w}YswV(}&_uwSkbpqMWFSx|IS3>{0X!41BtTEhrvia?s6ik<8W3oc7FYv=
zKvMJ|kkvU5D1-rcPe8w-03Cwxj(-pE0N{t6IzEpAo`iF9J_Rh}0_UfIqbCyxbn0Xs
zcmdGqlXKvuKvXz*Am9O@A>bO?lXdJpbig|Bbs%EEz$e%E0oR<v!9QNN1<n~x&f&m0
U<H^0)dpLjke&|o@z(=6}0?pY|g8%>k

literal 0
HcmV?d00001

diff --git a/extra/graphics/tiff/tiff-tests.factor b/extra/graphics/tiff/tiff-tests.factor
new file mode 100755
index 0000000000..daee9a5d9e
--- /dev/null
+++ b/extra/graphics/tiff/tiff-tests.factor
@@ -0,0 +1,9 @@
+! Copyright (C) 2009 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test graphics.tiff ;
+IN: graphics.tiff.tests
+
+: tiff-test-path ( -- path )
+    "resource:extra/graphics/tiff/rgb.tiff" ;
+
+
diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
new file mode 100755
index 0000000000..4676ea2748
--- /dev/null
+++ b/extra/graphics/tiff/tiff.factor
@@ -0,0 +1,37 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators io io.encodings.binary io.files
+kernel pack endian ;
+IN: graphics.tiff
+
+TUPLE: tiff
+endianness
+the-answer
+ifd-offset
+;
+
+
+ERROR: bad-tiff-magic bytes ;
+
+: tiff-endianness ( byte-array -- ? )
+    {
+        { B{ CHAR: M CHAR: M } [ big-endian ] }
+        { B{ CHAR: I CHAR: I } [ little-endian ] }
+        [ bad-tiff-magic ]
+    } case ;
+
+: read-header ( tiff -- tiff )
+    2 read tiff-endianness [ >>endianness ] keep
+    [
+        2 read endian> >>the-answer
+        4 read endian> >>ifd-offset
+    ] with-endianness ;
+
+: (load-tiff) ( path -- tiff )
+    binary [
+        tiff new
+        read-header
+    ] with-file-reader ;
+
+: load-tiff ( path -- tiff )
+    (load-tiff) ;

From a4b174d04b64df457331dd6e881b4e987d29422f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 00:58:02 -0600
Subject: [PATCH 08/42] spruce up unmaintained/openal -- can maybe go back into
 extra/

---
 unmaintained/openal/macosx/macosx.factor |   6 +-
 unmaintained/openal/openal.factor        | 252 +++++++++++------------
 2 files changed, 128 insertions(+), 130 deletions(-)

diff --git a/unmaintained/openal/macosx/macosx.factor b/unmaintained/openal/macosx/macosx.factor
index d2a0422d8d..abc0d65fb9 100644
--- a/unmaintained/openal/macosx/macosx.factor
+++ b/unmaintained/openal/macosx/macosx.factor
@@ -9,6 +9,6 @@ LIBRARY: alut
 FUNCTION: void alutLoadWAVFile ( ALbyte* fileName, ALenum* format, void** data, ALsizei* size, ALsizei* frequency ) ;
 
 M: macosx load-wav-file ( path -- format data size frequency )
-  0 <int> f <void*> 0 <int> 0 <int>
-  [ alutLoadWAVFile ] 4keep
-  >r >r >r *int r> *void* r> *int r> *int ;
+    0 <int> f <void*> 0 <int> 0 <int>
+    [ alutLoadWAVFile ] 4keep
+    [ [ [ *int ] dip *void* ] dip *int ] dip *int ;
diff --git a/unmaintained/openal/openal.factor b/unmaintained/openal/openal.factor
index 40593d1e8d..8533308f26 100644
--- a/unmaintained/openal/openal.factor
+++ b/unmaintained/openal/openal.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel arrays alien system combinators alien.syntax namespaces
-       alien.c-types sequences vocabs.loader shuffle combinators.lib
+       alien.c-types sequences vocabs.loader shuffle
        openal.backend specialized-arrays.uint ;
 IN: openal
 
@@ -36,75 +36,75 @@ TYPEDEF: int ALenum
 TYPEDEF: float ALfloat
 TYPEDEF: double ALdouble
 
-: AL_INVALID ( -- number ) -1 ; inline
-: AL_NONE ( -- number ) 0 ; inline
-: AL_FALSE ( -- number ) 0 ; inline
-: AL_TRUE ( -- number ) 1 ; inline
-: AL_SOURCE_RELATIVE ( -- number ) HEX: 202 ; inline
-: AL_CONE_INNER_ANGLE ( -- nmber ) HEX: 1001 ; inline
-: AL_CONE_OUTER_ANGLE ( -- number ) HEX: 1002 ; inline
-: AL_PITCH ( -- number ) HEX: 1003 ; inline
-: AL_POSITION ( -- number ) HEX: 1004 ; inline
-: AL_DIRECTION ( -- number ) HEX: 1005 ; inline
-: AL_VELOCITY ( -- number ) HEX: 1006 ; inline
-: AL_LOOPING ( -- number ) HEX: 1007 ; inline
-: AL_BUFFER ( -- number ) HEX: 1009 ; inline
-: AL_GAIN ( -- number ) HEX: 100A ; inline
-: AL_MIN_GAIN ( -- number ) HEX: 100D ; inline
-: AL_MAX_GAIN ( -- number ) HEX: 100E ; inline
-: AL_ORIENTATION ( -- number ) HEX: 100F ; inline
-: AL_CHANNEL_MASK ( -- number ) HEX: 3000 ; inline
-: AL_SOURCE_STATE ( -- number ) HEX: 1010 ; inline
-: AL_INITIAL ( -- number ) HEX: 1011 ; inline
-: AL_PLAYING ( -- number ) HEX: 1012 ; inline
-: AL_PAUSED ( -- number ) HEX: 1013 ; inline
-: AL_STOPPED ( -- number ) HEX: 1014 ; inline
-: AL_BUFFERS_QUEUED ( -- number ) HEX: 1015 ; inline
-: AL_BUFFERS_PROCESSED ( -- number ) HEX: 1016 ; inline
-: AL_SEC_OFFSET ( -- number ) HEX: 1024 ; inline
-: AL_SAMPLE_OFFSET ( -- number ) HEX: 1025 ; inline
-: AL_BYTE_OFFSET ( -- number ) HEX: 1026 ; inline
-: AL_SOURCE_TYPE ( -- number ) HEX: 1027 ; inline
-: AL_STATIC ( -- number ) HEX: 1028 ; inline
-: AL_STREAMING ( -- number ) HEX: 1029 ; inline
-: AL_UNDETERMINED ( -- number ) HEX: 1030 ; inline
-: AL_FORMAT_MONO8 ( -- number ) HEX: 1100 ; inline
-: AL_FORMAT_MONO16 ( -- number ) HEX: 1101 ; inline
-: AL_FORMAT_STEREO8 ( -- number ) HEX: 1102 ; inline
-: AL_FORMAT_STEREO16 ( -- number ) HEX: 1103 ; inline
-: AL_REFERENCE_DISTANCE ( -- number ) HEX: 1020 ; inline
-: AL_ROLLOFF_FACTOR ( -- number ) HEX: 1021 ; inline
-: AL_CONE_OUTER_GAIN ( -- number ) HEX: 1022 ; inline
-: AL_MAX_DISTANCE ( -- number ) HEX: 1023 ; inline
-: AL_FREQUENCY ( -- number ) HEX: 2001 ; inline
-: AL_BITS ( -- number ) HEX: 2002 ; inline
-: AL_CHANNELS ( -- number ) HEX: 2003 ; inline
-: AL_SIZE ( -- number ) HEX: 2004 ; inline
-: AL_UNUSED ( -- number ) HEX: 2010 ; inline
-: AL_PENDING ( -- number ) HEX: 2011 ; inline
-: AL_PROCESSED ( -- number ) HEX: 2012 ; inline
-: AL_NO_ERROR ( -- number ) AL_FALSE ; inline
-: AL_INVALID_NAME ( -- number ) HEX: A001 ; inline
-: AL_ILLEGAL_ENUM ( -- number ) HEX: A002 ; inline
-: AL_INVALID_ENUM ( -- number ) HEX: A002 ; inline
-: AL_INVALID_VALUE ( -- number ) HEX: A003 ; inline
-: AL_ILLEGAL_COMMAND ( -- number ) HEX: A004 ; inline
-: AL_INVALID_OPERATION ( -- number ) HEX: A004 ; inline
-: AL_OUT_OF_MEMORY ( -- number ) HEX: A005 ; inline
-: AL_VENDOR ( -- number ) HEX: B001 ; inline
-: AL_VERSION ( -- number ) HEX: B002 ; inline
-: AL_RENDERER ( -- number ) HEX: B003 ; inline
-: AL_EXTENSIONS ( -- number ) HEX: B004 ; inline
-: AL_DOPPLER_FACTOR ( -- number ) HEX: C000 ; inline
-: AL_DOPPLER_VELOCITY ( -- number ) HEX: C001 ; inline
-: AL_SPEED_OF_SOUND ( -- number ) HEX: C003 ; inline
-: AL_DISTANCE_MODEL ( -- number ) HEX: D000 ; inline
-: AL_INVERSE_DISTANCE ( -- number ) HEX: D001 ; inline
-: AL_INVERSE_DISTANCE_CLAMPED ( -- number ) HEX: D002 ; inline
-: AL_LINEAR_DISTANCE ( -- number ) HEX: D003 ; inline
-: AL_LINEAR_DISTANCE_CLAMPED ( -- number ) HEX: D004 ; inline
-: AL_EXPONENT_DISTANCE ( -- number ) HEX: D005 ; inline
-: AL_EXPONENT_DISTANCE_CLAMPED ( -- number ) HEX: D006 ; inline
+CONSTANT: AL_INVALID -1
+CONSTANT: AL_NONE 0
+CONSTANT: AL_FALSE 0
+CONSTANT: AL_TRUE 1
+CONSTANT: AL_SOURCE_RELATIVE HEX: 202
+CONSTANT: AL_CONE_INNER_ANGLE HEX: 1001
+CONSTANT: AL_CONE_OUTER_ANGLE HEX: 1002
+CONSTANT: AL_PITCH HEX: 1003
+CONSTANT: AL_POSITION HEX: 1004
+CONSTANT: AL_DIRECTION HEX: 1005
+CONSTANT: AL_VELOCITY HEX: 1006
+CONSTANT: AL_LOOPING HEX: 1007
+CONSTANT: AL_BUFFER HEX: 1009
+CONSTANT: AL_GAIN HEX: 100A
+CONSTANT: AL_MIN_GAIN HEX: 100D
+CONSTANT: AL_MAX_GAIN HEX: 100E
+CONSTANT: AL_ORIENTATION HEX: 100F
+CONSTANT: AL_CHANNEL_MASK HEX: 3000
+CONSTANT: AL_SOURCE_STATE HEX: 1010
+CONSTANT: AL_INITIAL HEX: 1011
+CONSTANT: AL_PLAYING HEX: 1012
+CONSTANT: AL_PAUSED HEX: 1013
+CONSTANT: AL_STOPPED HEX: 1014
+CONSTANT: AL_BUFFERS_QUEUED HEX: 1015
+CONSTANT: AL_BUFFERS_PROCESSED HEX: 1016
+CONSTANT: AL_SEC_OFFSET HEX: 1024
+CONSTANT: AL_SAMPLE_OFFSET HEX: 1025
+CONSTANT: AL_BYTE_OFFSET HEX: 1026
+CONSTANT: AL_SOURCE_TYPE HEX: 1027
+CONSTANT: AL_STATIC HEX: 1028
+CONSTANT: AL_STREAMING HEX: 1029
+CONSTANT: AL_UNDETERMINED HEX: 1030
+CONSTANT: AL_FORMAT_MONO8 HEX: 1100
+CONSTANT: AL_FORMAT_MONO16 HEX: 1101
+CONSTANT: AL_FORMAT_STEREO8 HEX: 1102
+CONSTANT: AL_FORMAT_STEREO16 HEX: 1103
+CONSTANT: AL_REFERENCE_DISTANCE HEX: 1020
+CONSTANT: AL_ROLLOFF_FACTOR HEX: 1021
+CONSTANT: AL_CONE_OUTER_GAIN HEX: 1022
+CONSTANT: AL_MAX_DISTANCE HEX: 1023
+CONSTANT: AL_FREQUENCY HEX: 2001
+CONSTANT: AL_BITS HEX: 2002
+CONSTANT: AL_CHANNELS HEX: 2003
+CONSTANT: AL_SIZE HEX: 2004
+CONSTANT: AL_UNUSED HEX: 2010
+CONSTANT: AL_PENDING HEX: 2011
+CONSTANT: AL_PROCESSED HEX: 2012
+CONSTANT: AL_NO_ERROR AL_FALSE
+CONSTANT: AL_INVALID_NAME HEX: A001
+CONSTANT: AL_ILLEGAL_ENUM HEX: A002
+CONSTANT: AL_INVALID_ENUM HEX: A002
+CONSTANT: AL_INVALID_VALUE HEX: A003
+CONSTANT: AL_ILLEGAL_COMMAND HEX: A004
+CONSTANT: AL_INVALID_OPERATION HEX: A004
+CONSTANT: AL_OUT_OF_MEMORY HEX: A005
+CONSTANT: AL_VENDOR HEX: B001
+CONSTANT: AL_VERSION HEX: B002
+CONSTANT: AL_RENDERER HEX: B003
+CONSTANT: AL_EXTENSIONS HEX: B004
+CONSTANT: AL_DOPPLER_FACTOR HEX: C000
+CONSTANT: AL_DOPPLER_VELOCITY HEX: C001
+CONSTANT: AL_SPEED_OF_SOUND HEX: C003
+CONSTANT: AL_DISTANCE_MODEL HEX: D000
+CONSTANT: AL_INVERSE_DISTANCE HEX: D001
+CONSTANT: AL_INVERSE_DISTANCE_CLAMPED HEX: D002
+CONSTANT: AL_LINEAR_DISTANCE HEX: D003
+CONSTANT: AL_LINEAR_DISTANCE_CLAMPED HEX: D004
+CONSTANT: AL_EXPONENT_DISTANCE HEX: D005
+CONSTANT: AL_EXPONENT_DISTANCE_CLAMPED HEX: D006
 
 FUNCTION: void alEnable ( ALenum capability ) ;
 FUNCTION: void alDisable ( ALenum capability ) ; 
@@ -182,34 +182,34 @@ FUNCTION: void alDistanceModel ( ALenum distanceModel ) ;
 
 LIBRARY: alut
 
-: ALUT_API_MAJOR_VERSION ( -- number ) 1 ; inline
-: ALUT_API_MINOR_VERSION ( -- number ) 1 ; inline
-: ALUT_ERROR_NO_ERROR ( -- number ) 0 ; inline
-: ALUT_ERROR_OUT_OF_MEMORY ( -- number ) HEX: 200 ; inline
-: ALUT_ERROR_INVALID_ENUM ( -- number ) HEX: 201 ; inline
-: ALUT_ERROR_INVALID_VALUE ( -- number ) HEX: 202 ; inline
-: ALUT_ERROR_INVALID_OPERATION ( -- number ) HEX: 203 ; inline
-: ALUT_ERROR_NO_CURRENT_CONTEXT ( -- number ) HEX: 204 ; inline
-: ALUT_ERROR_AL_ERROR_ON_ENTRY ( -- number ) HEX: 205 ; inline
-: ALUT_ERROR_ALC_ERROR_ON_ENTRY ( -- number ) HEX: 206 ; inline
-: ALUT_ERROR_OPEN_DEVICE ( -- number ) HEX: 207 ; inline
-: ALUT_ERROR_CLOSE_DEVICE ( -- number ) HEX: 208 ; inline
-: ALUT_ERROR_CREATE_CONTEXT ( -- number ) HEX: 209 ; inline
-: ALUT_ERROR_MAKE_CONTEXT_CURRENT ( -- number ) HEX: 20A ; inline
-: ALUT_ERROR_DESTRY_CONTEXT ( -- number ) HEX: 20B ; inline
-: ALUT_ERROR_GEN_BUFFERS ( -- number ) HEX: 20C ; inline
-: ALUT_ERROR_BUFFER_DATA ( -- number ) HEX: 20D ; inline
-: ALUT_ERROR_IO_ERROR ( -- number ) HEX: 20E ; inline
-: ALUT_ERROR_UNSUPPORTED_FILE_TYPE ( -- number ) HEX: 20F ; inline
-: ALUT_ERROR_UNSUPPORTED_FILE_SUBTYPE ( -- number ) HEX: 210 ; inline
-: ALUT_ERROR_CORRUPT_OR_TRUNCATED_DATA ( -- number ) HEX: 211 ; inline
-: ALUT_WAVEFORM_SINE ( -- number ) HEX: 100 ; inline
-: ALUT_WAVEFORM_SQUARE ( -- number ) HEX: 101 ; inline
-: ALUT_WAVEFORM_SAWTOOTH ( -- number ) HEX: 102 ; inline
-: ALUT_WAVEFORM_WHITENOISE ( -- number ) HEX: 103 ; inline
-: ALUT_WAVEFORM_IMPULSE ( -- number ) HEX: 104 ; inline
-: ALUT_LOADER_BUFFER ( -- number ) HEX: 300 ; inline
-: ALUT_LOADER_MEMORY ( -- number ) HEX: 301 ; inline
+CONSTANT: ALUT_API_MAJOR_VERSION 1
+CONSTANT: ALUT_API_MINOR_VERSION 1
+CONSTANT: ALUT_ERROR_NO_ERROR 0
+CONSTANT: ALUT_ERROR_OUT_OF_MEMORY HEX: 200
+CONSTANT: ALUT_ERROR_INVALID_ENUM HEX: 201
+CONSTANT: ALUT_ERROR_INVALID_VALUE HEX: 202
+CONSTANT: ALUT_ERROR_INVALID_OPERATION HEX: 203
+CONSTANT: ALUT_ERROR_NO_CURRENT_CONTEXT HEX: 204
+CONSTANT: ALUT_ERROR_AL_ERROR_ON_ENTRY HEX: 205
+CONSTANT: ALUT_ERROR_ALC_ERROR_ON_ENTRY HEX: 206
+CONSTANT: ALUT_ERROR_OPEN_DEVICE HEX: 207
+CONSTANT: ALUT_ERROR_CLOSE_DEVICE HEX: 208
+CONSTANT: ALUT_ERROR_CREATE_CONTEXT HEX: 209
+CONSTANT: ALUT_ERROR_MAKE_CONTEXT_CURRENT HEX: 20A
+CONSTANT: ALUT_ERROR_DESTRY_CONTEXT HEX: 20B
+CONSTANT: ALUT_ERROR_GEN_BUFFERS HEX: 20C
+CONSTANT: ALUT_ERROR_BUFFER_DATA HEX: 20D
+CONSTANT: ALUT_ERROR_IO_ERROR HEX: 20E
+CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_TYPE HEX: 20F
+CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_SUBTYPE HEX: 210
+CONSTANT: ALUT_ERROR_CORRUPT_OR_TRUNCATED_DATA HEX: 211
+CONSTANT: ALUT_WAVEFORM_SINE HEX: 100
+CONSTANT: ALUT_WAVEFORM_SQUARE HEX: 101
+CONSTANT: ALUT_WAVEFORM_SAWTOOTH HEX: 102
+CONSTANT: ALUT_WAVEFORM_WHITENOISE HEX: 103
+CONSTANT: ALUT_WAVEFORM_IMPULSE HEX: 104
+CONSTANT: ALUT_LOADER_BUFFER HEX: 300
+CONSTANT: ALUT_LOADER_MEMORY HEX: 301
 
 FUNCTION: ALboolean alutInit ( int* argcp, char** argv ) ;
 FUNCTION: ALboolean alutInitWithoutContext ( int* argcp, char** argv ) ;
@@ -234,37 +234,37 @@ FUNCTION: void alutUnloadWAV ( ALenum format, void* data, ALsizei size, ALsizei
 SYMBOL: init
 
 : init-openal ( -- )
-  init get-global expired? [
-    f f alutInit 0 = [ "Could not initialize OpenAL" throw ] when
-    1337 <alien> init set-global
-  ] when ;
+    init get-global expired? [
+        f f alutInit 0 = [ "Could not initialize OpenAL" throw ] when
+        1337 <alien> init set-global
+    ] when ;
 
 : exit-openal ( -- )
-  init get-global expired? [
-    alutExit 0 = [ "Could not close OpenAL" throw ] when
-    f init set-global
-  ] unless ;
+    init get-global expired? [
+        alutExit 0 = [ "Could not close OpenAL" throw ] when
+        f init set-global
+    ] unless ;
 
 : <uint-array> ( n -- byte-array ) "ALuint" <c-array> ;
 
 : gen-sources ( size -- seq )
-  dup <uint-array> 2dup underlying>> alGenSources swap ;
+    dup <uint-array> 2dup underlying>> alGenSources swap ;
 
 : gen-buffers ( size -- seq )
-  dup <uint-array> 2dup underlying>> alGenBuffers swap ;
+    dup <uint-array> 2dup underlying>> alGenBuffers swap ;
 
 : gen-buffer ( -- buffer ) 1 gen-buffers first ;
 
 : create-buffer-from-file ( filename -- buffer )
-  alutCreateBufferFromFile dup AL_NONE = [
-    "create-buffer-from-file failed" throw
-  ] when ;
+    alutCreateBufferFromFile dup AL_NONE = [
+        "create-buffer-from-file failed" throw
+    ] when ;
 
 os macosx? "openal.macosx" "openal.other" ? require
 
 : create-buffer-from-wav ( filename -- buffer )
-  gen-buffer dup rot load-wav-file
-  [ alBufferData ] 4keep alutUnloadWAV ;
+    gen-buffer dup rot load-wav-file
+    [ alBufferData ] 4keep alutUnloadWAV ;
 
 : queue-buffers ( source buffers -- )
     [ length ] [ >uint-array underlying>> ] bi alSourceQueueBuffers ;
@@ -273,29 +273,27 @@ os macosx? "openal.macosx" "openal.other" ? require
     1array queue-buffers ;
 
 : set-source-param ( source param value -- )
-  alSourcei ;
+    alSourcei ;
 
 : get-source-param ( source param -- value )
-  0 <uint> dup >r alGetSourcei r> *uint ;
+    0 <uint> dup [ alGetSourcei ] dip *uint ;
 
 : set-buffer-param ( source param value -- )
-  alBufferi ;
+    alBufferi ;
 
 : get-buffer-param ( source param -- value )
-  0 <uint> dup >r alGetBufferi r> *uint ;
+    0 <uint> dup [ alGetBufferi ] dip *uint ;
 
-: source-play ( source -- )
-  alSourcePlay ;
+: source-play ( source -- ) alSourcePlay ;
 
-: source-stop ( source -- )
-  alSourceStop ;
+: source-stop ( source -- ) alSourceStop ;
 
 : check-error ( -- )
-  alGetError dup ALUT_ERROR_NO_ERROR = [
-    drop
-  ] [
-    alGetString throw
-  ] if ;
+    alGetError dup ALUT_ERROR_NO_ERROR = [
+        drop
+    ] [
+        alGetString throw
+    ] if ;
 
 : source-playing? ( source -- bool )
-  AL_SOURCE_STATE get-source-param AL_PLAYING = ;
+    AL_SOURCE_STATE get-source-param AL_PLAYING = ;

From 5f39a714be67c05b9f8a86c64d4a4616af676fe3 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 00:59:50 -0600
Subject: [PATCH 09/42] add some constants to unix

---
 basis/unix/unix.factor | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor
index 76613934af..a6a0147504 100644
--- a/basis/unix/unix.factor
+++ b/basis/unix/unix.factor
@@ -17,6 +17,10 @@ CONSTANT: MAP_FILE    0
 CONSTANT: MAP_SHARED  1
 CONSTANT: MAP_PRIVATE 2
 
+CONSTANT: SEEK_SET 0
+CONSTANT: SEEK_CUR 1
+CONSTANT: SEEK_END 2
+
 : MAP_FAILED ( -- alien ) -1 <alien> ; inline
 
 CONSTANT: NGROUPS_MAX 16

From f6f716c4e3a6e6457c9eecfb9e3ab418f5463af4 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 01:03:12 -0600
Subject: [PATCH 10/42] unix support for stream seeking

---
 basis/io/backend/unix/unix.factor  | 3 +++
 basis/io/buffers/buffers.factor    | 3 +++
 basis/io/ports/ports.factor        | 8 +++++++-
 core/io/encodings/encodings.factor | 2 ++
 core/io/io.factor                  | 5 ++++-
 5 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index d86a72c665..7340260b2e 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -46,6 +46,9 @@ M: fd cancel-operation ( fd -- )
         2bi
     ] if ;
 
+M: unix (stream-seek)
+    handle>> fd>> swap SEEK_SET lseek io-error ;
+
 SYMBOL: +retry+ ! just try the operation again without blocking
 SYMBOL: +input+
 SYMBOL: +output+
diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index 4df081b17d..11fbbf947c 100644
--- a/basis/io/buffers/buffers.factor
+++ b/basis/io/buffers/buffers.factor
@@ -27,6 +27,9 @@ M: buffer dispose* ptr>> free ;
 : buffer-empty? ( buffer -- ? )
     fill>> zero? ; inline
 
+: buffer-seek ( n buffer -- )
+    (>>pos) ; inline
+
 : buffer-consume ( n buffer -- )
     [ + ] change-pos
     dup [ pos>> ] [ fill>> ] bi <
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 1fe717d5ee..dd95e37d72 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -4,7 +4,7 @@ USING: math kernel io sequences io.buffers io.timeouts generic
 byte-vectors system io.encodings math.order io.backend
 continuations classes byte-arrays namespaces splitting
 grouping dlists assocs io.encodings.binary summary accessors
-destructors combinators ;
+destructors combinators unix ;
 IN: io.ports
 
 SYMBOL: default-buffer-size
@@ -93,6 +93,12 @@ M: input-port stream-read-until ( seps port -- str/f sep/f )
         ] [ [ 2drop ] 2dip ] if
     ] if ;
 
+HOOK: (stream-seek) os ( n stream -- )
+
+M: input-port stream-seek ( n stream -- )
+    dup check-disposed
+    2dup buffer>> buffer-seek (stream-seek) ;
+
 TUPLE: output-port < buffered-port ;
 
 : <output-port> ( handle -- output-port )
diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 94d2115478..4693c672a4 100644
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -50,6 +50,8 @@ M: object <decoder> f decoder boa ;
 M: decoder stream-read1
     dup >decoder< decode-char fix-read1 ;
 
+M: decoder stream-seek stream>> stream-seek ;
+
 : fix-read ( stream string -- string )
     over cr>> [
         over cr-
diff --git a/core/io/io.factor b/core/io/io.factor
index 55cc336ef8..9b606194e0 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -15,6 +15,8 @@ GENERIC: stream-write ( seq stream -- )
 GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
+GENERIC: stream-seek ( n stream -- )
+
 : stream-print ( str stream -- ) [ stream-write ] keep stream-nl ;
 
 ! Default streams
@@ -27,6 +29,7 @@ SYMBOL: error-stream
 : read ( n -- seq ) input-stream get stream-read ;
 : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
 : read-partial ( n -- seq ) input-stream get stream-read-partial ;
+: seek ( n -- ) input-stream get stream-seek ;
 
 : write1 ( elt -- ) output-stream get stream-write1 ;
 : write ( seq -- ) output-stream get stream-write ;
@@ -82,4 +85,4 @@ PRIVATE>
 
 : stream-copy ( in out -- )
     [ [ [ write ] each-block ] with-output-stream ]
-    curry with-input-stream ;
\ No newline at end of file
+    curry with-input-stream ;

From 790f3b867c7642505a91284fd854da6563ff40d7 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 01:12:03 -0600
Subject: [PATCH 11/42] remove bogus unix depenedency, implement seeking on
 windows

---
 basis/io/backend/windows/nt/nt.factor | 2 ++
 basis/io/ports/ports.factor           | 2 +-
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor
index c6b24a0a11..52ab06e753 100755
--- a/basis/io/backend/windows/nt/nt.factor
+++ b/basis/io/backend/windows/nt/nt.factor
@@ -82,6 +82,8 @@ M: winnt init-io ( -- )
     H{ } clone pending-overlapped set-global
     windows.winsock:init-winsock ;
 
+M: winnt (stream-seek) ( n stream -- ) 2drop ;
+
 : file-error? ( n -- eof? )
     zero? [
         GetLastError {
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index dd95e37d72..0f2dcc6e21 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -4,7 +4,7 @@ USING: math kernel io sequences io.buffers io.timeouts generic
 byte-vectors system io.encodings math.order io.backend
 continuations classes byte-arrays namespaces splitting
 grouping dlists assocs io.encodings.binary summary accessors
-destructors combinators unix ;
+destructors combinators ;
 IN: io.ports
 
 SYMBOL: default-buffer-size

From ec7356446f275353781b80b31f6235d39d4756df Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 08:59:50 -0600
Subject: [PATCH 12/42] read ifds for tiff files

---
 extra/graphics/tiff/tiff.factor | 35 ++++++++++++++++++++++++++++++++-
 1 file changed, 34 insertions(+), 1 deletion(-)

diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
index 4676ea2748..34f6c3e4e0 100755
--- a/extra/graphics/tiff/tiff.factor
+++ b/extra/graphics/tiff/tiff.factor
@@ -1,15 +1,28 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators io io.encodings.binary io.files
-kernel pack endian ;
+kernel pack endian tools.hexdump constructors sequences arrays
+sorting.slots math.order ;
 IN: graphics.tiff
 
 TUPLE: tiff
 endianness
 the-answer
 ifd-offset
+ifds
 ;
 
+CONSTRUCTOR: tiff ( -- tiff )
+    V{ } clone >>ifds ;
+
+TUPLE: ifd count ifd-entries ;
+
+CONSTRUCTOR: ifd ( count ifd-entries -- ifd ) ;
+
+TUPLE: ifd-entry tag type count offset ;
+
+CONSTRUCTOR: ifd-entry ( tag type count offset -- ifd-entry ) ;
+
 
 ERROR: bad-tiff-magic bytes ;
 
@@ -20,6 +33,9 @@ ERROR: bad-tiff-magic bytes ;
         [ bad-tiff-magic ]
     } case ;
 
+: with-tiff-endianness ( tiff quot -- tiff )
+    [ dup endianness>> ] dip with-endianness ; inline
+
 : read-header ( tiff -- tiff )
     2 read tiff-endianness [ >>endianness ] keep
     [
@@ -27,10 +43,27 @@ ERROR: bad-tiff-magic bytes ;
         4 read endian> >>ifd-offset
     ] with-endianness ;
 
+: push-ifd ( tiff ifd -- tiff )
+    over ifds>> push ;
+
+: read-ifd ( -- ifd )
+    2 read endian>
+    2 read endian>
+    4 read endian>
+    4 read endian> <ifd-entry> ;
+
+: read-ifds ( tiff -- tiff )
+    [
+        dup ifd-offset>> seek
+        2 read endian>
+        dup [ read-ifd ] replicate <ifd> >>ifds
+    ] with-tiff-endianness ;
+
 : (load-tiff) ( path -- tiff )
     binary [
         tiff new
         read-header
+        read-ifds
     ] with-file-reader ;
 
 : load-tiff ( path -- tiff )

From 723f08ca615e9d9f52345230a086956080fa14a8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 09:52:34 -0600
Subject: [PATCH 13/42] fix buffer-seek

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

diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index 11fbbf947c..bfb6c08471 100644
--- a/basis/io/buffers/buffers.factor
+++ b/basis/io/buffers/buffers.factor
@@ -28,7 +28,7 @@ M: buffer dispose* ptr>> free ;
     fill>> zero? ; inline
 
 : buffer-seek ( n buffer -- )
-    (>>pos) ; inline
+    0 >>fill 0 >>pos 2drop ; inline
 
 : buffer-consume ( n buffer -- )
     [ + ] change-pos

From 044fd02b5cf2200acd59cbd8bed098993f4be418 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 10:07:41 -0600
Subject: [PATCH 14/42] more work on tiff -- parse all the relevant ifd-entries

---
 extra/graphics/tiff/tiff.factor | 165 ++++++++++++++++++++++++++++++--
 1 file changed, 159 insertions(+), 6 deletions(-)

diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
index 34f6c3e4e0..462f75ff79 100755
--- a/extra/graphics/tiff/tiff.factor
+++ b/extra/graphics/tiff/tiff.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators io io.encodings.binary io.files
 kernel pack endian tools.hexdump constructors sequences arrays
-sorting.slots math.order ;
+sorting.slots math.order math.parser prettyprint ;
 IN: graphics.tiff
 
 TUPLE: tiff
@@ -10,20 +10,135 @@ endianness
 the-answer
 ifd-offset
 ifds
-;
+processed-ifds ;
 
 CONSTRUCTOR: tiff ( -- tiff )
     V{ } clone >>ifds ;
 
-TUPLE: ifd count ifd-entries ;
+TUPLE: ifd count ifd-entries next ;
 
-CONSTRUCTOR: ifd ( count ifd-entries -- ifd ) ;
+CONSTRUCTOR: ifd ( count ifd-entries next -- ifd ) ;
 
 TUPLE: ifd-entry tag type count offset ;
 
 CONSTRUCTOR: ifd-entry ( tag type count offset -- ifd-entry ) ;
 
 
+TUPLE: photometric-interpretation color ;
+
+CONSTRUCTOR: photometric-interpretation ( color -- object ) ;
+
+SINGLETONS: white-is-zero black-is-zero rgb palette-color ;
+
+ERROR: bad-photometric-interpretation n ;
+
+: lookup-photometric-interpretation ( n -- singleton )
+    {
+        { 0 [ white-is-zero ] }
+        { 1 [ black-is-zero ] }
+        { 2 [ rgb ] }
+        { 3 [ palette-color ] }
+        [ bad-photometric-interpretation ]
+    } case <photometric-interpretation> ;
+
+
+TUPLE: compression method ;
+
+CONSTRUCTOR: compression ( method -- object ) ;
+
+SINGLETONS: no-compression CCITT-2 pack-bits lzw ;
+
+ERROR: bad-compression n ;
+
+: lookup-compression ( n -- compression )
+    {
+        { 1 [ no-compression ] }
+        { 2 [ CCITT-2 ] }
+        { 5 [ lzw ] }
+        { 32773 [ pack-bits ] }
+        [ bad-compression ]
+    } case <compression> ;
+
+TUPLE: image-length n ;
+CONSTRUCTOR: image-length ( n -- object ) ;
+
+TUPLE: image-width n ;
+CONSTRUCTOR: image-width ( n -- object ) ;
+
+TUPLE: x-resolution n ;
+CONSTRUCTOR: x-resolution ( n -- object ) ;
+
+TUPLE: y-resolution n ;
+CONSTRUCTOR: y-resolution ( n -- object ) ;
+
+TUPLE: rows-per-strip n ;
+CONSTRUCTOR: rows-per-strip ( n -- object ) ;
+
+TUPLE: strip-offsets n ;
+CONSTRUCTOR: strip-offsets ( n -- object ) ;
+
+TUPLE: strip-byte-counts n ;
+CONSTRUCTOR: strip-byte-counts ( n -- object ) ;
+
+TUPLE: bits-per-sample n ;
+CONSTRUCTOR: bits-per-sample ( n -- object ) ;
+
+TUPLE: samples-per-pixel n ;
+CONSTRUCTOR: samples-per-pixel ( n -- object ) ;
+
+SINGLETONS: no-resolution-unit
+inch-resolution-unit
+centimeter-resolution-unit ;
+
+TUPLE: resolution-unit type ;
+CONSTRUCTOR: resolution-unit ( type -- object ) ;
+
+ERROR: bad-resolution-unit n ;
+
+: lookup-resolution-unit ( n -- object )
+    {
+        { 1 [ no-resolution-unit ] }
+        { 2 [ inch-resolution-unit ] }
+        { 3 [ centimeter-resolution-unit ] }
+        [ bad-resolution-unit ]
+    } case <resolution-unit> ;
+
+
+TUPLE: predictor type ;
+CONSTRUCTOR: predictor ( type -- object ) ;
+
+SINGLETONS: no-predictor horizontal-differencing-predictor ;
+
+ERROR: bad-predictor n ;
+
+: lookup-predictor ( n -- object )
+    {
+        { 1 [ no-predictor ] }
+        { 2 [ horizontal-differencing-predictor ] }
+        [ bad-predictor ]
+    } case <predictor> ;
+
+
+TUPLE: planar-configuration type ;
+CONSTRUCTOR: planar-configuration ( type -- object ) ;
+
+SINGLETONS: chunky planar ;
+
+ERROR: bad-planar-configuration n ;
+
+: lookup-planar-configuration ( n -- object )
+    {
+        { 1 [ no-predictor ] }
+        { 2 [ horizontal-differencing-predictor ] }
+        [ bad-predictor ]
+    } case <planar-configuration> ;
+
+
+TUPLE: new-subfile-type n ;
+CONSTRUCTOR: new-subfile-type ( n -- object ) ;
+
+
+
 ERROR: bad-tiff-magic bytes ;
 
 : tiff-endianness ( byte-array -- ? )
@@ -56,14 +171,52 @@ ERROR: bad-tiff-magic bytes ;
     [
         dup ifd-offset>> seek
         2 read endian>
-        dup [ read-ifd ] replicate <ifd> >>ifds
+        dup [ read-ifd ] replicate
+        4 read endian>
+        [ <ifd> push-ifd ] [ 0 = [ read-ifds ] unless ] bi
     ] with-tiff-endianness ;
 
+! ERROR: unhandled-ifd-entry data n ;
+
+: unhandled-ifd-entry ;
+
+: ifd-entry-value ( ifd-entry -- n )
+    dup count>> 1 = [
+        offset>>
+    ] [
+        [ offset>> seek ] [ count>> read ] bi
+    ] if ;
+
+: process-ifd-entry ( ifd-entry -- object )
+    [ ifd-entry-value ] [ tag>> ] bi {
+        { 254 [ <new-subfile-type> ] }
+        { 256 [ <image-width> ] }
+        { 257 [ <image-length> ] }
+        { 258 [ <bits-per-sample> ] }
+        { 259 [ lookup-compression ] }
+        { 262 [ lookup-photometric-interpretation ] }
+        { 273 [ <strip-offsets> ] }
+        { 277 [ <samples-per-pixel> ] }
+        { 278 [ <rows-per-strip> ] }
+        { 279 [ <strip-byte-counts> ] }
+        { 282 [ <x-resolution> ] }
+        { 283 [ <y-resolution> ] }
+        { 284 [ <planar-configuration> ] }
+        { 296 [ lookup-resolution-unit ] }
+        { 317 [ lookup-predictor ] }
+        [ unhandled-ifd-entry swap 2array ]
+    } case ;
+
+: process-ifd ( ifd -- processed-ifd )
+    ifd-entries>> [ process-ifd-entry ] map ;
+
 : (load-tiff) ( path -- tiff )
     binary [
-        tiff new
+        <tiff>
         read-header
         read-ifds
+        dup ifds>> [ process-ifd ] map
+        >>processed-ifds
     ] with-file-reader ;
 
 : load-tiff ( path -- tiff )

From bc0521f88a52b7cef23ed77b75d165107ee36449 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 10:30:51 -0600
Subject: [PATCH 15/42] make seeking support the full lseek options, add
 seeking on output ports, remove seeking from decoders..

---
 basis/io/backend/unix/unix.factor  |  9 +++++++--
 basis/io/ports/ports.factor        | 13 +++++++------
 core/io/encodings/encodings.factor |  2 --
 core/io/io.factor                  |  6 ++++--
 4 files changed, 18 insertions(+), 12 deletions(-)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index 7340260b2e..e39ae3e7f8 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -46,8 +46,13 @@ M: fd cancel-operation ( fd -- )
         2bi
     ] if ;
 
-M: unix (stream-seek)
-    handle>> fd>> swap SEEK_SET lseek io-error ;
+M: unix (stream-seek) ( n seek-type stream -- )
+    swap {
+        { io:seek-absolute [ SEEK_SET ] }
+        { io:seek-relative [ SEEK_CUR ] }
+        { io:seek-end [ SEEK_END ] }
+    } case
+    [ handle>> fd>> swap ] dip lseek io-error ;
 
 SYMBOL: +retry+ ! just try the operation again without blocking
 SYMBOL: +input+
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 0f2dcc6e21..4b0336ed26 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -93,12 +93,6 @@ M: input-port stream-read-until ( seps port -- str/f sep/f )
         ] [ [ 2drop ] 2dip ] if
     ] if ;
 
-HOOK: (stream-seek) os ( n stream -- )
-
-M: input-port stream-seek ( n stream -- )
-    dup check-disposed
-    2dup buffer>> buffer-seek (stream-seek) ;
-
 TUPLE: output-port < buffered-port ;
 
 : <output-port> ( handle -- output-port )
@@ -126,6 +120,13 @@ M: output-port stream-write
 
 HOOK: (wait-to-write) io-backend ( port -- )
 
+HOOK: (stream-seek) os ( n seek-type stream -- )
+
+M: port stream-seek ( n seek-type stream -- )
+    dup check-disposed
+    [ nip buffer>> buffer-seek ] [ (stream-seek) ] 3bi ;
+
+
 GENERIC: shutdown ( handle -- )
 
 M: object shutdown drop ;
diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 4693c672a4..94d2115478 100644
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -50,8 +50,6 @@ M: object <decoder> f decoder boa ;
 M: decoder stream-read1
     dup >decoder< decode-char fix-read1 ;
 
-M: decoder stream-seek stream>> stream-seek ;
-
 : fix-read ( stream string -- string )
     over cr>> [
         over cr-
diff --git a/core/io/io.factor b/core/io/io.factor
index 9b606194e0..1cfdaf526e 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -15,7 +15,8 @@ GENERIC: stream-write ( seq stream -- )
 GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
-GENERIC: stream-seek ( n stream -- )
+SINGLETONS: seek-absolute seek-relative seek-end ;
+GENERIC: stream-seek ( n seek-type stream -- )
 
 : stream-print ( str stream -- ) [ stream-write ] keep stream-nl ;
 
@@ -29,7 +30,8 @@ SYMBOL: error-stream
 : read ( n -- seq ) input-stream get stream-read ;
 : read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
 : read-partial ( n -- seq ) input-stream get stream-read-partial ;
-: seek ( n -- ) input-stream get stream-seek ;
+: seek-input ( n seek-type -- ) input-stream get stream-seek ;
+: seek-output ( n seek-type -- ) output-stream get stream-seek ;
 
 : write1 ( elt -- ) output-stream get stream-write1 ;
 : write ( seq -- ) output-stream get stream-write ;

From 44a4c20f230920da2b6b6b6fe45535b6dd476d2d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 11:00:16 -0600
Subject: [PATCH 16/42] update stream seeking on windows for new api

---
 basis/io/backend/windows/nt/nt.factor  | 12 +++++++++++-
 basis/io/buffers/buffers.factor        |  6 +++---
 basis/io/ports/ports.factor            |  2 +-
 basis/windows/kernel32/kernel32.factor |  2 +-
 4 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor
index 52ab06e753..7479c0a0bb 100755
--- a/basis/io/backend/windows/nt/nt.factor
+++ b/basis/io/backend/windows/nt/nt.factor
@@ -82,7 +82,17 @@ M: winnt init-io ( -- )
     H{ } clone pending-overlapped set-global
     windows.winsock:init-winsock ;
 
-M: winnt (stream-seek) ( n stream -- ) 2drop ;
+ERROR: invalid-file-size n ;
+
+: handle>file-size ( handle -- n )
+    0 <ulonglong> [ GetFileSizeEx win32-error=0/f ] keep *ulonglong ;
+
+M: winnt (stream-seek) ( n seek-type stream -- )
+    swap {
+        { seek-absolute [ handle>> (>>ptr) ] }
+        { seek-relative [ handle>> [ + ] change-ptr drop ] }
+        { seek-end [ handle>> [ handle>> handle>file-size + ] keep (>>ptr) ] }
+    } case ;
 
 : file-error? ( n -- eof? )
     zero? [
diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index bfb6c08471..a647f27dfc 100644
--- a/basis/io/buffers/buffers.factor
+++ b/basis/io/buffers/buffers.factor
@@ -21,15 +21,15 @@ M: buffer dispose* ptr>> free ;
 : buffer-reset ( n buffer -- )
     swap >>fill 0 >>pos drop ;
 
+: buffer-reset-hard ( buffer -- )
+    0 >>fill 0 >>pos drop ;
+
 : buffer-capacity ( buffer -- n )
     [ size>> ] [ fill>> ] bi - ; inline
 
 : buffer-empty? ( buffer -- ? )
     fill>> zero? ; inline
 
-: buffer-seek ( n buffer -- )
-    0 >>fill 0 >>pos 2drop ; inline
-
 : buffer-consume ( n buffer -- )
     [ + ] change-pos
     dup [ pos>> ] [ fill>> ] bi <
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 4b0336ed26..1f7fc5f115 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -124,7 +124,7 @@ HOOK: (stream-seek) os ( n seek-type stream -- )
 
 M: port stream-seek ( n seek-type stream -- )
     dup check-disposed
-    [ nip buffer>> buffer-seek ] [ (stream-seek) ] 3bi ;
+    [ buffer>> buffer-reset-hard 2drop ] [ (stream-seek) ] 3bi ;
 
 
 GENERIC: shutdown ( handle -- )
diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index d3e823f844..3494e83e83 100755
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -1235,7 +1235,7 @@ ALIAS: GetFileAttributesEx GetFileAttributesExW
 
 FUNCTION: BOOL GetFileInformationByHandle ( HANDLE hFile, LPBY_HANDLE_FILE_INFORMATION lpFileInformation ) ;
 FUNCTION: DWORD GetFileSize ( HANDLE hFile, LPDWORD lpFileSizeHigh ) ;
-! FUNCTION: GetFileSizeEx
+FUNCTION: BOOL GetFileSizeEx ( HANDLE hFile, PLARGE_INTEGER lpFileSize ) ;
 FUNCTION: BOOL GetFileTime ( HANDLE hFile, LPFILETIME lpCreationTime, LPFILETIME lpLastAccessTime, LPFILETIME lpLastWriteTime ) ;
 FUNCTION: DWORD GetFileType ( HANDLE hFile ) ;
 ! FUNCTION: GetFirmwareEnvironmentVariableA

From 2820b9fc9981c9c6aef47844b858ae7b1e8a7ab9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 11:23:00 -0600
Subject: [PATCH 17/42] better error handling on unix seek, unit tests

---
 core/io/io-tests.factor | 65 ++++++++++++++++++++++++++++++++++++++++-
 core/io/io.factor       |  1 +
 2 files changed, 65 insertions(+), 1 deletion(-)

diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor
index 009ba3a9e7..8bfc52432d 100644
--- a/core/io/io-tests.factor
+++ b/core/io/io-tests.factor
@@ -1,6 +1,6 @@
 USING: arrays io io.files kernel math parser strings system
 tools.test words namespaces make io.encodings.8-bit
-io.encodings.binary sequences ;
+io.encodings.binary sequences io.files.unique ;
 IN: io.tests
 
 [ f ] [
@@ -10,3 +10,66 @@ IN: io.tests
 
 ! Make sure we use correct to_c_string form when writing
 [ ] [ "\0" write ] unit-test
+
+[ B{ 3 2 3 4 5 } ]
+[
+    "seek-test1" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write flush 0 seek-absolute seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 1 2 3 4 3 } ]
+[
+    "seek-test2" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write flush -1 seek-relative seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 1 2 3 4 5 0 3 } ]
+[
+    "seek-test3" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write flush 1 seek-relative seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 3 } ]
+[
+    B{ 1 2 3 4 5 } "seek-test4" unique-file binary [
+        set-file-contents
+    ] [
+        [
+            -3 seek-end seek-input 1 read
+        ] with-file-reader
+    ] 2bi
+] unit-test
+
+[ B{ 2 } ]
+[
+    B{ 1 2 3 4 5 } "seek-test5" unique-file binary [
+        set-file-contents
+    ] [
+        [
+            3 seek-absolute seek-input
+            -2 seek-relative seek-input
+            1 read
+        ] with-file-reader
+    ] 2bi
+] unit-test
diff --git a/core/io/io.factor b/core/io/io.factor
index 1cfdaf526e..11a2a6d1a8 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -15,6 +15,7 @@ GENERIC: stream-write ( seq stream -- )
 GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
+ERROR: bad-seek-type type ;
 SINGLETONS: seek-absolute seek-relative seek-end ;
 GENERIC: stream-seek ( n seek-type stream -- )
 

From 959ef7a7374de067b21ccfe4d403082641008811 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 11:24:12 -0600
Subject: [PATCH 18/42] better error handling for backends

---
 basis/io/backend/unix/unix.factor     | 1 +
 basis/io/backend/windows/nt/nt.factor | 1 +
 2 files changed, 2 insertions(+)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index e39ae3e7f8..3372f15cd9 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -51,6 +51,7 @@ M: unix (stream-seek) ( n seek-type stream -- )
         { io:seek-absolute [ SEEK_SET ] }
         { io:seek-relative [ SEEK_CUR ] }
         { io:seek-end [ SEEK_END ] }
+        [ io:bad-seek-type ]
     } case
     [ handle>> fd>> swap ] dip lseek io-error ;
 
diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor
index 7479c0a0bb..7b96e883dd 100755
--- a/basis/io/backend/windows/nt/nt.factor
+++ b/basis/io/backend/windows/nt/nt.factor
@@ -92,6 +92,7 @@ M: winnt (stream-seek) ( n seek-type stream -- )
         { seek-absolute [ handle>> (>>ptr) ] }
         { seek-relative [ handle>> [ + ] change-ptr drop ] }
         { seek-end [ handle>> [ handle>> handle>file-size + ] keep (>>ptr) ] }
+        [ bad-seek-type ]
     } case ;
 
 : file-error? ( n -- eof? )

From f499cab2fbc94ce34a98ec0b1de3aacf7acfb1c3 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 11:35:13 -0600
Subject: [PATCH 19/42] seek -> new seeking

---
 extra/graphics/tiff/tiff.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
index 462f75ff79..5c1fd4ec65 100755
--- a/extra/graphics/tiff/tiff.factor
+++ b/extra/graphics/tiff/tiff.factor
@@ -169,7 +169,7 @@ ERROR: bad-tiff-magic bytes ;
 
 : read-ifds ( tiff -- tiff )
     [
-        dup ifd-offset>> seek
+        dup ifd-offset>> seek-input
         2 read endian>
         dup [ read-ifd ] replicate
         4 read endian>
@@ -184,7 +184,7 @@ ERROR: bad-tiff-magic bytes ;
     dup count>> 1 = [
         offset>>
     ] [
-        [ offset>> seek ] [ count>> read ] bi
+        [ offset>> seek-input ] [ count>> read ] bi
     ] if ;
 
 : process-ifd-entry ( ifd-entry -- object )

From 8097b52b12656b0ddd34a4e7b75947742d905acd Mon Sep 17 00:00:00 2001
From: Philipp Bruschweiler <blei42@gmail.com>
Date: Sun, 8 Feb 2009 01:03:35 +0100
Subject: [PATCH 20/42] initial infix vocab

---
 extra/infix/ast/ast.factor                   |   8 +
 extra/infix/infix-docs.factor                |  38 ++++
 extra/infix/infix-tests.factor               |  45 +++++
 extra/infix/infix.factor                     |  99 +++++++++++
 extra/infix/parser/parser-tests.factor       | 175 +++++++++++++++++++
 extra/infix/parser/parser.factor             |  30 ++++
 extra/infix/tokenizer/tokenizer-tests.factor |  20 +++
 extra/infix/tokenizer/tokenizer.factor       |  21 +++
 8 files changed, 436 insertions(+)
 create mode 100644 extra/infix/ast/ast.factor
 create mode 100644 extra/infix/infix-docs.factor
 create mode 100644 extra/infix/infix-tests.factor
 create mode 100644 extra/infix/infix.factor
 create mode 100644 extra/infix/parser/parser-tests.factor
 create mode 100644 extra/infix/parser/parser.factor
 create mode 100644 extra/infix/tokenizer/tokenizer-tests.factor
 create mode 100644 extra/infix/tokenizer/tokenizer.factor

diff --git a/extra/infix/ast/ast.factor b/extra/infix/ast/ast.factor
new file mode 100644
index 0000000000..0bc22feeb7
--- /dev/null
+++ b/extra/infix/ast/ast.factor
@@ -0,0 +1,8 @@
+IN: infix.ast
+
+TUPLE: ast-number value ;
+TUPLE: ast-local name ;
+TUPLE: ast-array name index ;
+TUPLE: ast-function name arguments ;
+TUPLE: ast-op left right op ;
+TUPLE: ast-negation term ;
diff --git a/extra/infix/infix-docs.factor b/extra/infix/infix-docs.factor
new file mode 100644
index 0000000000..7a4febb514
--- /dev/null
+++ b/extra/infix/infix-docs.factor
@@ -0,0 +1,38 @@
+USING: help.syntax help.markup prettyprint locals ;
+IN: infix
+
+HELP: [infix
+{ $syntax "[infix ... infix]" }
+{ $description "Parses the infix code inside the brackets, converts it to stack code and executes it." }
+{ $examples
+    { $example
+        "USING: infix prettyprint ;"
+        "IN: scratchpad"
+        "[infix 8+2*3 infix] ."
+        "14"
+    } $nl
+    { $link POSTPONE: [infix } " isn't that useful by itself, as it can only access literal numbers and no variables. It is designed to be used together with locals; for example with " { $link POSTPONE: :: } " :"
+    { $example
+        "USING: infix locals math.functions prettyprint ;"
+        "IN: scratchpad"
+        ":: quadratic-equation ( a b c -- z- z+ )"
+        "    [infix (-b-sqrt(b*b-4*a*c)) / (2*a) infix]"
+        "    [infix (-b+sqrt(b*b-4*a*c)) / (2*a) infix] ;"
+        "1 0 -1 quadratic-equation . ."
+        "1.0\n-1.0"
+    }
+} ;
+
+HELP: [infix|
+{ $syntax "[infix| binding1 [ value1... ]\n        binding2 [ value2... ]\n        ... |\n    infix-expression infix]" }
+{ $description "Introduces a set of lexical bindings and evaluates the body as a snippet of infix code. The values are evaluated in parallel, and may not refer to other bindings within the same " { $link POSTPONE: [infix| } " form, as it is based on " { $link POSTPONE: [let } "." }
+{ $examples
+    { $example
+        "USING: infix prettyprint ;"
+        "IN: scratchpad"
+        "[infix| pi [ 3.14 ] r [ 12 ] | r*r*pi infix] ."
+        "452.16"
+    }
+} ;
+
+{ POSTPONE: [infix POSTPONE: [infix| } related-words
diff --git a/extra/infix/infix-tests.factor b/extra/infix/infix-tests.factor
new file mode 100644
index 0000000000..5ee6468131
--- /dev/null
+++ b/extra/infix/infix-tests.factor
@@ -0,0 +1,45 @@
+USING: infix infix.private kernel locals math math.functions
+tools.test ;
+IN: infix.tests
+
+[ 0 ] [ [infix 0 infix] ] unit-test
+[ 0.5 ] [ [infix 3.0/6 infix] ] unit-test
+[ 1+2/3 ] [ [infix 5/3 infix] ] unit-test
+[ 3 ] [ [infix 2*7%3+1 infix] ] unit-test
+[ 1 ] [ [infix 2-
+     1
+     -5*
+     0 infix] ] unit-test
+
+[ 452.16 ] [ [infix| r [ 12 ] pi [ 3.14 ] |
+    r*r*pi infix] ] unit-test
+[ 0 ] [ [infix| a [ 3 ] | 0 infix] ] unit-test
+[ 4/5 ] [ [infix| x [ 3 ] f [ 12 ] | f/(f+x) infix] ] unit-test
+[ 144 ] [ [infix| a [ 0 ] b [ 12 ] | b*b-a infix] ] unit-test
+
+[ 0 ] [ [infix| a [ { 0 1 2 3 } ] | a[0] infix] ] unit-test
+[ 0 ] [ [infix| a [ { 0 1 2 3 } ] | 3*a[0]*2*a[1] infix] ] unit-test
+[ 6 ] [ [infix| a [ { 0 1 2 3 } ] | a[0]+a[10%3]+a[3-1]+a[18/6] infix] ] unit-test
+[ -1 ] [ [infix| a [ { 0 1 2 3 } ] | -a[+1] infix] ] unit-test
+
+[ 0.0 ] [ [infix sin(0) infix] ] unit-test
+[ 10 ] [ [infix lcm(2,5) infix] ] unit-test
+[ 1.0 ] [ [infix +cos(-0*+3) infix] ] unit-test
+
+[ f ] [ 2 \ gcd check-word ] unit-test ! multiple return values
+[ f ] [ 1 \ drop check-word ] unit-test ! no return value
+[ f ] [ 1 \ lcm check-word ] unit-test ! takes 2 args
+: no-stack-effect-declared + ;
+[ 0 \ no-stack-effect-declared check-word ] must-fail
+
+: qux ( -- x ) 2 ;
+[ t ] [ 0 \ qux check-word ] unit-test
+[ 8 ] [ [infix qux()*3+2 infix] ] unit-test
+: foobar ( x -- y ) 1 + ;
+[ t ] [ 1 \ foobar check-word ] unit-test
+[ 4 ] [ [infix foobar(3*5%12) infix] ] unit-test
+: stupid_function ( x x x x x -- y ) + + + + ;
+[ t ] [ 5 \ stupid_function check-word ] unit-test
+[ 10 ] [ [infix stupid_function (0, 1, 2, 3, 4) infix] ] unit-test
+
+[ -1 ] [ [let | a [ 1 ] | [infix -a infix] ] ] unit-test
diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor
new file mode 100644
index 0000000000..31cd1cbe1f
--- /dev/null
+++ b/extra/infix/infix.factor
@@ -0,0 +1,99 @@
+USING: accessors assocs combinators combinators.short-circuit
+effects fry infix.parser infix.ast kernel locals.parser
+locals.types math multiline namespaces parser quotations
+sequences summary words ;
+IN: infix
+
+<PRIVATE
+: prepare-operand ( term -- quot )
+    dup callable? [ 1quotation ] unless ;
+
+ERROR: local-not-defined name ;
+M: local-not-defined summary
+    drop "local is not defined" ;
+
+: at? ( key assoc -- value/key ? )
+    dupd at* [ nip t ] [ drop f ] if ;
+
+: >local-word ( string -- word )
+    locals get at? [ local-not-defined ] unless ;
+
+: select-op ( string -- word )
+    {
+        { "+" [ [ + ] ] }
+        { "-" [ [ - ] ] }
+        { "*" [ [ * ] ] }
+        { "/" [ [ / ] ] }
+        [ drop [ mod ] ]
+    } case ;
+
+GENERIC: infix-codegen ( ast -- quot/number )
+
+M: ast-number infix-codegen value>> ;
+
+M: ast-local infix-codegen
+    name>> >local-word ;
+
+M: ast-array infix-codegen
+    [ index>> infix-codegen prepare-operand ]
+    [ name>> >local-word ] bi '[ @ _ nth ] ;
+
+M: ast-op infix-codegen
+    [ left>> infix-codegen ] [ right>> infix-codegen ]
+    [ op>> select-op ] tri
+    2over [ number? ] both? [ call ] [
+        [ [ prepare-operand ] bi@ ] dip '[ @ @ @ ]
+    ] if ;
+
+M: ast-negation infix-codegen
+    term>> infix-codegen
+    {
+        { [ dup number? ] [ neg ] }
+        { [ dup callable? ] [ '[ @ neg ] ] }
+        [ '[ _ neg ] ] ! local word
+    } cond ;
+
+ERROR: bad-stack-effect word ;
+M: bad-stack-effect summary
+    drop "Words used in infix must declare a stack effect and return exactly one value" ;
+
+: check-word ( argcount word -- ? )
+    dup stack-effect [ ] [ bad-stack-effect ] ?if
+    [ in>> length ] [ out>> length ] bi
+    [ = ] dip 1 = and ;
+
+: find-and-check ( args argcount string -- quot )
+    dup search [ ] [ no-word ] ?if
+    [ nip ] [ check-word ] 2bi
+    [ 1quotation compose ] [ bad-stack-effect ] if ;
+
+: arguments-codegen ( seq -- quot )
+    dup empty? [ drop [ ] ] [
+        [ infix-codegen prepare-operand ]
+        [ compose ] map-reduce
+    ] if ;
+
+M: ast-function infix-codegen
+    [ arguments>> [ arguments-codegen ] [ length ] bi ]
+    [ name>> ] bi find-and-check ;
+
+: [infix-parse ( end -- result/quot )
+    parse-multiline-string build-infix-ast
+    infix-codegen prepare-operand ;
+PRIVATE>
+
+: [infix
+    "infix]" [infix-parse parsed \ call parsed ; parsing
+
+<PRIVATE
+: parse-infix-locals ( assoc end -- quot )
+    [
+        in-lambda? on
+        [ dup [ locals set ] [ push-locals ] bi ] dip
+        [infix-parse prepare-operand swap pop-locals
+    ] with-scope ;
+PRIVATE>
+
+: [infix|
+    "|" parse-bindings "infix]" parse-infix-locals <let>
+    parsed-lambda ; parsing
diff --git a/extra/infix/parser/parser-tests.factor b/extra/infix/parser/parser-tests.factor
new file mode 100644
index 0000000000..0a0288c41b
--- /dev/null
+++ b/extra/infix/parser/parser-tests.factor
@@ -0,0 +1,175 @@
+USING: infix.ast infix.parser infix.tokenizer tools.test ;
+IN: infix.parser.tests
+
+\ parse-infix must-infer
+\ build-infix-ast must-infer
+
+[ T{ ast-number { value 1 } } ] [ "1" build-infix-ast ] unit-test
+[ T{ ast-negation f T{ ast-number { value 1 } } } ]
+[ "-1" build-infix-ast ] unit-test
+[ T{ ast-op
+    { left
+        T{ ast-op
+            { left T{ ast-number { value 1 } } }
+            { right T{ ast-number { value 2 } } }
+            { op "+" }
+        }
+    }
+    { right T{ ast-number { value 4 } } }
+    { op "+" }
+} ] [ "1+2+4" build-infix-ast ] unit-test
+
+[ T{ ast-op
+    { left T{ ast-number { value 1 } } }
+    { right
+        T{ ast-op
+            { left T{ ast-number { value 2 } } }
+            { right T{ ast-number { value 3 } } }
+            { op "*" }
+        }
+    }
+    { op "+" }
+} ] [ "1+2*3" build-infix-ast ] unit-test
+
+[ T{ ast-op 
+    { left T{ ast-number { value 1 } } }
+    { right T{ ast-number { value 2 } } }
+    { op "+" }
+} ] [ "(1+2)" build-infix-ast ] unit-test
+
+[ T{ ast-local { name "foo" } } ] [ "foo" build-infix-ast ] unit-test
+[ "-" build-infix-ast ] must-fail
+
+[ T{ ast-function
+    { name "foo" }
+    { arguments
+        V{
+            T{ ast-op
+                { left T{ ast-number { value 1 } } }
+                { right T{ ast-number { value 2 } } }
+                { op "+" }
+            }
+            T{ ast-op
+                { left T{ ast-number { value 2 } } }
+                { right T{ ast-number { value 3 } } }
+                { op "%" }
+            }
+        }
+    }
+} ] [ "foo (1+ 2,2%3)  " build-infix-ast ] unit-test
+
+[ T{ ast-op
+    { left
+        T{ ast-op
+            { left
+                T{ ast-function
+                    { name "bar" }
+                    { arguments V{ } }
+                }
+            }
+            { right
+                T{ ast-array
+                    { name "baz" }
+                    { index
+                        T{ ast-op
+                            { left
+                                T{ ast-op
+                                    { left
+                                        T{ ast-number
+                                            { value 2 }
+                                        }
+                                    }
+                                    { right
+                                        T{ ast-number
+                                            { value 3 }
+                                        }
+                                    }
+                                    { op "/" }
+                                }
+                            }
+                            { right
+                                T{ ast-number { value 4 } }
+                            }
+                            { op "+" }
+                        }
+                    }
+                }
+            }
+            { op "+" }
+        }
+    }
+    { right T{ ast-number { value 2 } } }
+    { op "/" }
+} ] [ "(bar() + baz[2/ 3+4 ] )/2" build-infix-ast ] unit-test
+
+[ T{ ast-op
+    { left T{ ast-number { value 1 } } }
+    { right
+        T{ ast-op
+            { left T{ ast-number { value 2 } } }
+            { right T{ ast-number { value 3 } } }
+            { op "/" }
+        }
+    }
+    { op "+" }
+} ] [ "1\n+\n2\r/\t3" build-infix-ast ] unit-test
+
+[ T{ ast-negation
+    { term
+        T{ ast-function
+            { name "foo" }
+            { arguments
+                V{
+                    T{ ast-number { value 2 } }
+                    T{ ast-negation
+                        { term T{ ast-number { value 3 } } }
+                    }
+                }
+            }
+        }
+    }
+} ] [ "-foo(+2,-3)" build-infix-ast ] unit-test
+
+[ T{ ast-array
+    { name "arr" }
+    { index
+        T{ ast-op
+            { left
+                T{ ast-negation
+                    { term
+                        T{ ast-op
+                            { left
+                                T{ ast-function
+                                    { name "foo" }
+                                    { arguments
+                                        V{
+                                            T{ ast-number
+                                                { value 2 }
+                                            }
+                                        }
+                                    }
+                                }
+                            }
+                            { right
+                                T{ ast-negation
+                                    { term
+                                        T{ ast-number
+                                            { value 1 }
+                                        }
+                                    }
+                                }
+                            }
+                            { op "+" }
+                        }
+                    }
+                }
+            }
+            { right T{ ast-number { value 3 } } }
+            { op "/" }
+        }
+    }
+} ] [ "+arr[-(foo(2)+-1)/3]" build-infix-ast ] unit-test
+
+[ "foo bar baz" build-infix-ast ] must-fail
+[ "1+2/4+" build-infix-ast ] must-fail
+[ "quaz(2/3,)" build-infix-ast ] must-fail
diff --git a/extra/infix/parser/parser.factor b/extra/infix/parser/parser.factor
new file mode 100644
index 0000000000..beaf3c335d
--- /dev/null
+++ b/extra/infix/parser/parser.factor
@@ -0,0 +1,30 @@
+USING: infix.ast infix.tokenizer kernel math peg.ebnf sequences
+strings vectors ;
+IN: infix.parser
+
+EBNF: parse-infix
+Number      = . ?[ ast-number? ]?
+Identifier  = . ?[ string? ]?
+Array       = Identifier:i "[" Sum:s "]" => [[ i s ast-array boa ]]
+Function    = Identifier:i "(" FunArgs?:a ")" => [[ i a [ V{ } ] unless* ast-function boa ]]
+
+FunArgs     =   FunArgs:a "," Sum:s => [[ s a push a ]]
+              | Sum:s => [[ s 1vector ]]
+
+Terminal    =   ("-"|"+"):op Terminal:term => [[ term op "-" = [ ast-negation boa ] when ]]
+              | "(" Sum:s ")" => [[ s ]]
+              | Number | Array | Function
+              | Identifier => [[ ast-local boa ]]
+
+Product     =   Product:p ("*"|"/"|"%"):op Terminal:term  => [[ p term op ast-op boa ]]
+              | Terminal
+
+Sum         =   Sum:s ("+"|"-"):op Product:p  => [[ s p op ast-op boa ]]
+              | Product
+
+End         = !(.)
+Expression  = Sum End
+;EBNF
+
+: build-infix-ast ( string -- ast )
+    tokenize-infix parse-infix ;
diff --git a/extra/infix/tokenizer/tokenizer-tests.factor b/extra/infix/tokenizer/tokenizer-tests.factor
new file mode 100644
index 0000000000..7e1fb005ef
--- /dev/null
+++ b/extra/infix/tokenizer/tokenizer-tests.factor
@@ -0,0 +1,20 @@
+USING: infix.ast infix.tokenizer tools.test ;
+IN: infix.tokenizer.tests
+
+\ tokenize-infix must-infer
+[ V{ T{ ast-number f 1 } } ] [ "1" tokenize-infix ] unit-test
+[ V{ T{ ast-number f 1.02 } CHAR: * T{ ast-number f 3 } } ] [ "1.02*3" tokenize-infix ] unit-test
+[ V{ T{ ast-number f 3 } CHAR: / CHAR: ( T{ ast-number f 3 } CHAR: + T{ ast-number f 4 } CHAR: ) } ]
+[ "3/(3+4)" tokenize-infix ] unit-test
+[ V{ "foo"  CHAR: ( "x" CHAR: , "y" CHAR: , "z" CHAR: ) } ] [ "foo(x,y,z)" tokenize-infix ] unit-test
+[ V{ "arr"  CHAR: [ "x" CHAR: + T{ ast-number f 3 } CHAR: ] } ]
+[ "arr[x+3]" tokenize-infix ] unit-test
+[ "1.0.4" tokenize-infix ] must-fail
+[ V{ CHAR: + CHAR: ] T{ ast-number f 3.4 } CHAR: , "bar" } ]
+[ "+]3.4,bar" tokenize-infix ] unit-test
+[ V{ "baz_34c" } ] [ "baz_34c" tokenize-infix ] unit-test
+[ V{ T{ ast-number f 34 } "c_baz" } ] [ "34c_baz"  tokenize-infix ] unit-test
+[ V{ CHAR: ( T{ ast-number f 1 } CHAR: + T{ ast-number f 2 } CHAR: ) } ]
+[ "(1+2)" tokenize-infix ] unit-test
+[ V{ T{ ast-number f 1 } CHAR: + T{ ast-number f 2 } CHAR: / T{ ast-number f 3 } } ]
+[ "1\n+\r2\t/ 3" tokenize-infix ] unit-test
diff --git a/extra/infix/tokenizer/tokenizer.factor b/extra/infix/tokenizer/tokenizer.factor
new file mode 100644
index 0000000000..8c1a1b4a18
--- /dev/null
+++ b/extra/infix/tokenizer/tokenizer.factor
@@ -0,0 +1,21 @@
+USING: infix.ast kernel peg peg.ebnf math.parser sequences
+strings ;
+IN: infix.tokenizer
+
+EBNF: tokenize-infix
+Letter            = [a-zA-Z]
+Digit             = [0-9]
+Digits            = Digit+
+Number            =   Digits '.' Digits => [[ concat >string string>number ast-number boa ]]
+                    | Digits => [[ >string string>number ast-number boa ]]
+Space             = " " | "\n" | "\r" | "\t"
+Spaces            = Space* => [[ ignore ]]
+NameFirst         = Letter | "_" => [[ CHAR: _ ]]
+NameRest          = NameFirst | Digit
+Name              = NameFirst NameRest* => [[ first2 swap prefix >string ]]
+Special           =   [+*/%(),] | "-" => [[ CHAR: - ]]
+                    | "[" => [[ CHAR: [ ]] | "]" => [[ CHAR: ] ]]
+Tok               = Spaces (Name | Number | Special )
+End               = !(.)
+Toks              = Tok* Spaces End
+;EBNF

From 36e5536110a213126cbcee0fd4084b7250799bd0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 7 Feb 2009 20:39:32 -0600
Subject: [PATCH 21/42] Mention string encoding in >string

---
 core/strings/strings-docs.factor | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/core/strings/strings-docs.factor b/core/strings/strings-docs.factor
index d40cd982d8..9a1671b126 100644
--- a/core/strings/strings-docs.factor
+++ b/core/strings/strings-docs.factor
@@ -53,8 +53,9 @@ HELP: 1string
 
 HELP: >string
 { $values { "seq" "a sequence of characters" } { "str" string } }
-{ $description "Outputs a freshly-allocated string with the same elements as a given sequence." }
-{ $errors "Throws an error if the sequence contains elements other than real numbers." } ;
+{ $description "Outputs a freshly-allocated string with the same elements as a given sequence, by interpreting the sequence elements as Unicode code points." }
+{ $notes "This operation is only appropriate if the underlying sequence holds Unicode code points, which is rare unless it is a " { $link slice } " of another string. To convert a sequence of bytes to a string, use the words documented in " { $link "io.encodings.string" } "." }
+{ $errors "Throws an error if the sequence contains elements other than integers." } ;
 
 HELP: resize-string ( n str -- newstr )
 { $values { "n" "a non-negative integer" } { "str" string } { "newstr" string } }

From f08c8dd66d0c840558a61e8b8dad1a7da0bb3841 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 21:23:35 -0600
Subject: [PATCH 22/42] fix some compile bugz

---
 extra/graphics/tiff/tiff.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
index 5c1fd4ec65..e66ebcc6bd 100755
--- a/extra/graphics/tiff/tiff.factor
+++ b/extra/graphics/tiff/tiff.factor
@@ -169,7 +169,7 @@ ERROR: bad-tiff-magic bytes ;
 
 : read-ifds ( tiff -- tiff )
     [
-        dup ifd-offset>> seek-input
+        dup ifd-offset>> seek-absolute seek-input
         2 read endian>
         dup [ read-ifd ] replicate
         4 read endian>
@@ -184,7 +184,7 @@ ERROR: bad-tiff-magic bytes ;
     dup count>> 1 = [
         offset>>
     ] [
-        [ offset>> seek-input ] [ count>> read ] bi
+        [ offset>> seek-absolute seek-input ] [ count>> read ] bi
     ] if ;
 
 : process-ifd-entry ( ifd-entry -- object )

From f36ec3f0c5da15143f2f6bd1ab3ca88006f14255 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 7 Feb 2009 23:04:55 -0600
Subject: [PATCH 23/42] Add nsum, nspread and nweave to generalizations

---
 .../generalizations-docs.factor               | 52 +++++++++++++++----
 .../generalizations-tests.factor              |  9 ++++
 basis/generalizations/generalizations.factor  | 19 ++++++-
 3 files changed, 67 insertions(+), 13 deletions(-)

diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor
index 912f69587e..ac8e14c05a 100644
--- a/basis/generalizations/generalizations-docs.factor
+++ b/basis/generalizations/generalizations-docs.factor
@@ -30,6 +30,10 @@ HELP: narray
 
 { nsequence narray } related-words
 
+HELP: nsum
+{ $values { "n" integer } }
+{ $description "Adds the top " { $snippet "n" } " stack values." } ;
+
 HELP: firstn
 { $values { "n" integer } }
 { $description "A generalization of " { $link first } ", "
@@ -238,6 +242,11 @@ HELP: ncleave
     }
 } ;
 
+HELP: nspread
+{ $values { "quots" "a sequence of quotations" } { "n" integer } }
+{ $description "A generalization of " { $link spread } " that can work for any quotation arity."
+} ;
+
 HELP: mnswap
 { $values { "m" integer } { "n" integer } }
 { $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." }
@@ -250,6 +259,17 @@ HELP: mnswap
     }
 } ;
 
+HELP: nweave
+{ $values { "n" integer } }
+{ $description "Copies the top " { $snippet "n" } " stack elements underneath each one of the " { $snippet "n" } " elements below." }
+{ $examples
+  { $example
+    "USING: arrays kernel generalizations prettyprint ;"
+    "\"e1\" \"e2\" \"o1\" \"o2\" 2 nweave [ 3array ] 3dip 3array 2array ."
+    "{ { \"e1\" \"o1\" \"o2\" } { \"e2\" \"o1\" \"o2\" } }"
+  }
+} ;
+
 HELP: n*quot
 { $values
      { "n" integer } { "seq" sequence }
@@ -299,18 +319,14 @@ 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." } ;
 
-ARTICLE: "generalizations" "Generalized shuffle words and combinators"
-"The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in "
-"macros where the arity of the input quotations depends on an "
-"input parameter."
-$nl
-"Generalized sequence operations:"
+ARTICLE: "sequence-generalizations" "Generalized sequence operations"
 { $subsection narray }
 { $subsection nsequence }
 { $subsection firstn }
 { $subsection nappend }
-{ $subsection nappend-as }
-"Generated stack shuffle operations:"
+{ $subsection nappend-as } ;
+
+ARTICLE: "shuffle-generalizations" "Generalized shuffle words"
 { $subsection ndup }
 { $subsection npick }
 { $subsection nrot }
@@ -319,14 +335,28 @@ $nl
 { $subsection ndrop }
 { $subsection ntuck }
 { $subsection mnswap }
-"Generalized combinators:"
+{ $subsection nweave } ;
+
+ARTICLE: "combinator-generalizations" "Generalized combinators"
 { $subsection ndip }
 { $subsection nslip }
 { $subsection nkeep }
 { $subsection napply }
 { $subsection ncleave }
-"Generalized quotation construction:"
+{ $subsection nspread } ;
+
+ARTICLE: "other-generalizations" "Additional generalizations"
 { $subsection ncurry } 
-{ $subsection nwith } ;
+{ $subsection nwith }
+{ $subsection nsum } ;
+
+ARTICLE: "generalizations" "Generalized shuffle words and combinators"
+"The " { $vocab-link "generalizations" } " vocabulary defines 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 "sequence-generalizations" }
+{ $subsection "shuffle-generalizations" }
+{ $subsection "combinator-generalizations" }
+{ $subsection "other-generalizations" } ;
 
 ABOUT: "generalizations"
diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor
index 35e02f08b4..7ede271d01 100644
--- a/basis/generalizations/generalizations-tests.factor
+++ b/basis/generalizations/generalizations-tests.factor
@@ -53,3 +53,12 @@ IN: generalizations.tests
 
 [ 4 nappend ] must-infer
 [ 4 { } nappend-as ] must-infer
+
+[ 17 ] [ 3 1 3 3 7 5 nsum ] unit-test
+{ 4 1 } [ 4 nsum ] must-infer-as
+
+[ "e1" "o1" "o2" "e2" "o1" "o2" ] [ "e1" "e2" "o1" "o2" 2 nweave ] unit-test
+{ 3 5 } [ 2 nweave ] must-infer-as
+
+[ { 0 1 2 } { 3 5 4 } { 7 8 6 } ]
+[ 9 [ ] each { [ 3array ] [ swap 3array ] [ rot 3array ] } 3 nspread ] unit-test
\ No newline at end of file
diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 4692fd20db..9b2b2456c2 100644
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Chris Double, Doug Coleman, Eduardo
+! Copyright (C) 2007, 2009 Chris Double, Doug Coleman, Eduardo
 ! Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences sequences.private math combinators
@@ -23,6 +23,9 @@ MACRO: nsequence ( n seq -- )
 MACRO: narray ( n -- )
     '[ _ { } nsequence ] ;
 
+MACRO: nsum ( n -- )
+    1- [ + ] n*quot ;
+
 MACRO: firstn ( n -- )
     dup zero? [ drop [ drop ] ] [
         [ [ '[ [ _ ] dip nth-unsafe ] ] map ]
@@ -70,11 +73,23 @@ MACRO: ncleave ( quots n -- )
     [ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi
     compose ;
 
+MACRO: nspread ( quots n -- )
+    over empty? [ 2drop [ ] ] [
+        [ [ but-last ] dip ]
+        [ [ peek ] dip ] 2bi
+        swap
+        '[ [ _ _ nspread ] _ ndip @ ]
+    ] if ;
+
 MACRO: napply ( quot n -- )
     swap <repetition> spread>quot ;
 
 MACRO: mnswap ( m n -- )
-    1+ '[ _ -nrot ] <repetition> spread>quot ;
+    1+ '[ _ -nrot ] swap '[ _ _ napply ] ;
+
+MACRO: nweave ( n -- )
+    [ dup <reversed> [ '[ _ _ mnswap ] ] with map ] keep
+    '[ _ _ ncleave ] ;
 
 : nappend-as ( n exemplar -- seq )
     [ narray concat ] dip like ; inline

From aa6166adf20004d792503fd90e8778047d5f7578 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 8 Feb 2009 00:20:56 -0600
Subject: [PATCH 24/42] Fix typo

---
 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 c1d62c6cda..35a1129338 100644
--- a/extra/websites/concatenative/concatenative.factor
+++ b/extra/websites/concatenative/concatenative.factor
@@ -65,7 +65,7 @@ SYMBOL: dh-file
     "concatenative.org" 25 <inet> smtp-server set-global
     "noreply@concatenative.org" lost-password-from set-global
     "website@concatenative.org" insomniac-sender set-global
-    "slava@factorcode.org" insomniac-recipients set-global
+    { "slava@factorcode.org" } insomniac-recipients set-global
     init-factor-db ;
 
 : init-testing ( -- )

From 16312f67111b3954507865cf5cba2aceb379db9d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 10:35:30 -0600
Subject: [PATCH 25/42] clean up stream-seek with some suggestions from slava

---
 basis/io/backend/unix/unix.factor     |  4 ++--
 basis/io/backend/windows/nt/nt.factor |  8 ++++----
 basis/io/buffers/buffers.factor       |  3 ---
 basis/io/ports/ports.factor           | 13 +++++++++----
 4 files changed, 15 insertions(+), 13 deletions(-)

diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index 3372f15cd9..f5e6426859 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -46,14 +46,14 @@ M: fd cancel-operation ( fd -- )
         2bi
     ] if ;
 
-M: unix (stream-seek) ( n seek-type stream -- )
+M: unix seek-handle ( n seek-type handle -- )
     swap {
         { io:seek-absolute [ SEEK_SET ] }
         { io:seek-relative [ SEEK_CUR ] }
         { io:seek-end [ SEEK_END ] }
         [ io:bad-seek-type ]
     } case
-    [ handle>> fd>> swap ] dip lseek io-error ;
+    [ fd>> swap ] dip lseek io-error ;
 
 SYMBOL: +retry+ ! just try the operation again without blocking
 SYMBOL: +input+
diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor
index 7b96e883dd..107f1902e3 100755
--- a/basis/io/backend/windows/nt/nt.factor
+++ b/basis/io/backend/windows/nt/nt.factor
@@ -87,11 +87,11 @@ ERROR: invalid-file-size n ;
 : handle>file-size ( handle -- n )
     0 <ulonglong> [ GetFileSizeEx win32-error=0/f ] keep *ulonglong ;
 
-M: winnt (stream-seek) ( n seek-type stream -- )
+M: winnt seek-handle ( n seek-type handle -- )
     swap {
-        { seek-absolute [ handle>> (>>ptr) ] }
-        { seek-relative [ handle>> [ + ] change-ptr drop ] }
-        { seek-end [ handle>> [ handle>> handle>file-size + ] keep (>>ptr) ] }
+        { seek-absolute [ (>>ptr) ] }
+        { seek-relative [ [ + ] change-ptr drop ] }
+        { seek-end [ [ handle>> handle>file-size + ] keep (>>ptr) ] }
         [ bad-seek-type ]
     } case ;
 
diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor
index a647f27dfc..4df081b17d 100644
--- a/basis/io/buffers/buffers.factor
+++ b/basis/io/buffers/buffers.factor
@@ -21,9 +21,6 @@ M: buffer dispose* ptr>> free ;
 : buffer-reset ( n buffer -- )
     swap >>fill 0 >>pos drop ;
 
-: buffer-reset-hard ( buffer -- )
-    0 >>fill 0 >>pos drop ;
-
 : buffer-capacity ( buffer -- n )
     [ size>> ] [ fill>> ] bi - ; inline
 
diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 1f7fc5f115..1a58d4200b 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -120,12 +120,17 @@ M: output-port stream-write
 
 HOOK: (wait-to-write) io-backend ( port -- )
 
-HOOK: (stream-seek) os ( n seek-type stream -- )
+HOOK: seek-handle os ( n seek-type handle -- )
 
-M: port stream-seek ( n seek-type stream -- )
-    dup check-disposed
-    [ buffer>> buffer-reset-hard 2drop ] [ (stream-seek) ] 3bi ;
+M: input-port stream-seek ( n seek-type stream -- )
+    [ check-disposed ]
+    [ buffer>> 0 swap buffer-reset ]
+    [ handle>> seek-handle ] tri ;
 
+M: output-port stream-seek ( n seek-type stream -- )
+    [ check-disposed ]
+    [ stream-flush ]
+    [ handle>> seek-handle ] tri ;
 
 GENERIC: shutdown ( handle -- )
 

From 69f4899e11cd69c01c572d9acd68e1ed20029cf9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 13:51:02 -0600
Subject: [PATCH 26/42] document stream seeking

---
 core/io/io-docs.factor | 53 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 52 insertions(+), 1 deletion(-)

diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor
index d7534ddb50..5d8aa6a88f 100644
--- a/core/io/io-docs.factor
+++ b/core/io/io-docs.factor
@@ -68,6 +68,51 @@ HELP: stream-copy
 { $description "Copies the contents of one stream into another, closing both streams when done." } 
 $io-error ;
 
+
+HELP: stream-seek
+{ $values
+     { "n" integer } { "seek-type" "a seek singleton" } { "stream" "a stream" }
+}
+{ $description "Moves the pointer associated with a stream's handle to an offset " { $snippet "n" } " bytes from the seek type so that further reading or writing happens at the new location. For output streams, the buffer is flushed before seeking. Seeking past the end of an output stream will pad the difference with zeros once the stream is written to again." $nl
+    "Three methods of seeking are supported:"
+    { $list { $link seek-absolute } { $link seek-relative } { $link seek-end } }
+}
+{ $notes "Stream seeking is not supported on streams that do not have a known length, e.g. TCP/IP streams." } ;
+
+HELP: seek-absolute
+{ $values
+    
+     { "value" "a seek singleton" }
+}
+{ $description "Seeks to an offset from the beginning of the stream." } ;
+
+HELP: seek-end
+{ $values
+    
+     { "value" "a seek singleton" }
+}
+{ $description "Seeks to an offset from the end of the stream. If the offset puts the stream pointer past the end of the data on an output stream, writing to it will pad the difference with zeros." } ;
+
+HELP: seek-relative
+{ $values
+    
+     { "value" "a seek singleton" }
+}
+{ $description "Seeks to an offset from the current position of the stream pointer." } ;
+
+
+HELP: seek-input
+{ $values
+     { "n" integer } { "seek-type" "a seek singleton" }
+}
+{ $description "Calls " { $link stream-seek } " on the stream stored in " { $link input-stream } "." } ;
+
+HELP: seek-output
+{ $values
+     { "n" integer } { "seek-type" "a seek singleton" }
+}
+{ $description "Calls " { $link stream-seek } " on the stream stored in " { $link output-stream } "." } ;
+
 HELP: input-stream
 { $var-description "Holds an input stream for various implicit stream operations. Rebound using " { $link with-input-stream } " and " { $link with-input-stream* } "." } ;
 
@@ -196,6 +241,8 @@ $nl
 { $subsection stream-write }
 "This word is only required for string output streams:"
 { $subsection stream-nl }
+"This word is for streams that allow seeking:"
+{ $subsection stream-seek }
 "For a discussion of the distinction between binary and string streams, see " { $link "stream-elements" } "."
 { $see-also "io.timeouts" } ;
 
@@ -249,6 +296,8 @@ $nl
 { $subsection read-partial }
 "If the default input stream is a string stream (" { $link "stream-elements" } "), lines of text can be read:"
 { $subsection readln }
+"Seeking on the default input stream:"
+{ $subsection seek-input }
 "A pair of combinators for rebinding the " { $link input-stream } " variable:"
 { $subsection with-input-stream }
 { $subsection with-input-stream* }
@@ -256,7 +305,7 @@ $nl
 { $subsection output-stream }
 "Unless rebound in a child namespace, this variable will be set to a console stream for showing output to the user."
 $nl
-"Words writing to the default input stream:"
+"Words writing to the default output stream:"
 { $subsection flush }
 { $subsection write1 }
 { $subsection write }
@@ -265,6 +314,8 @@ $nl
 { $subsection print }
 { $subsection nl }
 { $subsection bl }
+"Seeking on the default output stream:"
+{ $subsection seek-output }
 "A pair of combinators for rebinding the " { $link output-stream } " variable:"
 { $subsection with-output-stream }
 { $subsection with-output-stream* }

From fef602b1857ab649d882461e76522388cefb24a9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 13:58:39 -0600
Subject: [PATCH 27/42] remove superfluous flush from io tests

---
 core/io/io-tests.factor | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor
index 8bfc52432d..d227ebeadf 100644
--- a/core/io/io-tests.factor
+++ b/core/io/io-tests.factor
@@ -16,7 +16,7 @@ IN: io.tests
     "seek-test1" unique-file binary
     [
         [
-            B{ 1 2 3 4 5 } write flush 0 seek-absolute seek-output
+            B{ 1 2 3 4 5 } write 0 seek-absolute seek-output
             B{ 3 } write
         ] with-file-writer
     ] [
@@ -29,7 +29,7 @@ IN: io.tests
     "seek-test2" unique-file binary
     [
         [
-            B{ 1 2 3 4 5 } write flush -1 seek-relative seek-output
+            B{ 1 2 3 4 5 } write -1 seek-relative seek-output
             B{ 3 } write
         ] with-file-writer
     ] [
@@ -42,7 +42,7 @@ IN: io.tests
     "seek-test3" unique-file binary
     [
         [
-            B{ 1 2 3 4 5 } write flush 1 seek-relative seek-output
+            B{ 1 2 3 4 5 } write 1 seek-relative seek-output
             B{ 3 } write
         ] with-file-writer
     ] [

From bba15986972c5b3918fc56cbea83b489c533f199 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 13:59:32 -0600
Subject: [PATCH 28/42] move io tests into io.files

---
 core/io/files/files-tests.factor | 65 ++++++++++++++++++++++++++++++++
 core/io/io-tests.factor          | 63 -------------------------------
 2 files changed, 65 insertions(+), 63 deletions(-)

diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index f9702fd133..423eb38144 100644
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -75,3 +75,68 @@ USE: debugger.threads
 [ t ] [ "quux-test.txt" temp-file exists? ] unit-test
 
 [ ] [ "quux-test.txt" temp-file delete-file ] unit-test
+
+! File seeking tests
+[ B{ 3 2 3 4 5 } ]
+[
+    "seek-test1" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write 0 seek-absolute seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 1 2 3 4 3 } ]
+[
+    "seek-test2" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write -1 seek-relative seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 1 2 3 4 5 0 3 } ]
+[
+    "seek-test3" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write 1 seek-relative seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 3 } ]
+[
+    B{ 1 2 3 4 5 } "seek-test4" unique-file binary [
+        set-file-contents
+    ] [
+        [
+            -3 seek-end seek-input 1 read
+        ] with-file-reader
+    ] 2bi
+] unit-test
+
+[ B{ 2 } ]
+[
+    B{ 1 2 3 4 5 } "seek-test5" unique-file binary [
+        set-file-contents
+    ] [
+        [
+            3 seek-absolute seek-input
+            -2 seek-relative seek-input
+            1 read
+        ] with-file-reader
+    ] 2bi
+] unit-test
+
diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor
index d227ebeadf..9e931279d7 100644
--- a/core/io/io-tests.factor
+++ b/core/io/io-tests.factor
@@ -10,66 +10,3 @@ IN: io.tests
 
 ! Make sure we use correct to_c_string form when writing
 [ ] [ "\0" write ] unit-test
-
-[ B{ 3 2 3 4 5 } ]
-[
-    "seek-test1" unique-file binary
-    [
-        [
-            B{ 1 2 3 4 5 } write 0 seek-absolute seek-output
-            B{ 3 } write
-        ] with-file-writer
-    ] [
-        file-contents
-    ] 2bi
-] unit-test
-
-[ B{ 1 2 3 4 3 } ]
-[
-    "seek-test2" unique-file binary
-    [
-        [
-            B{ 1 2 3 4 5 } write -1 seek-relative seek-output
-            B{ 3 } write
-        ] with-file-writer
-    ] [
-        file-contents
-    ] 2bi
-] unit-test
-
-[ B{ 1 2 3 4 5 0 3 } ]
-[
-    "seek-test3" unique-file binary
-    [
-        [
-            B{ 1 2 3 4 5 } write 1 seek-relative seek-output
-            B{ 3 } write
-        ] with-file-writer
-    ] [
-        file-contents
-    ] 2bi
-] unit-test
-
-[ B{ 3 } ]
-[
-    B{ 1 2 3 4 5 } "seek-test4" unique-file binary [
-        set-file-contents
-    ] [
-        [
-            -3 seek-end seek-input 1 read
-        ] with-file-reader
-    ] 2bi
-] unit-test
-
-[ B{ 2 } ]
-[
-    B{ 1 2 3 4 5 } "seek-test5" unique-file binary [
-        set-file-contents
-    ] [
-        [
-            3 seek-absolute seek-input
-            -2 seek-relative seek-input
-            1 read
-        ] with-file-reader
-    ] 2bi
-] unit-test

From 08ad6ca1162f54d7264d95dc02740405b4c332c2 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Sun, 8 Feb 2009 23:22:23 +0100
Subject: [PATCH 29/42] FUEL: use factor.com instead of factor.exe as default
 binary under Windows.

---
 misc/fuel/fuel-connection.el | 8 ++++++--
 misc/fuel/fuel-listener.el   | 2 +-
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el
index 14c4d0b36f..f180d0f2b4 100644
--- a/misc/fuel/fuel-connection.el
+++ b/misc/fuel/fuel-connection.el
@@ -144,8 +144,12 @@
   (add-hook 'comint-redirect-hook
             'fuel-con--comint-redirect-hook nil t))
 
-(defadvice comint-redirect-setup (after fuel-con--advice activate)
-  (setq comint-redirect-finished-regexp fuel-con--comint-finished-regex))
+(defadvice comint-redirect-setup
+  (after fuel-con--advice (output-buffer comint-buffer finished-regexp &optional echo))
+  (with-current-buffer comint-buffer
+    (when fuel-con--connection
+      (setq comint-redirect-finished-regexp fuel-con--comint-finished-regex))))
+(ad-activate 'comint-redirect-setup)
 
 (defun fuel-con--comint-preoutput-filter (str)
   (when (string-match fuel-con--comint-finished-regex str)
diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el
index d0898de04f..b8bf4d4b7f 100644
--- a/misc/fuel/fuel-listener.el
+++ b/misc/fuel/fuel-listener.el
@@ -32,7 +32,7 @@
 
 (defcustom fuel-listener-factor-binary
   (expand-file-name (cond ((eq system-type 'windows-nt)
-                           "factor.exe")
+                           "factor.com")
                           ((eq system-type 'darwin)
                            "Factor.app/Contents/MacOS/factor")
                           (t "factor"))

From da45cbe96d1a3f242abefd125eac56301c0a6937 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-103.local>
Date: Sun, 8 Feb 2009 17:13:28 -0600
Subject: [PATCH 30/42] Rewriting basis/wrap with Knuth's algorithm. Minor API
 changes will probably break Slava's unmerged UI changes

---
 basis/wrap/wrap-docs.factor  |  28 +++---
 basis/wrap/wrap-tests.factor |  87 +++++++++++------
 basis/wrap/wrap.factor       | 181 ++++++++++++++++++++++++++---------
 3 files changed, 212 insertions(+), 84 deletions(-)

diff --git a/basis/wrap/wrap-docs.factor b/basis/wrap/wrap-docs.factor
index c94e12907f..09ddec36ed 100644
--- a/basis/wrap/wrap-docs.factor
+++ b/basis/wrap/wrap-docs.factor
@@ -10,10 +10,10 @@ ARTICLE: "wrap" "Word wrapping"
 { $subsection wrap-lines }
 { $subsection wrap-string }
 { $subsection wrap-indented-string }
-"Additionally, the vocabulary provides capabilities to wrap arbitrary groups of things, in units called words."
-{ $subsection wrap }
-{ $subsection word }
-{ $subsection <word> } ;
+"Additionally, the vocabulary provides capabilities to wrap arbitrary groups of things, in units called elements."
+{ $subsection wrap-elements }
+{ $subsection element }
+{ $subsection <element> } ;
 
 HELP: wrap-lines
 { $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } }
@@ -27,15 +27,15 @@ HELP: wrap-indented-string
 { $values { "string" string } { "width" integer } { "indent" string } { "newstring" string } }
 { $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space. Before each line, the indent string is added." } ;
 
-HELP: wrap
-{ $values { "words" { "a sequence of " { $instance word } "s" } } { "width" integer } { "lines" "a sequence of sequences of words" } }
-{ $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given width. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ;
+HELP: wrap-elements
+{ $values { "elements" { "a sequence of " { $instance element } "s" } } { "line-max" integer } { "line-ideal" integer } { "lines" "a sequence of sequences of words" } }
+{ $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given maximum. The returned set of lines is optimized to minimize the square of the deviation of each line from the ideal width. It is not guaranteed to be the minimal number of lines. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ;
 
-HELP: word
-{ $class-description "A word, for the purposes of " { $vocab-link "wrap" } ", is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Words can be created with " { $link <word> } "." }
-{ $see-also wrap } ;
+HELP: element
+{ $class-description "An element is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Elements can be created with " { $link <element> } "." }
+{ $see-also wrap-elements } ;
 
-HELP: <word>
-{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "word" word } }
-{ $description "Creates a " { $link word } " object with the given parameters." }
-{ $see-also wrap } ;
+HELP: <element>
+{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "element" element } }
+{ $description "Creates an " { $link element } " object with the given parameters." }
+{ $see-also wrap-elements } ;
diff --git a/basis/wrap/wrap-tests.factor b/basis/wrap/wrap-tests.factor
index ba5168a1c2..98d0b712f7 100644
--- a/basis/wrap/wrap-tests.factor
+++ b/basis/wrap/wrap-tests.factor
@@ -6,49 +6,77 @@ IN: wrap.tests
 [
     {
         {
-            T{ word f 1 10 f }
-            T{ word f 2 10 f }
-            T{ word f 3 2 t }
+            T{ element f 1 10 f }
+            T{ element f 2 10 f }
+            T{ element f 3 2 t }
         }
         {
-            T{ word f 4 10 f }
-            T{ word f 5 10 f }
+            T{ element f 4 10 f }
+            T{ element f 5 10 f }
         }
     }
 ] [
     {
-        T{ word f 1 10 f }
-        T{ word f 2 10 f }
-        T{ word f 3 2 t }
-        T{ word f 4 10 f }
-        T{ word f 5 10 f }
-    } 35 wrap [ { } like ] map
+        T{ element f 1 10 f }
+        T{ element f 2 10 f }
+        T{ element f 3 2 t }
+        T{ element f 4 10 f }
+        T{ element f 5 10 f }
+    } 35 35 wrap-elements [ { } like ] map
 ] unit-test
 
 [
     {
         {
-            T{ word f 1 10 f }
-            T{ word f 2 10 f }
-            T{ word f 3 9 t }
-            T{ word f 3 9 t }
-            T{ word f 3 9 t }
+            T{ element f 1 10 f }
+            T{ element f 2 10 f }
+            T{ element f 3 9 t }
+            T{ element f 3 9 t }
+            T{ element f 3 9 t }
         }
         {
-            T{ word f 4 10 f }
-            T{ word f 5 10 f }
+            T{ element f 4 10 f }
+            T{ element f 5 10 f }
         }
     }
 ] [
     {
-        T{ word f 1 10 f }
-        T{ word f 2 10 f }
-        T{ word f 3 9 t }
-        T{ word f 3 9 t }
-        T{ word f 3 9 t }
-        T{ word f 4 10 f }
-        T{ word f 5 10 f }
-    } 35 wrap [ { } like ] map
+        T{ element f 1 10 f }
+        T{ element f 2 10 f }
+        T{ element f 3 9 t }
+        T{ element f 3 9 t }
+        T{ element f 3 9 t }
+        T{ element f 4 10 f }
+        T{ element f 5 10 f }
+    } 35 35 wrap-elements [ { } like ] map
+] unit-test
+
+[
+    {
+        {
+            T{ element f 1 10 t }
+            T{ element f 1 10 f }
+            T{ element f 3 9 t }
+        }
+        {
+            T{ element f 2 10 f }
+            T{ element f 3 9 t }
+        }
+        {
+            T{ element f 4 10 f }
+            T{ element f 5 10 f }
+        }
+    }
+] [
+    {
+        T{ element f 1 10 t }
+        T{ element f 1 10 f }
+        T{ element f 3 9 t }
+        T{ element f 2 10 f }
+        T{ element f 3 9 t }
+        T{ element f 4 10 f }
+        T{ element f 5 10 f }
+    } 35 35 wrap-elements [ { } like ] map
 ] unit-test
 
 [
@@ -75,8 +103,13 @@ word wrap.">
     "  " wrap-indented-string
 ] unit-test
 
-[ "this text\nhas lots of\nspaces" ]
+[ "this text\nhas lots\nof spaces" ]
 [ "this text        has lots of       spaces" 12 wrap-string ] unit-test
 
 [ "hello\nhow\nare\nyou\ntoday?" ]
 [ "hello how are you today?" 3 wrap-string ] unit-test
+
+[ "aaa\nbb cc\nddddd" ] [ "aaa bb cc ddddd" 6 wrap-string ] unit-test
+[ "aaa\nbb ccc\ndddddd" ] [ "aaa bb ccc dddddd" 6 wrap-string ] unit-test
+[ "aaa bb\ncccc\nddddd" ] [ "aaa bb cccc ddddd" 6 wrap-string ] unit-test
+[ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test
diff --git a/basis/wrap/wrap.factor b/basis/wrap/wrap.factor
index e93509b58e..458d2f86d1 100644
--- a/basis/wrap/wrap.factor
+++ b/basis/wrap/wrap.factor
@@ -1,70 +1,165 @@
-! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: sequences kernel namespaces make splitting
-math math.order fry assocs accessors ;
+USING: kernel sequences math arrays locals fry accessors splitting
+make combinators.short-circuit namespaces grouping splitting.monotonic ;
 IN: wrap
 
-! Word wrapping/line breaking -- not Unicode-aware
-
-TUPLE: word key width break? ;
-
-C: <word> word
-
 <PRIVATE
 
-SYMBOL: width
+! black is the text length, white is the whitespace length
+TUPLE: word contents black white ;
+C: <word> word
 
-: break-here? ( column word -- ? )
-    break?>> not [ width get > ] [ drop f ] if ;
+: word-length ( word -- n )
+    [ black>> ] [ white>> ] bi + ;
 
-: walk ( n words -- n )
-    ! If on a break, take the rest of the breaks
-    ! If not on a break, go back until you hit a break
-    2dup bounds-check? [
-        2dup nth break?>>
-        [ [ break?>> not ] find-from drop ]
-        [ [ break?>> ] find-last-from drop 1+ ] if
-   ] [ drop ] if ;
+TUPLE: cons cdr car ; ! This order works out better
+C: <cons> cons
 
-: find-optimal-break ( words -- n )
-    [ 0 ] keep
-    [ [ width>> + dup ] keep break-here? ] find drop nip
-    [ 1 max swap walk ] [ drop f ] if* ;
+: >cons< ( cons -- cdr car )
+    [ cdr>> ] [ car>> ] bi ;
 
-: (wrap) ( words -- )
+: list-each ( list quot -- )
+    over [
+        [ [ car>> ] dip call ]
+        [ [ cdr>> ] dip list-each ] 2bi
+    ] [ 2drop ] if ; inline recursive
+
+: singleton? ( list -- ? )
+    { [ ] [ cdr>> not ] } 1&& ;
+
+: <singleton> ( elt -- list )
+    f swap <cons> ;
+
+: list>array ( list -- array )
+    [ [ , ] list-each ] { } make ;
+
+: lists>arrays ( lists -- arrays )
+    [ [ list>array , ] list-each ] { } make ;
+
+TUPLE: paragraph lines head-width tail-cost ;
+C: <paragraph> paragraph
+
+SYMBOL: line-max
+SYMBOL: line-ideal
+
+: deviation ( length -- n )
+    line-ideal get - sq ;
+
+: top-fits? ( paragraph -- ? )
+    [ head-width>> ]
+    [ lines>> singleton? line-ideal line-max ? get ] bi <= ;
+
+: fits? ( paragraph -- ? )
+    ! Make this not count spaces at end
+    { [ lines>> car>> singleton? ] [ top-fits? ] } 1|| ;
+
+:: min-by ( seq quot -- elt )
+    f 1.0/0.0 seq [| key value new |
+        new quot call :> newvalue
+        newvalue value < [ new newvalue ] [ key value ] if
+    ] each drop ; inline
+
+: paragraph-cost ( paragraph -- cost )
+    [ head-width>> deviation ]
+    [ tail-cost>> ] bi + ;
+
+: min-cost ( paragraphs -- paragraph )
+    [ paragraph-cost ] min-by ;
+
+: new-line ( paragraph word -- paragraph )
+    [ [ lines>> ] [ <singleton> ] bi* <cons> ]
+    [ nip black>> ]
+    [ drop paragraph-cost ] 2tri
+    <paragraph> ;
+
+: glue ( paragraph word -- paragraph )
+    [ [ lines>> >cons< ] dip <cons> <cons> ]
+    [ [ head-width>> ] [ word-length ] bi* + ]
+    [ drop tail-cost>> ] 2tri
+    <paragraph> ;
+
+: wrap-step ( paragraphs word -- paragraphs )
+    [ '[ _ glue ] map ]
+    [ [ min-cost ] dip new-line ]
+    2bi prefix
+    [ fits? ] filter ;
+
+: 1paragraph ( word -- paragraph )
+    [ <singleton> <singleton> ]
+    [ black>> ] bi
+    0 <paragraph> ;
+
+: post-process ( paragraph -- array )
+    lines>> lists>arrays
+    [ [ contents>> ] map ] map ;
+
+: initialize ( words -- words paragraph )
+    <reversed> unclip-slice 1paragraph 1array ;
+
+: wrap ( words line-max line-ideal -- paragraph )
     [
-        dup find-optimal-break
-        [ cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if*
-    ] unless-empty ;
+        line-ideal set
+        line-max set
+        initialize
+        [ wrap-step ] reduce
+        min-cost
+        post-process
+    ] with-scope ;
 
-: intersperse ( seq elt -- seq' )
-    [ '[ _ , ] [ , ] interleave ] { } make ;
+PRIVATE>
+
+TUPLE: element key width break? ;
+C: <element> element
+
+<PRIVATE
+
+: elements-length ( elements -- length )
+    [ width>> ] map sum ;
+
+: make-word ( whites blacks -- word )
+    [ append ] [ [ elements-length ] bi@ ] 2bi <word> ;
+ 
+: ?first2 ( seq -- first/f second/f )
+    [ 0 swap ?nth ]
+    [ 1 swap ?nth ] bi ;
+
+: split-elements ( seq -- half-words )
+    [ [ break?>> ] bi@ = ] monotonic-split ;
+
+: ?first-break ( seq -- newseq f/word )
+    dup first first break?>>
+    [ unclip-slice f swap make-word ]
+    [ f ] if ;
+
+: make-words ( seq f/word -- words )
+    [ 2 <groups> [ ?first2 make-word ] map ] dip
+    [ prefix ] when* ;
+
+: elements>words ( seq -- newseq )
+    split-elements ?first-break make-words ;
+
+PRIVATE>
+
+: wrap-elements ( elements line-max line-ideal -- lines )
+    [ elements>words ] 2dip wrap [ concat ] map ;
+
+<PRIVATE
 
 : split-lines ( string -- words-lines )
     string-lines [
         " \t" split harvest
-        [ dup length f <word> ] map
-        " " 1 t <word> intersperse
+        [ dup length 1 <word> ] map
     ] map ;
 
 : join-words ( wrapped-lines -- lines )
-    [
-        [ break?>> ] trim-slice
-        [ key>> ] map concat
-    ] map ;
+    [ " " join ] map ;
 
 : join-lines ( strings -- string )
     "\n" join ;
 
 PRIVATE>
 
-: wrap ( words width -- lines )
-    width [
-        [ (wrap) ] { } make
-    ] with-variable ;
-
 : wrap-lines ( lines width -- newlines )
-    [ split-lines ] dip '[ _ wrap join-words ] map concat ;
+    [ split-lines ] dip '[ _ dup wrap join-words ] map concat ;
 
 : wrap-string ( string width -- newstring )
     wrap-lines join-lines ;

From c069add10b86dc8038354e5b91c1b2d3a8da5c87 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 17:34:17 -0600
Subject: [PATCH 31/42] fix using lists

---
 core/io/files/files-tests.factor | 10 ++++------
 core/io/io-tests.factor          |  4 +---
 2 files changed, 5 insertions(+), 9 deletions(-)

diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 423eb38144..d7fc3851e2 100644
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -1,8 +1,7 @@
-USING: tools.test io.files io.files.private io.files.temp
-io.directories io.encodings.8-bit arrays make system
-io.encodings.binary io threads kernel continuations
-io.encodings.ascii sequences strings accessors
-io.encodings.utf8 math destructors namespaces ;
+USING: arrays debugger.threads destructors io io.directories
+io.encodings.8-bit io.encodings.ascii io.encodings.binary
+io.files io.files.private io.files.temp io.files.unique kernel
+make math sequences system threads tools.test ;
 IN: io.files.tests
 
 \ exists? must-infer
@@ -139,4 +138,3 @@ USE: debugger.threads
         ] with-file-reader
     ] 2bi
 ] unit-test
-
diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor
index 9e931279d7..cf6b935215 100644
--- a/core/io/io-tests.factor
+++ b/core/io/io-tests.factor
@@ -1,6 +1,4 @@
-USING: arrays io io.files kernel math parser strings system
-tools.test words namespaces make io.encodings.8-bit
-io.encodings.binary sequences io.files.unique ;
+USING: io parser tools.test words ;
 IN: io.tests
 
 [ f ] [

From 83252cce04ef5864f6c38eb2343b94e974d5a05c Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 17:37:54 -0600
Subject: [PATCH 32/42] working on tiff

---
 extra/graphics/tiff/tiff.factor | 24 ++++++++++++++----------
 1 file changed, 14 insertions(+), 10 deletions(-)

diff --git a/extra/graphics/tiff/tiff.factor b/extra/graphics/tiff/tiff.factor
index e66ebcc6bd..f0b3f9337e 100755
--- a/extra/graphics/tiff/tiff.factor
+++ b/extra/graphics/tiff/tiff.factor
@@ -2,20 +2,19 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators io io.encodings.binary io.files
 kernel pack endian tools.hexdump constructors sequences arrays
-sorting.slots math.order math.parser prettyprint ;
+sorting.slots math.order math.parser prettyprint classes ;
 IN: graphics.tiff
 
 TUPLE: tiff
 endianness
 the-answer
 ifd-offset
-ifds
-processed-ifds ;
+ifds ;
 
 CONSTRUCTOR: tiff ( -- tiff )
     V{ } clone >>ifds ;
 
-TUPLE: ifd count ifd-entries next ;
+TUPLE: ifd count ifd-entries next processed-tags strips ;
 
 CONSTRUCTOR: ifd ( count ifd-entries next -- ifd ) ;
 
@@ -137,8 +136,6 @@ ERROR: bad-planar-configuration n ;
 TUPLE: new-subfile-type n ;
 CONSTRUCTOR: new-subfile-type ( n -- object ) ;
 
-
-
 ERROR: bad-tiff-magic bytes ;
 
 : tiff-endianness ( byte-array -- ? )
@@ -176,6 +173,12 @@ ERROR: bad-tiff-magic bytes ;
         [ <ifd> push-ifd ] [ 0 = [ read-ifds ] unless ] bi
     ] with-tiff-endianness ;
 
+: read-strips ( ifd -- ifd )
+    dup processed-tags>>
+    [ [ strip-byte-counts instance? ] find nip n>> ]
+    [ [ strip-offsets instance? ] find nip n>> ] bi
+    [ seek-absolute seek-input read ] { } 2map-as >>strips ;
+
 ! ERROR: unhandled-ifd-entry data n ;
 
 : unhandled-ifd-entry ;
@@ -207,17 +210,18 @@ ERROR: bad-tiff-magic bytes ;
         [ unhandled-ifd-entry swap 2array ]
     } case ;
 
-: process-ifd ( ifd -- processed-ifd )
-    ifd-entries>> [ process-ifd-entry ] map ;
+: process-ifd ( ifd -- ifd )
+    dup ifd-entries>> [ process-ifd-entry ] map >>processed-tags ;
 
 : (load-tiff) ( path -- tiff )
     binary [
         <tiff>
         read-header
         read-ifds
-        dup ifds>> [ process-ifd ] map
-        >>processed-ifds
+        dup ifds>> [ process-ifd read-strips drop ] each
     ] with-file-reader ;
 
 : load-tiff ( path -- tiff )
     (load-tiff) ;
+
+! TODO: duplicate ifds = error, seeking out of bounds = error

From 0e8986176f7597d23b5908968c7785ad3b4a02a2 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-103.local>
Date: Sun, 8 Feb 2009 18:24:22 -0600
Subject: [PATCH 33/42] Adding failing unit test to wrap (must-infer)

---
 basis/wrap/wrap-tests.factor | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/basis/wrap/wrap-tests.factor b/basis/wrap/wrap-tests.factor
index 98d0b712f7..933238fddc 100644
--- a/basis/wrap/wrap-tests.factor
+++ b/basis/wrap/wrap-tests.factor
@@ -113,3 +113,6 @@ word wrap.">
 [ "aaa\nbb ccc\ndddddd" ] [ "aaa bb ccc dddddd" 6 wrap-string ] unit-test
 [ "aaa bb\ncccc\nddddd" ] [ "aaa bb cccc ddddd" 6 wrap-string ] unit-test
 [ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test
+
+\ wrap-string must-infer
+\ wrap-elements must-infer

From 1818ea5136cd5515772b4c29d6c978378ffae1d2 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 18:42:11 -0600
Subject: [PATCH 34/42] update README.txt

---
 README.txt | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

diff --git a/README.txt b/README.txt
index 98616539d2..d60bf03130 100755
--- a/README.txt
+++ b/README.txt
@@ -116,16 +116,22 @@ Now if $DISPLAY is set, running ./factor will start the UI.
 
 * Running Factor on Windows XP/Vista
 
+The Factor runtime is compiled into two binaries:
+
+  factor.com - a Windows console application
+  factor.exe - a Windows native application, without a console
+
 If you did not download the binary package, you can bootstrap Factor in
-the command prompt:
+the command prompt using the console application:
 
-  factor.exe -i=boot.<cpu>.image
+  factor.com -i=boot.<cpu>.image
 
-Once bootstrapped, double-clicking factor.exe starts the Factor UI.
+Once bootstrapped, double-clicking factor.exe or factor.com starts
+the Factor UI.
 
 To run the listener in the command prompt:
 
-  factor.exe -run=listener
+  factor.com -run=listener
 
 * The Factor FAQ
 

From b529df965234019bfdd98a472636dd875bc910a6 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 8 Feb 2009 20:18:30 -0600
Subject: [PATCH 35/42] handle seeking before the file start on windows, add a
 unit test for this

---
 basis/io/backend/windows/nt/nt.factor | 11 ++++++++---
 core/io/files/files-tests.factor      |  6 ++++++
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor
index 107f1902e3..6f283ac1bb 100755
--- a/basis/io/backend/windows/nt/nt.factor
+++ b/basis/io/backend/windows/nt/nt.factor
@@ -87,11 +87,16 @@ ERROR: invalid-file-size n ;
 : handle>file-size ( handle -- n )
     0 <ulonglong> [ GetFileSizeEx win32-error=0/f ] keep *ulonglong ;
 
+ERROR: seek-before-start n ;
+
+: set-seek-ptr ( n handle -- )
+    [ dup 0 < [ seek-before-start ] when ] dip (>>ptr) ;
+
 M: winnt seek-handle ( n seek-type handle -- )
     swap {
-        { seek-absolute [ (>>ptr) ] }
-        { seek-relative [ [ + ] change-ptr drop ] }
-        { seek-end [ [ handle>> handle>file-size + ] keep (>>ptr) ] }
+        { seek-absolute [ set-seek-ptr ] }
+        { seek-relative [ [ ptr>> + ] keep set-seek-ptr ] }
+        { seek-end [ [ handle>> handle>file-size + ] keep set-seek-ptr ] }
         [ bad-seek-type ]
     } case ;
 
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index d7fc3851e2..152d1bb85d 100644
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -138,3 +138,9 @@ USE: debugger.threads
         ] with-file-reader
     ] 2bi
 ] unit-test
+
+[
+    "seek-test6" unique-file binary [
+        -10 seek-absolute seek-input
+    ] with-file-reader
+] must-fail

From b65b88364c46b8c21b4f36e302bc406e0861bf49 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-103.local>
Date: Sun, 8 Feb 2009 22:12:11 -0600
Subject: [PATCH 36/42] Updating lots of things to use call( -- )

---
 basis/alien/c-types/c-types.factor                     |  4 ++--
 basis/cocoa/messages/messages.factor                   |  4 ++--
 .../compiler/tree/propagation/inlining/inlining.factor |  7 ++++---
 basis/help/lint/lint.factor                            | 10 +++++-----
 basis/html/templates/chloe/chloe.factor                |  4 ++--
 basis/html/templates/chloe/compiler/compiler.factor    |  6 +++---
 basis/html/templates/fhtml/fhtml.factor                |  4 ++--
 basis/ui/tools/interactor/interactor.factor            |  5 ++---
 basis/ui/ui.factor                                     |  4 ++--
 9 files changed, 24 insertions(+), 24 deletions(-)

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index cf5daa1562..89b3572daf 100644
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
 namespaces make parser sequences strings words assocs splitting
 math.parser cpu.architecture alien alien.accessors quotations
 layouts system compiler.units io.files io.encodings.binary
-accessors combinators effects continuations fry ;
+accessors combinators effects continuations fry call ;
 IN: alien.c-types
 
 DEFER: <int>
@@ -258,7 +258,7 @@ M: long-long-type box-return ( type -- )
         unclip [
             [
                 dup word? [
-                    def>> { } swap with-datastack first
+                    def>> call( -- object )
                 ] when
             ] map
         ] dip prefix
diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index a0b0e89a0d..60bdde262c 100644
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -5,7 +5,7 @@ continuations combinators compiler compiler.alien kernel math
 namespaces make parser quotations sequences strings words
 cocoa.runtime io macros memoize io.encodings.utf8
 effects libc libc.private parser lexer init core-foundation fry
-generalizations specialized-arrays.direct.alien ;
+generalizations specialized-arrays.direct.alien call ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )
@@ -83,7 +83,7 @@ class-init-hooks global [ H{ } clone or ] change-at
 
 : (objc-class) ( name word -- class )
     2dup execute dup [ 2nip ] [
-        drop over class-init-hooks get at [ assert-depth ] when*
+        drop over class-init-hooks get at [ call( -- ) ] when*
         2dup execute dup [ 2nip ] [
             2drop "No such class: " prepend throw
         ] if
diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index f3b3238b4e..06d8d4f733 100755
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel arrays sequences math math.order
+USING: accessors kernel arrays sequences math math.order call
 math.partial-dispatch generic generic.standard generic.math
 classes.algebra classes.union sets quotations assocs combinators
 words namespaces continuations classes fry combinators.smart
@@ -181,8 +181,9 @@ SYMBOL: history
     "custom-inlining" word-prop ;
 
 : inline-custom ( #call word -- ? )
-    [ dup 1array ] [ "custom-inlining" word-prop ] bi* with-datastack
-    first object swap eliminate-dispatch ;
+    [ dup ] [ "custom-inlining" word-prop ] bi*
+    call( #call -- word/quot/f )
+    object swap eliminate-dispatch ;
 
 : inline-instance-check ( #call word -- ? )
     over in-d>> second value-info literal>> dup class?
diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor
index b5f8b78ea3..57f64459c8 100755
--- a/basis/help/lint/lint.factor
+++ b/basis/help/lint/lint.factor
@@ -7,7 +7,7 @@ combinators combinators.short-circuit splitting debugger
 hashtables sorting effects vocabs vocabs.loader assocs editors
 continuations classes.predicate macros math sets eval
 vocabs.parser words.symbol values grouping unicode.categories
-sequences.deep ;
+sequences.deep call ;
 IN: help.lint
 
 SYMBOL: vocabs-quot
@@ -15,9 +15,9 @@ SYMBOL: vocabs-quot
 : check-example ( element -- )
     [
         rest [
-            but-last "\n" join 1vector
-            [ (eval>string) ] with-datastack
-            peek "\n" ?tail drop
+            but-last "\n" join
+            [ (eval>string) ] call( code -- output )
+            "\n" ?tail drop
         ] keep
         peek assert=
     ] vocabs-quot get call ;
@@ -145,7 +145,7 @@ M: help-error error.
     bi ;
 
 : check-something ( obj quot -- )
-    flush '[ _ assert-depth ] swap '[ _ <help-error> , ] recover ; inline
+    flush '[ _ call( -- ) ] swap '[ _ <help-error> , ] recover ; inline
 
 : check-word ( word -- )
     [ with-file-vocabs ] vocabs-quot set
diff --git a/basis/html/templates/chloe/chloe.factor b/basis/html/templates/chloe/chloe.factor
index 89d00e1f6e..eafa3c3a5d 100644
--- a/basis/html/templates/chloe/chloe.factor
+++ b/basis/html/templates/chloe/chloe.factor
@@ -4,7 +4,7 @@ USING: accessors kernel sequences combinators kernel fry
 namespaces make classes.tuple assocs splitting words arrays io
 io.files io.files.info io.encodings.utf8 io.streams.string
 unicode.case mirrors math urls present multiline quotations xml
-logging continuations
+logging call
 xml.data xml.writer xml.syntax strings
 html.forms
 html
@@ -130,6 +130,6 @@ TUPLE: cached-template path last-modified quot ;
     template-cache get clear-assoc ;
 
 M: chloe call-template*
-    template-quot assert-depth ;
+    template-quot call( -- ) ;
 
 INSTANCE: chloe template
diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor
index 394b5ef359..1a1abc9f7b 100644
--- a/basis/html/templates/chloe/compiler/compiler.factor
+++ b/basis/html/templates/chloe/compiler/compiler.factor
@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs namespaces make kernel sequences accessors
 combinators strings splitting io io.streams.string present
-xml.writer xml.data xml.entities html.forms
-html.templates html.templates.chloe.syntax continuations ;
+xml.writer xml.data xml.entities html.forms call
+html.templates html.templates.chloe.syntax ;
 IN: html.templates.chloe.compiler
 
 : chloe-attrs-only ( assoc -- assoc' )
@@ -83,7 +83,7 @@ ERROR: unknown-chloe-tag tag ;
 
 : compile-chloe-tag ( tag -- )
     dup main>> dup tags get at
-    [ curry assert-depth ]
+    [ curry call( -- ) ]
     [ unknown-chloe-tag ]
     ?if ;
 
diff --git a/basis/html/templates/fhtml/fhtml.factor b/basis/html/templates/fhtml/fhtml.factor
index c419c4a197..e76a812bef 100644
--- a/basis/html/templates/fhtml/fhtml.factor
+++ b/basis/html/templates/fhtml/fhtml.factor
@@ -3,7 +3,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations sequences kernel namespaces debugger
 combinators math quotations generic strings splitting accessors
-assocs fry vocabs.parser parser lexer io io.files
+assocs fry vocabs.parser parser lexer io io.files call
 io.streams.string io.encodings.utf8 html.templates ;
 IN: html.templates.fhtml
 
@@ -72,6 +72,6 @@ TUPLE: fhtml path ;
 C: <fhtml> fhtml
 
 M: fhtml call-template* ( filename -- )
-    '[ _ path>> utf8 file-contents eval-template ] assert-depth ;
+    '[ _ path>> utf8 file-contents eval-template ] call( -- ) ;
 
 INSTANCE: fhtml template
diff --git a/basis/ui/tools/interactor/interactor.factor b/basis/ui/tools/interactor/interactor.factor
index 40da6ebafc..eb2eef3742 100644
--- a/basis/ui/tools/interactor/interactor.factor
+++ b/basis/ui/tools/interactor/interactor.factor
@@ -5,7 +5,7 @@ hashtables io io.styles kernel math math.order math.vectors
 models models.delay namespaces parser lexer prettyprint
 quotations sequences strings threads listener classes.tuple
 ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.status-bar
-ui.gadgets.presentations ui.gadgets.worlds ui.gestures
+ui.gadgets.presentations ui.gadgets.worlds ui.gestures call
 definitions calendar concurrency.flags concurrency.mailboxes
 ui.tools.workspace accessors sets destructors fry vocabs.parser ;
 IN: ui.tools.interactor
@@ -82,8 +82,7 @@ M: interactor model-changed
     mailbox>> mailbox-put ;
 
 : clear-input ( interactor -- )
-    #! The with-datastack is a kludge to make it infer. Stupid.
-    model>> 1array [ clear-doc ] with-datastack drop ;
+    model>> [ clear-doc ] call( model -- ) ;
 
 : interactor-finish ( interactor -- )
     [ editor-string ] keep
diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index 37ce4ea499..78f150987f 100644
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -4,7 +4,7 @@ USING: arrays assocs io kernel math models namespaces make
 dlists deques sequences threads sequences words ui.gadgets
 ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend
 ui.render continuations init combinators hashtables
-concurrency.flags sets accessors calendar ;
+concurrency.flags sets accessors calendar call ;
 IN: ui
 
 ! Assoc mapping aliens to gadgets
@@ -140,7 +140,7 @@ SYMBOL: ui-hook
             layout-queued
             redraw-worlds
             send-queued-gestures
-        ] assert-depth
+        ] call( -- )
     ] [ ui-error ] recover ;
 
 SYMBOL: ui-thread

From af9f5112d45beb02023aee377f3d0fbf6b2ceae5 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-103.local>
Date: Sun, 8 Feb 2009 22:39:22 -0600
Subject: [PATCH 37/42] Adding call( -- )

---
 basis/call/call-tests.factor | 10 ++++++++++
 basis/call/call.factor       | 24 ++++++++++++++++++++++++
 2 files changed, 34 insertions(+)
 create mode 100644 basis/call/call-tests.factor
 create mode 100644 basis/call/call.factor

diff --git a/basis/call/call-tests.factor b/basis/call/call-tests.factor
new file mode 100644
index 0000000000..4a59a6d2fb
--- /dev/null
+++ b/basis/call/call-tests.factor
@@ -0,0 +1,10 @@
+! Copyright (C) 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: math tools.test call kernel ;
+IN: call.tests
+
+[ 3 ] [ 1 2 [ + ] call( x y -- z ) ] unit-test
+[ 1 2 [ + ] call( -- z ) ] must-fail
+[ 1 2 [ + ] call( x y -- z a ) ] must-fail
+[ 1 2 3 { 4 } ] [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test
+[ [ + ] call( x y -- z ) ] must-infer
diff --git a/basis/call/call.factor b/basis/call/call.factor
new file mode 100644
index 0000000000..363b024dff
--- /dev/null
+++ b/basis/call/call.factor
@@ -0,0 +1,24 @@
+! Copyright (C) 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel macros fry summary sequences generalizations accessors
+continuations effects.parser parser ;
+IN: call
+
+ERROR: wrong-values values quot length-required ;
+
+M: wrong-values summary
+    drop "Wrong number of values returned from quotation" ;
+
+<PRIVATE
+
+: firstn-safe ( array quot n -- ... )
+    3dup nip swap length = [ nip firstn ] [ wrong-values ] if ; inline
+
+PRIVATE>
+
+MACRO: call-effect ( effect -- quot )
+    [ in>> length ] [ out>> length ] bi
+    '[ [ _ narray ] dip [ with-datastack ] keep _ firstn-safe ] ;
+
+: call(
+    ")" parse-effect parsed \ call-effect parsed ; parsing

From c4aa14b9d96d0a55b6c94e2441d952cf056ddfcc Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-103.local>
Date: Sun, 8 Feb 2009 23:06:03 -0600
Subject: [PATCH 38/42] Making lazy lists compile, and using them where
 applicable

---
 basis/persistent/deques/deques.factor | 14 ++--
 basis/wrap/wrap-docs.factor           | 26 +++----
 basis/wrap/wrap-tests.factor          | 84 +++++++++++------------
 basis/wrap/wrap.factor                | 97 ++++++++++++---------------
 extra/lists/lazy/lazy-tests.factor    |  8 ++-
 extra/lists/lazy/lazy.factor          | 22 +++---
 extra/lists/lists.factor              |  5 +-
 extra/promises/promises.factor        | 10 +--
 8 files changed, 125 insertions(+), 141 deletions(-)

diff --git a/basis/persistent/deques/deques.factor b/basis/persistent/deques/deques.factor
index be63d807b9..ece1cda772 100644
--- a/basis/persistent/deques/deques.factor
+++ b/basis/persistent/deques/deques.factor
@@ -1,6 +1,6 @@
 ! Copyback (C) 2008 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors math ;
+USING: kernel accessors math lists ;
 QUALIFIED: sequences
 IN: persistent.deques
 
@@ -9,25 +9,23 @@ IN: persistent.deques
 !   same source, it could take O(m) amortized time per update.
 
 <PRIVATE
-TUPLE: cons { car read-only } { cdr read-only } ;
-C: <cons> cons
 
 : each ( list quot: ( elt -- ) -- )
     over
-    [ [ [ car>> ] dip call ] [ [ cdr>> ] dip ] 2bi each ]
+    [ [ [ car ] dip call ] [ [ cdr ] dip ] 2bi each ]
     [ 2drop ] if ; inline recursive
 
 : reduce ( list start quot -- end )
     swapd each ; inline
 
 : reverse ( list -- reversed )
-    f [ swap <cons> ] reduce ;
+    f [ swap cons ] reduce ;
 
 : length ( list -- length )
     0 [ drop 1+ ] reduce ;
 
 : cut ( list index -- back front-reversed )
-    f swap [ [ [ cdr>> ] [ car>> ] bi ] dip <cons> ] times ;
+    f swap [ [ [ cdr ] [ car ] bi ] dip cons ] times ;
 
 : split-reverse ( list -- back-reversed front )
     dup length 2/ cut [ reverse ] bi@ ;
@@ -49,7 +47,7 @@ PRIVATE>
 
 <PRIVATE
 : push ( item deque -- newdeque )
-    [ front>> <cons> ] [ back>> ] bi deque boa ; inline
+    [ front>> cons ] [ back>> ] bi deque boa ; inline
 PRIVATE>
 
 : push-front ( deque item -- newdeque )
@@ -60,7 +58,7 @@ PRIVATE>
 
 <PRIVATE
 : remove ( deque -- item newdeque )
-    [ front>> car>> ] [ [ front>> cdr>> ] [ back>> ] bi deque boa ] bi ; inline
+    [ front>> car ] [ [ front>> cdr ] [ back>> ] bi deque boa ] bi ; inline
 
 : transfer ( deque -- item newdeque )
     back>> [ split-reverse deque boa remove ]
diff --git a/basis/wrap/wrap-docs.factor b/basis/wrap/wrap-docs.factor
index 09ddec36ed..59c0352bc7 100644
--- a/basis/wrap/wrap-docs.factor
+++ b/basis/wrap/wrap-docs.factor
@@ -10,10 +10,10 @@ ARTICLE: "wrap" "Word wrapping"
 { $subsection wrap-lines }
 { $subsection wrap-string }
 { $subsection wrap-indented-string }
-"Additionally, the vocabulary provides capabilities to wrap arbitrary groups of things, in units called elements."
-{ $subsection wrap-elements }
-{ $subsection element }
-{ $subsection <element> } ;
+"Additionally, the vocabulary provides capabilities to wrap arbitrary groups of things, in units called segments."
+{ $subsection wrap-segments }
+{ $subsection segment }
+{ $subsection <segment> } ;
 
 HELP: wrap-lines
 { $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } }
@@ -27,15 +27,15 @@ HELP: wrap-indented-string
 { $values { "string" string } { "width" integer } { "indent" string } { "newstring" string } }
 { $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space. Before each line, the indent string is added." } ;
 
-HELP: wrap-elements
-{ $values { "elements" { "a sequence of " { $instance element } "s" } } { "line-max" integer } { "line-ideal" integer } { "lines" "a sequence of sequences of words" } }
+HELP: wrap-segments
+{ $values { "segments" { "a sequence of " { $instance segment } "s" } } { "line-max" integer } { "line-ideal" integer } { "lines" "a sequence of sequences of words" } }
 { $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given maximum. The returned set of lines is optimized to minimize the square of the deviation of each line from the ideal width. It is not guaranteed to be the minimal number of lines. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ;
 
-HELP: element
-{ $class-description "An element is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Elements can be created with " { $link <element> } "." }
-{ $see-also wrap-elements } ;
+HELP: segment
+{ $class-description "A segment is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Elements can be created with " { $link <segment> } "." }
+{ $see-also wrap-segments } ;
 
-HELP: <element>
-{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "element" element } }
-{ $description "Creates an " { $link element } " object with the given parameters." }
-{ $see-also wrap-elements } ;
+HELP: <segment>
+{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "segment" segment } }
+{ $description "Creates a " { $link segment } " object with the given parameters." }
+{ $see-also wrap-segments } ;
diff --git a/basis/wrap/wrap-tests.factor b/basis/wrap/wrap-tests.factor
index 933238fddc..eeea3850d5 100644
--- a/basis/wrap/wrap-tests.factor
+++ b/basis/wrap/wrap-tests.factor
@@ -6,77 +6,77 @@ IN: wrap.tests
 [
     {
         {
-            T{ element f 1 10 f }
-            T{ element f 2 10 f }
-            T{ element f 3 2 t }
+            T{ segment f 1 10 f }
+            T{ segment f 2 10 f }
+            T{ segment f 3 2 t }
         }
         {
-            T{ element f 4 10 f }
-            T{ element f 5 10 f }
+            T{ segment f 4 10 f }
+            T{ segment f 5 10 f }
         }
     }
 ] [
     {
-        T{ element f 1 10 f }
-        T{ element f 2 10 f }
-        T{ element f 3 2 t }
-        T{ element f 4 10 f }
-        T{ element f 5 10 f }
-    } 35 35 wrap-elements [ { } like ] map
+        T{ segment f 1 10 f }
+        T{ segment f 2 10 f }
+        T{ segment f 3 2 t }
+        T{ segment f 4 10 f }
+        T{ segment f 5 10 f }
+    } 35 35 wrap-segments [ { } like ] map
 ] unit-test
 
 [
     {
         {
-            T{ element f 1 10 f }
-            T{ element f 2 10 f }
-            T{ element f 3 9 t }
-            T{ element f 3 9 t }
-            T{ element f 3 9 t }
+            T{ segment f 1 10 f }
+            T{ segment f 2 10 f }
+            T{ segment f 3 9 t }
+            T{ segment f 3 9 t }
+            T{ segment f 3 9 t }
         }
         {
-            T{ element f 4 10 f }
-            T{ element f 5 10 f }
+            T{ segment f 4 10 f }
+            T{ segment f 5 10 f }
         }
     }
 ] [
     {
-        T{ element f 1 10 f }
-        T{ element f 2 10 f }
-        T{ element f 3 9 t }
-        T{ element f 3 9 t }
-        T{ element f 3 9 t }
-        T{ element f 4 10 f }
-        T{ element f 5 10 f }
-    } 35 35 wrap-elements [ { } like ] map
+        T{ segment f 1 10 f }
+        T{ segment f 2 10 f }
+        T{ segment f 3 9 t }
+        T{ segment f 3 9 t }
+        T{ segment f 3 9 t }
+        T{ segment f 4 10 f }
+        T{ segment f 5 10 f }
+    } 35 35 wrap-segments [ { } like ] map
 ] unit-test
 
 [
     {
         {
-            T{ element f 1 10 t }
-            T{ element f 1 10 f }
-            T{ element f 3 9 t }
+            T{ segment f 1 10 t }
+            T{ segment f 1 10 f }
+            T{ segment f 3 9 t }
         }
         {
-            T{ element f 2 10 f }
-            T{ element f 3 9 t }
+            T{ segment f 2 10 f }
+            T{ segment f 3 9 t }
         }
         {
-            T{ element f 4 10 f }
-            T{ element f 5 10 f }
+            T{ segment f 4 10 f }
+            T{ segment f 5 10 f }
         }
     }
 ] [
     {
-        T{ element f 1 10 t }
-        T{ element f 1 10 f }
-        T{ element f 3 9 t }
-        T{ element f 2 10 f }
-        T{ element f 3 9 t }
-        T{ element f 4 10 f }
-        T{ element f 5 10 f }
-    } 35 35 wrap-elements [ { } like ] map
+        T{ segment f 1 10 t }
+        T{ segment f 1 10 f }
+        T{ segment f 3 9 t }
+        T{ segment f 2 10 f }
+        T{ segment f 3 9 t }
+        T{ segment f 4 10 f }
+        T{ segment f 5 10 f }
+    } 35 35 wrap-segments [ { } like ] map
 ] unit-test
 
 [
@@ -115,4 +115,4 @@ word wrap.">
 [ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test
 
 \ wrap-string must-infer
-\ wrap-elements must-infer
+\ wrap-segments must-infer
diff --git a/basis/wrap/wrap.factor b/basis/wrap/wrap.factor
index 458d2f86d1..f54c858bf4 100644
--- a/basis/wrap/wrap.factor
+++ b/basis/wrap/wrap.factor
@@ -1,39 +1,28 @@
-USING: kernel sequences math arrays locals fry accessors splitting
-make combinators.short-circuit namespaces grouping splitting.monotonic ;
+USING: kernel sequences math arrays locals fry accessors
+lists splitting call make combinators.short-circuit namespaces
+grouping splitting.monotonic ;
 IN: wrap
 
 <PRIVATE
 
 ! black is the text length, white is the whitespace length
-TUPLE: word contents black white ;
-C: <word> word
+TUPLE: element contents black white ;
+C: <element> element
 
-: word-length ( word -- n )
+: element-length ( element -- n )
     [ black>> ] [ white>> ] bi + ;
 
-TUPLE: cons cdr car ; ! This order works out better
-C: <cons> cons
+: swons ( cdr car -- cons )
+    swap cons ;
 
-: >cons< ( cons -- cdr car )
-    [ cdr>> ] [ car>> ] bi ;
+: unswons ( cons -- cdr car )
+    [ cdr ] [ car ] bi ;
 
-: list-each ( list quot -- )
-    over [
-        [ [ car>> ] dip call ]
-        [ [ cdr>> ] dip list-each ] 2bi
-    ] [ 2drop ] if ; inline recursive
-
-: singleton? ( list -- ? )
-    { [ ] [ cdr>> not ] } 1&& ;
-
-: <singleton> ( elt -- list )
-    f swap <cons> ;
-
-: list>array ( list -- array )
-    [ [ , ] list-each ] { } make ;
+: 1list? ( list -- ? )
+    { [ ] [ cdr +nil+ = ] } 1&& ;
 
 : lists>arrays ( lists -- arrays )
-    [ [ list>array , ] list-each ] { } make ;
+    [ list>seq ] lmap>array ;
 
 TUPLE: paragraph lines head-width tail-cost ;
 C: <paragraph> paragraph
@@ -46,11 +35,11 @@ SYMBOL: line-ideal
 
 : top-fits? ( paragraph -- ? )
     [ head-width>> ]
-    [ lines>> singleton? line-ideal line-max ? get ] bi <= ;
+    [ lines>> 1list? line-ideal line-max ? get ] bi <= ;
 
 : fits? ( paragraph -- ? )
     ! Make this not count spaces at end
-    { [ lines>> car>> singleton? ] [ top-fits? ] } 1|| ;
+    { [ lines>> car 1list? ] [ top-fits? ] } 1|| ;
 
 :: min-by ( seq quot -- elt )
     f 1.0/0.0 seq [| key value new |
@@ -65,26 +54,26 @@ SYMBOL: line-ideal
 : min-cost ( paragraphs -- paragraph )
     [ paragraph-cost ] min-by ;
 
-: new-line ( paragraph word -- paragraph )
-    [ [ lines>> ] [ <singleton> ] bi* <cons> ]
+: new-line ( paragraph element -- paragraph )
+    [ [ lines>> ] [ 1list ] bi* swons ]
     [ nip black>> ]
     [ drop paragraph-cost ] 2tri
     <paragraph> ;
 
-: glue ( paragraph word -- paragraph )
-    [ [ lines>> >cons< ] dip <cons> <cons> ]
-    [ [ head-width>> ] [ word-length ] bi* + ]
+: glue ( paragraph element -- paragraph )
+    [ [ lines>> unswons ] dip swons swons ]
+    [ [ head-width>> ] [ element-length ] bi* + ]
     [ drop tail-cost>> ] 2tri
     <paragraph> ;
 
-: wrap-step ( paragraphs word -- paragraphs )
+: wrap-step ( paragraphs element -- paragraphs )
     [ '[ _ glue ] map ]
     [ [ min-cost ] dip new-line ]
     2bi prefix
     [ fits? ] filter ;
 
-: 1paragraph ( word -- paragraph )
-    [ <singleton> <singleton> ]
+: 1paragraph ( element -- paragraph )
+    [ 1list 1list ]
     [ black>> ] bi
     0 <paragraph> ;
 
@@ -92,10 +81,10 @@ SYMBOL: line-ideal
     lines>> lists>arrays
     [ [ contents>> ] map ] map ;
 
-: initialize ( words -- words paragraph )
+: initialize ( elements -- elements paragraph )
     <reversed> unclip-slice 1paragraph 1array ;
 
-: wrap ( words line-max line-ideal -- paragraph )
+: wrap ( elements line-max line-ideal -- paragraph )
     [
         line-ideal set
         line-max set
@@ -107,50 +96,50 @@ SYMBOL: line-ideal
 
 PRIVATE>
 
-TUPLE: element key width break? ;
-C: <element> element
+TUPLE: segment key width break? ;
+C: <segment> segment
 
 <PRIVATE
 
-: elements-length ( elements -- length )
+: segments-length ( segments -- length )
     [ width>> ] map sum ;
 
-: make-word ( whites blacks -- word )
-    [ append ] [ [ elements-length ] bi@ ] 2bi <word> ;
+: make-element ( whites blacks -- element )
+    [ append ] [ [ segments-length ] bi@ ] 2bi <element> ;
  
 : ?first2 ( seq -- first/f second/f )
     [ 0 swap ?nth ]
     [ 1 swap ?nth ] bi ;
 
-: split-elements ( seq -- half-words )
+: split-segments ( seq -- half-elements )
     [ [ break?>> ] bi@ = ] monotonic-split ;
 
-: ?first-break ( seq -- newseq f/word )
+: ?first-break ( seq -- newseq f/element )
     dup first first break?>>
-    [ unclip-slice f swap make-word ]
+    [ unclip-slice f swap make-element ]
     [ f ] if ;
 
-: make-words ( seq f/word -- words )
-    [ 2 <groups> [ ?first2 make-word ] map ] dip
+: make-elements ( seq f/element -- elements )
+    [ 2 <groups> [ ?first2 make-element ] map ] dip
     [ prefix ] when* ;
 
-: elements>words ( seq -- newseq )
-    split-elements ?first-break make-words ;
+: segments>elements ( seq -- newseq )
+    split-segments ?first-break make-elements ;
 
 PRIVATE>
 
-: wrap-elements ( elements line-max line-ideal -- lines )
-    [ elements>words ] 2dip wrap [ concat ] map ;
+: wrap-segments ( segments line-max line-ideal -- lines )
+    [ segments>elements ] 2dip wrap [ concat ] map ;
 
 <PRIVATE
 
-: split-lines ( string -- words-lines )
+: split-lines ( string -- elements-lines )
     string-lines [
         " \t" split harvest
-        [ dup length 1 <word> ] map
+        [ dup length 1 <element> ] map
     ] map ;
 
-: join-words ( wrapped-lines -- lines )
+: join-elements ( wrapped-lines -- lines )
     [ " " join ] map ;
 
 : join-lines ( strings -- string )
@@ -159,7 +148,7 @@ PRIVATE>
 PRIVATE>
 
 : wrap-lines ( lines width -- newlines )
-    [ split-lines ] dip '[ _ dup wrap join-words ] map concat ;
+    [ split-lines ] dip '[ _ dup wrap join-elements ] map concat ;
 
 : wrap-string ( string width -- newstring )
     wrap-lines join-lines ;
diff --git a/extra/lists/lazy/lazy-tests.factor b/extra/lists/lazy/lazy-tests.factor
index 5749f94364..03221841c1 100644
--- a/extra/lists/lazy/lazy-tests.factor
+++ b/extra/lists/lazy/lazy-tests.factor
@@ -1,6 +1,5 @@
 ! Copyright (C) 2006 Matthew Willis and Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-!
 USING: lists lists.lazy tools.test kernel math io sequences ;
 IN: lists.lazy.tests
 
@@ -27,3 +26,10 @@ IN: lists.lazy.tests
 [ { 4 5 6 } ] [ 
     3 { 1 2 3 } >list [ + ] lazy-map-with list>array
 ] unit-test
+
+[ [ ] lmap ] must-infer
+[ [ ] lmap>array ] must-infer
+[ [ drop ] foldr ] must-infer
+[ [ drop ] foldl ] must-infer
+[ [ drop ] leach ] must-infer
+[ lnth ] must-infer
diff --git a/extra/lists/lazy/lazy.factor b/extra/lists/lazy/lazy.factor
index e60fcbaadf..213285e643 100644
--- a/extra/lists/lazy/lazy.factor
+++ b/extra/lists/lazy/lazy.factor
@@ -1,12 +1,7 @@
-! Copyright (C) 2004 Chris Double.
+! Copyright (C) 2004, 2008 Chris Double, Matthew Willis, James Cash.
 ! See http://factorcode.org/license.txt for BSD license.
-!
-! Updated by Matthew Willis, July 2006
-! Updated by Chris Double, September 2006
-! Updated by James Cash, June 2008
-!
 USING: kernel sequences math vectors arrays namespaces make
-quotations promises combinators io lists accessors ;
+quotations promises combinators io lists accessors call ;
 IN: lists.lazy
 
 M: promise car ( promise -- car )
@@ -86,7 +81,7 @@ C: <lazy-map> lazy-map
 
 M: lazy-map car ( lazy-map -- car )
     [ cons>> car ] keep
-    quot>> call ;
+    quot>> call( old -- new ) ;
 
 M: lazy-map cdr ( lazy-map -- cdr )
     [ cons>> cdr ] keep
@@ -130,7 +125,7 @@ M: lazy-until car ( lazy-until -- car )
      cons>> car ;
 
 M: lazy-until cdr ( lazy-until -- cdr )
-     [ cons>> uncons ] keep quot>> tuck call
+     [ cons>> uncons ] keep quot>> tuck call( elt -- ? )
      [ 2drop nil ] [ luntil ] if ;
 
 M: lazy-until nil? ( lazy-until -- bool )
@@ -150,7 +145,7 @@ M: lazy-while cdr ( lazy-while -- cdr )
      [ cons>> cdr ] keep quot>> lwhile ;
 
 M: lazy-while nil? ( lazy-while -- bool )
-     [ car ] keep quot>> call not ;
+     [ car ] keep quot>> call( elt -- ? ) not ;
 
 TUPLE: lazy-filter cons quot ;
 
@@ -160,7 +155,7 @@ C: <lazy-filter> lazy-filter
     over nil? [ 2drop nil ] [ <lazy-filter> <memoized-cons> ] if ;
 
 : car-filter? ( lazy-filter -- ? )
-    [ cons>> car ] [ quot>> ] bi call ;
+    [ cons>> car ] [ quot>> ] bi call( elt -- ? ) ;
 
 : skip ( lazy-filter -- )
     dup cons>> cdr >>cons drop ;
@@ -221,7 +216,7 @@ M: lazy-from-by car ( lazy-from-by -- car )
 
 M: lazy-from-by cdr ( lazy-from-by -- cdr )
     [ n>> ] keep
-    quot>> dup slip lfrom-by ;
+    quot>> [ call( old -- new ) ] keep lfrom-by ;
 
 M: lazy-from-by nil? ( lazy-from-by -- bool )
     drop f ;
@@ -355,7 +350,8 @@ M: lazy-io car ( lazy-io -- car )
     dup car>> dup [
         nip
     ] [
-        drop dup stream>> over quot>> call
+        drop dup stream>> over quot>>
+        call( stream -- value )
         >>car
     ] if ;
 
diff --git a/extra/lists/lists.factor b/extra/lists/lists.factor
index bf822889e3..5568b9d53e 100644
--- a/extra/lists/lists.factor
+++ b/extra/lists/lists.factor
@@ -1,7 +1,6 @@
 ! Copyright (C) 2008 James Cash
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences accessors math arrays vectors classes words locals ;
-
 IN: lists
 
 ! List Protocol
@@ -46,7 +45,7 @@ M: object nil? drop f ;
 : 2car ( cons -- car caar )    
     [ car ] [ cdr car ] bi ;
     
-: 3car ( cons -- car caar caaar )    
+: 3car ( cons -- car cadr caddr )    
     [ car ] [ cdr car ] [ cdr cdr car ] tri ;
 
 : lnth ( n list -- elt )
@@ -109,4 +108,4 @@ M: object nil? drop f ;
     [ 2over call [ tuck [ call ] 2dip ] when
       pick list? [ traverse ] [ 2drop ] if ] 2curry lmap ; inline recursive
     
-INSTANCE: cons list
\ No newline at end of file
+INSTANCE: cons list
diff --git a/extra/promises/promises.factor b/extra/promises/promises.factor
index 38366697ea..bec2761e53 100755
--- a/extra/promises/promises.factor
+++ b/extra/promises/promises.factor
@@ -1,10 +1,6 @@
-! Copyright (C) 2004 Chris Double.
+! Copyright (C) 2004, 2006 Chris Double, Matthew Willis.
 ! See http://factorcode.org/license.txt for BSD license.
-!
-! Updated by Matthew Willis, July 2006
-! Updated by Chris Double, September 2006
-
-USING: arrays kernel sequences math vectors arrays namespaces
+USING: arrays kernel sequences math vectors arrays namespaces call
 make quotations parser effects stack-checker words accessors ;
 IN: promises
 
@@ -24,7 +20,7 @@ TUPLE: promise quot forced? value ;
     #! promises quotation on the stack. Re-forcing the promise
     #! will return the same value and not recall the quotation.
     dup forced?>> [
-        dup quot>> call >>value
+        dup quot>> call( -- value ) >>value
         t >>forced?
     ] unless
     value>> ;

From 89e3eb6fa312ce7fd2ab777d8768fb9cd3e5ce2c Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-103.local>
Date: Sun, 8 Feb 2009 23:49:05 -0600
Subject: [PATCH 39/42] Moving lists to basis

---
 basis/html/templates/chloe/compiler/compiler.factor        | 2 +-
 basis/html/templates/fhtml/fhtml.factor                    | 2 +-
 {extra => basis}/lists/authors.txt                         | 0
 {extra => basis}/lists/lazy/authors.txt                    | 0
 {extra => basis}/lists/lazy/examples/authors.txt           | 0
 {extra => basis}/lists/lazy/examples/examples-tests.factor | 0
 {extra => basis}/lists/lazy/examples/examples.factor       | 0
 {extra => basis}/lists/lazy/lazy-docs.factor               | 0
 {extra => basis}/lists/lazy/lazy-tests.factor              | 0
 {extra => basis}/lists/lazy/lazy.factor                    | 0
 {extra => basis}/lists/lazy/old-doc.html                   | 0
 {extra => basis}/lists/lazy/summary.txt                    | 0
 {extra => basis}/lists/lazy/tags.txt                       | 0
 {extra => basis}/lists/lists-docs.factor                   | 0
 {extra => basis}/lists/lists-tests.factor                  | 0
 {extra => basis}/lists/lists.factor                        | 0
 {extra => basis}/lists/summary.txt                         | 0
 {extra => basis}/lists/tags.txt                            | 0
 18 files changed, 2 insertions(+), 2 deletions(-)
 rename {extra => basis}/lists/authors.txt (100%)
 rename {extra => basis}/lists/lazy/authors.txt (100%)
 rename {extra => basis}/lists/lazy/examples/authors.txt (100%)
 rename {extra => basis}/lists/lazy/examples/examples-tests.factor (100%)
 rename {extra => basis}/lists/lazy/examples/examples.factor (100%)
 rename {extra => basis}/lists/lazy/lazy-docs.factor (100%)
 rename {extra => basis}/lists/lazy/lazy-tests.factor (100%)
 rename {extra => basis}/lists/lazy/lazy.factor (100%)
 rename {extra => basis}/lists/lazy/old-doc.html (100%)
 rename {extra => basis}/lists/lazy/summary.txt (100%)
 rename {extra => basis}/lists/lazy/tags.txt (100%)
 rename {extra => basis}/lists/lists-docs.factor (100%)
 rename {extra => basis}/lists/lists-tests.factor (100%)
 rename {extra => basis}/lists/lists.factor (100%)
 rename {extra => basis}/lists/summary.txt (100%)
 rename {extra => basis}/lists/tags.txt (100%)

diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor
index 1a1abc9f7b..3cb7523bdc 100644
--- a/basis/html/templates/chloe/compiler/compiler.factor
+++ b/basis/html/templates/chloe/compiler/compiler.factor
@@ -83,7 +83,7 @@ ERROR: unknown-chloe-tag tag ;
 
 : compile-chloe-tag ( tag -- )
     dup main>> dup tags get at
-    [ curry call( -- ) ]
+    [ call( tag -- ) ]
     [ unknown-chloe-tag ]
     ?if ;
 
diff --git a/basis/html/templates/fhtml/fhtml.factor b/basis/html/templates/fhtml/fhtml.factor
index e76a812bef..78202d6460 100644
--- a/basis/html/templates/fhtml/fhtml.factor
+++ b/basis/html/templates/fhtml/fhtml.factor
@@ -72,6 +72,6 @@ TUPLE: fhtml path ;
 C: <fhtml> fhtml
 
 M: fhtml call-template* ( filename -- )
-    '[ _ path>> utf8 file-contents eval-template ] call( -- ) ;
+    [ path>> utf8 file-contents eval-template ] call( filename -- ) ;
 
 INSTANCE: fhtml template
diff --git a/extra/lists/authors.txt b/basis/lists/authors.txt
similarity index 100%
rename from extra/lists/authors.txt
rename to basis/lists/authors.txt
diff --git a/extra/lists/lazy/authors.txt b/basis/lists/lazy/authors.txt
similarity index 100%
rename from extra/lists/lazy/authors.txt
rename to basis/lists/lazy/authors.txt
diff --git a/extra/lists/lazy/examples/authors.txt b/basis/lists/lazy/examples/authors.txt
similarity index 100%
rename from extra/lists/lazy/examples/authors.txt
rename to basis/lists/lazy/examples/authors.txt
diff --git a/extra/lists/lazy/examples/examples-tests.factor b/basis/lists/lazy/examples/examples-tests.factor
similarity index 100%
rename from extra/lists/lazy/examples/examples-tests.factor
rename to basis/lists/lazy/examples/examples-tests.factor
diff --git a/extra/lists/lazy/examples/examples.factor b/basis/lists/lazy/examples/examples.factor
similarity index 100%
rename from extra/lists/lazy/examples/examples.factor
rename to basis/lists/lazy/examples/examples.factor
diff --git a/extra/lists/lazy/lazy-docs.factor b/basis/lists/lazy/lazy-docs.factor
similarity index 100%
rename from extra/lists/lazy/lazy-docs.factor
rename to basis/lists/lazy/lazy-docs.factor
diff --git a/extra/lists/lazy/lazy-tests.factor b/basis/lists/lazy/lazy-tests.factor
similarity index 100%
rename from extra/lists/lazy/lazy-tests.factor
rename to basis/lists/lazy/lazy-tests.factor
diff --git a/extra/lists/lazy/lazy.factor b/basis/lists/lazy/lazy.factor
similarity index 100%
rename from extra/lists/lazy/lazy.factor
rename to basis/lists/lazy/lazy.factor
diff --git a/extra/lists/lazy/old-doc.html b/basis/lists/lazy/old-doc.html
similarity index 100%
rename from extra/lists/lazy/old-doc.html
rename to basis/lists/lazy/old-doc.html
diff --git a/extra/lists/lazy/summary.txt b/basis/lists/lazy/summary.txt
similarity index 100%
rename from extra/lists/lazy/summary.txt
rename to basis/lists/lazy/summary.txt
diff --git a/extra/lists/lazy/tags.txt b/basis/lists/lazy/tags.txt
similarity index 100%
rename from extra/lists/lazy/tags.txt
rename to basis/lists/lazy/tags.txt
diff --git a/extra/lists/lists-docs.factor b/basis/lists/lists-docs.factor
similarity index 100%
rename from extra/lists/lists-docs.factor
rename to basis/lists/lists-docs.factor
diff --git a/extra/lists/lists-tests.factor b/basis/lists/lists-tests.factor
similarity index 100%
rename from extra/lists/lists-tests.factor
rename to basis/lists/lists-tests.factor
diff --git a/extra/lists/lists.factor b/basis/lists/lists.factor
similarity index 100%
rename from extra/lists/lists.factor
rename to basis/lists/lists.factor
diff --git a/extra/lists/summary.txt b/basis/lists/summary.txt
similarity index 100%
rename from extra/lists/summary.txt
rename to basis/lists/summary.txt
diff --git a/extra/lists/tags.txt b/basis/lists/tags.txt
similarity index 100%
rename from extra/lists/tags.txt
rename to basis/lists/tags.txt

From 57ac121d2b87ab5c3cfd541ec898403e4a0ce273 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-103.local>
Date: Mon, 9 Feb 2009 00:33:30 -0600
Subject: [PATCH 40/42] adding execute( -- ) and documentation for basis/call

---
 basis/call/call-docs.factor  | 32 ++++++++++++++++++++++++++++++++
 basis/call/call-tests.factor |  5 +++++
 basis/call/call.factor       |  8 +++++++-
 3 files changed, 44 insertions(+), 1 deletion(-)
 create mode 100644 basis/call/call-docs.factor

diff --git a/basis/call/call-docs.factor b/basis/call/call-docs.factor
new file mode 100644
index 0000000000..463bfdac09
--- /dev/null
+++ b/basis/call/call-docs.factor
@@ -0,0 +1,32 @@
+! Copyright (C) 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax quotations effects words ;
+IN: call
+
+ABOUT: "call"
+
+ARTICLE: "call" "Calling code with known stack effects"
+"The " { $vocab-link "call" } " vocabulary allows for arbitrary quotations to be called from code accepted by the optimizing compiler. This is done by specifying the stack effect of the quotation literally. It is checked at runtime that the stack effect is accurate."
+{ $subsection POSTPONE: call( }
+{ $subsection POSTPONE: execute( }
+{ $subsection call-effect }
+{ $subsection execute-effect } ;
+
+HELP: call(
+{ $syntax "[ ] call( foo -- bar )" }
+{ $description "Calls the quotation on the top of the stack, asserting that it has the given stack effect. The quotation does not need to be known at compile time." } ;
+
+HELP: call-effect
+{ $values { "quot" quotation } { "effect" effect } }
+{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." } ;
+
+HELP: execute(
+{ $syntax "word execute( foo -- bar )" }
+{ $description "Calls the word on the top of the stack, aserting that it has the given stack effect. The word does not need to be known at compile time." } ;
+
+HELP: execute-effect
+{ $values { "word" word } { "effect" effect } }
+{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." } ;
+
+{ execute-effect call-effect } related-words
+{ POSTPONE: call( POSTPONE: execute( } related-words
diff --git a/basis/call/call-tests.factor b/basis/call/call-tests.factor
index 4a59a6d2fb..a2bd11b06a 100644
--- a/basis/call/call-tests.factor
+++ b/basis/call/call-tests.factor
@@ -8,3 +8,8 @@ IN: call.tests
 [ 1 2 [ + ] call( x y -- z a ) ] must-fail
 [ 1 2 3 { 4 } ] [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test
 [ [ + ] call( x y -- z ) ] must-infer
+
+[ 3 ] [ 1 2 \ + execute( x y -- z ) ] unit-test
+[ 1 2 \ + execute( -- z ) ] must-fail
+[ 1 2 \ + execute( x y -- z a ) ] must-fail
+[ \ + execute( x y -- z ) ] must-infer
diff --git a/basis/call/call.factor b/basis/call/call.factor
index 363b024dff..9b49acf64a 100644
--- a/basis/call/call.factor
+++ b/basis/call/call.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel macros fry summary sequences generalizations accessors
-continuations effects.parser parser ;
+continuations effects.parser parser words ;
 IN: call
 
 ERROR: wrong-values values quot length-required ;
@@ -22,3 +22,9 @@ MACRO: call-effect ( effect -- quot )
 
 : call(
     ")" parse-effect parsed \ call-effect parsed ; parsing
+
+: execute-effect ( word effect -- )
+    [ [ execute ] curry ] dip call-effect ; inline
+
+: execute(
+    ")" parse-effect parsed \ execute-effect parsed ; parsing

From 3e5ec77439381fe12318d4faecc925a953f7cace Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-103.local>
Date: Mon, 9 Feb 2009 01:12:32 -0600
Subject: [PATCH 41/42] Splitting up basis/wrap into three vocabs

---
 basis/wrap/strings/strings-docs.factor  |  25 +++++
 basis/wrap/strings/strings-tests.factor |  41 ++++++++
 basis/wrap/strings/strings.factor       |  29 ++++++
 basis/wrap/words/words-docs.factor      |  25 +++++
 basis/wrap/words/words-tests.factor     |  82 ++++++++++++++++
 basis/wrap/words/words.factor           |  40 ++++++++
 basis/wrap/wrap-docs.factor             |  36 +-------
 basis/wrap/wrap-tests.factor            | 118 ------------------------
 basis/wrap/wrap.factor                  |  66 +------------
 basis/xml/writer/writer.factor          |   2 +-
 10 files changed, 248 insertions(+), 216 deletions(-)
 create mode 100644 basis/wrap/strings/strings-docs.factor
 create mode 100644 basis/wrap/strings/strings-tests.factor
 create mode 100644 basis/wrap/strings/strings.factor
 create mode 100644 basis/wrap/words/words-docs.factor
 create mode 100644 basis/wrap/words/words-tests.factor
 create mode 100644 basis/wrap/words/words.factor
 delete mode 100644 basis/wrap/wrap-tests.factor

diff --git a/basis/wrap/strings/strings-docs.factor b/basis/wrap/strings/strings-docs.factor
new file mode 100644
index 0000000000..e20780d3ac
--- /dev/null
+++ b/basis/wrap/strings/strings-docs.factor
@@ -0,0 +1,25 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup strings math ;
+IN: wrap.strings
+
+ABOUT: "wrap.strings"
+
+ARTICLE: "wrap.strings" "String word wrapping"
+"The " { $vocab-link "wrap.strings" } " vocabulary implements word wrapping for simple strings, assumed to be in monospace font."
+{ $subsection wrap-lines }
+{ $subsection wrap-string }
+{ $subsection wrap-indented-string } ;
+
+HELP: wrap-lines
+{ $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } }
+{ $description "Given a string, divides it into a sequence of lines where each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
+
+HELP: wrap-string
+{ $values { "string" string } { "width" integer } { "newstring" string } }
+{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
+
+HELP: wrap-indented-string
+{ $values { "string" string } { "width" integer } { "indent" string } { "newstring" string } }
+{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space. Before each line, the indent string is added." } ;
+
diff --git a/basis/wrap/strings/strings-tests.factor b/basis/wrap/strings/strings-tests.factor
new file mode 100644
index 0000000000..0bea9b5d32
--- /dev/null
+++ b/basis/wrap/strings/strings-tests.factor
@@ -0,0 +1,41 @@
+! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: wrap.strings tools.test multiline ;
+IN: wrap.strings.tests
+
+[
+    <" This is a
+long piece
+of text
+that we
+wish to
+word wrap.">
+] [
+    <" This is a long piece of text that we wish to word wrap."> 10
+    wrap-string
+] unit-test
+    
+[
+    <"   This is a
+  long piece
+  of text
+  that we
+  wish to
+  word wrap.">
+] [
+    <" This is a long piece of text that we wish to word wrap."> 12
+    "  " wrap-indented-string
+] unit-test
+
+[ "this text\nhas lots\nof spaces" ]
+[ "this text        has lots of       spaces" 12 wrap-string ] unit-test
+
+[ "hello\nhow\nare\nyou\ntoday?" ]
+[ "hello how are you today?" 3 wrap-string ] unit-test
+
+[ "aaa\nbb cc\nddddd" ] [ "aaa bb cc ddddd" 6 wrap-string ] unit-test
+[ "aaa\nbb ccc\ndddddd" ] [ "aaa bb ccc dddddd" 6 wrap-string ] unit-test
+[ "aaa bb\ncccc\nddddd" ] [ "aaa bb cccc ddddd" 6 wrap-string ] unit-test
+[ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test
+
+\ wrap-string must-infer
diff --git a/basis/wrap/strings/strings.factor b/basis/wrap/strings/strings.factor
new file mode 100644
index 0000000000..7009352f2a
--- /dev/null
+++ b/basis/wrap/strings/strings.factor
@@ -0,0 +1,29 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: wrap kernel sequences fry splitting math ;
+IN: wrap.strings
+
+<PRIVATE
+
+: split-lines ( string -- elements-lines )
+    string-lines [
+        " \t" split harvest
+        [ dup length 1 <element> ] map
+    ] map ;
+
+: join-elements ( wrapped-lines -- lines )
+    [ " " join ] map ;
+
+: join-lines ( strings -- string )
+    "\n" join ;
+
+PRIVATE>
+
+: wrap-lines ( lines width -- newlines )
+    [ split-lines ] dip '[ _ dup wrap join-elements ] map concat ;
+
+: wrap-string ( string width -- newstring )
+    wrap-lines join-lines ;
+
+: wrap-indented-string ( string width indent -- newstring )
+    [ length - wrap-lines ] keep '[ _ prepend ] map join-lines ;
diff --git a/basis/wrap/words/words-docs.factor b/basis/wrap/words/words-docs.factor
new file mode 100644
index 0000000000..422aea0ac3
--- /dev/null
+++ b/basis/wrap/words/words-docs.factor
@@ -0,0 +1,25 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup math kernel ;
+IN: wrap.words
+
+ABOUT: "wrap.words"
+
+ARTICLE: "wrap.words" "Word object wrapping"
+"The " { $vocab-link "wrap.words" } " vocabulary implements word wrapping on abstract word objects, which have certain properties making it a more suitable input representation than strings."
+{ $subsection wrap-words }
+{ $subsection word }
+{ $subsection <word> } ;
+
+HELP: wrap-words
+{ $values { "words" { "a sequence of " { $instance word } "s" } } { "line-max" integer } { "line-ideal" integer } { "lines" "a sequence of sequences of words" } }
+{ $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given maximum. The returned set of lines is optimized to minimize the square of the deviation of each line from the ideal width. It is not guaranteed to be the minimal number of lines. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ;
+
+HELP: word
+{ $class-description "A word is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Words can be created with " { $link <word> } "." }
+{ $see-also wrap-words } ;
+
+HELP: <word>
+{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "word" word } }
+{ $description "Creates a " { $link word } " object with the given parameters." }
+{ $see-also wrap-words } ;
diff --git a/basis/wrap/words/words-tests.factor b/basis/wrap/words/words-tests.factor
new file mode 100644
index 0000000000..7598b382ba
--- /dev/null
+++ b/basis/wrap/words/words-tests.factor
@@ -0,0 +1,82 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test wrap.words sequences ;
+IN: wrap.words.tests    
+
+[
+    {
+        {
+            T{ word f 1 10 f }
+            T{ word f 2 10 f }
+            T{ word f 3 2 t }
+        }
+        {
+            T{ word f 4 10 f }
+            T{ word f 5 10 f }
+        }
+    }
+] [
+    {
+        T{ word f 1 10 f }
+        T{ word f 2 10 f }
+        T{ word f 3 2 t }
+        T{ word f 4 10 f }
+        T{ word f 5 10 f }
+    } 35 35 wrap-words [ { } like ] map
+] unit-test
+
+[
+    {
+        {
+            T{ word f 1 10 f }
+            T{ word f 2 10 f }
+            T{ word f 3 9 t }
+            T{ word f 3 9 t }
+            T{ word f 3 9 t }
+        }
+        {
+            T{ word f 4 10 f }
+            T{ word f 5 10 f }
+        }
+    }
+] [
+    {
+        T{ word f 1 10 f }
+        T{ word f 2 10 f }
+        T{ word f 3 9 t }
+        T{ word f 3 9 t }
+        T{ word f 3 9 t }
+        T{ word f 4 10 f }
+        T{ word f 5 10 f }
+    } 35 35 wrap-words [ { } like ] map
+] unit-test
+
+[
+    {
+        {
+            T{ word f 1 10 t }
+            T{ word f 1 10 f }
+            T{ word f 3 9 t }
+        }
+        {
+            T{ word f 2 10 f }
+            T{ word f 3 9 t }
+        }
+        {
+            T{ word f 4 10 f }
+            T{ word f 5 10 f }
+        }
+    }
+] [
+    {
+        T{ word f 1 10 t }
+        T{ word f 1 10 f }
+        T{ word f 3 9 t }
+        T{ word f 2 10 f }
+        T{ word f 3 9 t }
+        T{ word f 4 10 f }
+        T{ word f 5 10 f }
+    } 35 35 wrap-words [ { } like ] map
+] unit-test
+
+\ wrap-words must-infer
diff --git a/basis/wrap/words/words.factor b/basis/wrap/words/words.factor
new file mode 100644
index 0000000000..00f257a5cf
--- /dev/null
+++ b/basis/wrap/words/words.factor
@@ -0,0 +1,40 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences kernel splitting.monotonic accessors wrap grouping ;
+IN: wrap.words
+
+TUPLE: word key width break? ;
+C: <word> word
+
+<PRIVATE
+
+: words-length ( words -- length )
+    [ width>> ] map sum ;
+
+: make-element ( whites blacks -- element )
+    [ append ] [ [ words-length ] bi@ ] 2bi <element> ;
+ 
+: ?first2 ( seq -- first/f second/f )
+    [ 0 swap ?nth ]
+    [ 1 swap ?nth ] bi ;
+
+: split-words ( seq -- half-elements )
+    [ [ break?>> ] bi@ = ] monotonic-split ;
+
+: ?first-break ( seq -- newseq f/element )
+    dup first first break?>>
+    [ unclip-slice f swap make-element ]
+    [ f ] if ;
+
+: make-elements ( seq f/element -- elements )
+    [ 2 <groups> [ ?first2 make-element ] map ] dip
+    [ prefix ] when* ;
+
+: words>elements ( seq -- newseq )
+    split-words ?first-break make-elements ;
+
+PRIVATE>
+
+: wrap-words ( words line-max line-ideal -- lines )
+    [ words>elements ] 2dip wrap [ concat ] map ;
+
diff --git a/basis/wrap/wrap-docs.factor b/basis/wrap/wrap-docs.factor
index 59c0352bc7..feac7c51a7 100644
--- a/basis/wrap/wrap-docs.factor
+++ b/basis/wrap/wrap-docs.factor
@@ -6,36 +6,6 @@ IN: wrap
 ABOUT: "wrap"
 
 ARTICLE: "wrap" "Word wrapping"
-"The " { $vocab-link "wrap" } " vocabulary implements word wrapping. There is support for simple string wrapping, with the following words:"
-{ $subsection wrap-lines }
-{ $subsection wrap-string }
-{ $subsection wrap-indented-string }
-"Additionally, the vocabulary provides capabilities to wrap arbitrary groups of things, in units called segments."
-{ $subsection wrap-segments }
-{ $subsection segment }
-{ $subsection <segment> } ;
-
-HELP: wrap-lines
-{ $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } }
-{ $description "Given a string, divides it into a sequence of lines where each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
-
-HELP: wrap-string
-{ $values { "string" string } { "width" integer } { "newstring" string } }
-{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
-
-HELP: wrap-indented-string
-{ $values { "string" string } { "width" integer } { "indent" string } { "newstring" string } }
-{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space. Before each line, the indent string is added." } ;
-
-HELP: wrap-segments
-{ $values { "segments" { "a sequence of " { $instance segment } "s" } } { "line-max" integer } { "line-ideal" integer } { "lines" "a sequence of sequences of words" } }
-{ $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given maximum. The returned set of lines is optimized to minimize the square of the deviation of each line from the ideal width. It is not guaranteed to be the minimal number of lines. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ;
-
-HELP: segment
-{ $class-description "A segment is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Elements can be created with " { $link <segment> } "." }
-{ $see-also wrap-segments } ;
-
-HELP: <segment>
-{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "segment" segment } }
-{ $description "Creates a " { $link segment } " object with the given parameters." }
-{ $see-also wrap-segments } ;
+"The " { $vocab-link "wrap" } " vocabulary implements word wrapping. Wrapping can take place based on simple strings, assumed to be monospace, or abstract word objects."
+{ $vocab-subsection "String word wrapping" "wrap.strings" } 
+{ $vocab-subsection "Word object wrapping" "wrap.words" } ;
diff --git a/basis/wrap/wrap-tests.factor b/basis/wrap/wrap-tests.factor
deleted file mode 100644
index eeea3850d5..0000000000
--- a/basis/wrap/wrap-tests.factor
+++ /dev/null
@@ -1,118 +0,0 @@
-! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test wrap multiline sequences ;
-IN: wrap.tests
-    
-[
-    {
-        {
-            T{ segment f 1 10 f }
-            T{ segment f 2 10 f }
-            T{ segment f 3 2 t }
-        }
-        {
-            T{ segment f 4 10 f }
-            T{ segment f 5 10 f }
-        }
-    }
-] [
-    {
-        T{ segment f 1 10 f }
-        T{ segment f 2 10 f }
-        T{ segment f 3 2 t }
-        T{ segment f 4 10 f }
-        T{ segment f 5 10 f }
-    } 35 35 wrap-segments [ { } like ] map
-] unit-test
-
-[
-    {
-        {
-            T{ segment f 1 10 f }
-            T{ segment f 2 10 f }
-            T{ segment f 3 9 t }
-            T{ segment f 3 9 t }
-            T{ segment f 3 9 t }
-        }
-        {
-            T{ segment f 4 10 f }
-            T{ segment f 5 10 f }
-        }
-    }
-] [
-    {
-        T{ segment f 1 10 f }
-        T{ segment f 2 10 f }
-        T{ segment f 3 9 t }
-        T{ segment f 3 9 t }
-        T{ segment f 3 9 t }
-        T{ segment f 4 10 f }
-        T{ segment f 5 10 f }
-    } 35 35 wrap-segments [ { } like ] map
-] unit-test
-
-[
-    {
-        {
-            T{ segment f 1 10 t }
-            T{ segment f 1 10 f }
-            T{ segment f 3 9 t }
-        }
-        {
-            T{ segment f 2 10 f }
-            T{ segment f 3 9 t }
-        }
-        {
-            T{ segment f 4 10 f }
-            T{ segment f 5 10 f }
-        }
-    }
-] [
-    {
-        T{ segment f 1 10 t }
-        T{ segment f 1 10 f }
-        T{ segment f 3 9 t }
-        T{ segment f 2 10 f }
-        T{ segment f 3 9 t }
-        T{ segment f 4 10 f }
-        T{ segment f 5 10 f }
-    } 35 35 wrap-segments [ { } like ] map
-] unit-test
-
-[
-    <" This is a
-long piece
-of text
-that we
-wish to
-word wrap.">
-] [
-    <" This is a long piece of text that we wish to word wrap."> 10
-    wrap-string
-] unit-test
-    
-[
-    <"   This is a
-  long piece
-  of text
-  that we
-  wish to
-  word wrap.">
-] [
-    <" This is a long piece of text that we wish to word wrap."> 12
-    "  " wrap-indented-string
-] unit-test
-
-[ "this text\nhas lots\nof spaces" ]
-[ "this text        has lots of       spaces" 12 wrap-string ] unit-test
-
-[ "hello\nhow\nare\nyou\ntoday?" ]
-[ "hello how are you today?" 3 wrap-string ] unit-test
-
-[ "aaa\nbb cc\nddddd" ] [ "aaa bb cc ddddd" 6 wrap-string ] unit-test
-[ "aaa\nbb ccc\ndddddd" ] [ "aaa bb ccc dddddd" 6 wrap-string ] unit-test
-[ "aaa bb\ncccc\nddddd" ] [ "aaa bb cccc ddddd" 6 wrap-string ] unit-test
-[ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test
-
-\ wrap-string must-infer
-\ wrap-segments must-infer
diff --git a/basis/wrap/wrap.factor b/basis/wrap/wrap.factor
index f54c858bf4..55fe10283a 100644
--- a/basis/wrap/wrap.factor
+++ b/basis/wrap/wrap.factor
@@ -1,10 +1,10 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences math arrays locals fry accessors
 lists splitting call make combinators.short-circuit namespaces
 grouping splitting.monotonic ;
 IN: wrap
 
-<PRIVATE
-
 ! black is the text length, white is the whitespace length
 TUPLE: element contents black white ;
 C: <element> element
@@ -93,65 +93,3 @@ SYMBOL: line-ideal
         min-cost
         post-process
     ] with-scope ;
-
-PRIVATE>
-
-TUPLE: segment key width break? ;
-C: <segment> segment
-
-<PRIVATE
-
-: segments-length ( segments -- length )
-    [ width>> ] map sum ;
-
-: make-element ( whites blacks -- element )
-    [ append ] [ [ segments-length ] bi@ ] 2bi <element> ;
- 
-: ?first2 ( seq -- first/f second/f )
-    [ 0 swap ?nth ]
-    [ 1 swap ?nth ] bi ;
-
-: split-segments ( seq -- half-elements )
-    [ [ break?>> ] bi@ = ] monotonic-split ;
-
-: ?first-break ( seq -- newseq f/element )
-    dup first first break?>>
-    [ unclip-slice f swap make-element ]
-    [ f ] if ;
-
-: make-elements ( seq f/element -- elements )
-    [ 2 <groups> [ ?first2 make-element ] map ] dip
-    [ prefix ] when* ;
-
-: segments>elements ( seq -- newseq )
-    split-segments ?first-break make-elements ;
-
-PRIVATE>
-
-: wrap-segments ( segments line-max line-ideal -- lines )
-    [ segments>elements ] 2dip wrap [ concat ] map ;
-
-<PRIVATE
-
-: split-lines ( string -- elements-lines )
-    string-lines [
-        " \t" split harvest
-        [ dup length 1 <element> ] map
-    ] map ;
-
-: join-elements ( wrapped-lines -- lines )
-    [ " " join ] map ;
-
-: join-lines ( strings -- string )
-    "\n" join ;
-
-PRIVATE>
-
-: wrap-lines ( lines width -- newlines )
-    [ split-lines ] dip '[ _ dup wrap join-elements ] map concat ;
-
-: wrap-string ( string width -- newstring )
-    wrap-lines join-lines ;
-
-: wrap-indented-string ( string width indent -- newstring )
-    [ length - wrap-lines ] keep '[ _ prepend ] map join-lines ;
diff --git a/basis/xml/writer/writer.factor b/basis/xml/writer/writer.factor
index 4b80e0818e..4f5bad1aa5 100755
--- a/basis/xml/writer/writer.factor
+++ b/basis/xml/writer/writer.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: hashtables kernel math namespaces sequences strings
 assocs combinators io io.streams.string accessors
-xml.data wrap xml.entities unicode.categories fry ;
+xml.data wrap.strings xml.entities unicode.categories fry ;
 IN: xml.writer
 
 SYMBOL: sensitive-tags

From 25d20c6000d36dc0d04c52ad5b2998bb23a1af2b Mon Sep 17 00:00:00 2001
From: Nicholas Seckar <nseckar@gmail.com>
Date: Sun, 8 Feb 2009 23:45:59 -0800
Subject: [PATCH 42/42] Update docs for GENERIC: GENERIC# and HOOK to show
 stack effect decl

---
 core/syntax/syntax-docs.factor | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor
index e08821bddd..035622454f 100644
--- a/core/syntax/syntax-docs.factor
+++ b/core/syntax/syntax-docs.factor
@@ -551,12 +551,12 @@ HELP: BIN:
 { $examples { $example "USE: prettyprint" "BIN: 100 ." "4" } } ;
 
 HELP: GENERIC:
-{ $syntax "GENERIC: word" }
+{ $syntax "GENERIC: word" "GENERIC: word ( stack -- effect )" }
 { $values { "word" "a new word to define" } }
 { $description "Defines a new generic word in the current vocabulary. Initially, it contains no methods, and thus will throw a " { $link no-method } " error when called." } ;
 
 HELP: GENERIC#
-{ $syntax "GENERIC# word n" }
+{ $syntax "GENERIC# word n" "GENERIC# word n ( stack -- effect )" }
 { $values { "word" "a new word to define" } { "n" "the stack position to dispatch on" } }
 { $description "Defines a new generic word which dispatches on the " { $snippet "n" } "th most element from the top of the stack in the current vocabulary. Initially, it contains no methods, and thus will throw a " { $link no-method } " error when called." }
 { $notes
@@ -571,7 +571,7 @@ HELP: MATH:
 { $description "Defines a new generic word which uses the " { $link math-combination } " method combination." } ;
 
 HELP: HOOK:
-{ $syntax "HOOK: word variable" }
+{ $syntax "HOOK: word variable" "HOOK: word variable ( stack -- effect ) " }
 { $values { "word" "a new word to define" } { "variable" word } }
 { $description "Defines a new hook word in the current vocabulary. Hook words are generic words which dispatch on the value of a variable, so methods are defined with " { $link POSTPONE: M: } ". Hook words differ from other generic words in that the dispatch value is removed from the stack before the chosen method is called." }
 { $examples