fix cut bug in Shape refactor task

src/core/editor/Ctx.re

@@ -202,42 +202,3 @@ let zip_step =
       Some((rel, zipped, link(~open_, (l, r), ctx)))
     }
   };
-
-// processes open hd of ctx to explicate any latent closed frames. unlike zip,
-// button goes top-down and does not require a syntactically complete cell to start.
-let button = (ctx: t): t => {
-  let ((dn, up), tl) = uncons(ctx);
-  let rec go = (~ctx, (rev_dn, rev_up)) =>
-    switch (rev_dn, rev_up) {
-    | ([], []) => ctx
-    | ([], [hd, ...tl]) =>
-      let ctx = map_hd(Frame.Open.cons(~onto=R, hd), ctx);
-      go(~ctx, (rev_dn, tl));
-    | ([hd, ...tl], []) =>
-      let ctx = map_hd(Frame.Open.cons(~onto=L, hd), ctx);
-      go(~ctx, (tl, rev_up));
-    | ([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 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])
-        when
-          Token.merges(Terr.face(l), Terr.face(r))
-          || Mtrl.(
-               is_space(Terr.face(l).mtrl) && is_space(Terr.face(r).mtrl)
-             )
-          || !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(Frame.eq(l.wald, r.wald));
-      let ctx = link((l, r), ctx);
-      go(~ctx, (tl_l, tl_r));
-    };
-  go(~ctx=cons(Frame.Open.empty, tl), (List.rev(dn), List.rev(up)));
-};

src/core/editor/Modify.re

@@ -26,7 +26,7 @@ let relabel =
     |> Option.value(~default="");
   let labeled = Labeler.label(s_l ++ s ++ s_r);
   // push left face back if its labeling remains unchanged
-  let (labeled, rest, pushed_back_left) =
+  let (labeled, rest, pushed_back_l) =
     switch (labeled) {
     | [hd, ...tl] when hd.text == s_l && s_l != "" && !merges =>
       let ctx =
@@ -37,22 +37,22 @@ let relabel =
     | labeled => (labeled, rest, false)
     };
   // push right face back if its labeling remains unchanged
-  let (labeled, rest) =
+  let (labeled, rest, pushed_back_r) =
     switch (Lists.Framed.ft(labeled)) {
     | Some((pre, ft)) when ft.text == s_r && s_r != "" && !merges =>
       let ctx =
         Delim.is_tok(r)
         |> Option.map(t => Ctx.push(~onto=R, t, rest))
         |> Option.value(~default=rest);
       // (List.rev(pre), 0, ctx);
-      (List.rev(pre), ctx);
+      (List.rev(pre), ctx, true);
     | _ =>
       // (labeled, Utf8.length(s_r), rest)
-      (labeled, rest)
+      (labeled, rest, false)
     };
 
   // restore caret position
-  let n = Utf8.length((pushed_back_left ? "" : s_l) ++ s);
+  let n = Utf8.length((pushed_back_l ? "" : s_l) ++ s);
   let (_, marked) =
     labeled
     |> Lists.fold_map(
@@ -87,7 +87,10 @@ let relabel =
          | _ => Chain.link(Cell.dirty, tok, c)
          }
        );
-  (normalized, Ctx.button(rest));
+  // if both faces were pushed back, then use original ctx to preserve any closed
+  // frames broken by pulling faces
+  let ctx = pushed_back_l && pushed_back_r ? ctx : rest;
+  (normalized, ctx);
 };
 
 // None means token was removed. Some(ctx) means token was molded (or deferred and

src/core/editor/Move.re

@@ -75,25 +75,37 @@ let push_sites = (site: Zipper.Site.cursor, ctx: Ctx.t) =>
 let hstep = (d: Dir.t, z: Zipper.t): option(Zipper.t) => {
   open Options.Syntax;
   let b = Dir.toggle(d);
+  // P.log("--- Move.hstep");
+  let (cur_site, ctx_sans_sites) = Zipper.cursor_site(z);
   let+ ctx =
-    switch (z.cur) {
-    | Select({range: zigg, _}) =>
+    switch (cur_site) {
+    | Select(_) =>
+      let sel = Option.get(Cursor.get_select(z.cur));
       // move to d end of selection, taking care to update any token marks
-      let (_, ctx_sans_sites) = Zipper.cursor_site(z);
+      // let (_, ctx_sans_sites) = Zipper.cursor_site(z);
       let zigg =
-        zigg
+        sel.range
         |> Zigg.map_face(~side=d, Token.focus_point)
         |> Zigg.map_face(~side=b, Token.clear_marks);
       return(Ctx.push_zigg(~onto=b, zigg, ctx_sans_sites));
-    | Point(_) =>
-      let (face, ctx) = Ctx.pull(~from=d, z.ctx);
+    | Point(site) =>
+      // P.log("--- Move.hstep/Point");
+      let (face, ctx) =
+        switch (site) {
+        | Between => Ctx.pull(~from=d, ctx_sans_sites)
+        | Within(tok) => (Delim.tok(tok), ctx_sans_sites)
+        };
+      // P.show("face", Delim.show(face));
+      // P.show("ctx", Ctx.show(ctx));
       let+ tok = Bound.to_opt(face);
       let (stepped, exited) = hstep_tok(d, tok);
+      // P.show("stepped", Token.show(stepped));
+      // P.show("exited", string_of_bool(exited));
       ctx
       |> Ctx.push(~onto=b, stepped)
       |> (exited ? Fun.id : Ctx.push(~onto=d, stepped));
     };
-  Zipper.mk(Ctx.button(ctx));
+  Zipper.(rebutton(mk(ctx)));
 };
 let rec hstep_n = (n: int, z: Zipper.t): Zipper.t => {
   let step = (d, z) =>

src/core/editor/Select.re

@@ -113,48 +113,50 @@ let hstep = (~char=false, d: Dir.t, z: Zipper.t): option(Zipper.t) => {
     let (tok, rest) = Zigg.pull(~side=sel.focus, sel.range);
     let (stepped, exited) = char ? hstep_tok(d, tok) : (tok, true);
 
-    switch (rest) {
-    // sel spanned more than one token
-    | Some(rest) =>
-      let zigg = exited ? rest : Zigg.grow(~side=sel.focus, stepped, rest);
-      let cur = Cursor.Select({...sel, range: zigg});
-      let ctx =
-        ctx_sans_site
-        |> Ctx.push(~onto=sel.focus, stepped)
-        |> push_site(~onto=Dir.toggle(sel.focus), site_anc);
-      return(Zipper.mk_button(~cur, ctx));
-    // sel was a single token, need to consider anchor side more carefully
-    | None =>
-      switch (stepped.marks, site_anc) {
-      | (None, _) =>
-        // must be true bc anchor does not move
-        assert(site_anc == Between);
-        let cur = Cursor.Point(Caret.focus());
-        let ctx = Ctx.push(~onto=sel.focus, stepped, ctx_sans_site);
-        return(Zipper.mk_button(~cur, ctx));
-      | (Some(Point(car)), Between) =>
-        assert(car.hand == Focus);
-        let cur = Cursor.Select({...sel, range: Zigg.of_tok(stepped)});
-        let ctx = Ctx.push(~onto=sel.focus, stepped, ctx_sans_site);
-        return(Zipper.mk_button(~cur, ctx));
-      | (Some(Point(car)), Within(_)) =>
-        assert(car.hand == Focus);
-        let cur = Cursor.Point(Caret.focus());
+    let z =
+      switch (rest) {
+      // sel spanned more than one token
+      | Some(rest) =>
+        let zigg = exited ? rest : Zigg.grow(~side=sel.focus, stepped, rest);
+        let cur = Cursor.Select({...sel, range: zigg});
         let ctx =
-          // maybe can encapsulate as push point ctx
           ctx_sans_site
           |> Ctx.push(~onto=sel.focus, stepped)
-          |> Ctx.push(~onto=Dir.toggle(sel.focus), stepped);
-        return(Zipper.mk_button(~cur, ctx));
-      | (Some(Select(_)), _) =>
-        let cur = Cursor.Select({...sel, range: Zigg.of_tok(stepped)});
-        let ctx =
-          ctx_sans_site
-          |> Ctx.push(~onto=sel.focus, stepped)
-          |> Ctx.push(~onto=Dir.toggle(sel.focus), stepped);
-        return(Zipper.mk_button(~cur, ctx));
-      }
-    };
+          |> push_site(~onto=Dir.toggle(sel.focus), site_anc);
+        Zipper.mk(~cur, ctx);
+      // sel was a single token, need to consider anchor side more carefully
+      | None =>
+        switch (stepped.marks, site_anc) {
+        | (None, _) =>
+          // must be true bc anchor does not move
+          assert(site_anc == Between);
+          let cur = Cursor.Point(Caret.focus());
+          let ctx = Ctx.push(~onto=sel.focus, stepped, ctx_sans_site);
+          Zipper.mk(~cur, ctx);
+        | (Some(Point(car)), Between) =>
+          assert(car.hand == Focus);
+          let cur = Cursor.Select({...sel, range: Zigg.of_tok(stepped)});
+          let ctx = Ctx.push(~onto=sel.focus, stepped, ctx_sans_site);
+          Zipper.mk(~cur, ctx);
+        | (Some(Point(car)), Within(_)) =>
+          assert(car.hand == Focus);
+          let cur = Cursor.Point(Caret.focus());
+          let ctx =
+            // maybe can encapsulate as push point ctx
+            ctx_sans_site
+            |> Ctx.push(~onto=sel.focus, stepped)
+            |> Ctx.push(~onto=Dir.toggle(sel.focus), stepped);
+          Zipper.mk(~cur, ctx);
+        | (Some(Select(_)), _) =>
+          let cur = Cursor.Select({...sel, range: Zigg.of_tok(stepped)});
+          let ctx =
+            ctx_sans_site
+            |> Ctx.push(~onto=sel.focus, stepped)
+            |> Ctx.push(~onto=Dir.toggle(sel.focus), stepped);
+          Zipper.mk(~cur, ctx);
+        }
+      };
+    return(Zipper.rebutton(z));
   };
 };
 

src/core/editor/Zipper.re

@@ -270,6 +270,7 @@ let zip = (~save_cursor=false, z: t) => {
   let zipped = save_cursor ? Cell.point(Focus) : Cell.empty;
   Ctx.zip(ctx, ~zipped, ~save_cursor);
 };
+let rebutton = (z: t) => zip(~save_cursor=true, z) |> unzip_exn;
 
 let path_of_ctx = (ctx: Ctx.t) => {
   let c = zip(~save_cursor=true, mk(ctx));
@@ -292,23 +293,6 @@ let normalize = (~cell: Cell.t, path: Path.t): Path.t => {
   car.path;
 };
 
-let mk_button = (~cur: Cursor.t, ctx) =>
-  switch (cur) {
-  | Point(_) => mk(~cur, Ctx.button(ctx))
-  | Select(sel) =>
-    let (l, r) =
-      Selection.carets(sel)
-      |> Tuples.map2(Caret.map(Fun.const(Path.empty)))
-      |> Tuples.map2(Cell.caret);
-    let ((dn, up), tl) = Ctx.uncons(ctx);
-    let (zigg, rolled_l, dn') =
-      Zigg.take_ineq(~side=L, sel.range, ~fill=l, dn);
-    let (zigg, rolled_r, up') = Zigg.take_ineq(~side=R, zigg, ~fill=r, up);
-    let cell = Cell.put(Zigg.roll(~l=rolled_l, zigg, ~r=rolled_r));
-    let ctx = Ctx.(button(cons((dn', up'), tl)));
-    unzip_exn(cell, ~ctx);
-  };
-
 let selection_str = (cur: Cursor.Base.t('tok)): option(string) =>
   switch (cur) {
   | Point(_) => None

src/core/parser/Melder.re

@@ -249,7 +249,15 @@ and discharge = (~remold, stack: Stack.t, ~fill=Cell.empty, t: Token.t) => {
       |> 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 l = Stack.cat(dn, {...stack, slope: tl});
+    let l = {
+      let bound =
+        switch (tl) {
+        | [] => stack.bound
+        | [t, ..._] => Node(t)
+        };
+      Stack.mk(bound, ~slope=dn);
+    };
     let r = {
       let (c_fill, up_fill) = Slope.Up.unroll(fill);
       let slope =
@@ -258,6 +266,7 @@ and discharge = (~remold, stack: Stack.t, ~fill=Cell.empty, t: Token.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);
+    let stack = Stack.cat(slope, {...stack, slope: tl});
+    push(~repair=remold, t, ~fill, stack, ~onto=L);
   };
 };

src/core/parser/Stack.re

@@ -14,6 +14,7 @@ module Base = {
 };
 include Base;
 
+let mk = (~slope=Slope.empty, bound) => {slope, bound};
 let empty = {slope: Slope.empty, bound: Bound.root};
 
 let cat = (slope: Slope.t, stack: t) => {