proper ghost cleanup

src/core/editor/Ctx.re

@@ -216,10 +216,10 @@ let button = (ctx: t): t => {
     | ([hd, ...tl], []) =>
       let ctx = map_hd(Frame.Open.cons(~onto=L, hd), ctx);
       go(~ctx, (tl, rev_up));
-    | ([l, ...tl], [r, ..._]) when Melder.lt(l.wald, r.wald) =>
+    | ([l, ...tl], [r, ..._]) when Frame.lt(l.wald, r.wald) =>
       let ctx = map_hd(Frame.Open.cons(~onto=L, l), ctx);
       go(~ctx, (tl, rev_up));
-    | ([l, ..._], [r, ...tl]) when Melder.gt(l.wald, r.wald) =>
+    | ([l, ..._], [r, ...tl]) when Frame.gt(l.wald, r.wald) =>
       let ctx = map_hd(Frame.Open.cons(~onto=R, r), ctx);
       go(~ctx, (rev_dn, tl));
     | ([l, ...tl_l], [r, ...tl_r])
@@ -228,14 +228,14 @@ let button = (ctx: t): t => {
           || Mtrl.(
                is_space(Terr.face(l).mtrl) && is_space(Terr.face(r).mtrl)
              )
-          || !Melder.eq(l.wald, r.wald) =>
+          || !Frame.eq(l.wald, r.wald) =>
       let ctx =
         ctx
         |> map_hd(Frame.Open.cons(~onto=L, l))
         |> map_hd(Frame.Open.cons(~onto=R, r));
       go(~ctx, (tl_l, tl_r));
     | ([l, ...tl_l], [r, ...tl_r]) =>
-      assert(Melder.eq(l.wald, r.wald));
+      assert(Frame.eq(l.wald, r.wald));
       let ctx = link((l, r), ctx);
       go(~ctx, (tl_l, tl_r));
     };

src/core/editor/Frame.re

@@ -1,3 +1,21 @@
+open Stds;
+
+let lt = (l: Wald.t, r: Wald.t) =>
+  !
+    Lists.is_empty(
+      Walker.lt(Node(Wald.face(l).mtrl), Node(Wald.face(r).mtrl)),
+    );
+let gt = (l: Wald.t, r: Wald.t) =>
+  !
+    Lists.is_empty(
+      Walker.gt(Node(Wald.face(l).mtrl), Node(Wald.face(r).mtrl)),
+    );
+let eq = (l: Wald.t, r: Wald.t) =>
+  !
+    Lists.is_empty(
+      Walker.eq(Node(Wald.face(l).mtrl), Node(Wald.face(r).mtrl)),
+    );
+
 let zip_lt = (zipped: Cell.t, r: Terr.L.t) =>
   Cell.put(M(zipped, r.wald, r.cell));
 let zip_gt = (l: Terr.R.t, zipped: Cell.t) =>
@@ -68,12 +86,17 @@ module Open = {
       let w =
         Option.get(Wald.merge_hds(~save_cursor, ~from=L, l.wald, r.wald));
       Some((Eq(), Cell.put(M(l.cell, w, r.cell)), (dn, up)));
-    | ([l, ..._], [r, ...up]) when Melder.lt(l.wald, r.wald) =>
+    | ([l, ..._], [r, ...up]) when lt(l.wald, r.wald) =>
       Some((Neq(L), zip_lt(zipped, r), (dn, up)))
-    | ([l, ...dn], [r, ..._]) when Melder.gt(l.wald, r.wald) =>
+    | ([l, ...dn], [r, ..._]) when gt(l.wald, r.wald) =>
       Some((Neq(R), zip_gt(l, zipped), (dn, up)))
     | ([l, ...dn], [r, ...up]) =>
-      assert(Melder.eq(l.wald, r.wald));
+      try(assert(eq(l.wald, r.wald))) {
+      | _ =>
+        open Stds;
+        P.show("(dn, up)", show((dn, up)));
+        failwith("");
+      };
       Some((Eq(), zip_eq(l, zipped, r), (dn, up)));
     };
 

src/core/editor/Modify.re

@@ -119,7 +119,9 @@ let rec remold = (~fill=Cell.dirty, ctx: Ctx.t): (Cell.t, Ctx.t) => {
     tl
     |> Ctx.map_hd(Frame.Open.cat(Stack.(to_slope(l'), to_slope(r'))))
     |> remold(~fill)
-  | Ok(cell) =>
+  | Ok((dn, fill)) =>
+    let bounds = (l.bound, r.bound);
+    let cell = Melder.complete_bounded(~bounds, ~onto=L, dn, ~fill);
     let hd = ({...l, slope: []}, {...r, slope: []});
     let ctx = Ctx.link_stacks(hd, tl);
     (cell, ctx);

src/core/parser/Melder.re

@@ -4,22 +4,6 @@ exception Bug__failed_to_push_space;
 
 let debug = ref(true);
 
-let lt = (l: Wald.t, r: Wald.t) =>
-  !
-    Lists.is_empty(
-      Walker.lt(Node(Wald.face(l).mtrl), Node(Wald.face(r).mtrl)),
-    );
-let gt = (l: Wald.t, r: Wald.t) =>
-  !
-    Lists.is_empty(
-      Walker.gt(Node(Wald.face(l).mtrl), Node(Wald.face(r).mtrl)),
-    );
-let eq = (l: Wald.t, r: Wald.t) =>
-  !
-    Lists.is_empty(
-      Walker.eq(Node(Wald.face(l).mtrl), Node(Wald.face(r).mtrl)),
-    );
-
 // assumes w is already oriented toward side.
 // used to complete zigg top when it takes precedence over pushed wald.
 let complete_wald = (~side: Dir.t, ~fill=Cell.empty, w: Wald.t): Terr.t => {
@@ -181,24 +165,84 @@ let connect =
   |> Options.get(() => Error(complete_terr(~onto=d, ~fill, onto)));
 };
 
+let rec unzip_tok = (~frame=Frame.Open.empty, path: Path.t, cell: Cell.t) => {
+  let m = Cell.get(cell);
+  switch (path) {
+  | [] => raise(Marks.Invalid)
+  | [hd, ...tl] =>
+    let m = Options.get_exn(Marks.Invalid, m);
+    switch (Meld.unzip(hd, m)) {
+    | Loop((pre, cell, suf)) =>
+      unzip_tok(~frame=Frame.Open.add((pre, suf), frame), tl, cell)
+    | Link((pre, tok, suf)) =>
+      let (cell_pre, pre) = Chain.uncons(pre);
+      let (cell_suf, suf) = Chain.uncons(suf);
+      let (cell_pre, dn) = Slope.Dn.unroll(cell_pre);
+      let (cell_suf, up) = Slope.Up.unroll(cell_suf);
+      let frame =
+        frame |> Frame.Open.add((pre, suf)) |> Frame.Open.cat((dn, up));
+      ((cell_pre, tok, cell_suf), frame);
+    };
+  };
+};
+
 let rec push =
         (
-          ~repair=false,
+          ~repair=?,
           t: Token.t,
           ~fill=Cell.empty,
           stack: Stack.t,
           ~onto: Dir.t,
         )
-        : option((Grouted.t, Stack.t)) =>
+        : option((Grouted.t, Stack.t)) => {
+  let r = Option.is_some(repair);
   switch (stack.slope) {
   | [] =>
-    connect_ineq(~repair, ~onto, stack.bound, ~fill, t)
+    connect_ineq(~repair=r, ~onto, stack.bound, ~fill, t)
     |> Option.map(((grouted, bound)) =>
          (grouted, Stack.{slope: [], bound})
        )
   | [hd, ...tl] =>
-    switch (connect(~repair, ~onto, hd, ~fill, t)) {
-    | Error(fill) => push(~repair, t, ~fill, {...stack, slope: tl}, ~onto)
-    | Ok((grouted, hd)) => Some((grouted, {...stack, slope: [hd, ...tl]}))
-    }
+    let connect = () =>
+      switch (connect(~repair=r, ~onto, hd, ~fill, t)) {
+      | Error(fill) =>
+        push(~repair?, t, ~fill, {...stack, slope: tl}, ~onto)
+      | Ok((grouted, hd)) =>
+        Some((grouted, {...stack, slope: [hd, ...tl]}))
+      };
+    switch (repair) {
+    | None => connect()
+    | Some(remold) =>
+      let discharge = () => discharge(~remold, stack, ~fill, t);
+      Oblig.Delta.minimize(f => f(), [discharge, connect]);
+    };
   };
+}
+and discharge = (~remold, stack: Stack.t, ~fill=Cell.empty, t: Token.t) => {
+  switch (stack.slope) {
+  | [] => None
+  | [hd, ...tl] =>
+    open Options.Syntax;
+    let* (path, _) =
+      hd.cell.marks.obligs
+      |> Path.Map.filter((_, mtrl: Mtrl.T.t) =>
+           switch (mtrl) {
+           | Tile(_) when mtrl == t.mtrl => true
+           | _ => false
+           }
+         )
+      |> Path.Map.max_binding_opt;
+    let ((c_l, tok, c_r), (dn, up)) = unzip_tok(path, hd.cell);
+    Effects.remove(tok);
+    let l = Stack.cat(dn, {...stack, slope: tl});
+    let r = {
+      let (c_fill, up_fill) = Slope.Up.unroll(fill);
+      let slope =
+        up @ [Terr.of_wald(Wald.rev(hd.wald), ~cell=c_fill), ...up_fill];
+      Stack.{slope, bound: Node(Terr.of_tok(t))};
+    };
+    let c = Cell.Space.merge(c_l, ~fill=Cell.dirty, c_r);
+    let* (slope, fill) = Result.to_option(remold(~fill=c, (l, r)));
+    push(~repair=remold, t, ~fill, {...l, slope}, ~onto=L);
+  };
+};

src/core/parser/Molder.re

@@ -25,7 +25,7 @@ let candidates = (t: Token.Unmolded.t): list(Token.t) =>
     Token.mk(~id=t.id, ~marks=?t.marks, ~text=t.text),
     switch (t.mtrl) {
     | Space(t) => [Mtrl.Space(t)]
-    | Grout(_) => failwith("bug: attempted to mold grout")
+    | Grout(_) => []
     | Tile(lbls) =>
       lbls
       |> List.concat_map(lbl =>
@@ -44,36 +44,6 @@ let candidates = (t: Token.Unmolded.t): list(Token.t) =>
     },
   );
 
-// returns None if input token is empty
-let mold =
-    (stack: Stack.t, ~fill=Cell.empty, t: Token.Unmolded.t)
-    : option((Token.t, Grouted.t, Stack.t)) =>
-  switch (
-    candidates(t)
-    |> Oblig.Delta.minimize(tok =>
-         Melder.push(~repair=true, tok, ~fill, stack, ~onto=L)
-         |> Option.map(((grouted, stack)) => (tok, grouted, stack))
-       )
-  ) {
-  // pushed token was empty ghost connected via neq-relation
-  | Some((tok, grouted, _) as molded) =>
-    Mtrl.is_tile(tok.mtrl) && tok.text == "" && Grouted.is_neq(grouted)
-      ? None : Some(molded)
-  | None =>
-    let deferred = Token.Unmolded.defer(t);
-    Token.is_empty(deferred)
-      ? None
-      : Some(
-          {
-            let (fill, slope) = Slope.Dn.unroll(fill);
-            let stack = Stack.cat(slope, stack);
-            Melder.push(deferred, ~fill, stack, ~onto=L)
-            |> Option.map(((grouted, stack)) => (deferred, grouted, stack))
-            |> Options.get_fail("bug: failed to push space");
-          },
-        );
-  };
-
 let complete_pending_ghosts = (~bounds, l: Stack.t, ~fill) => {
   let (cell, effs) =
     Effects.dry_run(
@@ -100,34 +70,52 @@ let complete_pending_ghosts = (~bounds, l: Stack.t, ~fill) => {
     };
 };
 
-let rec remold =
-        (~fill=Cell.empty, (l, r): Stack.Frame.t)
-        : Result.t(Cell.t, (Cell.t, Stack.Frame.t)) => {
-  open Result.Syntax;
+// returns None if input token is empty
+let rec mold =
+        (stack: Stack.t, ~fill=Cell.empty, t: Token.Unmolded.t)
+        : option((Token.t, Grouted.t, Stack.t)) =>
+  switch (
+    candidates(t)
+    |> Oblig.Delta.minimize(tok =>
+         Melder.push(tok, ~fill, stack, ~onto=L, ~repair=remold)
+         |> Option.map(((grouted, stack)) => (tok, grouted, stack))
+       )
+  ) {
+  // pushed token was empty ghost connected via neq-relation
+  | Some((tok, grouted, _) as molded) =>
+    Mtrl.is_tile(tok.mtrl) && tok.text == "" && Grouted.is_neq(grouted)
+      ? None : Some(molded)
+  | None =>
+    let deferred = Token.Unmolded.defer(t);
+    Token.is_empty(deferred)
+      ? None
+      : Some(
+          {
+            let (fill, slope) = Slope.Dn.unroll(fill);
+            let stack = Stack.cat(slope, stack);
+            Melder.push(deferred, ~fill, stack, ~onto=L)
+            |> Option.map(((grouted, stack)) => (deferred, grouted, stack))
+            |> Options.get_fail("bug: failed to push space");
+          },
+        );
+  }
+and remold =
+    (~fill, (l, r): Stack.Frame.t)
+    : Result.t((Slope.Dn.t, Cell.t), (Cell.t, Stack.Frame.t)) => {
+  // open Result.Syntax;
   // P.log("--- remold");
   // P.show("fill", Cell.show(fill));
-  // P.show("ctx", Ctx.show(ctx));
+  // P.show("(l, r)", Stack.Frame.show((l, r)));
   let bounds = (l.bound, r.bound);
-  let/ _ =
-    // first try removing grout and continuing
-    switch (Slope.unlink(r.slope)) {
-    | Some((tok, (cell, _), up)) when Token.Grout.is(tok) =>
-      Effects.remove(tok);
-      let up = Slope.cat(snd(Slope.Up.unroll(cell)), up);
-      let r = {...r, slope: up};
-      remold(~fill, (l, r));
-    | _ =>
-      // think I'm missing a type quantifier in result syntax.
-      // empty values here just to typecheck and are ignored.
-      Error((Cell.empty, Stack.Frame.empty))
-    };
   switch (r.slope) {
   | [] =>
     // P.log("--- remold/done");
     // P.show("l", Stack.show(l));
     // P.show("fill", Cell.show(fill));
-    Ok(Melder.complete_bounded(~bounds, ~onto=L, l.slope, ~fill))
+    Ok((l.slope, fill))
   | [hd, ...tl] =>
+    // P.log("--- remold/continue");
+    // P.show("hd", Terr.show(hd));
     // insert any pending ghosts if next terr has newlines
     let (l, fill) =
       Terr.tokens(hd)

src/core/structure/Terr.re

@@ -46,7 +46,7 @@ let map_face = (f, terr: t) => {...terr, wald: Wald.map_hd(f, terr.wald)};
 let sort = (terr: t) => Wald.sort(terr.wald);
 let cells = (terr: t) => Wald.cells(terr.wald) @ [terr.cell];
 
-let of_wald = wald => Base.{cell: Cell.empty, wald};
+let of_wald = (~cell=Cell.empty, wald) => Base.{cell, wald};
 let of_tok = tok => of_wald(Wald.of_tok(tok));
 
 let link = (t, c, terr: t) => {...terr, wald: Wald.link(t, c, terr.wald)};

src/core/structure/Token.re

@@ -310,7 +310,7 @@ let unmold = (~relabel=true, tok: Molded.t): Unmolded.t => {
       | [] => Space(Unmolded)
       | [_, ..._] as lbls => Tile(lbls)
       }
-    | Grout(_) => raise(Invalid_argument("Token.Unmolded.unmold"))
+    | Grout(_) => Grout()
     | Tile((lbl, _)) =>
       Tile(
         is_empty(tok) || !relabel