Add deriving eq so we can test the editor/zippers

src/haz3lcore/dune

@@ -12,7 +12,8 @@
    js_of_ocaml-ppx
    ppx_let
    ppx_sexp_conv
-   ppx_deriving.show)))
+   ppx_deriving.show
+   ppx_deriving.eq)))
 
 (env
  (dev

src/haz3lcore/dynamics/FilterAction.re

@@ -1,14 +1,14 @@
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type action =
   | Step
   | Eval;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type count =
   | One
   | All;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = (action, count);
 
 let string_of_t = v => {

src/haz3lcore/dynamics/InvalidOperationError.re

@@ -1,4 +1,4 @@
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t =
   | InvalidOfString
   | IndexOutOfBounds

src/haz3lcore/dynamics/VarBstMap.re

@@ -29,7 +29,7 @@ module Inner = {
 };
 
 module VarBstMap0 = {
-  [@deriving (show({with_path: false}), sexp, yojson)]
+  [@deriving (show({with_path: false}), sexp, yojson, eq)]
   type t_('a) = Inner.t('a);
 
   let empty = Inner.empty;
@@ -61,6 +61,8 @@ module VarBstMap0 = {
   let to_list = ctx => ctx |> Inner.to_seq |> List.of_seq;
 
   let of_list = bindings => bindings |> List.to_seq |> Inner.of_seq;
+
+  let equal = Inner.equal;
 };
 
 module Ordered = {
@@ -206,6 +208,9 @@ module Ordered = {
   let without_keys = (keys, m) => {
     filterk(((s, _)) => !List.exists(x => x == s, keys), m);
   };
+
+  let equal_t_ = (cmp, m1, m2) =>
+    VarBstMap0.equal(cmp, m1.map, m2.map) && m1.rev_order == m2.rev_order;
 };
 
 include VarBstMap0;

src/haz3lcore/dynamics/VarBstMap.rei

@@ -174,4 +174,6 @@ module Ordered: {
     [without_keys] removes all entires with the given keys from the map
    */
   let without_keys: (list(Var.t), t_('a)) => t_('a);
+
+  let equal_t_: (('a, 'a) => bool, t_('a), t_('a)) => bool;
 };

src/haz3lcore/lang/Operators.re

@@ -1,21 +1,21 @@
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type op_un_bool =
   | Not;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type op_un_meta =
   | Unquote;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type op_un_int =
   | Minus;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type op_bin_bool =
   | And
   | Or;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type op_bin_int =
   | Plus
   | Minus
@@ -29,7 +29,7 @@ type op_bin_int =
   | Equals
   | NotEquals;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type op_bin_float =
   | Plus
   | Minus
@@ -43,25 +43,25 @@ type op_bin_float =
   | Equals
   | NotEquals;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type op_bin_string =
   | Concat
   | Equals;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type op_un =
   | Meta(op_un_meta)
   | Int(op_un_int)
   | Bool(op_un_bool);
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type op_bin =
   | Int(op_bin_int)
   | Float(op_bin_float)
   | Bool(op_bin_bool)
   | String(op_bin_string);
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type ap_direction =
   | Forward
   | Reverse;

src/haz3lcore/lang/Precedence.re

@@ -3,7 +3,7 @@ open Util;
 /**
  * higher precedence means lower int representation
  */
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = int;
 
 let max: t = 0;

src/haz3lcore/lang/Sort.re

@@ -1,4 +1,4 @@
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t =
   | Any
   | Nul

src/haz3lcore/lang/term/IdTagged.re

@@ -14,6 +14,8 @@ type t('a) = {
   term: 'a,
 };
 
+// TODO This fully ignores ids for equality
+let equal = (eq, a, b) => eq(a.term, b.term);
 // To be used if you want to remove the id from the debug output
 // let pp: ((Format.formatter, 'a) => unit, Format.formatter, t('a)) => unit =
 //   (fmt_a, formatter, ta) => {

src/haz3lcore/statics/TermBase.re

@@ -2,7 +2,7 @@ open Util;
 
 let continue = x => x;
 let stop = (_, x) => x;
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type deferral_position_t =
   | InAp
   | OutsideAp;
@@ -46,7 +46,7 @@ type deferral_position_t =
      the id of the closure.
  */
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type any_t =
   | Exp(exp_t)
   | Pat(pat_t)

src/haz3lcore/statics/Var.re

@@ -1,6 +1,6 @@
 open Util;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = string;
 
 let eq = String.equal;

src/haz3lcore/tiles/Base.re

@@ -3,7 +3,7 @@ open Util;
 /* The different kinds of projector. New projectors
  * types need to be registered here in order to be
  * able to create and update their instances */
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type kind =
   | Fold
   | Info
@@ -12,7 +12,7 @@ type kind =
   | SliderF
   | TextArea;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type segment = list(piece)
 and piece =
   | Tile(tile)
@@ -25,13 +25,15 @@ and tile = {
   // - length(shards) <= length(label)
   // - length(shards) == length(children) + 1
   // - sort(shards) == shards
+  [@equal (_, _) => true]
   id: Id.t,
   label: Label.t,
   mold: Mold.t,
   shards: list(int),
   children: list(segment),
 }
 and projector = {
+  [@equal (_, _) => true]
   id: Id.t,
   kind,
   syntax: piece,

src/haz3lcore/tiles/Grout.re

@@ -1,6 +1,6 @@
 open Util;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type shape =
   | Convex
   | Concave;
@@ -10,7 +10,7 @@ type t = {
   id: Id.t,
   shape,
 };
-
+let equal = (a: t, b: t) => a.shape == b.shape;
 let id = g => g.id;
 
 let shapes = g =>

src/haz3lcore/tiles/Id.re

@@ -58,6 +58,7 @@ let t_of_yojson: Yojson.Safe.t => Uuidm.t =
 
 type t = Uuidm.t;
 
+let equal: (t, t) => bool = (==);
 let mk: unit => t = Uuidm.v4_gen(Random.State.make_self_init());
 
 let compare: (t, t) => int = Uuidm.compare;

src/haz3lcore/tiles/Label.re

@@ -1,6 +1,6 @@
 open Util;
 
 /* A label is the textual expression of a form's delimiters */
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = list(Token.t);
 exception Empty_label;

src/haz3lcore/tiles/Mold.re

@@ -1,6 +1,6 @@
 open Util;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = {
   out: Sort.t,
   in_: list(Sort.t),

src/haz3lcore/tiles/Nib.re

@@ -1,7 +1,7 @@
 open Util;
 
 module Shape = {
-  [@deriving (show({with_path: false}), sexp, yojson)]
+  [@deriving (show({with_path: false}), sexp, yojson, eq)]
   type t =
     | Convex
     | Concave(Precedence.t);
@@ -45,7 +45,7 @@ module Shape = {
     };
 };
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = {
   shape: Shape.t,
   sort: Sort.t,

src/haz3lcore/tiles/Nibs.re

@@ -1,4 +1,4 @@
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = (Nib.t, Nib.t);
 
 [@deriving show]

src/haz3lcore/tiles/Piece.re

@@ -1,6 +1,6 @@
 include Base;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = piece;
 
 let secondary = w => Secondary(w);

src/haz3lcore/tiles/Secondary.re

@@ -1,11 +1,11 @@
 open Util;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type cls =
   | Whitespace
   | Comment;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type secondary_content =
   | Whitespace(string)
   | Comment(string);
@@ -16,6 +16,7 @@ type t = {
   content: secondary_content,
 };
 
+let equal = (a: t, b: t) => a.content == b.content;
 let cls_of = (s: t): cls =>
   switch (s.content) {
   | Whitespace(_) => Whitespace

src/haz3lcore/tiles/Segment.re

@@ -2,7 +2,7 @@ open Util;
 
 exception Empty_segment;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = Base.segment;
 
 let empty = [];

src/haz3lcore/tiles/Token.re

@@ -1,7 +1,7 @@
 open Util;
 
 // make an enum
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = string;
 
 module Index = {

src/haz3lcore/zipper/Ancestor.re

@@ -2,11 +2,12 @@ open Util;
 
 exception Empty_shard_affix;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type step = int;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = {
+  [@equal (_, _) => true]
   id: Id.t,
   label: Label.t,
   mold: Mold.t,

src/haz3lcore/zipper/Ancestors.re

@@ -1,9 +1,9 @@
 open Util;
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type generation = (Ancestor.t, Siblings.t);
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = list(generation);
 
 let empty = [];

src/haz3lcore/zipper/Backpack.re

@@ -203,7 +203,7 @@ module ShardInfo = {
   };
 };
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = list(Selection.t);
 
 let empty = [];

src/haz3lcore/zipper/Editor.re

@@ -140,6 +140,7 @@ module State = {
     meta: Meta.t,
   };
 
+  let equal = (a: t, b: t) => Zipper.equal(a.zipper, b.zipper);
   let init = (zipper, ~settings: CoreSettings.t) => {
     zipper,
     meta: Meta.init(zipper, ~settings),
@@ -152,9 +153,9 @@ module State = {
 };
 
 module History = {
-  [@deriving (show({with_path: false}), sexp, yojson)]
+  [@deriving (show({with_path: false}), sexp, yojson, eq)]
   type affix = list((Action.t, State.t));
-  [@deriving (show({with_path: false}), sexp, yojson)]
+  [@deriving (show({with_path: false}), sexp, yojson, eq)]
   type t = (affix, affix);
 
   let empty = ([], []);
@@ -165,7 +166,7 @@ module History = {
   );
 };
 
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t = {
   state: State.t,
   history: History.t,