Haz3l binding uses

src/haz3lcore/VarMap.re

@@ -19,6 +19,9 @@ let concat = (ctx, new_ctx) => new_ctx @ ctx;
 
 let lookup = (ctx, x) => List.assoc_opt(x, ctx);
 
+let lookup_all = (ctx, x) =>
+  List.fold_left((vs, (tok, v)) => {tok == x ? [v, ...vs] : vs}, [], ctx);
+
 let contains = (ctx, x) => List.mem_assoc(x, ctx);
 
 let map = (f, xs) => List.map(((x, _) as xa) => (x, f(xa)), xs);

src/haz3lcore/statics/Statics.re

@@ -38,7 +38,8 @@ type info_pat = {
   term: Term.UPat.t,
   mode: Typ.mode,
   self: Typ.self,
-  ctx: Ctx.t // TODO: detect in-pattern shadowing
+  ctx: Ctx.t, // TODO: detect in-pattern shadowing
+  body_ids: list(Id.t),
 };
 
 /* (Syntactic) Types are assigned their corresponding semantic type. */
@@ -160,6 +161,90 @@ let is_error = (ci: t): bool => {
   };
 };
 
+type usage_info = (Token.t, list(Id.t));
+let binding_uses = (ci: t, info_map: map): list(usage_info) => {
+  switch (ci) {
+  | InfoPat({term, body_ids, _}) =>
+    let bindings = List.sort_uniq(compare, Term.UPat.get_all_bindings(term));
+    let exps_to_search: list(info_exp) =
+      List.fold_left(
+        (exps, id) => {
+          switch (Id.Map.find_opt(id, info_map)) {
+          | Some(InfoExp(info_body)) => [info_body, ...exps]
+          | _ => exps
+          }
+        },
+        [],
+        body_ids,
+      );
+    let empty_bindings_map: list(usage_info) =
+      List.map(var => (var, []), bindings);
+    let bindings_map =
+      List.fold_left(
+        (binding_map: list(usage_info), info_exp: info_exp) => {
+          let updated_map: list(usage_info) =
+            List.map(
+              (usage_pair: usage_info) => {
+                let (var, ids) = usage_pair;
+                let new_ids: list(Id.t) =
+                  List.map(
+                    (item: Ctx.co_item) => {item.id},
+                    List.flatten(VarMap.lookup_all(info_exp.free, var)),
+                  );
+                print_string("co_ctx | ");
+                let _ =
+                  List.map(
+                    coctx_pair => {
+                      let (var, co_items) = coctx_pair;
+                      print_string(var);
+                      print_string(":[");
+                      let _ =
+                        List.map(
+                          (co_it: Ctx.co_item) => {
+                            print_int(co_it.id);
+                            print_string(",");
+                          },
+                          co_items,
+                        );
+                      print_string("]; ");
+                    },
+                    info_exp.free,
+                  );
+                let all_ids: list(Id.t) =
+                  List.sort_uniq(compare, new_ids @ ids);
+                let pair: (Token.t, list(Id.t)) = (var, all_ids);
+                pair;
+              },
+              binding_map,
+            );
+          updated_map;
+        },
+        empty_bindings_map,
+        exps_to_search,
+      );
+    let _ =
+      List.map(
+        (usage_pair: usage_info) => {
+          let (var, ids) = usage_pair;
+          print_string(var);
+          print_string(": ");
+          let _ =
+            List.map(
+              id => {
+                print_int(id);
+                print_string(", ");
+              },
+              ids,
+            );
+          print_newline();
+        },
+        bindings_map,
+      );
+    bindings_map;
+  | _ => []
+  };
+};
+
 /* Determined the type of an expression or pattern 'after hole wrapping';
    that is, all ill-typed terms are considered to be 'wrapped in
    non-empty holes', i.e. assigned Unknown type. */
@@ -226,12 +311,13 @@ let add_info = (ids, info: 'a, m: Ptmap.t('a)) =>
   |> List.fold_left(Id.Map.disj_union, m);
 
 let extend_let_def_ctx =
-    (ctx: Ctx.t, pat: Term.UPat.t, pat_ctx: Ctx.t, def: Term.UExp.t) =>
+    (ctx: Ctx.t, pat: Term.UPat.t, pat_ctx: Ctx.t, def: Term.UExp.t)
+    : (Ctx.t, bool) =>
   if (Term.UPat.is_tuple_of_arrows(pat)
       && Term.UExp.is_tuple_of_functions(def)) {
-    VarMap.concat(ctx, pat_ctx);
+    (VarMap.concat(ctx, pat_ctx), true);
   } else {
-    ctx;
+    (ctx, false);
   };
 
 let typ_exp_binop_bin_int: Term.UExp.op_bin_int => Typ.t =
@@ -415,7 +501,8 @@ and uexp_to_info_map =
     );
   | Fun(pat, body) =>
     let (mode_pat, mode_body) = Typ.matched_arrow_mode(mode);
-    let (ty_pat, ctx_pat, m_pat) = upat_to_info_map(~mode=mode_pat, pat);
+    let (ty_pat, ctx_pat, m_pat) =
+      upat_to_info_map(~mode=mode_pat, ~body_ids=body.ids, pat);
     let ctx_body = VarMap.concat(ctx, ctx_pat);
     let (ty_body, free_body, m_body) =
       uexp_to_info_map(~ctx=ctx_body, ~mode=mode_body, body);
@@ -425,25 +512,49 @@ and uexp_to_info_map =
       union_m([m_pat, m_body]),
     );
   | Let(pat, def, body) =>
-    let (ty_pat, ctx_pat, _m_pat) = upat_to_info_map(~mode=Syn, pat);
-    let def_ctx = extend_let_def_ctx(ctx, pat, ctx_pat, def);
+    let (ty_pat, ctx_pat, _m_pat) =
+      upat_to_info_map(~mode=Syn, ~body_ids=body.ids @ def.ids, pat);
+    let (def_ctx, is_rec) = extend_let_def_ctx(ctx, pat, ctx_pat, def);
+    // use this ^^ to determine if recursive let or not
     let (ty_def, free_def, m_def) =
       uexp_to_info_map(~ctx=def_ctx, ~mode=Ana(ty_pat), def);
     /* Analyze pattern to incorporate def type into ctx */
-    let (_, ctx_pat_ana, m_pat) = upat_to_info_map(~mode=Ana(ty_def), pat);
+    let pat_body_ids =
+      if (is_rec) {
+        body.ids @ def.ids;
+      } else {
+        body.ids;
+      };
+    let (_, ctx_pat_ana, m_pat) =
+      upat_to_info_map(~mode=Ana(ty_def), ~body_ids=pat_body_ids, pat);
     let ctx_body = VarMap.concat(ctx, ctx_pat_ana);
     let (ty_body, free_body, m_body) =
       uexp_to_info_map(~ctx=ctx_body, ~mode, body);
     add(
       ~self=Just(ty_body),
-      ~free=Ctx.union([free_def, Ctx.subtract_typ(ctx_pat_ana, free_body)]),
+      ~free=
+        Ctx.union([
+          free_def,
+          Ctx.subtract_typ(
+            def_ctx,
+            Ctx.subtract_typ(ctx_pat_ana, free_body),
+          ),
+        ]),
       union_m([m_pat, m_def, m_body]),
     );
   | Match(scrut, rules) =>
     let (ty_scrut, free_scrut, m_scrut) = go(~mode=Syn, scrut);
     let (pats, branches) = List.split(rules);
     let pat_infos =
-      List.map(upat_to_info_map(~mode=Typ.Ana(ty_scrut)), pats);
+      List.mapi(
+        (i, p) =>
+          upat_to_info_map(
+            ~mode=Typ.Ana(ty_scrut),
+            ~body_ids=List.nth(branches, i).ids,
+            p,
+          ),
+        pats,
+      );
     let branch_infos =
       List.map2(
         (branch, (_, ctx_pat, _)) =>
@@ -459,24 +570,33 @@ and uexp_to_info_map =
       );
     let pat_ms = List.map(((_, _, m)) => m, pat_infos);
     let branch_ms = List.map(((_, _, m)) => m, branch_infos);
-    let branch_frees = List.map(((_, free, _)) => free, branch_infos);
+    let branch_frees =
+      List.map2(
+        ((_, body_free, _), (_, ctx_pat, _)) => {
+          Ctx.subtract_typ(ctx_pat, body_free)
+        },
+        branch_infos,
+        pat_infos,
+      );
     let self = Typ.Joined(Fun.id, branch_sources);
-    let free = Ctx.union([free_scrut] @ branch_frees);
+    /* let free = Ctx.union([free_scrut] @ branch_frees); */
+    let free = Ctx.union([free_scrut, ...branch_frees]);
     add(~self, ~free, union_m([m_scrut] @ pat_ms @ branch_ms));
   };
 }
 and upat_to_info_map =
     (
       ~ctx=Ctx.empty,
       ~mode: Typ.mode=Typ.Syn,
+      ~body_ids: list(Id.t)=[Id.invalid],
       {ids, term} as upat: Term.UPat.t,
     )
     : (Typ.t, Ctx.t, map) => {
   let cls = Term.UPat.cls_of_term(term);
   let add = (~self, ~ctx, m) => (
     typ_after_fix(mode, self),
     ctx,
-    add_info(ids, InfoPat({cls, self, mode, ctx, term: upat}), m),
+    add_info(ids, InfoPat({cls, self, mode, ctx, body_ids, term: upat}), m),
   );
   let atomic = self => add(~self, ~ctx, Id.Map.empty);
   let unknown = Typ.Just(Unknown(SynSwitch));
@@ -503,7 +623,8 @@ and upat_to_info_map =
     let (ctx, infos) =
       List.fold_left2(
         ((ctx, infos), e, mode) => {
-          let (_, ctx, _) as info = upat_to_info_map(~mode, ~ctx, e);
+          let (_, ctx, _) as info =
+            upat_to_info_map(~mode, ~ctx, ~body_ids, e);
           (ctx, infos @ [info]);
         },
         (ctx, []),
@@ -520,15 +641,17 @@ and upat_to_info_map =
         )
       | Some(ty) => Just(List(ty))
       };
-    let info: t = InfoPat({cls, self, mode, ctx, term: upat});
+    let info: t = InfoPat({cls, self, mode, body_ids, ctx, term: upat});
     let m = union_m(List.map(((_, _, m)) => m, infos));
     /* Add an entry for the id of each comma tile */
     let m = List.fold_left((m, id) => Id.Map.add(id, info, m), m, ids);
     (typ_after_fix(mode, self), ctx, m);
   | Cons(hd, tl) =>
     let mode_elem = Typ.matched_list_mode(mode);
-    let (ty, ctx, m_hd) = upat_to_info_map(~ctx, ~mode=mode_elem, hd);
-    let (_, ctx, m_tl) = upat_to_info_map(~ctx, ~mode=Ana(List(ty)), tl);
+    let (ty, ctx, m_hd) =
+      upat_to_info_map(~ctx, ~mode=mode_elem, ~body_ids, hd);
+    let (_, ctx, m_tl) =
+      upat_to_info_map(~ctx, ~mode=Ana(List(ty)), ~body_ids, tl);
     add(~self=Just(List(ty)), ~ctx, union_m([m_hd, m_tl]));
   | Tag(name) =>
     switch (BuiltinADTs.get_tag_typ(name)) {
@@ -549,7 +672,8 @@ and upat_to_info_map =
     let (ctx, infos) =
       List.fold_left2(
         ((ctx, infos), e, mode) => {
-          let (_, ctx, _) as info = upat_to_info_map(~mode, ~ctx, e);
+          let (_, ctx, _) as info =
+            upat_to_info_map(~mode, ~ctx, ~body_ids, e);
           (ctx, infos @ [info]);
         },
         (ctx, []),
@@ -560,18 +684,21 @@ and upat_to_info_map =
     let m = union_m(List.map(((_, _, m)) => m, infos));
     add(~self, ~ctx, m);
   | Parens(p) =>
-    let (ty, ctx, m) = upat_to_info_map(~ctx, ~mode, p);
+    let (ty, ctx, m) = upat_to_info_map(~ctx, ~mode, ~body_ids, p);
     add(~self=Just(ty), ~ctx, m);
   | Ap(fn, arg) =>
     /* Contructor application */
     /* Function position mode Ana(Hole->Hole) instead of Syn */
-    let (ty_fn, ctx, m_fn) = upat_to_info_map(~ctx, ~mode=Typ.ap_mode, fn);
+    let (ty_fn, ctx, m_fn) =
+      upat_to_info_map(~ctx, ~mode=Typ.ap_mode, ~body_ids, fn);
     let (ty_in, ty_out) = Typ.matched_arrow(ty_fn);
-    let (_, ctx, m_arg) = upat_to_info_map(~ctx, ~mode=Ana(ty_in), arg);
+    let (_, ctx, m_arg) =
+      upat_to_info_map(~ctx, ~mode=Ana(ty_in), ~body_ids, arg);
     add(~self=Just(ty_out), ~ctx, union_m([m_fn, m_arg]));
   | TypeAnn(p, ty) =>
     let (ty_ann, m_typ) = utyp_to_info_map(ty);
-    let (_ty, ctx, m) = upat_to_info_map(~ctx, ~mode=Ana(ty_ann), p);
+    let (_ty, ctx, m) =
+      upat_to_info_map(~ctx, ~mode=Ana(ty_ann), ~body_ids, p);
     add(~self=Just(ty_ann), ~ctx, union_m([m, m_typ]));
   };
 }

src/haz3lcore/statics/Term.re

@@ -319,6 +319,29 @@ module UPat = {
       }
     };
   };
+
+  let rec get_all_bindings = (pat: t) => {
+    switch (pat.term) {
+    | Var(x) => [x]
+    | Parens(pat)
+    | TypeAnn(pat, _) => get_all_bindings(pat)
+    | Cons(pat1, pat2)
+    | Ap(pat1, pat2) =>
+      List.append(get_all_bindings(pat1), get_all_bindings(pat2))
+    | ListLit(pats)
+    | Tuple(pats) => List.flatten(List.map(get_all_bindings, pats))
+    | Invalid(_)
+    | EmptyHole
+    | MultiHole(_)
+    | Wild
+    | Int(_)
+    | Float(_)
+    | Bool(_)
+    | String(_)
+    | Triv
+    | Tag(_) => []
+    };
+  };
 };
 
 module UExp = {

src/haz3lweb/view/Cell.re

@@ -155,6 +155,18 @@ let test_result_layer =
   );
 };
 
+let get_usage_ids = (zipper, info_map) => {
+  /* bad style, does reason have let*? */
+  switch (Haz3lcore.Indicated.index(zipper)) {
+  | Some(index) =>
+    switch (Haz3lcore.Id.Map.find_opt(index, info_map)) {
+    | Some(ci) => Haz3lcore.Statics.binding_uses(ci, info_map)
+    | None => []
+    }
+  | None => []
+  };
+};
+
 let deco =
     (
       ~zipper,
@@ -168,6 +180,16 @@ let deco =
       ~color_highlighting: option(ColorSteps.colorMap),
     ) => {
   let unselected = Zipper.unselect_and_zip(zipper);
+  let use_ids = get_usage_ids(zipper, info_map);
+  let use_highlights =
+    List.flatten(
+      List.map(
+        ((_tok, ids): Haz3lcore.Statics.usage_info) => {
+          List.map(id => (id, "orange"), ids)
+        },
+        use_ids,
+      ),
+    );
   module Deco =
     Deco.Deco({
       let font_metrics = font_metrics;
@@ -179,6 +201,7 @@ let deco =
       let tiles = TileMap.mk(unselected);
     });
   let decos = selected ? Deco.all(zipper, segment) : Deco.err_holes(zipper);
+  let decos = decos @ Deco.color_highlights(use_highlights);
   let decos =
     switch (test_results) {
     | None => decos

src/haz3lweb/view/CursorInspector.re

@@ -250,7 +250,24 @@ let view =
     | Some(index) =>
       switch (Haz3lcore.Id.Map.find_opt(index, info_map)) {
       | Some(ci) =>
-        inspector_view(~inject, ~settings, ~show_lang_doc, index, ci)
+        let _ =
+          List.map(
+            usage => {
+              print_string(fst(usage));
+              print_string(": ");
+              let _ =
+                List.map(
+                  id => {
+                    print_int(id);
+                    print_string(", ");
+                  },
+                  snd(usage),
+                );
+              print_newline();
+            },
+            Haz3lcore.Statics.binding_uses(ci, info_map),
+          );
+        inspector_view(~inject, ~settings, ~show_lang_doc, index, ci);
       | None =>
         div(
           ~attr=clss(["cursor-inspector"]),