Remove usages of delegation from core io

core/io/streams/duplex/duplex-docs.factor

@@ -10,7 +10,7 @@ ARTICLE: "io.streams.duplex" "Duplex streams"
 ABOUT: "io.streams.duplex"
 
 HELP: duplex-stream
-{ $class-description "A bidirectional stream delegating to a pair of streams, sending input to one delegate and output to another." } ;
+{ $class-description "A bidirectional stream wrapping an input and output stream." } ;
 
 HELP: <duplex-stream>
 { $values { "in" "an input stream" } { "out" "an output stream" } { "stream" " a duplex stream" } }

core/io/streams/nested/nested.factor

@@ -1,30 +1,57 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: io.streams.nested
 USING: arrays generic assocs kernel namespaces strings
-quotations io continuations ;
+quotations io continuations accessors ;
+IN: io.streams.nested
 
-TUPLE: ignore-close-stream ;
+TUPLE: filter-writer stream ;
 
-: <ignore-close-stream> ignore-close-stream construct-delegate ;
+M: filter-writer stream-format
+    stream>> stream-format ;
 
-M: ignore-close-stream dispose drop ;
+M: filter-writer stream-write
+    stream>> stream-write ;
 
-TUPLE: style-stream style ;
+M: filter-writer stream-write1
+    stream>> stream-write1 ;
 
-: do-nested-style ( style stream -- style delegate )
+M: filter-writer make-span-stream
-    [ style-stream-style swap union ] keep
+    stream>> make-span-stream ;
-    delegate ; inline
 
-: <style-stream> ( style delegate -- stream )
+M: filter-writer make-block-stream
-    { set-style-stream-style set-delegate }
+    stream>> make-block-stream ;
-    style-stream construct ;
+
+M: filter-writer make-cell-stream
+    stream>> make-cell-stream ;
+
+M: filter-writer stream-flush
+    stream>> stream-flush ;
+
+M: filter-writer stream-nl
+    stream>> stream-nl ;
+
+M: filter-writer stream-write-table
+    stream>> stream-write-table ;
+
+M: filter-writer dispose
+    drop ;
+
+TUPLE: ignore-close-stream < filter-writer ;
+
+C: <ignore-close-stream> ignore-close-stream
+
+TUPLE: style-stream < filter-writer style ;
+
+: do-nested-style ( style style-stream -- style stream )
+    [ style>> swap union ] [ stream>> ] bi ; inline
+
+C: <style-stream> style-stream
 
 M: style-stream stream-format
     do-nested-style stream-format ;
 
 M: style-stream stream-write
-    dup style-stream-style swap delegate stream-format ;
+    [ style>> ] [ stream>> ] bi stream-format ;
 
 M: style-stream stream-write1
     >r 1string r> stream-write ;
@@ -33,15 +60,9 @@ M: style-stream make-span-stream
     do-nested-style make-span-stream ;
 
 M: style-stream make-block-stream
-    [ do-nested-style make-block-stream ] keep
+    [ do-nested-style make-block-stream ] [ style>> ] bi
-    style-stream-style swap <style-stream> ;
+    <style-stream> ;
 
 M: style-stream make-cell-stream
-    [ do-nested-style make-cell-stream ] keep
+    [ do-nested-style make-cell-stream ] [ style>> ] bi
-    style-stream-style swap <style-stream> ;
+    <style-stream> ;
-
-TUPLE: block-stream ;
-
-: <block-stream> block-stream construct-delegate ;
-
-M: block-stream dispose drop ;

core/io/streams/plain/plain.factor

@@ -12,7 +12,7 @@ M: plain-writer stream-format
     nip stream-write ;
 
 M: plain-writer make-span-stream
-    <style-stream> <ignore-close-stream> ;
+    swap <style-stream> ;
 
 M: plain-writer make-block-stream
     nip <ignore-close-stream> ;

core/prettyprint/sections/sections-docs.factor

@@ -86,7 +86,7 @@ HELP: section
     { { $snippet "overhang" } " - number of columns which must be left blank before the wrap margin for the prettyprinter to consider emitting this section as a " { $link short-section } ". Avoids lone hanging closing brackets" }
 } } ;
 
-HELP: <section>
+HELP: construct-section
 { $values { "style" hashtable } { "length" integer } { "section" section } }
 { $description "Creates a new section with the given length starting from " { $link position } ", advancing " { $link position } "." } ;
 

core/prettyprint/sections/sections.factor

@@ -11,37 +11,38 @@ SYMBOL: position
 SYMBOL: recursion-check
 SYMBOL: pprinter-stack
 
-SYMBOL: last-newline
-SYMBOL: line-count
-SYMBOL: end-printing
-SYMBOL: indent
-
 ! We record vocabs of all words
 SYMBOL: pprinter-in
 SYMBOL: pprinter-use
 
+TUPLE: pprinter last-newline line-count end-printing indent ;
+
+: <pprinter> ( -- pprinter ) 0 1 f 0 pprinter construct-boa ;
+
 : record-vocab ( word -- )
     word-vocabulary [ dup pprinter-use get set-at ] when* ;
 
 ! Utility words
 : line-limit? ( -- ? )
-    line-limit get dup [ line-count get <= ] when ;
+    line-limit get dup [ pprinter get line-count>> <= ] when ;
 
-: do-indent ( -- ) indent get CHAR: \s <string> write ;
+: do-indent ( -- ) pprinter get indent>> CHAR: \s <string> write ;
 
 : fresh-line ( n -- )
-    dup last-newline get = [
+    dup pprinter get last-newline>> = [
         drop
     ] [
-        last-newline set
+        pprinter get (>>last-newline)
-        line-limit? [ "..." write end-printing get continue ] when
+        line-limit? [
-        line-count inc
+            "..." write pprinter get end-printing>> continue
+        ] when
+        pprinter get [ 1+ ] change-line-count drop
         nl do-indent
     ] if ;
 
 : text-fits? ( len -- ? )
     margin get dup zero?
-    [ 2drop t ] [ >r indent get + r> <= ] if ;
+    [ 2drop t ] [ >r pprinter get indent>> + r> <= ] if ;
 
 ! break only if position margin 2 / >
 SYMBOL: soft
@@ -78,7 +79,9 @@ style overhang ;
         0 >>overhang ; inline
 
 M: section section-fits? ( section -- ? )
-    [ end>> last-newline get - ] [ overhang>> ] bi + text-fits? ;
+    [ end>> pprinter get last-newline>> - ]
+    [ overhang>> ] bi
+    + text-fits? ;
 
 M: section indent-section? drop f ;
 
@@ -88,12 +91,14 @@ M: section newline-after? drop f ;
 
 M: object short-section? section-fits? ;
 
-: change-indent ( section n -- )
+: indent+ ( section n -- )
-    swap indent-section? [ indent +@ ] [ drop ] if ;
+    swap indent-section? [
+        pprinter get [ + ] change-indent drop
+    ] [ drop ] if ;
 
-: <indent ( section -- ) tab-size get change-indent ;
+: <indent ( section -- ) tab-size get indent+ ;
 
-: indent> ( section -- ) tab-size get neg change-indent ;
+: indent> ( section -- ) tab-size get neg indent+ ;
 
 : <fresh-line ( section -- )
     start>> fresh-line ;
@@ -108,17 +113,14 @@ M: object short-section? section-fits? ;
 : long-section> ( section -- )
     dup indent> fresh-line> ;
 
-: with-style* ( style quot -- )
-    swap stdio [ <style-stream> ] change
-    call stdio [ delegate ] change ; inline
-
 : pprint-section ( section -- )
     dup short-section? [
-        dup section-style [ short-section ] with-style*
+        dup section-style [ short-section ] with-style
     ] [
-        dup <long-section
+        [ <long-section ]
-        dup section-style [ dup long-section ] with-style*
+        [ dup section-style [ long-section ] with-style ]
-        long-section>
+        [ long-section> ]
+        tri
     ] if ;
 
 ! Break section
@@ -159,7 +161,7 @@ TUPLE: block < section sections ;
     last-section t >>end-group? drop ;
 
 : advance ( section -- )
-    [ start>> last-newline get = not ]
+    [ start>> pprinter get last-newline>> = not ]
     [ short-section? ] bi
     and [ bl ] when ;
 
@@ -178,9 +180,10 @@ M: block short-section ( block -- )
     [ advance ] pprint-sections ;
 
 : do-break ( break -- )
-    dup type>> hard eq?
+    [ ]
-    over section-end last-newline get - margin get 2/ > or
+    [ type>> hard eq? ]
-    [ <fresh-line ] [ drop ] if ;
+    [ end>> pprinter get last-newline>> - margin get 2/ > ] tri
+    or [ <fresh-line ] [ drop ] if ;
 
 : empty-block? ( block -- ? ) sections>> empty? ;
 
@@ -267,22 +270,17 @@ M: colon unindent-first-line? drop t ;
     pprinter-stack get pop
     [ [ save-end-position ] [ add-section ] bi ] if-nonempty ;
 
-: with-section-state ( quot -- )
-    [
-        0 indent set
-        0 last-newline set
-        1 line-count set
-        call
-    ] with-scope ; inline
-
 : do-pprint ( block -- )
-    [
+    <pprinter> pprinter [
         [
             dup style>> [
-                [ end-printing set dup short-section ] callcc0
+                [
-            ] with-nesting drop
+                    >r pprinter get (>>end-printing) r>
+                    short-section
+                ] curry callcc0
+            ] with-nesting
         ] if-nonempty
-    ] with-section-state ;
+    ] with-variable ;
 
 ! Long section layout algorithm
 : chop-break ( seq -- seq )