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 1/8] 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 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 2/8] 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 3/8] 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 4/8] 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 5/8] 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 6/8] 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 7/8] 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 8/8] 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>> ;