edit action history panel

src/hazelcore/semantics/Action.re

@@ -45,6 +45,25 @@ type t =
   | Backspace
   | Construct(shape);
 
+/* group entries in undo_history if their shapes are similar */
+let can_group_shape = (shape_1: shape, shape_2: shape): bool => {
+  switch (shape_1, shape_2) {
+  | (SLine, SLine)
+  | (SChar(_), _) => true
+  | (SParenthesized, _)
+  | (SList, _)
+  | (SAsc, _)
+  | (SLam, _)
+  | (SListNil, _)
+  | (SInj(_), _)
+  | (SLet, _)
+  | (SLine, _)
+  | (SCase, _)
+  | (SOp(_), _)
+  | (SApPalette(_), _) => false
+  };
+};
+
 module Outcome = {
   type t('success) =
     | Succeeded('success)

src/hazelcore/semantics/CursorInfo.re

@@ -80,6 +80,16 @@ type typed =
   | OnLine
   | OnRule;
 
+type cursor_term =
+  | Exp(CursorPosition.t, UHExp.operand)
+  | Pat(CursorPosition.t, UHPat.operand)
+  | Typ(CursorPosition.t, UHTyp.operand)
+  | ExpOp(CursorPosition.t, UHExp.operator)
+  | PatOp(CursorPosition.t, UHPat.operator)
+  | TypOp(CursorPosition.t, UHTyp.operator)
+  | Line(CursorPosition.t, UHExp.line)
+  | Rule(CursorPosition.t, UHExp.rule);
+
 // TODO refactor into variants
 // based on term family and shape
 [@deriving sexp]
@@ -90,6 +100,154 @@ type t = {
   uses: option(UsageAnalysis.uses_list),
 };
 
+let rec extract_cursor_term = (exp: ZExp.t): (option(cursor_term), bool) => {
+  let cursor_term = extract_cursor_exp_term(exp);
+  let prev_is_empty_line = {
+    let prefix = ZList.prj_prefix(exp);
+    switch (ListUtil.split_last(prefix)) {
+    | None => false
+    | Some((_, elt)) => UHExp.is_empty_line(elt)
+    };
+  };
+  (cursor_term, prev_is_empty_line);
+}
+and extract_cursor_exp_term = (exp: ZExp.t): option(cursor_term) => {
+  extract_from_zline(ZList.prj_z(exp));
+}
+and extract_from_zline = (zline: ZExp.zline): option(cursor_term) => {
+  switch (zline) {
+  | CursorL(cursor_pos, uex_line) => Some(Line(cursor_pos, uex_line))
+  | ExpLineZ(zopseq) => extract_from_zexp_opseq(zopseq)
+  | LetLineZP(zpat, _, _) => extract_cursor_pat_term(zpat)
+  | LetLineZA(_, ztyp, _) => extract_cursor_type_term(ztyp)
+  | LetLineZE(_, _, zexp) => extract_cursor_exp_term(zexp)
+  };
+}
+and extract_from_zexp_operand =
+    (zexp_operand: ZExp.zoperand): option(cursor_term) => {
+  switch (zexp_operand) {
+  | CursorE(cursor_pos, operand) => Some(Exp(cursor_pos, operand))
+  | ParenthesizedZ(zexp) => extract_cursor_exp_term(zexp)
+  | LamZP(_, zpat, _, _) => extract_cursor_pat_term(zpat)
+  | LamZA(_, _, ztyp, _) => extract_cursor_type_term(ztyp)
+  | LamZE(_, _, _, zexp)
+  | InjZ(_, _, zexp)
+  | CaseZE(_, zexp, _, _) => extract_cursor_exp_term(zexp)
+  | CaseZR(_, _, zrules, _) => extract_from_zrules(zrules)
+  | CaseZA(_, _, _, ztyp) => extract_cursor_type_term(ztyp)
+  | ApPaletteZ(_, _, _, _) => failwith("ApPalette is not implemented")
+  };
+}
+and extract_from_zrules = (zrules: ZExp.zrules): option(cursor_term) => {
+  let zrule = ZList.prj_z(zrules);
+  switch (zrule) {
+  | CursorR(cursor_pos, uex_rule) => Some(Rule(cursor_pos, uex_rule))
+  | RuleZP(zpat, _) => extract_cursor_pat_term(zpat)
+  | RuleZE(_, zexp) => extract_cursor_exp_term(zexp)
+  };
+}
+and extract_from_zexp_opseq = (zopseq: ZExp.zopseq): option(cursor_term) => {
+  switch (zopseq) {
+  | ZOpSeq(_, zseq) =>
+    switch (zseq) {
+    | ZOperand(zoperand, _) => extract_from_zexp_operand(zoperand)
+    | ZOperator(zoperator, _) =>
+      let (cursor_pos, uop) = zoperator;
+      Some(ExpOp(cursor_pos, uop));
+    }
+  };
+}
+and extract_cursor_pat_term = (zpat: ZPat.t): option(cursor_term) => {
+  switch (zpat) {
+  | ZOpSeq(_, zseq) =>
+    switch (zseq) {
+    | ZOperand(zpat_operand, _) => extract_from_zpat_operand(zpat_operand)
+    | ZOperator(zpat_operator, _) =>
+      let (cursor_pos, uop) = zpat_operator;
+      Some(PatOp(cursor_pos, uop));
+    }
+  };
+}
+and extract_from_zpat_operand =
+    (zpat_operand: ZPat.zoperand): option(cursor_term) => {
+  switch (zpat_operand) {
+  | CursorP(cursor_pos, upat_operand) => Some(Pat(cursor_pos, upat_operand))
+  | ParenthesizedZ(zpat)
+  | InjZ(_, _, zpat) => extract_cursor_pat_term(zpat)
+  };
+}
+and extract_cursor_type_term = (ztyp: ZTyp.t): option(cursor_term) => {
+  switch (ztyp) {
+  | ZOpSeq(_, zseq) =>
+    switch (zseq) {
+    | ZOperand(ztyp_operand, _) => extract_from_ztyp_operand(ztyp_operand)
+    | ZOperator(ztyp_operator, _) =>
+      let (cursor_pos, uop) = ztyp_operator;
+      Some(TypOp(cursor_pos, uop));
+    }
+  };
+}
+and extract_from_ztyp_operand =
+    (ztyp_operand: ZTyp.zoperand): option(cursor_term) => {
+  switch (ztyp_operand) {
+  | CursorT(cursor_pos, utyp_operand) => Some(Typ(cursor_pos, utyp_operand))
+  | ParenthesizedZ(ztyp)
+  | ListZ(ztyp) => extract_cursor_type_term(ztyp)
+  };
+};
+
+let can_group_cursor_term =
+    (cursor_term_1: option(cursor_term), cursor_term_2: option(cursor_term))
+    : bool => {
+  switch (cursor_term_1, cursor_term_2) {
+  | (None, _)
+  | (_, None) => false
+  | (Some(cur1), Some(cur2)) =>
+    switch (cur1, cur2) {
+    | (Exp(_, op1), Exp(_, op2)) => UHExp.can_group_operand(op1, op2)
+    | (Pat(_, op1), Pat(_, op2)) => UHPat.can_group_operand(op1, op2)
+    | (Line(_, line1), Line(_, line2)) =>
+      UHExp.can_group_lines(line1, line2)
+    | (Exp(_, _), _)
+    | (Pat(_, _), _)
+    | (Typ(_, _), _)
+    | (ExpOp(_, _), _)
+    | (PatOp(_, _), _)
+    | (TypOp(_, _), _)
+    | (Line(_, _), _)
+    | (Rule(_, _), _) => false
+    }
+  };
+};
+let is_hole = (cursor_term: option(cursor_term)): bool => {
+  switch (cursor_term) {
+  | None => false
+  | Some(cursor_term') =>
+    switch (cursor_term') {
+    | Exp(_, exp) => UHExp.operand_is_hole(exp)
+    | Pat(_, pat) => UHPat.operand_is_hole(pat)
+    | Typ(_, typ) => UHTyp.operand_is_hole(typ)
+    | ExpOp(_, _)
+    | PatOp(_, _)
+    | TypOp(_, _)
+    | Line(_, _)
+    | Rule(_, _) => false
+    }
+  };
+};
+
+let get_cursor_pos = (cursor_term: cursor_term) => {
+  switch (cursor_term) {
+  | Exp(cursor_pos, _)
+  | Pat(cursor_pos, _)
+  | Typ(cursor_pos, _)
+  | ExpOp(cursor_pos, _)
+  | PatOp(cursor_pos, _)
+  | TypOp(cursor_pos, _)
+  | Line(cursor_pos, _)
+  | Rule(cursor_pos, _) => cursor_pos
+  };
+};
 let mk = (~uses=?, typed, ctx) => {typed, ctx, uses};
 
 let get_ctx = ci => ci.ctx;

src/hazelcore/semantics/ErrStatus.re

@@ -4,9 +4,8 @@ module HoleReason = {
   type t =
     | TypeInconsistent
     | WrongLength;
-};
+} /* Variable: `err` */;
 
-/* Variable: `err` */
 [@deriving sexp]
 type t =
   | NotInHole

src/hazelcore/semantics/Monads.re

@@ -1,10 +1,10 @@
 /* TODO: we might want to just use this API?
 
-    https://github.com/rgrinberg/ocaml-mtl/blob/master/lib/mtl.ml
+                                                                                                             https://github.com/rgrinberg/ocaml-mtl/blob/master/lib/mtl.ml
 
-   Though it's a bit heavy, especially with the extra type parameter...
+                                                                                                            Though it's a bit heavy, especially with the extra type parameter...
 
-   In any case, that's a good reference. */
+                                                                                                            In any case, that's a good reference. */
 
 module type MONAD = {
   [@deriving sexp]