Merge branch 'melds' into grammar_filter_extensions

Makefile

@@ -1,6 +1,8 @@
 HTML_DIR=_build/default/src/web/www
 HTML_FILE=$(HTML_DIR)/index.html
 
+.PHONY: all deps release clean open watch test test-watch
+
 all:
 	dune build @src/fmt --auto-promote || true
 	dune build src --profile dev
@@ -42,3 +44,11 @@ open:
 
 watch:
 	dune build @src/fmt --auto-promote src --profile dev --watch
+
+test:
+	dune build @fmt --auto-promote || true
+	dune runtest --force
+
+test-watch:
+	dune build @fmt --auto-promote || true
+	dune runtest --watch

dune-project

@@ -1 +1,2 @@
 (lang dune 3.15)
+(formatting (enabled_for reason))

opam.export

@@ -1,6 +1,7 @@
 opam-version: "2.0"
 compiler: ["ocaml-base-compiler.5.0.0"]
 roots: [
+  "alcotest.1.7.0"
   "dune.3.15.0"
   "fmt.0.9.0"
   "incr_dom.v0.16.0"
@@ -21,6 +22,7 @@ roots: [
 ]
 installed: [
   "abstract_algebra.v0.16.0"
+  "alcotest.1.7.0"
   "angstrom.0.16.0"
   "astring.0.8.5"
   "async_js.v0.16.0"

src/core/editor/Ctx.re

@@ -22,6 +22,8 @@ module Base = {
       Fun.id,
       ctx,
     );
+  let map_toks = (f, ctx) =>
+    Chain.map(Frame.Open.map_toks(f), Frame.Closed.map_toks(f), ctx);
 };
 include Base;
 

src/core/editor/Frame.re

@@ -39,6 +39,8 @@ module Open = {
       | L => ([terr, ...dn], up)
       | R => (dn, [terr, ...up])
       };
+    let map_toks = (f, (dn, up)) =>
+      Slope.Base.(map_toks(f, dn), map_toks(f, up));
   };
   include Base;
   [@deriving (show({with_path: false}), sexp, yojson)]
@@ -131,4 +133,6 @@ module Closed = {
       let (r, up) = Slope.pull_terr(~from=R, r);
       (r, ([l], up));
     };
+  let map_toks = (f, (l, r)) =>
+    Terr.Base.(map_toks(f, l), map_toks(f, r));
 };

src/core/editor/Modify.re

@@ -156,9 +156,9 @@ let rec remold = (~fill=Cell.dirty, ctx: Ctx.t): (Cell.t, Ctx.t) => {
     P.show("dn", Slope.Dn.show(dn));
     P.show("fill", Cell.show(fill));
     let bounds = (l.bound, r.bound);
-    // Melder.dbg := true;
+    // Melder.debug := true;
     let cell = Melder.complete_bounded(~bounds, ~onto=L, dn, ~fill);
-    // Melder.dbg := false;
+    // Melder.debug := false;
     // P.show("completed", Cell.show(cell));
     let hd = ({...l, slope: []}, {...r, slope: []});
     let ctx = Ctx.link_stacks(hd, tl);
@@ -230,24 +230,33 @@ let extend = (~side=Dir.R, s: string, tok: Token.t) =>
   };
 let try_extend = (s: string, z: Zipper.t): option(Zipper.t) => {
   open Options.Syntax;
+  // P.log("--- Modify.try_extend");
   let* () = Options.of_bool(!Strings.is_empty(s));
+  // P.log("not empty");
   let (sites, ctx) = Zipper.cursor_site(z);
   let* site = Cursor.get_point(sites);
+  // P.log("cursor site is point");
   let+ (extended, ctx) =
     switch (site) {
     | Within(tok) =>
       let+ extended = extend(~side=R, s, tok);
       (extended, ctx);
     | Between =>
       let/ () = {
+        // P.log("--- Modify.try_extend/Between/trying left");
         let (face, ctx) = Ctx.pull(~from=L, ctx);
         let* tok = Delim.is_tok(face);
+        // P.log("is tok");
         let+ extended = extend(~side=R, s, tok);
+        // P.log("extended");
         (extended, ctx);
       };
+      // P.log("--- Modify.try_extend/Between/trying right");
       let (face, ctx) = Ctx.pull(~from=R, ctx);
       let* tok = Delim.is_tok(face);
+      // P.log("is tok");
       let+ extended = extend(~side=L, s, tok);
+      // P.log("extended");
       (extended, ctx);
     };
   ctx
@@ -327,13 +336,13 @@ let insert_toks =
   |> Chain.fold_left(
        fill => (ctx, fill),
        ((ctx, fill), tok, next_fill) => {
-         //  P.log("--- insert_toks/tok");
-         //  P.show("ctx", Ctx.show(ctx));
-         //  P.show("fill", Cell.show(fill));
+         //  P.log("--- Modify.insert_toks/tok");
          //  P.show("tok", Token.Unmolded.show(tok));
+         //  P.show("fill", Cell.show(fill));
+         //  P.show("ctx", Ctx.show(ctx));
          switch (mold(ctx, ~fill, tok)) {
          | Ok(ctx) =>
-           //  P.show("molded tok", Ctx.show(ctx));
+           //  P.show("-- Modify.insert_toks/tok/Ok ctx", Ctx.show(ctx));
            let (face, rest) = Ctx.pull(~from=L, ctx);
            switch (face, next_fill.marks.cursor) {
            // if molded token is longer than original, then move cursor out of
@@ -352,6 +361,7 @@ let insert_toks =
            | _ => (ctx, next_fill)
            };
          | Error(fill) =>
+           //  P.log("--- Modify.insert_toks/tok/Error removed");
            // removed empty token
            let next_fill =
              Cell.mark_ends_dirty(Cell.Space.merge(fill, next_fill));
@@ -366,20 +376,29 @@ let meld_remold =
     : option((Cell.t, Ctx.t)) => {
   P.log("--- Modify.meld_remold");
   open Options.Syntax;
+  // P.log("--- Modify.meld_remold");
+  // P.show("prev", Cell.show(prev));
+  // P.sexp("tok", Token.sexp_of_t(tok));
+  // P.show("next", Cell.show(next));
+  // P.show("ctx", Ctx.show(ctx));
   let ((l, r), rest) = Ctx.unlink_stacks(ctx);
   let* (grouted, l) =
     Melder.push(tok, ~fill=prev, l, ~onto=L, ~repair=Molder.remold);
+  // P.log("--- Modify.meld_remold/pushed");
+  // P.show("grouted", Grouted.show(grouted));
+  // P.show("l", Stack.show(l));
   let is_redundant =
-    Token.is_empty(tok)
+    tok.text == ""
     && (
-      Grouted.is_neq(grouted)
+      Token.is_complete(tok)
+      || Grouted.is_neq(grouted)
       || Option.is_some(Grouted.is_eq(grouted))
       && l.slope == []
     );
   if (is_redundant) {
     P.log("--- Modify.meld_remold/is_redundant");
     Effects.remove(tok);
-    let fill = Cell.Space.merge(prev, next);
+    let fill = Cell.Space.merge(prev, ~fill=Cell.degrouted, next);
     Some(remold(~fill, ctx));
   } else {
     P.log("--- Modify.meld_remold/not_redundant");
@@ -407,31 +426,37 @@ let meld_remold =
     // P.show("effects", Fmt.(to_to_string(list(Effects.pp), Effects.log^)));
     switch (tok.mtrl) {
     | Tile((lbl, _))
+        // delay expansion if obligations more severe than holes
         when
           !expanding
           && !Label.is_instant(lbl)
-          && Oblig.Delta.(not_hole(of_effects(Effects.log^))) =>
+          && Oblig.Delta.(not_hole(of_effects(Effects.log^)))
+          // this is necessary when deleting delims to empty ghosts
+          && !Token.is_empty(tok) =>
       None
     | _ => Some(remolded)
     };
   };
 };
 
 let expand_remold =
-    (tok: Token.Unmolded.t, ~fill, ctx: Ctx.t): (Cell.t, Ctx.t) => {
+    (tok: Token.Unmolded.t, ~fill, ctx: Ctx.t): (Token.t, (Cell.t, Ctx.t)) => {
   switch (
     Molder.candidates(tok)
     |> Oblig.Delta.minimize(tok =>
          meld_remold(~expanding=true, Cell.dirty, tok, fill, ctx)
+         |> Option.map(r => (tok, r))
        )
   ) {
-  | Some((cell, ctx)) => (cell, ctx)
+  | Some(r) => r
   | None =>
     let tok = Token.Unmolded.defer(tok);
-    meld_remold(~expanding=true, Cell.dirty, tok, fill, ctx)
-    |> Options.get_fail(
-         "bug: at least deferred candidate should have succeeded",
-       );
+    let r =
+      meld_remold(~expanding=true, Cell.dirty, tok, fill, ctx)
+      |> Options.get_fail(
+           "bug: at least deferred candidate should have succeeded",
+         );
+    (tok, r);
   };
 };
 // maybe rename expandable
@@ -449,7 +474,7 @@ let expand = (tok: Token.t): option(Token.Unmolded.t) =>
     };
   | Tile(_) =>
     open Options.Syntax;
-    let* labeled = Labeler.single(tok.text);
+    let* labeled = Labeler.single(~id=tok.id, tok.text);
     Token.Unmolded.expands(labeled);
   };
 let try_expand = (s: string, z: Zipper.t): option(Zipper.t) => {
@@ -460,30 +485,42 @@ let try_expand = (s: string, z: Zipper.t): option(Zipper.t) => {
   let* tok = Delim.is_tok(face);
   // if expandable, consider all expandable const labels
   let* expanded = expand(tok);
-  let (remolded, ctx) =
+  let (molded, (remolded, ctx)) =
     expand_remold(expanded, ~fill=Cell.point(~dirty=true, Focus), rest);
-  return(finalize_(remolded, ctx));
+  molded == tok ? None : return(finalize_(remolded, ctx));
 };
 
 let mold_remold =
     (prev, tok: Token.Unmolded.t, next, ctx: Ctx.t): (Cell.t, Ctx.t) => {
-  Molder.candidates(tok)
-  @ [Token.Unmolded.defer(tok)]
-  |> Oblig.Delta.minimize(tok => meld_remold(prev, tok, next, ctx))
-  |> Options.get_fail(
-       "bug: at least deferred candidate should have succeeded",
-     );
+  open Options.Syntax;
+  // P.log("--- Modify.mold_remold");
+  // P.show("prev", Cell.show(prev));
+  // P.show("tok", Token.Unmolded.show(tok));
+  // P.show("next", Cell.show(next));
+  // P.show("ctx", Ctx.show(ctx));
+  let- () =
+    Molder.candidates(tok)
+    @ (tok.text == "" ? [] : [Token.Unmolded.defer(tok)])
+    |> Oblig.Delta.minimize(tok => meld_remold(prev, tok, next, ctx));
+  assert(tok.text == "");
+  let fill = Cell.Space.merge(prev, ~fill=Cell.degrouted, next);
+  remold(~fill, ctx);
 };
 
 let insert_remold =
     (toks: Chain.t(Cell.t, Token.Unmolded.t), ctx: Ctx.t): (Cell.t, Ctx.t) => {
+  // P.log("--- Modify.insert_remold");
+  // P.show("ctx", Ctx.show(ctx));
   switch (Chain.(unlink(rev(toks)))) {
   | Error(cell) => remold(~fill=cell, ctx)
   | Ok((next, tok, toks)) =>
+    // P.log("--- Modify.insert_remold/Ok");
+    // P.show("next", Cell.show(next));
+    // P.show("tok", Token.Unmolded.show(tok));
+    // P.show("toks", Chain.show(Cell.pp, Token.Unmolded.pp, toks));
     let (ctx, prev) = insert_toks(Chain.rev(toks), ctx);
-    P.show("ctx", Ctx.show(ctx));
-    P.show("prev", Cell.show(prev));
-    P.show("next", Cell.show(next));
+    // P.show("inserted toks ctx", Ctx.show(ctx));
+    // P.show("prev", Cell.show(prev));
     mold_remold(prev, tok, next, ctx);
   };
 };
@@ -513,7 +550,7 @@ let delete_sel = (d: Dir.t, z: Zipper.t): Zipper.t => {
           : Fun.id
       )
       |> delete_toks(d);
-    // P.log("--- delete_sel/Select");
+    // P.log("--- Modify.delete_sel/Select");
     // P.show("ctx sans sites", Ctx.show(ctx));
     // P.show("site l", Zipper.Site.show(l));
     // P.show("site r", Zipper.Site.show(r));
@@ -532,6 +569,7 @@ let try_truncate = (z: Zipper.t) => {
   switch (z.cur) {
   | Point(_) => None
   | Select(sel) =>
+    // P.log("--- Modify.try_truncate");
     // prune ctx of any duplicated tokens
     let (sites, ctx) = Zipper.cursor_site(z);
     let (l, r) = Option.get(Cursor.get_select(sites));
@@ -552,6 +590,7 @@ let try_truncate = (z: Zipper.t) => {
     | [tok] =>
       switch (Token.split_text(tok)) {
       | Some((l, _, "")) when !Strings.is_empty(l) =>
+        // P.log("--- Modify.try_truncate/success");
         let tok = {
           ...tok,
           text: l,
@@ -585,7 +624,7 @@ let delete = (d: Dir.t, z: Zipper.t) => {
   //     Move.perform(Step(H(d)), z)
   //   | _ => None
   //   };
-  // P.log("--- delete");
+  // P.log("--- Modify.delete");
   // P.show("z", Zipper.show(z));
   let+ z =
     Cursor.is_point(z.cur) ? Select.hstep(~char=true, d, z) : return(z);

src/core/editor/Tab.re

@@ -23,6 +23,7 @@ let perform = (d: Dir.t, z: Zipper.t): option(Zipper.t) =>
   | (Select(_), _) => Move.hstep(d, z)
   | (Point(site), ctx) =>
     open Options.Syntax;
+    // P.log("--- Tab.perform/Point");
     // first try completing or expanding a neighbor
     let/ () =
       switch (d) {
@@ -33,6 +34,7 @@ let perform = (d: Dir.t, z: Zipper.t): option(Zipper.t) =>
       };
     // otherwise jump to next obligation
     let c = Zipper.zip(~save_cursor=true, z);
+    // P.show("c", Cell.show(c));
     let normal = Zipper.normalize(~cell=c);
     let car =
       c.marks.cursor
@@ -51,6 +53,7 @@ let perform = (d: Dir.t, z: Zipper.t): option(Zipper.t) =>
          )
       |> Option.map(fst)
       |> Options.get(() => Cell.end_path(~side=d, c));
+    // P.show("path", Path.show(path));
     c
     |> Cell.put_cursor(Point(Caret.focus(path)))
     |> Zipper.unzip_exn

src/core/editor/Zigg.re

@@ -22,6 +22,11 @@ module Base = {
     let top = Dir.pick(d, (Fun.id, Wald.rev), top);
     mk(~up, top, ~dn);
   };
+  let map_toks = (f, {up, top, dn}: t(_)) => {
+    up: Slope.Base.map_toks(f, up),
+    top: Wald.Base.map_toks(f, top),
+    dn: Slope.Base.map_toks(f, dn),
+  };
 };
 include Base;
 

src/core/editor/Zipper.re

@@ -21,6 +21,7 @@ module Selection = {
   type t = Base.t(Token.t);
   let split_range = Fun.const(((), ()));
   let carets = carets(~split_range);
+  let map_toks = (f, sel) => Selection.map(Zigg.map_toks(f), sel);
 };
 module Cur = Cursor;
 module Cursor = {
@@ -31,6 +32,7 @@ module Cursor = {
   };
   [@deriving (show({with_path: false}), sexp, yojson)]
   type t = Base.t(Token.t);
+  let map_toks = (f, cur) => Cur.map(Fun.id, Selection.map_toks(f), cur);
   // let flatten: t => _ =
   //   fun
   //   | Point(_) => []
@@ -61,6 +63,9 @@ type t = Base.t(Token.t);
 
 let mk = (~cur=Cursor.point(Caret.focus()), ctx) => Base.{cur, ctx};
 
+let map_toks = (f, {cur, ctx}: t) =>
+  Base.{cur: Cursor.map_toks(f, cur), ctx: Ctx.map_toks(f, ctx)};
+
 let empty =
   mk(
     ~cur=Point(Caret.focus()),

src/core/parser/Effects.re

@@ -16,7 +16,17 @@ let oprint = x => {
   x;
 };
 
-let perform = (eff: t) => log := [eff, ...log^];
+let invert = (eff: t): t =>
+  switch (eff) {
+  | Insert(tok) => Remove(tok)
+  | Remove(tok) => Insert(tok)
+  };
+
+let perform = (eff: t) => {
+  log :=
+    List.mem(invert(eff), log^)
+      ? List.filter(eff' => eff' != invert(eff), log^) : [eff, ...log^];
+};
 let insert = tok => {
   perform(Insert(tok));
   tok;