kernel: new combinator 2with = with with

2014-07-22 15:09:26 +02:00 · 2014-07-22 15:09:26 +02:00 · 60ffe0680e
parent 8c8f58dfee
commit 60ffe0680e
38 changed files with 105 additions and 85 deletions
--- a/basis/combinators/short-circuit/short-circuit.factor
+++ b/basis/combinators/short-circuit/short-circuit.factor
@ -29,8 +29,8 @@ PRIVATE>

 : 0&& ( quots -- ? ) [ ] unoptimized-&& ;
 : 1&& ( obj quots -- ? ) [ with ] unoptimized-&& ;
-: 2&& ( obj1 obj2 quots -- ? ) [ with with ] unoptimized-&& ;
-: 3&& ( obj1 obj2 obj3 quots -- ? ) [ with with with ] unoptimized-&& ;
+: 2&& ( obj1 obj2 quots -- ? ) [ 2with ] unoptimized-&& ;
+: 3&& ( obj1 obj2 obj3 quots -- ? ) [ 3 nwith ] unoptimized-&& ;

 MACRO: n|| ( quots n -- quot )
    [
@ -51,5 +51,5 @@ PRIVATE>

 : 0|| ( quots -- ? ) [ ] unoptimized-|| ;
 : 1|| ( obj quots -- ? ) [ with ] unoptimized-|| ;
-: 2|| ( obj1 obj2 quots -- ? ) [ with with ] unoptimized-|| ;
-: 3|| ( obj1 obj2 obj3 quots -- ? ) [ with with with ] unoptimized-|| ;
+: 2|| ( obj1 obj2 quots -- ? ) [ 2with ] unoptimized-|| ;
+: 3|| ( obj1 obj2 obj3 quots -- ? ) [ 3 nwith ] unoptimized-|| ;
--- a/basis/compiler/cfg/branch-splitting/branch-splitting.factor
+++ b/basis/compiler/cfg/branch-splitting/branch-splitting.factor
@ -44,7 +44,7 @@ IN: compiler.cfg.branch-splitting

 : update-successor-predecessors ( copies old-bb -- )
    dup successors>>
-    [ update-successor-predecessor ] with with each ;
+    [ update-successor-predecessor ] 2with each ;

 : split-branch ( bb -- )
    [ new-blocks ] keep
--- a/basis/compiler/cfg/def-use/def-use.factor
+++ b/basis/compiler/cfg/def-use/def-use.factor
@ -109,7 +109,7 @@ SYMBOLS: defs insns ;
 : insn-of ( vreg -- insn ) insns get at ;

 : set-def-of ( obj insn assoc -- )
-    swap defs-vregs [ swap set-at ] with with each ;
+    swap defs-vregs [ swap set-at ] 2with each ;

 : compute-defs ( cfg -- )
    H{ } clone [
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@ -162,7 +162,7 @@ M: hairy-clobber-insn compute-live-intervals* ( insn -- )
 : handle-live-out ( bb -- )
    live-out dup assoc-empty? [ drop ] [
        [ from get to get ] dip keys
-        [ live-interval add-range ] with with each
+        [ live-interval add-range ] 2with each
    ] if ;

 ! A location where all registers have to be spilled
--- a/basis/db/tuples/tuples.factor
+++ b/basis/db/tuples/tuples.factor
@ -35,7 +35,7 @@ GENERIC: eval-generator ( singleton -- object )

 : query-tuples ( exemplar-tuple statement -- seq )
    [ out-params>> ] keep query-results [
-        [ sql-row-typed swap resulting-tuple ] with with query-map
+        [ sql-row-typed swap resulting-tuple ] 2with query-map
    ] with-disposal ;

 : query-modify-tuple ( tuple statement -- )
--- a/basis/debugger/debugger-docs.factor
+++ b/basis/debugger/debugger-docs.factor
@ -105,7 +105,7 @@ HELP: type-check-error.
 { $error-description "Thrown by various primitives if one of the inputs does not have the expected type. Generic words throw " { $link no-method } " and " { $link no-math-method } " errors in such cases instead." } ;

 HELP: divide-by-zero-error.
-{ $error-description "This error is thrown when " { $link / } " or " { $link /i } " is called with with a zero denominator." }
+{ $error-description "This error is thrown when " { $link / } " or " { $link /i } " is called with a zero denominator." }
 { $see-also "division-by-zero" } ;

 HELP: signal-error.
--- a/basis/game/input/input.factor
+++ b/basis/game/input/input.factor
@ -79,7 +79,7 @@ SYMBOLS:
    get-controllers [
        [ product-id  = ]
        [ instance-id = ] bi-curry bi* and
-    ] with with find nip ;
+    ] 2with find nip ;

 TUPLE: keyboard-state keys ;

--- a/basis/io/monitors/recursive/recursive.factor
+++ b/basis/io/monitors/recursive/recursive.factor
@ -69,7 +69,7 @@ M: recursive-monitor dispose*
            { +rename-file-new+ [ child-added ] }
            [ 3drop ]
        } case
-    ] with with each ;
+    ] 2with each ;

 : pump-loop ( -- )
    receive {
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@ -410,7 +410,7 @@ M: float round dup sgn 2 /f + truncate ;
 : roots ( x t -- seq )
    [ [ log ] [ recip ] bi* * e^ ]
    [ recip 2pi * 0 swap complex boa e^ ]
-    [ iota [ ^ * ] with with map ] tri ;
+    [ iota [ ^ * ] 2with map ] tri ;

 : sigmoid ( x -- y ) neg e^ 1 + recip ; inline

--- a/basis/math/vectors/simd/intrinsics/intrinsics.factor
+++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor
@ -201,7 +201,7 @@ SIMD-INTRINSIC: (simd-vmax)              ( a b rep -- c ) [ max ] components-2ma
 ! XXX
 SIMD-INTRINSIC: (simd-v.)                ( a b rep -- n )
    [ 2byte>rep-array [ [ first ] bi@ * ] 2keep ] keep
-    1 swap rep-length [a,b) [ '[ _ swap nth-unsafe ] bi@ * + ] with with each ;
+    1 swap rep-length [a,b) [ '[ _ swap nth-unsafe ] bi@ * + ] 2with each ;
 SIMD-INTRINSIC: (simd-vsqrt)             ( a   rep -- c ) [ fsqrt ] components-map ;
 SIMD-INTRINSIC: (simd-vsad)              ( a b rep -- c ) 2byte>rep-array [ - abs ] [ + ] 2map-reduce ;
 SIMD-INTRINSIC: (simd-sum)               ( a   rep -- n ) [ + ] components-reduce ;
--- a/basis/sorting/insertion/insertion.factor
+++ b/basis/sorting/insertion/insertion.factor
@ -16,4 +16,4 @@ PRIVATE>

 : insertion-sort ( ... seq quot: ( ... elt -- ... elt' ) -- ... )
    ! quot is a transformation on elements
-    over length [ insert ] with with 1 -rot (each-integer) ; inline
+    over length [ insert ] 2with 1 -rot (each-integer) ; inline
--- a/basis/sorting/slots/slots.factor
+++ b/basis/sorting/slots/slots.factor
@ -16,7 +16,7 @@ IN: sorting.slots
            unclip-last-slice
            [ [ execute-accessor ] each ] dip
        ] when execute-comparator
-    ] with with map-find drop +eq+ or ;
+    ] 2with map-find drop +eq+ or ;

 : sort-by-with ( seq sort-specs quot: ( obj -- key ) -- seq' )
    swap '[ _ bi@ _ compare-slots ] sort ; inline
--- a/basis/typed/typed.factor
+++ b/basis/typed/typed.factor
@ -1,7 +1,7 @@
 ! (c)Joe Groff bsd license
 USING: accessors arrays classes classes.tuple combinators
-combinators.short-circuit definitions effects fry hints
-math kernel kernel.private namespaces parser quotations
+combinators.short-circuit definitions effects fry generalizations
+hints math kernel kernel.private namespaces parser quotations
 sequences slots words locals effects.parser
 locals.parser macros stack-checker.dependencies
 classes.maybe classes.algebra ;
@ -52,7 +52,7 @@ PREDICATE: typed-word < word "typed-word" word-prop >boolean ;
    compose compose ;

 : make-unboxer ( error-quot word types -- quot )
-    dup [ unboxer ] with with with
+    dup [ unboxer ] 3 nwith
    [ swap \ dip [ ] 2sequence prepend ] map-reduce ;

 : (unboxed-types) ( type -- types )
--- a/basis/ui/gadgets/menus/menus.factor
+++ b/basis/ui/gadgets/menus/menus.factor
@ -57,7 +57,7 @@ M: ---- <menu-item>
    ] make-corners ;

 : <commands-menu> ( target hook commands -- menu )
-    [ <menu-item> ] with with map <menu> ;
+    [ <menu-item> ] 2with map <menu> ;

 : show-commands-menu ( target commands -- )
    [ dup [ ] ] dip <commands-menu> show-menu ;
--- a/basis/unicode/collation/collation-tests.factor
+++ b/basis/unicode/collation/collation-tests.factor
@ -13,7 +13,7 @@ IN: unicode.collation.tests

 : test-equality ( str1 str2 -- ? ? ? ? )
    { primary= secondary= tertiary= quaternary= }
-    [ execute( a b -- ? ) ] with with map
+    [ execute( a b -- ? ) ] 2with map
    first4 ;

 [ f f f f ] [ "hello" "hi" test-equality ] unit-test
--- a/basis/unicode/collation/collation.factor
+++ b/basis/unicode/collation/collation.factor
@ -83,7 +83,7 @@ ducet get-global insert-helpers
 : add ( char -- )
    dup blocked? [ 1string , ] [
        dup possible-bases dup length iota
-        [ ?combine ] with with any?
+        [ ?combine ] 2with any?
        [ drop ] [ 1string , ] if
    ] if ;

--- a/basis/vocabs/metadata/resources/resources.factor
+++ b/basis/vocabs/metadata/resources/resources.factor
@ -40,6 +40,5 @@ PRIVATE>
    [ 2drop ] [
        [ [ vocab-dir append-path ] [ vocab-dir-in-root ] bi ] dip
        [ 2drop make-directories ]
-        [ [ copy-vocab-resource ] with with each ] 3bi
+        [ [ copy-vocab-resource ] 2with each ] 3bi
    ] if-empty ;
-
--- a/core/generic/math/math.factor
+++ b/core/generic/math/math.factor
@ -118,7 +118,7 @@ M: math-combination perform-combination
    drop dup generic-word [
        dup [ over ] [
            dup math-class? [
-                [ dup ] [ math-method ] with with math-dispatch-step
+                [ dup ] [ math-method ] 2with math-dispatch-step
            ] [
                drop object-method
            ] if
--- a/core/generic/single/single.factor
+++ b/core/generic/single/single.factor
@ -75,7 +75,7 @@ C: <predicate-engine> predicate-engine

 : flatten-method ( method class assoc -- )
    over flatten-class keys
-    [ swap push-method ] with with with each ;
+    [ swap push-method ] 2with with each ;

 : flatten-methods ( assoc -- assoc' )
    H{ } clone [ [ swapd flatten-method ] curry assoc-each ] keep ;
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@ -777,9 +777,19 @@ HELP: with
 { $notes "This operation is efficient and does not copy the quotation." }
 { $examples
    { $example "USING: kernel math prettyprint sequences ;" "1 { 1 2 3 } [ / ] with map ." "{ 1 1/2 1/3 }" }
-    { $example "USING: kernel math prettyprint sequences ;" "1000 100 5 iota [ sq + + ] with with map ." "{ 1100 1101 1104 1109 1116 }" }
+    { $example "USING: kernel math prettyprint sequences ;" "1000 100 5 iota [ sq + + ] 2with map ." "{ 1100 1101 1104 1109 1116 }" }
 } ;

+HELP: 2with
+{ $values
+  { "param1" object }
+  { "param1" object }
+  { "obj" object }
+  { "quot" { $quotation ( param1 param2 elt -- ... ) } }
+  { "curry" curry }
+}
+{ $description "Partial application on the left of two parameters." } ;
+
 HELP: compose
 { $values { "quot1" callable } { "quot2" callable } { "compose" compose } }
 { $description "Quotation composition. Outputs a " { $link callable } " which calls " { $snippet "quot1" } " followed by " { $snippet "quot2" } "." }
@ -951,4 +961,3 @@ ARTICLE: "assertions" "Assertions"
    assert
    assert=
 } ;
-
--- a/core/kernel/kernel-tests.factor
+++ b/core/kernel/kernel-tests.factor
@ -8,6 +8,21 @@ IN: kernel.tests
 [ 0 ] [ f size ] unit-test
 [ t ] [ [ \ = \ = ] all-equal? ] unit-test

+[
+    {
+        { 1 2 0 }
+        { 1 2 1 }
+        { 1 2 2 }
+        { 1 2 3 }
+        { 1 2 4 }
+        { 1 2 5 }
+        { 1 2 6 }
+        { 1 2 7 }
+        { 1 2 8 }
+        { 1 2 9 }
+    }
+] [ 1 2 10 iota [ 3array ] 2with map ] unit-test
+
 ! Don't leak extra roots if error is thrown
 [ ] [ 1000 [ [ 3 throw ] ignore-errors ] times ] unit-test

--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@ -135,6 +135,9 @@ DEFER: if
 : with ( param obj quot -- obj curry )
    swapd [ swapd call ] 2curry ; inline

+: 2with ( param1 param2 obj quot -- obj curry )
+    with with ; inline
+
 : prepose ( quot1 quot2 -- compose )
    swap compose ; inline

--- a/extra/benchmark/raytracer-simd/raytracer-simd.factor
+++ b/extra/benchmark/raytracer-simd/raytracer-simd.factor
@ -1,7 +1,7 @@
 ! Factor port of the raytracer benchmark from
 ! http://www.ffconsultancy.com/languages/ray_tracer/index.html

-USING: arrays accessors io io.files io.files.temp
+USING: arrays accessors generalizations io io.files io.files.temp
 io.encodings.binary kernel math math.constants math.functions
 math.vectors math.vectors.simd math.vectors.simd.cords
 math.parser make sequences words combinators ;
@ -129,7 +129,7 @@ CONSTANT: create-offsets
 : create-group ( level c r -- scene )
    2dup create-bound [
        2dup <sphere> ,
-        create-offsets [ create-step , ] with with with each
+        create-offsets [ create-step , ] 3 nwith each
    ] make-group ;

 : create ( level c r -- scene )
@ -145,15 +145,15 @@ CONSTANT: create-offsets
            ss-point v+ normalize
            double-4{ 0.0 0.0 -4.0 0.0 } swap <ray>
            swap cast-ray +
-        ] with with with each
-    ] with with each ; inline no-compile
+        ] 3 nwith each
+    ] 2with each ; inline no-compile

 : ray-trace ( scene -- grid )
    size iota <reversed> [
        size iota [
            [ size 0.5 * - ] bi@ swap size
            0.0 double-4-boa ray-pixel
-        ] with with map
+        ] 2with map
    ] with map ;

 : pgm-header ( w h -- )
--- a/extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor
+++ b/extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor
@ -78,12 +78,12 @@ STRUCT: yuv-buffer
 : yuv>rgb-row ( index rgb yuv y -- index )
    over stride
    pick y_width>> iota
-    [ yuv>rgb-pixel ] with with with with each ; inline
+    [ yuv>rgb-pixel ] 4 nwith each ; inline

 TYPED: yuv>rgb ( rgb: byte-array yuv: yuv-buffer -- )
    [ 0 ] 2dip
    dup y_height>> iota
-    [ yuv>rgb-row ] with with each
+    [ yuv>rgb-row ] 2with each
    drop ;

 : yuv-to-rgb-benchmark ( -- )
--- a/extra/boids/simulation/simulation.factor
+++ b/extra/boids/simulation/simulation.factor
@ -65,7 +65,7 @@ GENERIC: force ( neighbors boid behaviour -- force )
 :: simulate ( boids behaviours dt -- boids )
    boids [| boid |
        boid boids behaviours
-        [ [ (force) ] keep weight>> v*n ] with with map vsum :> a
+        [ [ (force) ] keep weight>> v*n ] 2with map vsum :> a

        boid vel>> a dt v*n v+ normalize :> vel
        boid pos>> vel dt v*n v+ wrap-pos :> pos
@ -98,4 +98,3 @@ M:: separation force ( neighbors boid behaviour -- force )
    behaviour radius>> :> r
    boid pos>> neighbors
    [ pos>> v- [ normalize ] [ r v/n ] bi v- ] with map vsum ;
-
--- a/extra/bunny/model/model.factor
+++ b/extra/bunny/model/model.factor
@ -30,7 +30,7 @@ IN: bunny.model
    vneg normalize ;

 : normal ( ns vs triple -- )
-    [ n ] keep [ rot [ v+ ] change-nth ] with with each ;
+    [ n ] keep [ rot [ v+ ] change-nth ] 2with each ;

 : normals ( vs is -- ns )
    [ [ length { 0.0 0.0 0.0 } <array> ] keep ] dip
@ -55,7 +55,7 @@ CONSTANT: model-url "http://duriansoftware.com/joe/media/bun_zipper.ply"
    ] each ;

 : draw-triangles ( ns vs is -- )
-    GL_TRIANGLES [ [ (draw-triangle) ] with with each ] do-state ;
+    GL_TRIANGLES [ [ (draw-triangle) ] 2with each ] do-state ;

 TUPLE: bunny-dlist list ;
 TUPLE: bunny-buffers array element-array nv ni ;
--- a/extra/game/models/collada/collada.factor
+++ b/extra/game/models/collada/collada.factor
@ -129,7 +129,7 @@ VERTEX-FORMAT: collada-vertex-format
            [
                [ data>> ] [ offset>> ] bi
                rot = [ nth ] [ 2drop f ] if
-            ] with with map sift flatten ,
+            ] 2with map sift flatten ,
        ] curry each-index
    ] V{ } make flatten ;

@ -153,7 +153,7 @@ VERTEX-FORMAT: collada-vertex-format
    ] bi ;

 : mesh>triangles ( sources vertices mesh-tag -- models )
-    "triangles" tags-named [ triangles>model ] with with map ;
+    "triangles" tags-named [ triangles>model ] 2with map ;

 : mesh>models ( mesh-tag -- models )
    [
--- a/extra/gml/viewer/viewer.factor
+++ b/extra/gml/viewer/viewer.factor
@ -258,7 +258,7 @@ CONSTANT: edge-hitbox-radius 0.05
    ] [ f ] if ;

 : intersecting-edge-node ( source direction b-rep -- edge/f )
-    edges>> [ intersects-edge-node? ] with with find nip ;
+    edges>> [ intersects-edge-node? ] 2with find nip ;

 : select-edge ( world -- )
    [ [ location>> ] [ hand-loc get wasd-pixel-ray ] bi ]
@ -311,4 +311,3 @@ M: gml-viewer-world wasd-mouse-scale drag?>> -1/600. 0.0 ? ;
        _ >>selected
        drop
    ] with-ui ;
-
--- a/extra/graphviz/notation/notation.factor
+++ b/extra/graphviz/notation/notation.factor
@ -59,7 +59,7 @@ IN: graphviz.notation
        name>>
        [ attrs-obj-=attr ] keep
        graph-obj-=attr
-    ] with with each ;
+    ] 2with each ;

 PRIVATE>

--- a/extra/irc/client/participants/participants.factor
+++ b/extra/irc/client/participants/participants.factor
@ -28,7 +28,7 @@ M: irc-channel-chat has-participant? participants>> key? ;
    dup participant-chats [ part-participant ] with each ;

 : rename-participant* ( new old -- )
-    [ dup participant-chats [ rename-participant ] with with each ]
+    [ dup participant-chats [ rename-participant ] 2with each ]
    [ dup chat> [ rename-nick-chat ] [ 2drop ] if ]
    2bi ;

--- a/extra/koszul/koszul.factor
+++ b/extra/koszul/koszul.factor
@ -163,7 +163,7 @@ DEFER: (d)
    swap call [ at 0 or ] curry map ; inline

 : op-matrix ( domain range quot -- matrix )
-    rot [ (op-matrix) ] with with map ; inline
+    rot [ (op-matrix) ] 2with map ; inline

 : d-matrix ( domain range -- matrix )
    [ (d) ] op-matrix ;
--- a/extra/nurbs/nurbs.factor
+++ b/extra/nurbs/nurbs.factor
@ -32,7 +32,7 @@ TUPLE: nurbs-curve

 : order-knot-constants ( curve order -- knot-constants )
    2dup [ knots>> length ] dip - iota
-    [ order-index-knot-constants ] with with map ;
+    [ order-index-knot-constants ] 2with map ;

 : knot-constants ( curve -- knot-constants )
    2 over order>> [a,b]
@ -71,5 +71,3 @@ TUPLE: nurbs-curve

 : eval-nurbs ( nurbs-curve t -- value )
    2dup knot-interval 1 - { 1.0 } 2 (eval-bases) ;
-
-
--- a/extra/pcre/pcre.factor
+++ b/extra/pcre/pcre.factor
@ -22,9 +22,6 @@ ERROR: pcre-error value ;
 : split-subseqs ( seq subseqs -- seqs )
    dup first [ replace-all ] keep split-subseq [ >string ] map harvest ;

-: 2with ( param1 param2 obj quot -- obj curry )
-    [ -rot ] dip [ [ rot ] dip call ] 3curry ; inline
-
 : utf8-start-byte? ( byte -- ? )
    0xc0 bitand 0x80 = not ;

--- a/extra/project-euler/265/265.factor
+++ b/extra/project-euler/265/265.factor
@ -1,6 +1,7 @@
 ! Copyright (c) 2010 Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions project-euler.common sequences sets ;
+USING: generalizations kernel math math.functions project-euler.common
+sequences sets ;
 IN: project-euler.265

 ! http://projecteuler.net/index.php?section=problems&id=265
@ -51,7 +52,7 @@ CONSTANT: N 5
        nip ?register
    ] [
        [ 1 - ] dip
-        { 0 1 } [ add-bit [ iterate ] [ 3drop ] if ] with with with each
+        { 0 1 } [ add-bit [ iterate ] [ 3drop ] if ] 3 nwith each
    ] if ;

 : euler265 ( -- answer )
--- a/extra/sudoku/sudoku.factor
+++ b/extra/sudoku/sudoku.factor
@ -1,5 +1,5 @@
 ! Based on http://www.ffconsultancy.com/ocaml/sudoku/index.html
-USING: columns combinators combinators.short-circuit io
+USING: columns combinators combinators.short-circuit generalizations io
 io.styles kernel math math.parser namespaces sequences ;
 IN: sudoku

@ -17,7 +17,7 @@ SYMBOL: board
 : cell-any? ( n x y i -- ? ) 3 /mod pair+ board> = ;

 : box-any? ( n x y -- ? )
-    [ 3 /i 3 * ] bi@ 9 iota [ cell-any? ] with with with any? ;
+    [ 3 /i 3 * ] bi@ 9 iota [ cell-any? ] 3 nwith any? ;

 : board-any? ( n x y -- ? )
    { [ nip row-any? ] [ drop col-any? ] [ box-any? ] } 3|| ;
--- a/extra/usa-cities/usa-cities.factor
+++ b/extra/usa-cities/usa-cities.factor
@ -49,7 +49,7 @@ MEMO: cities-named ( name -- cities )
 MEMO: cities-named-in ( name state -- cities )
    cities [
        [ name>> = ] [ state>> = ] bi-curry bi* and
-    ] with with filter ;
+    ] 2with filter ;

 : find-zip-code ( code -- city )
    cities [ first-zip>> <=> ] with search nip ;
--- a/extra/window-controls-demo/window-controls-demo.factor
+++ b/extra/window-controls-demo/window-controls-demo.factor
@ -39,6 +39,6 @@ M: window-controls-demo-world pref-dim*
        open-window*
            windows >>windows
            windows push
-    ] with with assoc-each ;
+    ] 2with assoc-each ;

 MAIN: window-controls-demo
--- a/extra/yaml/yaml.factor
+++ b/extra/yaml/yaml.factor
@ -426,7 +426,7 @@ M:: yaml-alias emit-value ( emitter event unused obj -- )
    yaml_emitter_emit_asserted ;

 : emit-sequence-body ( emitter event seq -- )
-    [ emit-object ] with with each ;
+    [ emit-object ] 2with each ;

 : emit-assoc-body ( emitter event assoc -- )
    [
@ -534,5 +534,5 @@ PRIVATE>
 : >yaml-docs ( seq -- str )
    [
        [ init-emitter ] dip
-        [ [ replace-identities emit-doc ] with with each ] [ drop flush-emitter ] 3bi
+        [ [ replace-identities emit-doc ] 2with each ] [ drop flush-emitter ] 3bi
    ] with-destructors ;