From 08ac8a8cedd60ded6779955c26458112edecf0bd Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 30 Oct 2022 15:47:31 -0400 Subject: [PATCH 001/129] update Typ.re to reflect new provenances and matched patterns with constraints --- src/haz3lcore/statics/Typ.re | 131 +++++++++++++++++++++++++---------- 1 file changed, 95 insertions(+), 36 deletions(-) diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index 5738e94734..33199f63b7 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -6,9 +6,17 @@ open Sexplib.Std; generated by an internal judgement (Internal)? */ [@deriving (show({with_path: false}), sexp, yojson)] type type_provenance = - | SynSwitch - | TypeHole - | Internal; + | Anonymous + | SynSwitch(Id.t) + | TypeHole(Id.t) + | Internal(Id.t) + | Inference(matched_provenance, type_provenance) +and matched_provenance = + | Matched_Arrow_Left + | Matched_Arrow_Right + | Matched_Prod_Left + | Matched_Prod_Right + | Matched_List; /* TYP.T: Hazel types */ [@deriving (show({with_path: false}), sexp, yojson)] @@ -24,6 +32,9 @@ type t = | Sum(t, t) // unused | Prod(list(t)); +type equivalence = (t, t) +and constraints = list(equivalence); + /* SOURCE: Hazel type annotated with a relevant source location. Currently used to track match branches for inconsistent branches errors, but could perhaps be used more broadly @@ -69,15 +80,29 @@ let source_tys = List.map((source: source) => source.ty); /* How type provenance information should be collated when joining unknown types. This probably requires more thought, but right now TypeHole strictly predominates over Internal - which strictly predominates over SynSwitch. */ + which strictly predominates over SynSwitch, which + strictly predominates over Anonymous. + If two provenances have different Ids, either can be taken as a + representative of the other in later computations regarding the + type as a whole. + Similarly, if two Internal provenances have different matched provenance + strucutres, either structure can be taken. Precedence: + TypeHole > Internal > SynSwitch > Inference > Anonymous*/ let join_type_provenance = (p1: type_provenance, p2: type_provenance): type_provenance => switch (p1, p2) { - | (TypeHole, TypeHole | Internal | SynSwitch) - | (Internal | SynSwitch, TypeHole) => TypeHole - | (Internal, Internal | SynSwitch) - | (SynSwitch, Internal) => Internal - | (SynSwitch, SynSwitch) => SynSwitch + | ( + TypeHole(_) as t, + Inference(_) | TypeHole(_) | Internal(_) | SynSwitch(_) | Anonymous, + ) + | (Inference(_) | Internal(_) | SynSwitch(_) | Anonymous, TypeHole(_) as t) => t + | (Internal(_) as i, Inference(_) | Internal(_) | SynSwitch(_) | Anonymous) + | (Inference(_) | SynSwitch(_) | Anonymous, Internal(_) as i) => i + | (SynSwitch(_) as s, Inference(_) | SynSwitch(_) | Anonymous) + | (Inference(_) | Anonymous, SynSwitch(_) as s) => s + | (Inference(_) as inf, Anonymous | Inference(_)) + | (Anonymous, Inference(_) as inf) => inf + | (Anonymous, Anonymous) => Anonymous }; /* Lattice join on types. This is a LUB join in the hazel2 @@ -131,7 +156,7 @@ let rec join = (ty1: t, ty2: t): option(t) => let join_all: list(t) => option(t) = List.fold_left( (acc, ty) => Util.OptUtil.and_then(join(ty), acc), - Some(Unknown(Internal)), + Some(Unknown(Anonymous)), ); let join_or_fst = (ty: t, ty': t): t => @@ -140,35 +165,56 @@ let join_or_fst = (ty: t, ty': t): t => | Some(ty) => ty }; +let rec contains_hole = (ty: t): bool => + switch (ty) { + | Unknown(_) => true + | Arrow(ty1, ty2) + | Sum(ty1, ty2) => contains_hole(ty1) || contains_hole(ty2) + | Prod(tys) => List.exists(contains_hole, tys) + | _ => false + }; + let t_of_self = fun | Just(t) => t | Joined(wrap, ss) => switch (ss |> List.map(s => s.ty) |> join_all) { - | None => Unknown(Internal) + | None => Unknown(Anonymous) | Some(t) => wrap(t) } | Multi - | Free(_) => Unknown(Internal); + | Free(_) => Unknown(Anonymous); /* MATCHED JUDGEMENTS: Note that matched judgements work a bit different than hazel2 here since hole fixing is implicit. Somebody should check that what I'm doing here actually makes sense -Andrew */ -let matched_arrow: t => (t, t) = - fun - | Arrow(ty_in, ty_out) => (ty_in, ty_out) - | Unknown(prov) => (Unknown(prov), Unknown(prov)) - | _ => (Unknown(Internal), Unknown(Internal)); +let matched_arrow = (ty: t, termId: Id.t): ((t, t), constraints) => { + let prov_to_arrow = prov => { + let (arrow_lhs, arrow_rhs) = ( + Unknown(Inference(Matched_Arrow_Left, prov)), + Unknown(Inference(Matched_Arrow_Right, prov)), + ); + ((arrow_lhs, arrow_rhs), [(ty, Arrow(arrow_lhs, arrow_rhs))]); + }; + switch (ty) { + | Arrow(ty_in, ty_out) => ((ty_in, ty_out), []) + | Unknown(Anonymous) => ((Unknown(Anonymous), Unknown(Anonymous)), []) + | Unknown(prov) => prov_to_arrow(prov) + | _ => prov_to_arrow(Internal(termId)) + }; +}; -let matched_arrow_mode: mode => (mode, mode) = - fun - | Syn => (Syn, Syn) - | Ana(ty) => { - let (ty_in, ty_out) = matched_arrow(ty); - (Ana(ty_in), Ana(ty_out)); - }; +let matched_arrow_mode = + (mode: mode, termId: Id.t): ((mode, mode), constraints) => { + switch (mode) { + | Syn => ((Syn, Syn), []) + | Ana(ty) => + let ((ty_in, ty_out), constraints) = matched_arrow(ty, termId); + ((Ana(ty_in), Ana(ty_out)), constraints); + }; +}; let matched_prod_mode = (mode: mode, length): list(mode) => switch (mode) { @@ -177,21 +223,34 @@ let matched_prod_mode = (mode: mode, length): list(mode) => | _ => List.init(length, _ => Syn) }; -let matched_list: t => t = - fun - | List(ty) => ty - | Unknown(prov) => Unknown(prov) - | _ => Unknown(Internal); +let matched_list = (ty: t, termId: Id.t): (t, constraints) => { + let prov_to_list = prov => { + let list_elt_typ = Unknown(Inference(Matched_List, prov)); + (list_elt_typ, [(ty, List(list_elt_typ))]); + }; + switch (ty) { + | List(ty) => (ty, []) + | Unknown(prov) => prov_to_list(prov) + | _ => prov_to_list(Internal(termId)) + }; +}; -let matched_list_mode: mode => mode = - fun - | Syn => Syn - | Ana(ty) => Ana(matched_list(ty)); +let matched_list_mode = (mode: mode, termId: Id.t): (mode, constraints) => { + switch (mode) { + | Syn => (Syn, []) + | Ana(ty) => + let (ty_elts, constraints) = matched_list(ty, termId); + (Ana(ty_elts), constraints); + }; +}; -let matched_list_lit_mode = (mode: mode, length): list(mode) => +let matched_list_lit_mode = + (mode: mode, length, termId: Id.t): (list(mode), constraints) => switch (mode) { - | Syn => List.init(length, _ => Syn) - | Ana(ty) => List.init(length, _ => Ana(matched_list(ty))) + | Syn => (List.init(length, _ => Syn), []) + | Ana(ty) => + let (ty_elts, constraints) = matched_list(ty, termId); + (List.init(length, _ => Ana(ty_elts)), constraints); }; let ap_mode: mode = Syn; From a87c395621faea999329d347430599ac9f869769 Mon Sep 17 00:00:00 2001 From: RaefM Date: Tue, 1 Nov 2022 18:46:22 -0400 Subject: [PATCH 002/129] got new notion of matched functions and provenances compiling --- src/haz3lcore/dynamics/DH.re | 7 ++- src/haz3lcore/dynamics/Evaluator.re | 30 ++++++------ src/haz3lcore/dynamics/elaborator.re | 2 +- src/haz3lcore/statics/Statics.re | 70 ++++++++++++++++++---------- src/haz3lcore/statics/Term.re | 4 +- src/haz3lcore/statics/Typ.re | 32 ++++++++++--- src/haz3lweb/view/Type.re | 10 ++-- 7 files changed, 103 insertions(+), 52 deletions(-) diff --git a/src/haz3lcore/dynamics/DH.re b/src/haz3lcore/dynamics/DH.re index fabb85a680..8ec764d707 100644 --- a/src/haz3lcore/dynamics/DH.re +++ b/src/haz3lcore/dynamics/DH.re @@ -220,13 +220,18 @@ module rec DHExp: { | [_] => failwith("mk_tuple: expected at least 2 elements") | xs => Tuple(xs); + let is_any_synswitch: Typ.t => bool = + fun + | Unknown(SynSwitch(_)) => true + | _ => false; + let cast = (d: t, t1: Typ.t, t2: Typ.t): t => switch (d, t2) { | (ListLit(_, _, _, _, []), List(_)) => //HACK(andrew, cyrus) d | _ => - if (Typ.eq(t1, t2) || t2 == Unknown(SynSwitch)) { + if (Typ.eq(t1, t2) || is_any_synswitch(t2)) { d; } else { Cast(d, t1, t2); diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 8a2ef42b47..0fcd63774a 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -20,12 +20,14 @@ type match_result = | IndetMatch; let grounded_Arrow = - NotGroundOrHole(Arrow(Unknown(Internal), Unknown(Internal))); + NotGroundOrHole(Arrow(Unknown(Anonymous), Unknown(Anonymous))); let grounded_Sum = - NotGroundOrHole(Sum(Unknown(Internal), Unknown(Internal))); + NotGroundOrHole(Sum(Unknown(Anonymous), Unknown(Anonymous))); let grounded_Prod = length => - NotGroundOrHole(Prod(ListUtil.replicate(length, Typ.Unknown(Internal)))); -let grounded_List = NotGroundOrHole(List(Unknown(Internal))); + NotGroundOrHole( + Prod(ListUtil.replicate(length, Typ.Unknown(Anonymous))), + ); +let grounded_List = NotGroundOrHole(List(Unknown(Anonymous))); let ground_cases_of = (ty: Typ.t): ground_cases => switch (ty) { @@ -181,7 +183,7 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => [ List.combine( tys, - List.init(List.length(tys), _ => Typ.Unknown(Internal)), + List.init(List.length(tys), _ => Typ.Unknown(Anonymous)), ), ], ) @@ -191,7 +193,7 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => d, [ List.combine( - List.init(List.length(tys'), _ => Typ.Unknown(Internal)), + List.init(List.length(tys'), _ => Typ.Unknown(Anonymous)), tys', ), ], @@ -201,9 +203,9 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => | (Cons(_) | ListLit(_), Cast(d, List(ty1), List(ty2))) => matches_cast_Cons(dp, d, [(ty1, ty2)]) | (Cons(_) | ListLit(_), Cast(d, Unknown(_), List(ty2))) => - matches_cast_Cons(dp, d, [(Unknown(Internal), ty2)]) + matches_cast_Cons(dp, d, [(Unknown(Anonymous), ty2)]) | (Cons(_) | ListLit(_), Cast(d, List(ty1), Unknown(_))) => - matches_cast_Cons(dp, d, [(ty1, Unknown(Internal))]) + matches_cast_Cons(dp, d, [(ty1, Unknown(Anonymous))]) | (Cons(_, _), Cons(_, _)) | (ListLit(_, _), Cons(_, _)) | (Cons(_, _), ListLit(_)) @@ -245,14 +247,14 @@ and matches_cast_Inj = side, dp, d', - [(tyL1, tyR1, Unknown(Internal), Unknown(Internal))], + [(tyL1, tyR1, Unknown(Anonymous), Unknown(Anonymous))], ) | Cast(d', Unknown(_), Sum(tyL2, tyR2)) => matches_cast_Inj( side, dp, d', - [(Unknown(Internal), Unknown(Internal), tyL2, tyR2)], + [(Unknown(Anonymous), Unknown(Anonymous), tyL2, tyR2)], ) | Cast(_, _, _) => DoesNotMatch | BoundVar(_) => DoesNotMatch @@ -324,10 +326,10 @@ and matches_cast_Tuple = matches_cast_Tuple(dps, d', [List.combine(tys, tys'), ...elt_casts]); } | Cast(d', Prod(tys), Unknown(_)) => - let tys' = List.init(List.length(tys), _ => Typ.Unknown(Internal)); + let tys' = List.init(List.length(tys), _ => Typ.Unknown(Anonymous)); matches_cast_Tuple(dps, d', [List.combine(tys, tys'), ...elt_casts]); | Cast(d', Unknown(_), Prod(tys')) => - let tys = List.init(List.length(tys'), _ => Typ.Unknown(Internal)); + let tys = List.init(List.length(tys'), _ => Typ.Unknown(Anonymous)); matches_cast_Tuple(dps, d', [List.combine(tys, tys'), ...elt_casts]); | Cast(_, _, _) => DoesNotMatch | BoundVar(_) => DoesNotMatch @@ -463,9 +465,9 @@ and matches_cast_Cons = | Cast(d', List(ty1), List(ty2)) => matches_cast_Cons(dp, d', [(ty1, ty2), ...elt_casts]) | Cast(d', List(ty1), Unknown(_)) => - matches_cast_Cons(dp, d', [(ty1, Unknown(Internal)), ...elt_casts]) + matches_cast_Cons(dp, d', [(ty1, Unknown(Anonymous)), ...elt_casts]) | Cast(d', Unknown(_), List(ty2)) => - matches_cast_Cons(dp, d', [(Unknown(Internal), ty2), ...elt_casts]) + matches_cast_Cons(dp, d', [(Unknown(Anonymous), ty2), ...elt_casts]) | Cast(_, _, _) => DoesNotMatch | BoundVar(_) => DoesNotMatch | FreeVar(_) => IndetMatch diff --git a/src/haz3lcore/dynamics/elaborator.re b/src/haz3lcore/dynamics/elaborator.re index 279d122c18..8e406991b7 100644 --- a/src/haz3lcore/dynamics/elaborator.re +++ b/src/haz3lcore/dynamics/elaborator.re @@ -360,5 +360,5 @@ let uexp_elab = (m: Statics.map, uexp: Term.UExp.t): ElaborationResult.t => | None => DoesNotElaborate | Some(d) => let d = uexp_elab_wrap_builtins(d); - Elaborates(d, Typ.Unknown(Internal), Delta.empty); //TODO: get type from ci + Elaborates(d, Typ.Unknown(Anonymous), Delta.empty); //TODO: get type from ci }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 86e4a8ca34..d651e9b193 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -107,7 +107,7 @@ type error_status = let error_status = (mode: Typ.mode, self: Typ.self): error_status => switch (mode, self) { | (Syn | Ana(_), Free(free_error)) => InHole(Free(free_error)) - | (Syn | Ana(_), Multi) => NotInHole(SynConsistent(Unknown(Internal))) + | (Syn | Ana(_), Multi) => NotInHole(SynConsistent(Unknown(Anonymous))) | (Syn, Just(ty)) => NotInHole(SynConsistent(ty)) | (Syn, Joined(wrap, tys_syn)) => /*| (Ana(Unknown(SynSwitch)), Joined(tys_syn))*/ @@ -163,9 +163,9 @@ let is_error = (ci: t): bool => { /* 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. */ -let typ_after_fix = (mode: Typ.mode, self: Typ.self): Typ.t => +let typ_after_fix = (mode: Typ.mode, self: Typ.self, termId: Id.t): Typ.t => switch (error_status(mode, self)) { - | InHole(_) => Unknown(Internal) + | InHole(_) => Unknown(Internal(termId)) | NotInHole(SynConsistent(t)) => t | NotInHole(AnaConsistent(_, _, ty_join)) => ty_join | NotInHole(AnaExternalInconsistent(ty_ana, _)) => ty_ana @@ -175,7 +175,8 @@ let typ_after_fix = (mode: Typ.mode, self: Typ.self): Typ.t => /* The type of an expression after hole wrapping */ let exp_typ = (m: map, e: Term.UExp.t): Typ.t => switch (Id.Map.find_opt(Term.UExp.rep_id(e), m)) { - | Some(InfoExp({mode, self, _})) => typ_after_fix(mode, self) + | Some(InfoExp({mode, self, _})) => + typ_after_fix(mode, self, Term.UExp.rep_id(e)) | Some(InfoPat(_) | InfoTyp(_) | InfoRul(_) | Invalid(_)) | None => failwith(__LOC__ ++ ": XXX") }; @@ -203,7 +204,8 @@ let exp_mode = (m: map, e: Term.UExp.t): Typ.mode => /* The type of a pattern after hole wrapping */ let pat_typ = (m: map, p: Term.UPat.t): Typ.t => switch (Id.Map.find_opt(Term.UPat.rep_id(p), m)) { - | Some(InfoPat({mode, self, _})) => typ_after_fix(mode, self) + | Some(InfoPat({mode, self, _})) => + typ_after_fix(mode, self, Term.UPat.rep_id(p)) | Some(InfoExp(_) | InfoTyp(_) | InfoRul(_) | Invalid(_)) | None => failwith(__LOC__ ++ ": XXX") }; @@ -283,27 +285,27 @@ and uexp_to_info_map = /* Maybe switch mode to syn */ let mode = switch (mode) { - | Ana(Unknown(SynSwitch)) => Typ.Syn + | Ana(Unknown(SynSwitch(_))) => Typ.Syn | _ => mode }; let cls = Term.UExp.cls_of_term(term); let go = uexp_to_info_map(~ctx); let add = (~self, ~free, m) => ( - typ_after_fix(mode, self), + typ_after_fix(mode, self, Term.UExp.rep_id(uexp)), free, add_info(ids, InfoExp({cls, self, mode, ctx, free, term: uexp}), m), ); let atomic = self => add(~self, ~free=[], Id.Map.empty); switch (term) { | Invalid(msg) => ( - Unknown(Internal), + Unknown(Internal(Term.UExp.rep_id(uexp))), [], add_info(ids, Invalid(msg), Id.Map.empty), ) | MultiHole(tms) => let (free, maps) = tms |> List.map(any_to_info_map(~ctx)) |> List.split; add(~self=Multi, ~free=Ctx.union(free), union_m(maps)); - | EmptyHole => atomic(Just(Unknown(Internal))) + | EmptyHole => atomic(Just(Unknown(Internal(Term.UExp.rep_id(uexp))))) | Triv => atomic(Just(Prod([]))) | Bool(_) => atomic(Just(Bool)) | Int(_) => atomic(Just(Int)) @@ -348,7 +350,8 @@ and uexp_to_info_map = | Some(typ) => atomic(Just(typ)) } | Cons(e1, e2) => - let mode_ele = Typ.matched_list_mode(mode); + let (mode_ele, _constraints) = + Typ.matched_list_mode(mode, Term.UExp.rep_id(uexp)); let (ty1, free1, m1) = go(~mode=mode_ele, e1); let (_, free2, m2) = go(~mode=Ana(List(ty1)), e2); add( @@ -356,9 +359,14 @@ and uexp_to_info_map = ~free=Ctx.union([free1, free2]), union_m([m1, m2]), ); - | ListLit([]) => atomic(Just(List(Unknown(Internal)))) + | ListLit([]) => atomic(Just(List(Unknown(Anonymous)))) | ListLit(es) => - let modes = Typ.matched_list_lit_mode(mode, List.length(es)); + let (modes, _constraints) = + Typ.matched_list_lit_mode( + mode, + List.length(es), + Term.UExp.rep_id(uexp), + ); let e_ids = List.map(Term.UExp.rep_id, es); let infos = List.map2((e, mode) => go(~mode, e), es, modes); let tys = List.map(((ty, _, _)) => ty, infos); @@ -405,7 +413,8 @@ and uexp_to_info_map = /* Function position mode Ana(Hole->Hole) instead of Syn */ let (ty_fn, free_fn, m_fn) = uexp_to_info_map(~ctx, ~mode=Typ.ap_mode, fn); - let (ty_in, ty_out) = Typ.matched_arrow(ty_fn); + let ((ty_in, ty_out), _constraints) = + Typ.matched_arrow_inf(ty_fn, Term.UExp.rep_id(uexp)); let (_, free_arg, m_arg) = uexp_to_info_map(~ctx, ~mode=Ana(ty_in), arg); add( @@ -414,7 +423,8 @@ and uexp_to_info_map = union_m([m_fn, m_arg]), ); | Fun(pat, body) => - let (mode_pat, mode_body) = Typ.matched_arrow_mode(mode); + let ((mode_pat, mode_body), _constraints) = + Typ.matched_arrow_mode(mode, Term.UExp.rep_id(uexp)); let (ty_pat, ctx_pat, m_pat) = upat_to_info_map(~mode=mode_pat, pat); let ctx_body = VarMap.concat(ctx, ctx_pat); let (ty_body, free_body, m_body) = @@ -474,15 +484,15 @@ and upat_to_info_map = : (Typ.t, Ctx.t, map) => { let cls = Term.UPat.cls_of_term(term); let add = (~self, ~ctx, m) => ( - typ_after_fix(mode, self), + typ_after_fix(mode, self, Term.UPat.rep_id(upat)), ctx, add_info(ids, InfoPat({cls, self, mode, ctx, term: upat}), m), ); let atomic = self => add(~self, ~ctx, Id.Map.empty); - let unknown = Typ.Just(Unknown(SynSwitch)); + let unknown = Typ.Just(Unknown(SynSwitch(Term.UPat.rep_id(upat)))); switch (term) { | Invalid(msg) => ( - Unknown(Internal), + Unknown(Internal(Term.UPat.rep_id(upat))), ctx, add_info(ids, Invalid(msg), Id.Map.empty), ) @@ -496,9 +506,14 @@ and upat_to_info_map = | Triv => atomic(Just(Prod([]))) | Bool(_) => atomic(Just(Bool)) | String(_) => atomic(Just(String)) - | ListLit([]) => atomic(Just(List(Unknown(Internal)))) + | ListLit([]) => atomic(Just(List(Unknown(Anonymous)))) | ListLit(ps) => - let modes = Typ.matched_list_lit_mode(mode, List.length(ps)); + let (modes, _constraints) = + Typ.matched_list_lit_mode( + mode, + List.length(ps), + Term.UPat.rep_id(upat), + ); let p_ids = List.map(Term.UPat.rep_id, ps); let (ctx, infos) = List.fold_left2( @@ -524,9 +539,10 @@ and upat_to_info_map = 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); + (typ_after_fix(mode, self, Term.UPat.rep_id(upat)), ctx, m); | Cons(hd, tl) => - let mode_elem = Typ.matched_list_mode(mode); + let (mode_elem, _constraints) = + Typ.matched_list_mode(mode, Term.UPat.rep_id(upat)); 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); add(~self=Just(List(ty)), ~ctx, union_m([m_hd, m_tl])); @@ -537,7 +553,7 @@ and upat_to_info_map = } | Var(name) => let self = unknown; - let typ = typ_after_fix(mode, self); + let typ = typ_after_fix(mode, self, Term.UPat.rep_id(upat)); add( ~self, ~ctx= @@ -566,7 +582,8 @@ and upat_to_info_map = /* 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_in, ty_out) = Typ.matched_arrow(ty_fn); + let ((ty_in, ty_out), _constraints) = + Typ.matched_arrow_inf(ty_fn, Term.UPat.rep_id(upat)); let (_, ctx, m_arg) = upat_to_info_map(~ctx, ~mode=Ana(ty_in), arg); add(~self=Just(ty_out), ~ctx, union_m([m_fn, m_arg])); | TypeAnn(p, ty) => @@ -582,7 +599,7 @@ and utyp_to_info_map = ({ids, term} as utyp: Term.UTyp.t): (Typ.t, map) => { let just = m => (ty, add(Just(ty), m)); switch (term) { | Invalid(msg) => ( - Unknown(Internal), + Unknown(Internal(Term.UTyp.rep_id(utyp))), add_info(ids, Invalid(msg), Id.Map.empty), ) | EmptyHole @@ -603,7 +620,10 @@ and utyp_to_info_map = ({ids, term} as utyp: Term.UTyp.t): (Typ.t, map) => { just(m); | Var(name) => switch (BuiltinADTs.is_typ_var(name)) { - | None => (Unknown(Internal), add(Free(TypeVariable), Id.Map.empty)) + | None => ( + Unknown(Internal(Term.UTyp.rep_id(utyp))), + add(Free(TypeVariable), Id.Map.empty), + ) | Some(_) => (Var(name), add(Just(Var(name)), Id.Map.empty)) } | MultiHole(tms) => diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index 90d9d785d1..de0de8b0a1 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -499,8 +499,8 @@ let rec utyp_to_ty: UTyp.t => Typ.t = utyp => switch (utyp.term) { | Invalid(_) - | MultiHole(_) => Unknown(Internal) - | EmptyHole => Unknown(TypeHole) + | MultiHole(_) => Unknown(Internal(UTyp.rep_id(utyp))) + | EmptyHole => Unknown(TypeHole(UTyp.rep_id(utyp))) | Bool => Bool | Int => Int | Float => Float diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index 33199f63b7..27a8233e40 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -188,9 +188,17 @@ let t_of_self = /* MATCHED JUDGEMENTS: Note that matched judgements work a bit different than hazel2 here since hole fixing is implicit. Somebody should check that what I'm doing - here actually makes sense -Andrew */ + here actually makes sense -Andrew -let matched_arrow = (ty: t, termId: Id.t): ((t, t), constraints) => { + Matched judgements come in three forms: non inference, inference, and mode + Inference and mode judgements are constraint generating and require the id of the term matched on + Mode judgements additionally require a mode as input + Non inference judgements simply require a type as input and do not generate constraint information + + TLDR: Statics should never use non inference and all other modules should ONLY use non inference. + */ + +let matched_arrow_inf = (ty: t, termId: Id.t): ((t, t), constraints) => { let prov_to_arrow = prov => { let (arrow_lhs, arrow_rhs) = ( Unknown(Inference(Matched_Arrow_Left, prov)), @@ -206,12 +214,18 @@ let matched_arrow = (ty: t, termId: Id.t): ((t, t), constraints) => { }; }; +let matched_arrow = (ty: t): (t, t) => { + let dummy_id: Id.t = (-1); + let (res, _) = matched_arrow_inf(ty, dummy_id); + res; +}; + let matched_arrow_mode = (mode: mode, termId: Id.t): ((mode, mode), constraints) => { switch (mode) { | Syn => ((Syn, Syn), []) | Ana(ty) => - let ((ty_in, ty_out), constraints) = matched_arrow(ty, termId); + let ((ty_in, ty_out), constraints) = matched_arrow_inf(ty, termId); ((Ana(ty_in), Ana(ty_out)), constraints); }; }; @@ -223,7 +237,7 @@ let matched_prod_mode = (mode: mode, length): list(mode) => | _ => List.init(length, _ => Syn) }; -let matched_list = (ty: t, termId: Id.t): (t, constraints) => { +let matched_list_inf = (ty: t, termId: Id.t): (t, constraints) => { let prov_to_list = prov => { let list_elt_typ = Unknown(Inference(Matched_List, prov)); (list_elt_typ, [(ty, List(list_elt_typ))]); @@ -235,11 +249,17 @@ let matched_list = (ty: t, termId: Id.t): (t, constraints) => { }; }; +let matched_list = (ty: t): t => { + let dummy_id: Id.t = (-1); + let (res, _) = matched_list_inf(ty, dummy_id); + res; +}; + let matched_list_mode = (mode: mode, termId: Id.t): (mode, constraints) => { switch (mode) { | Syn => (Syn, []) | Ana(ty) => - let (ty_elts, constraints) = matched_list(ty, termId); + let (ty_elts, constraints) = matched_list_inf(ty, termId); (Ana(ty_elts), constraints); }; }; @@ -249,7 +269,7 @@ let matched_list_lit_mode = switch (mode) { | Syn => (List.init(length, _ => Syn), []) | Ana(ty) => - let (ty_elts, constraints) = matched_list(ty, termId); + let (ty_elts, constraints) = matched_list_inf(ty, termId); (List.init(length, _ => Ana(ty_elts)), constraints); }; diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 985eaaa2ec..17e453de78 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -7,9 +7,13 @@ let ty_view = (cls: string, s: string): Node.t => let prov_view: Haz3lcore.Typ.type_provenance => Node.t = fun - | Internal => div([]) - | TypeHole => div(~attr=clss(["typ-mod", "type-hole"]), [text("𝜏")]) - | SynSwitch => div(~attr=clss(["typ-mod", "syn-switch"]), [text("⇒")]); + | Inference(_) => div([]) + | Internal(_) => div([]) + | TypeHole(_) => + div(~attr=clss(["typ-mod", "type-hole"]), [text("𝜏")]) + | SynSwitch(_) => + div(~attr=clss(["typ-mod", "syn-switch"]), [text("⇒")]) + | Anonymous => div([]); let rec view = (ty: Haz3lcore.Typ.t): Node.t => //TODO: parens on ops when ambiguous From ec96408fa5437eecc68cb3f4c50f3d8edce657e6 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 25 Dec 2022 23:08:48 -0500 Subject: [PATCH 003/129] wip; ammend later --- src/haz3lcore/dynamics/elaborator.re | 25 +++++-- src/haz3lcore/statics/Statics.re | 24 +++---- src/haz3lcore/statics/Typ.re | 97 +++++++++++++--------------- 3 files changed, 76 insertions(+), 70 deletions(-) diff --git a/src/haz3lcore/dynamics/elaborator.re b/src/haz3lcore/dynamics/elaborator.re index 8e406991b7..d65815a12a 100644 --- a/src/haz3lcore/dynamics/elaborator.re +++ b/src/haz3lcore/dynamics/elaborator.re @@ -95,7 +95,11 @@ let rec dhexp_of_uexp = (m: Statics.map, uexp: Term.UExp.t): option(DHExp.t) => //TODO: rewrite this whole case switch (Statics.exp_mode(m, uexp)) { | Syn => - let ty = Typ.matched_list(Statics.exp_self_typ(m, uexp)); + let ty = + Typ.matched_list( + Statics.exp_self_typ(m, uexp), + Term.UExp.rep_id(uexp), + ); let* ds = List.fold_left( (acc, e) => { @@ -110,7 +114,7 @@ let rec dhexp_of_uexp = (m: Statics.map, uexp: Term.UExp.t): option(DHExp.t) => ); wrap(DHExp.ListLit(u, 0, StandardErrStatus(NotInHole), Int, ds)); | Ana(ana_ty) => - let ty = Typ.matched_list(ana_ty); + let ty = Typ.matched_list(ana_ty, Term.UExp.rep_id(uexp)); let* ds = List.fold_left( (acc, e) => { @@ -157,10 +161,14 @@ let rec dhexp_of_uexp = (m: Statics.map, uexp: Term.UExp.t): option(DHExp.t) => switch (Statics.exp_mode(m, uexp)) { | Syn => d1 | Ana(ty_ana) => - let ty = Typ.matched_list(ty_ana); + let ty = Typ.matched_list(ty_ana, Term.UExp.rep_id(uexp)); DHExp.cast(d1, ty1, ty); }; - let ty_hd = Typ.matched_list(Statics.exp_self_typ(m, uexp)); + let ty_hd = + Typ.matched_list( + Statics.exp_self_typ(m, uexp), + Term.UExp.rep_id(uexp), + ); let dc2 = DHExp.cast(d2, ty2, List(ty_hd)); wrap(Cons(dc1, dc2)); | UnOp(Int(Minus), e) => @@ -232,7 +240,8 @@ let rec dhexp_of_uexp = (m: Statics.map, uexp: Term.UExp.t): option(DHExp.t) => let* d_arg = dhexp_of_uexp(m, arg); let ty_fn = Statics.exp_self_typ(m, fn); let ty_arg = Statics.exp_self_typ(m, arg); - let (ty_in, ty_out) = Typ.matched_arrow(ty_fn); + let (ty_in, ty_out) = + Typ.matched_arrow(ty_fn, Term.UExp.rep_id(uexp)); let c_fn = DHExp.cast(d_fn, ty_fn, Typ.Arrow(ty_in, ty_out)); let c_arg = DHExp.cast(d_arg, ty_arg, ty_in); wrap(Ap(c_fn, c_arg)); @@ -299,7 +308,11 @@ and dhpat_of_upat = (m: Statics.map, upat: Term.UPat.t): option(DHPat.t) => { | String(s) => wrap(StringLit(s)) | Triv => wrap(Tuple([])) | ListLit(ps) => - let ty = Typ.matched_list(Statics.pat_self_typ(m, upat)); + let ty = + Typ.matched_list( + Statics.pat_self_typ(m, upat), + Term.UPat.rep_id(upat), + ); let* ds = List.fold_left( (acc, p) => { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index d651e9b193..284f02fad2 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -350,8 +350,7 @@ and uexp_to_info_map = | Some(typ) => atomic(Just(typ)) } | Cons(e1, e2) => - let (mode_ele, _constraints) = - Typ.matched_list_mode(mode, Term.UExp.rep_id(uexp)); + let mode_ele = Typ.matched_list_mode(mode, Term.UExp.rep_id(uexp)); let (ty1, free1, m1) = go(~mode=mode_ele, e1); let (_, free2, m2) = go(~mode=Ana(List(ty1)), e2); add( @@ -361,7 +360,7 @@ and uexp_to_info_map = ); | ListLit([]) => atomic(Just(List(Unknown(Anonymous)))) | ListLit(es) => - let (modes, _constraints) = + let modes = Typ.matched_list_lit_mode( mode, List.length(es), @@ -413,8 +412,7 @@ and uexp_to_info_map = /* Function position mode Ana(Hole->Hole) instead of Syn */ let (ty_fn, free_fn, m_fn) = uexp_to_info_map(~ctx, ~mode=Typ.ap_mode, fn); - let ((ty_in, ty_out), _constraints) = - Typ.matched_arrow_inf(ty_fn, Term.UExp.rep_id(uexp)); + let (ty_in, ty_out) = Typ.matched_arrow(ty_fn, Term.UExp.rep_id(uexp)); let (_, free_arg, m_arg) = uexp_to_info_map(~ctx, ~mode=Ana(ty_in), arg); add( @@ -423,7 +421,7 @@ and uexp_to_info_map = union_m([m_fn, m_arg]), ); | Fun(pat, body) => - let ((mode_pat, mode_body), _constraints) = + let (mode_pat, mode_body) = Typ.matched_arrow_mode(mode, Term.UExp.rep_id(uexp)); let (ty_pat, ctx_pat, m_pat) = upat_to_info_map(~mode=mode_pat, pat); let ctx_body = VarMap.concat(ctx, ctx_pat); @@ -437,6 +435,12 @@ and uexp_to_info_map = | 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); + // this is the key part that depends on the assumption that + // Ana(Unknown(SynSwtich)) == Syn + // This is ok even with our code though, as we are simply forcing + // the body to synthesize some type without immediately constraining + // it to the unannot let, which is the behavior the prototype would've + // taken anyway. 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 */ @@ -508,7 +512,7 @@ and upat_to_info_map = | String(_) => atomic(Just(String)) | ListLit([]) => atomic(Just(List(Unknown(Anonymous)))) | ListLit(ps) => - let (modes, _constraints) = + let modes = Typ.matched_list_lit_mode( mode, List.length(ps), @@ -541,8 +545,7 @@ and upat_to_info_map = let m = List.fold_left((m, id) => Id.Map.add(id, info, m), m, ids); (typ_after_fix(mode, self, Term.UPat.rep_id(upat)), ctx, m); | Cons(hd, tl) => - let (mode_elem, _constraints) = - Typ.matched_list_mode(mode, Term.UPat.rep_id(upat)); + let mode_elem = Typ.matched_list_mode(mode, Term.UPat.rep_id(upat)); 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); add(~self=Just(List(ty)), ~ctx, union_m([m_hd, m_tl])); @@ -582,8 +585,7 @@ and upat_to_info_map = /* 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_in, ty_out), _constraints) = - Typ.matched_arrow_inf(ty_fn, Term.UPat.rep_id(upat)); + let (ty_in, ty_out) = Typ.matched_arrow(ty_fn, Term.UPat.rep_id(upat)); let (_, ctx, m_arg) = upat_to_info_map(~ctx, ~mode=Ana(ty_in), arg); add(~self=Just(ty_out), ~ctx, union_m([m_fn, m_arg])); | TypeAnn(p, ty) => diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index 27a8233e40..7dc3c2ca7f 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -32,9 +32,6 @@ type t = | Sum(t, t) // unused | Prod(list(t)); -type equivalence = (t, t) -and constraints = list(equivalence); - /* SOURCE: Hazel type annotated with a relevant source location. Currently used to track match branches for inconsistent branches errors, but could perhaps be used more broadly @@ -77,7 +74,11 @@ type mode = /* Strip location information from a list of sources */ let source_tys = List.map((source: source) => source.ty); -/* How type provenance information should be collated when +/* + I THINK THIS MIGHT BE THE PROBLEM: WHY IS INFERENCE < SYNSWITCH? + NVM LOL + + How type provenance information should be collated when joining unknown types. This probably requires more thought, but right now TypeHole strictly predominates over Internal which strictly predominates over SynSwitch, which @@ -188,90 +189,80 @@ let t_of_self = /* MATCHED JUDGEMENTS: Note that matched judgements work a bit different than hazel2 here since hole fixing is implicit. Somebody should check that what I'm doing - here actually makes sense -Andrew - - Matched judgements come in three forms: non inference, inference, and mode - Inference and mode judgements are constraint generating and require the id of the term matched on - Mode judgements additionally require a mode as input - Non inference judgements simply require a type as input and do not generate constraint information - - TLDR: Statics should never use non inference and all other modules should ONLY use non inference. - */ + here actually makes sense -Andrew*/ -let matched_arrow_inf = (ty: t, termId: Id.t): ((t, t), constraints) => { +let matched_arrow = (ty: t, termId: Id.t): (t, t) => { let prov_to_arrow = prov => { let (arrow_lhs, arrow_rhs) = ( Unknown(Inference(Matched_Arrow_Left, prov)), Unknown(Inference(Matched_Arrow_Right, prov)), ); - ((arrow_lhs, arrow_rhs), [(ty, Arrow(arrow_lhs, arrow_rhs))]); + (arrow_lhs, arrow_rhs); }; switch (ty) { - | Arrow(ty_in, ty_out) => ((ty_in, ty_out), []) - | Unknown(Anonymous) => ((Unknown(Anonymous), Unknown(Anonymous)), []) + | Arrow(ty_in, ty_out) => (ty_in, ty_out) | Unknown(prov) => prov_to_arrow(prov) | _ => prov_to_arrow(Internal(termId)) }; }; -let matched_arrow = (ty: t): (t, t) => { - let dummy_id: Id.t = (-1); - let (res, _) = matched_arrow_inf(ty, dummy_id); - res; -}; - -let matched_arrow_mode = - (mode: mode, termId: Id.t): ((mode, mode), constraints) => { +let matched_arrow_mode = (mode: mode, termId: Id.t): (mode, mode) => { switch (mode) { - | Syn => ((Syn, Syn), []) + | Syn => (Syn, Syn) | Ana(ty) => - let ((ty_in, ty_out), constraints) = matched_arrow_inf(ty, termId); - ((Ana(ty_in), Ana(ty_out)), constraints); + let (ty_in, ty_out) = matched_arrow(ty, termId); + (Ana(ty_in), Ana(ty_out)); }; }; -let matched_prod_mode = (mode: mode, length): list(mode) => - switch (mode) { - | Ana(Prod(ana_tys)) when List.length(ana_tys) == length => - List.map(ty => Ana(ty), ana_tys) - | _ => List.init(length, _ => Syn) - }; - -let matched_list_inf = (ty: t, termId: Id.t): (t, constraints) => { +let matched_list = (ty: t, termId: Id.t): t => { let prov_to_list = prov => { let list_elt_typ = Unknown(Inference(Matched_List, prov)); - (list_elt_typ, [(ty, List(list_elt_typ))]); + list_elt_typ; }; switch (ty) { - | List(ty) => (ty, []) + | List(ty) => ty | Unknown(prov) => prov_to_list(prov) | _ => prov_to_list(Internal(termId)) }; }; -let matched_list = (ty: t): t => { - let dummy_id: Id.t = (-1); - let (res, _) = matched_list_inf(ty, dummy_id); - res; -}; - -let matched_list_mode = (mode: mode, termId: Id.t): (mode, constraints) => { +let matched_list_mode = (mode: mode, termId: Id.t): mode => { switch (mode) { - | Syn => (Syn, []) + | Syn => Syn | Ana(ty) => - let (ty_elts, constraints) = matched_list_inf(ty, termId); - (Ana(ty_elts), constraints); + let ty_elts = matched_list(ty, termId); + Ana(ty_elts); }; }; -let matched_list_lit_mode = - (mode: mode, length, termId: Id.t): (list(mode), constraints) => +let matched_list_lit_mode = (mode: mode, length, termId: Id.t): list(mode) => switch (mode) { - | Syn => (List.init(length, _ => Syn), []) + | Syn => List.init(length, _ => Syn) | Ana(ty) => - let (ty_elts, constraints) = matched_list_inf(ty, termId); - (List.init(length, _ => Ana(ty_elts)), constraints); + let ty_elts = matched_list(ty, termId); + List.init(length, _ => Ana(ty_elts)); + }; + +let rec matched_prod_mode = (mode: mode, length): list(mode) => { + switch (mode, length) { + | (Ana(Unknown(prov)), 2) => + let left = Ana(Unknown(Inference(Matched_Prod_Left, prov))); + let right = Ana(Unknown(Inference(Matched_Prod_Right, prov))); + [left, right]; + | (Ana(Unknown(prov)), _) when length > 2 => + let first = Ana(Unknown(Inference(Matched_Prod_Left, prov))); + let rest = + matched_prod_mode( + Ana(Unknown(Inference(Matched_Prod_Right, prov))), + length - 1, + ); + [first, ...rest]; + | (Ana(Prod(ana_tys)), _) when List.length(ana_tys) == length => + List.map(ty => Ana(ty), ana_tys) + | _ => List.init(length, _ => Syn) }; +}; let ap_mode: mode = Syn; From e5b4b7a46c81e2fea305a48cec8377df6fab5dc8 Mon Sep 17 00:00:00 2001 From: RaefM Date: Mon, 26 Dec 2022 00:44:34 -0500 Subject: [PATCH 004/129] fix remaining compiler errors after merge --- src/haz3lcore/dynamics/DH.re | 2 +- src/haz3lcore/dynamics/elaborator.re | 9 +++- src/haz3lcore/statics/Statics.re | 34 +++++++++++---- src/haz3lcore/statics/Typ.re | 64 ++++++++++++++-------------- 4 files changed, 66 insertions(+), 43 deletions(-) diff --git a/src/haz3lcore/dynamics/DH.re b/src/haz3lcore/dynamics/DH.re index 5f5141b386..3da8661045 100644 --- a/src/haz3lcore/dynamics/DH.re +++ b/src/haz3lcore/dynamics/DH.re @@ -230,7 +230,7 @@ module rec DHExp: { | _ => false; let cast = (d: t, t1: Typ.t, t2: Typ.t): t => - if (Typ.eq(t1, t2) || t2 == Unknown(SynSwitch)) { + if (Typ.eq(t1, t2) || is_any_synswitch(t2)) { d; } else { Cast(d, t1, t2); diff --git a/src/haz3lcore/dynamics/elaborator.re b/src/haz3lcore/dynamics/elaborator.re index 13cdbc0a8e..94a58bc5f1 100644 --- a/src/haz3lcore/dynamics/elaborator.re +++ b/src/haz3lcore/dynamics/elaborator.re @@ -168,7 +168,11 @@ let rec dhexp_of_uexp = (m: Statics.map, uexp: Term.UExp.t): option(DHExp.t) => | String(s) => Some(StringLit(s)) | ListLit(es) => let+ ds = es |> List.map(dhexp_of_uexp(m)) |> OptUtil.sequence; - let ty = Typ.matched_list(Statics.exp_typ(m, uexp), Term.UExp.rep_id(uexp)); + let ty = + Typ.matched_list( + Statics.exp_typ(m, uexp), + Term.UExp.rep_id(uexp), + ); //TODO: why is there an err status on below? DHExp.ListLit(id, 0, StandardErrStatus(NotInHole), ty, ds); | Fun(p, body) => @@ -323,7 +327,8 @@ and dhpat_of_upat = (m: Statics.map, upat: Term.UPat.t): option(DHPat.t) => { | Triv => wrap(Tuple([])) | ListLit(ps) => let* ds = ps |> List.map(dhpat_of_upat(m)) |> OptUtil.sequence; - let ty = Typ.matched_list(Statics.pat_typ(m, upat), Term.UPat.rep_id(upat)); + let ty = + Typ.matched_list(Statics.pat_typ(m, upat), Term.UPat.rep_id(upat)); wrap(ListLit(ty, ds)); | Tag(name) => wrap(Tag(name)) | Cons(hd, tl) => diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 84611d1b89..df512fd503 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -109,7 +109,7 @@ type error_status = let error_status = (mode: Typ.mode, self: Typ.self): error_status => switch (mode, self) { | (SynFun, Just(ty)) => - switch (Typ.join(Arrow(Unknown(Internal), Unknown(Internal)), ty)) { + switch (Typ.join(Arrow(Unknown(Anonymous), Unknown(Anonymous)), ty)) { | None => InHole(NoFun(ty)) | Some(_) => NotInHole(SynConsistent(ty)) } @@ -119,7 +119,7 @@ let error_status = (mode: Typ.mode, self: Typ.self): error_status => | None => InHole(SynInconsistentBranches(tys_syn)) | Some(ty_joined) => switch ( - Typ.join(Arrow(Unknown(Internal), Unknown(Internal)), ty_joined) + Typ.join(Arrow(Unknown(Anonymous), Unknown(Anonymous)), ty_joined) ) { | None => InHole(NoFun(ty_joined)) | Some(_) => NotInHole(SynConsistent(ty_joined)) @@ -330,7 +330,10 @@ and uexp_to_info_map = | String(_) => atomic(Just(String)) | ListLit([]) => atomic(Just(List(Unknown(Anonymous)))) | ListLit(es) => - let modes = List.init(List.length(es), _ => Typ.matched_list_mode(mode, Term.UExp.rep_id(uexp))); + let modes = + List.init(List.length(es), _ => + Typ.matched_list_mode(mode, Term.UExp.rep_id(uexp)) + ); let e_ids = List.map(Term.UExp.rep_id, es); let infos = List.map2((e, mode) => go(~mode, e), es, modes); let tys = List.map(((ty, _, _)) => ty, infos); @@ -433,7 +436,8 @@ and uexp_to_info_map = union_m([m_fn, m_arg]), ); | Fun(pat, body) => - let (mode_pat, mode_body) = Typ.matched_arrow_mode(mode, Term.UExp.rep_id(uexp)); + let (mode_pat, mode_body) = + Typ.matched_arrow_mode(mode, Term.UExp.rep_id(uexp)); let (ty_pat, ctx_pat, m_pat) = upat_to_info_map(~is_synswitch=false, ~mode=mode_pat, pat); let ctx_body = VarMap.concat(ctx, ctx_pat); @@ -499,7 +503,12 @@ and upat_to_info_map = ) : (Typ.t, Ctx.t, map) => { let upat_to_info_map = upat_to_info_map(~is_synswitch); - let unknown = Typ.Unknown(is_synswitch ? SynSwitch : Internal); + let unknown = + Typ.Unknown( + is_synswitch + ? SynSwitch(Term.UPat.rep_id(upat)) + : Internal(Term.UPat.rep_id(upat)), + ); let cls = Term.UPat.cls_of_term(term); let add = (~self, ~ctx, m) => ( typ_after_fix(mode, self, Term.UPat.rep_id(upat)), @@ -524,7 +533,10 @@ and upat_to_info_map = | String(_) => atomic(Just(String)) | ListLit([]) => atomic(Just(List(Unknown(Anonymous)))) | ListLit(ps) => - let modes = List.init(List.length(ps), _ => Typ.matched_list_mode(mode, Term.UPat.rep_id(upat))); + let modes = + List.init(List.length(ps), _ => + Typ.matched_list_mode(mode, Term.UPat.rep_id(upat)) + ); let p_ids = List.map(Term.UPat.rep_id, ps); let (ctx, infos) = List.fold_left2( @@ -563,8 +575,14 @@ and upat_to_info_map = } | Wild => atomic(Just(unknown)) | Var(name) => - let typ = typ_after_fix(mode, Just(Unknown(Internal)), Term.UPat.rep_id(upat)); - let entry = Ctx.VarEntry({name, id: Term.UPat.rep_id(upat), typ}); + let upat_rep_id = Term.UPat.rep_id(upat); + let typ = + typ_after_fix( + mode, + Just(Unknown(Internal(upat_rep_id))), + upat_rep_id, + ); + let entry = Ctx.VarEntry({name, id: upat_rep_id, typ}); add(~self=Just(unknown), ~ctx=Ctx.extend(entry, ctx), Id.Map.empty); | Tuple(ps) => let modes = Typ.matched_prod_mode(mode, List.length(ps)); diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index 0eca6507bc..d255b5713c 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -2,24 +2,24 @@ open Sexplib.Std; /* TYPE_PROVENANCE: From whence does an unknown type originate? - Forms associated with a unique Id.t linking them to some UExp/UPat - ------------------------------------------------------------ - SynSwitch: Generated from an unannotated pattern variable - TypeHole: Generataed from a pattern variable annotated with a type hole - Internal: Generated by an internal judgement + Forms associated with a unique Id.t linking them to some UExp/UPat + ------------------------------------------------------------ + SynSwitch: Generated from an unannotated pattern variable + TypeHole: Generataed from a pattern variable annotated with a type hole + Internal: Generated by an internal judgement - Forms without a unique Id.t of their own - ---------------------------------------- - Inference: Always derived from some other provenance for use in global inference. - Composed of a 'matched_provenenace' indicating how it was derived, - and the provenance it was derived from. - Generally, will always link to some form with its own unique Id.t - Currently supports matched list, arrow, and prod. + Forms without a unique Id.t of their own + ---------------------------------------- + Inference: Always derived from some other provenance for use in global inference. + Composed of a 'matched_provenenace' indicating how it was derived, + and the provenance it was derived from. + Generally, will always link to some form with its own unique Id.t + Currently supports matched list, arrow, and prod. - Anonymous: Generated for unknown types not linked to any UExp/UPat, wildcards, - and other generally 'unconstrainable' unknown types - Consequently, Anonymous unknown types do not accumulate constraints - or receive inference results.*/ + Anonymous: Generated for unknown types not linked to any UExp/UPat, wildcards, + and other generally 'unconstrainable' unknown types + Consequently, Anonymous unknown types do not accumulate constraints + or receive inference results.*/ [@deriving (show({with_path: false}), sexp, yojson)] type type_provenance = | Anonymous @@ -92,21 +92,21 @@ type mode = /* Strip location information from a list of sources */ let source_tys = List.map((source: source) => source.ty); -/* - I THINK THIS MIGHT BE THE PROBLEM: WHY IS INFERENCE < SYNSWITCH? - NVM LOL - - How type provenance information should be collated when - joining unknown types. This probably requires more thought, - but right now TypeHole strictly predominates over Internal - which strictly predominates over SynSwitch, which - strictly predominates over Anonymous. - If two provenances have different Ids, either can be taken as a - representative of the other in later computations regarding the - type as a whole. - Similarly, if two Internal provenances have different matched provenance - strucutres, either structure can be taken. Precedence: - TypeHole > Internal > SynSwitch > Inference > Anonymous*/ +/* + I THINK THIS MIGHT BE THE PROBLEM: WHY IS INFERENCE < SYNSWITCH? + NVM LOL + + How type provenance information should be collated when + joining unknown types. This probably requires more thought, + but right now TypeHole strictly predominates over Internal + which strictly predominates over SynSwitch, which + strictly predominates over Anonymous. + If two provenances have different Ids, either can be taken as a + representative of the other in later computations regarding the + type as a whole. + Similarly, if two Internal provenances have different matched provenance + strucutres, either structure can be taken. Precedence: + TypeHole > Internal > SynSwitch > Inference > Anonymous*/ let join_type_provenance = (p1: type_provenance, p2: type_provenance): type_provenance => switch (p1, p2) { @@ -247,7 +247,7 @@ let matched_list_mode = (mode: mode, termId: Id.t): mode => { switch (mode) { | SynFun | Syn => Syn - | Ana(ty) => Ana(matched_list(ty, termId)); + | Ana(ty) => Ana(matched_list(ty, termId)) }; }; From 09ddeeaa5cffb0e0ea16253b7347a7b620fc195b Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 29 Dec 2022 00:33:35 -0500 Subject: [PATCH 005/129] adds constraints to Typ.re; doesn't compile yet --- src/haz3lcore/statics/Typ.re | 75 +++++++++++++++++++++--------------- 1 file changed, 44 insertions(+), 31 deletions(-) diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index d255b5713c..1c112452f0 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -48,6 +48,10 @@ type t = | Sum(t, t) // unused | Prod(list(t)); +[@deriving (show({with_path: false}), sexp, yojson)] +type equivalence = (t, t) +and constraints = list(equivalence); + /* SOURCE: Hazel type annotated with a relevant source location. Currently used to track match branches for inconsistent branches errors, but could perhaps be used more broadly @@ -209,65 +213,74 @@ let t_of_self = implicit. Somebody should check that what I'm doing here actually makes sense -Andrew*/ -let matched_arrow = (ty: t, termId: Id.t): (t, t) => { - let prov_to_arrow = prov => { +let matched_arrow = (ty: t, termId: Id.t): ((t, t), constraints) => { + let matched_arrow_of_prov = prov => { let (arrow_lhs, arrow_rhs) = ( Unknown(Inference(Matched_Arrow_Left, prov)), Unknown(Inference(Matched_Arrow_Right, prov)), ); - (arrow_lhs, arrow_rhs); + ((arrow_lhs, arrow_rhs), [(Unknown(prov), Arrow(arrow_lhs, arrow_rhs))]); }; switch (ty) { - | Arrow(ty_in, ty_out) => (ty_in, ty_out) - | Unknown(prov) => prov_to_arrow(prov) - | _ => prov_to_arrow(Internal(termId)) + | Arrow(ty_in, ty_out) => ((ty_in, ty_out), []) + | Unknown(prov) => matched_arrow_of_prov(prov) + | _ => matched_arrow_of_prov(Internal(termId)) }; }; -let matched_arrow_mode = (mode: mode, termId: Id.t): (mode, mode) => { +let matched_arrow_mode = (mode: mode, termId: Id.t): ((mode, mode), constraints) => { switch (mode) { | SynFun - | Syn => (Syn, Syn) + | Syn => ((Syn, Syn), []) | Ana(ty) => - let (ty_in, ty_out) = matched_arrow(ty, termId); - (Ana(ty_in), Ana(ty_out)); + let ((ty_in, ty_out), constraints) = matched_arrow(ty, termId); + ((Ana(ty_in), Ana(ty_out)), constraints); }; }; -let matched_list = (ty: t, termId: Id.t): t => { - let prov_to_list = prov => Unknown(Inference(Matched_List, prov)); +let matched_list = (ty: t, termId: Id.t): (t, constraints) => { + let matched_list_of_prov = prov => { + let list_elts_typ = Unknown(Inference(Matched_List, prov)); + (list_elts_typ, [(Unknown(prov), List(list_elts_typ))]) + }; + switch (ty) { - | List(ty) => ty - | Unknown(prov) => prov_to_list(prov) - | _ => prov_to_list(Internal(termId)) + | List(ty) => (ty, []) + | Unknown(prov) => matched_list_of_prov(prov) + | _ => matched_list_of_prov(Internal(termId)) }; }; -let matched_list_mode = (mode: mode, termId: Id.t): mode => { +let matched_list_mode = (mode: mode, termId: Id.t): (mode, constraints) => { switch (mode) { | SynFun - | Syn => Syn - | Ana(ty) => Ana(matched_list(ty, termId)) + | Syn => (Syn, []) + | Ana(ty) => + let (ty_elts, constraints) = matched_list(ty, termId); + (Ana(ty_elts), constraints) }; }; -let rec matched_prod_mode = (mode: mode, length): list(mode) => { +let rec matched_prod_mode = (mode: mode, length): (list(mode), constraints) => { + let binary_matched_prod_of_prov = (prov: type_provenance): ((t, t), equivalence) => { + let (left_ty, right_ty) = ( + Unknown(Inference(Matched_Prod_Left, prov)), + Unknown(Inference(Matched_Prod_Right, prov)) + ); + ((left_ty, right_ty), (Unknown(prov), Prod([left_ty, right_ty]))); + }; + switch (mode, length) { | (Ana(Unknown(prov)), 2) => - let left = Ana(Unknown(Inference(Matched_Prod_Left, prov))); - let right = Ana(Unknown(Inference(Matched_Prod_Right, prov))); - [left, right]; + let ((left_ty, right_ty), equivalence) = binary_matched_prod_of_prov(prov); + ([Ana(left_ty), Ana(right_ty)], [equivalence]) | (Ana(Unknown(prov)), _) when length > 2 => - let first = Ana(Unknown(Inference(Matched_Prod_Left, prov))); - let rest = - matched_prod_mode( - Ana(Unknown(Inference(Matched_Prod_Right, prov))), - length - 1, - ); - [first, ...rest]; + let ((left_ty, right_ty), equivalence) = binary_matched_prod_of_prov(prov); + let (modes_of_rest, constraints_of_rest) = matched_prod_mode(Ana(right_ty), length - 1); + ([Ana(left_ty), ...modes_of_rest], [equivalence, ...constraints_of_rest]) | (Ana(Prod(ana_tys)), _) when List.length(ana_tys) == length => - List.map(ty => Ana(ty), ana_tys) - | _ => List.init(length, _ => Syn) + (List.map(ty => Ana(ty), ana_tys), []) + | _ => (List.init(length, _ => Syn), []) }; }; From c4488cde16275a63914081db92c44a2c1d1340fd Mon Sep 17 00:00:00 2001 From: RaefM Date: Sat, 31 Dec 2022 04:19:39 -0500 Subject: [PATCH 006/129] adds constraint generation to static type checking --- src/haz3lcore/dynamics/elaborator.re | 4 +- src/haz3lcore/statics/Statics.re | 359 +++++++++++++++++++-------- src/haz3lcore/statics/Typ.re | 45 ++-- 3 files changed, 287 insertions(+), 121 deletions(-) diff --git a/src/haz3lcore/dynamics/elaborator.re b/src/haz3lcore/dynamics/elaborator.re index 94a58bc5f1..376245138f 100644 --- a/src/haz3lcore/dynamics/elaborator.re +++ b/src/haz3lcore/dynamics/elaborator.re @@ -168,7 +168,7 @@ let rec dhexp_of_uexp = (m: Statics.map, uexp: Term.UExp.t): option(DHExp.t) => | String(s) => Some(StringLit(s)) | ListLit(es) => let+ ds = es |> List.map(dhexp_of_uexp(m)) |> OptUtil.sequence; - let ty = + let (ty, _constraints) = Typ.matched_list( Statics.exp_typ(m, uexp), Term.UExp.rep_id(uexp), @@ -327,7 +327,7 @@ and dhpat_of_upat = (m: Statics.map, upat: Term.UPat.t): option(DHPat.t) => { | Triv => wrap(Tuple([])) | ListLit(ps) => let* ds = ps |> List.map(dhpat_of_upat(m)) |> OptUtil.sequence; - let ty = + let (ty, _constraints) = Typ.matched_list(Statics.pat_typ(m, upat), Term.UPat.rep_id(upat)); wrap(ListLit(ty, ds)); | Tag(name) => wrap(Tag(name)) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index df512fd503..185971103b 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -280,25 +280,48 @@ let typ_exp_unop: Term.UExp.op_un => (Typ.t, Typ.t) = fun | Int(Minus) => (Int, Int); -let rec any_to_info_map = (~ctx: Ctx.t, any: Term.any): (Ctx.co, map) => +let join_constraints = (tys: list(Typ.t)): Typ.constraints => { + // find first elt containing hole and constrain it to every other elt + let elts_with_hole = List.filter(Typ.contains_hole, tys); + switch (elts_with_hole) { + | [] => [] + | [hd, ..._] => + let constrain_rep_to_elt = + (acc: Typ.constraints, curr: Typ.t): Typ.constraints => { + [(hd, curr), ...acc]; + }; + List.fold_left(constrain_rep_to_elt, [], tys); + }; +}; + +let subsumption_constraints = (mode: Typ.mode, final_typ: Typ.t) => { + switch (mode) { + | Ana(expected_typ) => [(final_typ, expected_typ)] + | _ => [] + }; +}; + +let rec any_to_info_map = + (~ctx: Ctx.t, any: Term.any): (Ctx.co, map, Typ.constraints) => switch (any) { | Exp(e) => - let (_, co, map) = uexp_to_info_map(~ctx, e); - (co, map); + let (_, co, map, constraints) = uexp_to_info_map(~ctx, e); + (co, map, constraints); | Pat(p) => - let (_, _, map) = upat_to_info_map(~is_synswitch=false, ~ctx, p); - (VarMap.empty, map); + let (_, _, map, constraints) = + upat_to_info_map(~is_synswitch=false, ~ctx, p); + (VarMap.empty, map, constraints); | Typ(ty) => let (_, map) = utyp_to_info_map(ty); - (VarMap.empty, map); + (VarMap.empty, map, []); // TODO(d) consider Rul case | Rul(_) | Nul () - | Any () => (VarMap.empty, Id.Map.empty) + | Any () => (VarMap.empty, Id.Map.empty, []) } and uexp_to_info_map = (~ctx: Ctx.t, ~mode=Typ.Syn, {ids, term} as uexp: Term.UExp.t) - : (Typ.t, Ctx.co, map) => { + : (Typ.t, Ctx.co, map, Typ.constraints) => { /* Maybe switch mode to syn */ let mode = switch (mode) { @@ -307,21 +330,51 @@ and uexp_to_info_map = }; let cls = Term.UExp.cls_of_term(term); let go = uexp_to_info_map(~ctx); - let add = (~self, ~free, m) => ( - typ_after_fix(mode, self, Term.UExp.rep_id(uexp)), - free, - add_info(ids, InfoExp({cls, self, mode, ctx, free, term: uexp}), m), - ); - let atomic = self => add(~self, ~free=[], Id.Map.empty); + let add = (~self: Typ.self, ~free, m, constraints) => { + let joined_constraints = + switch (self) { + | Joined(wrap, sources) => + sources |> Typ.source_tys |> List.map(wrap) |> join_constraints + | _ => [] + }; + ( + typ_after_fix(mode, self, Term.UExp.rep_id(uexp)), + free, + add_info(ids, InfoExp({cls, self, mode, ctx, free, term: uexp}), m), + joined_constraints @ constraints, + ); + }; + let atomic = self => + add( + ~self, + ~free=[], + Id.Map.empty, + subsumption_constraints( + mode, + typ_after_fix(mode, self, Term.UExp.rep_id(uexp)), + ), + ); switch (term) { - | Invalid(msg) => ( - Unknown(Internal(Term.UExp.rep_id(uexp))), + | Invalid(msg) => + let final_typ: Typ.t = Unknown(Internal(Term.UExp.rep_id(uexp))); + ( + final_typ, [], add_info(ids, Invalid(msg), Id.Map.empty), - ) + subsumption_constraints(mode, final_typ), + ); | MultiHole(tms) => - let (free, maps) = tms |> List.map(any_to_info_map(~ctx)) |> List.split; - add(~self=Multi, ~free=Ctx.union(free), union_m(maps)); + let info = tms |> List.map(any_to_info_map(~ctx)); + let free = List.map(((f, _, _)) => f, info); + let maps = List.map(((_, m, _)) => m, info); + let constraints = List.map(((_, _, c)) => c, info) |> List.flatten; + let constraints = + constraints + @ subsumption_constraints( + mode, + typ_after_fix(mode, Multi, Term.UExp.rep_id(uexp)), + ); + add(~self=Multi, ~free=Ctx.union(free), union_m(maps), constraints); | EmptyHole => atomic(Just(Unknown(Internal(Term.UExp.rep_id(uexp))))) | Triv => atomic(Just(Prod([]))) | Bool(_) => atomic(Just(Bool)) @@ -330,13 +383,16 @@ and uexp_to_info_map = | String(_) => atomic(Just(String)) | ListLit([]) => atomic(Just(List(Unknown(Anonymous)))) | ListLit(es) => - let modes = + let (modes, list_of_match_constraints) = List.init(List.length(es), _ => Typ.matched_list_mode(mode, Term.UExp.rep_id(uexp)) - ); + ) + |> List.split; + let match_constraints = List.flatten(list_of_match_constraints); let e_ids = List.map(Term.UExp.rep_id, es); let infos = List.map2((e, mode) => go(~mode, e), es, modes); - let tys = List.map(((ty, _, _)) => ty, infos); + let tys = List.map(((ty, _, _, _)) => ty, infos); + let constraints = List.map(((_, _, _, c)) => c, infos) |> List.flatten; let self: Typ.self = switch (Typ.join_all(tys)) { | None => @@ -346,17 +402,19 @@ and uexp_to_info_map = ) | Some(ty) => Just(List(ty)) }; - let free = Ctx.union(List.map(((_, f, _)) => f, infos)); - let m = union_m(List.map(((_, _, m)) => m, infos)); - add(~self, ~free, m); + let free = Ctx.union(List.map(((_, f, _, _)) => f, infos)); + let m = union_m(List.map(((_, _, m, _)) => m, infos)); + add(~self, ~free, m, match_constraints @ constraints); | Cons(e1, e2) => - let mode_e = Typ.matched_list_mode(mode, Term.UExp.rep_id(uexp)); - let (ty1, free1, m1) = go(~mode=mode_e, e1); - let (_, free2, m2) = go(~mode=Ana(List(ty1)), e2); + let (mode_e, match_constraints) = + Typ.matched_list_mode(mode, Term.UExp.rep_id(uexp)); + let (ty1, free1, m1, constraints1) = go(~mode=mode_e, e1); + let (_, free2, m2, constraints2) = go(~mode=Ana(List(ty1)), e2); add( ~self=Just(List(ty1)), ~free=Ctx.union([free1, free2]), union_m([m1, m2]), + match_constraints @ constraints1 @ constraints2, ); | Var(name) => switch (Ctx.lookup_var(ctx, name)) { @@ -366,43 +424,53 @@ and uexp_to_info_map = ~self=Just(var.typ), ~free=[(name, [{id: Term.UExp.rep_id(uexp), mode}])], Id.Map.empty, + subsumption_constraints(mode, var.typ), ) } | Parens(e) => - let (ty, free, m) = go(~mode, e); - add(~self=Just(ty), ~free, m); + let (ty, free, m, constraints) = go(~mode, e); + add(~self=Just(ty), ~free, m, constraints); | UnOp(op, e) => let (ty_in, ty_out) = typ_exp_unop(op); - let (_, free, m) = go(~mode=Ana(ty_in), e); - add(~self=Just(ty_out), ~free, m); + let (_, free, m, constraints) = go(~mode=Ana(ty_in), e); + add( + ~self=Just(ty_out), + ~free, + m, + subsumption_constraints(mode, ty_out) @ constraints, + ); | BinOp(op, e1, e2) => let (ty1, ty2, ty_out) = typ_exp_binop(op); - let (_, free1, m1) = go(~mode=Ana(ty1), e1); - let (_, free2, m2) = go(~mode=Ana(ty2), e2); + let (_, free1, m1, constraints1) = go(~mode=Ana(ty1), e1); + let (_, free2, m2, constraints2) = go(~mode=Ana(ty2), e2); add( ~self=Just(ty_out), ~free=Ctx.union([free1, free2]), union_m([m1, m2]), + subsumption_constraints(mode, ty_out) @ constraints1 @ constraints2, ); | Tuple(es) => - let modes = Typ.matched_prod_mode(mode, List.length(es)); + let (modes, match_constraints) = + Typ.matched_prod_mode(mode, List.length(es)); let infos = List.map2((e, mode) => go(~mode, e), es, modes); - let free = Ctx.union(List.map(((_, f, _)) => f, infos)); - let self = Typ.Just(Prod(List.map(((ty, _, _)) => ty, infos))); - let m = union_m(List.map(((_, _, m)) => m, infos)); - add(~self, ~free, m); + let free = Ctx.union(List.map(((_, f, _, _)) => f, infos)); + let final_typ = Typ.Prod(List.map(((ty, _, _, _)) => ty, infos)); + let self = Typ.Just(final_typ); + let m = union_m(List.map(((_, _, m, _)) => m, infos)); + let constraints = List.map(((_, _, _, c)) => c, infos) |> List.flatten; + add(~self, ~free, m, match_constraints @ constraints); | Tag(name) => switch (BuiltinADTs.get_tag_typ(name)) { | None => atomic(Free(Tag)) | Some(typ) => atomic(Just(typ)) } | Test(test) => - let (_, free_test, m1) = go(~mode=Ana(Bool), test); - add(~self=Just(Prod([])), ~free=free_test, m1); + let (_, free_test, m1, constraints) = go(~mode=Ana(Bool), test); + add(~self=Just(Prod([])), ~free=free_test, m1, constraints); | If(cond, e1, e2) => - let (_, free_e0, m1) = go(~mode=Ana(Bool), cond); - let (ty_e1, free_e1, m2) = go(~mode, e1); - let (ty_e2, free_e2, m3) = go(~mode, e2); + let (_, free_e0, m1, constraints1) = go(~mode=Ana(Bool), cond); + let (ty_e1, free_e1, m2, constraints2) = go(~mode, e1); + let (ty_e2, free_e2, m3, constraints3) = go(~mode, e2); add( ~self= Joined( @@ -414,59 +482,68 @@ and uexp_to_info_map = ), ~free=Ctx.union([free_e0, free_e1, free_e2]), union_m([m1, m2, m3]), + constraints1 @ constraints2 @ constraints3, ); | Seq(e1, e2) => - let (_, free1, m1) = go(~mode=Syn, e1); - let (ty2, free2, m2) = go(~mode, e2); + let (_, free1, m1, constraints1) = go(~mode=Syn, e1); + let (ty2, free2, m2, constraints2) = go(~mode, e2); add( ~self=Just(ty2), ~free=Ctx.union([free1, free2]), union_m([m1, m2]), + constraints1 @ constraints2, ); | Ap(fn, arg) => /* Function position mode Ana(Hole->Hole) instead of Syn */ - let (ty_fn, free_fn, m_fn) = + let (ty_fn, free_fn, m_fn, constraints1) = uexp_to_info_map(~ctx, ~mode=Typ.ap_mode, fn); - let (ty_in, ty_out) = Typ.matched_arrow(ty_fn, Term.UExp.rep_id(uexp)); - let (_, free_arg, m_arg) = + let ((ty_in, ty_out), match_constraints) = + Typ.matched_arrow(ty_fn, Term.UExp.rep_id(uexp)); + let (_, free_arg, m_arg, constraints2) = uexp_to_info_map(~ctx, ~mode=Ana(ty_in), arg); add( ~self=Just(ty_out), ~free=Ctx.union([free_fn, free_arg]), union_m([m_fn, m_arg]), + match_constraints + @ constraints1 + @ constraints2 + @ subsumption_constraints(mode, ty_out), ); | Fun(pat, body) => - let (mode_pat, mode_body) = + let ((mode_pat, mode_body), match_constraints) = Typ.matched_arrow_mode(mode, Term.UExp.rep_id(uexp)); - let (ty_pat, ctx_pat, m_pat) = + let (ty_pat, ctx_pat, m_pat, constraints1) = upat_to_info_map(~is_synswitch=false, ~mode=mode_pat, pat); let ctx_body = VarMap.concat(ctx, ctx_pat); - let (ty_body, free_body, m_body) = + let (ty_body, free_body, m_body, constraints2) = uexp_to_info_map(~ctx=ctx_body, ~mode=mode_body, body); add( ~self=Just(Arrow(ty_pat, ty_body)), ~free=Ctx.subtract_typ(ctx_pat, free_body), union_m([m_pat, m_body]), + match_constraints @ constraints1 @ constraints2, ); | Let(pat, def, body) => - let (ty_pat, ctx_pat, _m_pat) = + let (ty_pat, ctx_pat, _m_pat, constraints1) = upat_to_info_map(~is_synswitch=true, ~mode=Syn, pat); let def_ctx = extend_let_def_ctx(ctx, pat, ctx_pat, def); - let (ty_def, free_def, m_def) = + let (ty_def, free_def, m_def, constraints2) = 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) = + let (_, ctx_pat_ana, m_pat, constraints3) = upat_to_info_map(~is_synswitch=false, ~mode=Ana(ty_def), pat); let ctx_body = VarMap.concat(ctx, ctx_pat_ana); - let (ty_body, free_body, m_body) = + let (ty_body, free_body, m_body, constraints4) = 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)]), union_m([m_pat, m_def, m_body]), + constraints1 @ constraints2 @ constraints3 @ constraints4, ); | Match(scrut, rules) => - let (ty_scrut, free_scrut, m_scrut) = go(~mode=Syn, scrut); + let (ty_scrut, free_scrut, m_scrut, constraints1) = go(~mode=Syn, scrut); let (pats, branches) = List.split(rules); let pat_infos = List.map( @@ -475,23 +552,33 @@ and uexp_to_info_map = ); let branch_infos = List.map2( - (branch, (_, ctx_pat, _)) => + (branch, (_, ctx_pat, _, _)) => uexp_to_info_map(~ctx=VarMap.concat(ctx, ctx_pat), ~mode, branch), branches, pat_infos, ); let branch_sources = List.map2( - (e: Term.UExp.t, (ty, _, _)) => Typ.{id: Term.UExp.rep_id(e), ty}, + (e: Term.UExp.t, (ty, _, _, _)) => + Typ.{id: Term.UExp.rep_id(e), ty}, branches, branch_infos, ); - 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 pat_ms = List.map(((_, _, m, _)) => m, pat_infos); + let pat_constraints = + List.map(((_, _, _, c)) => c, pat_infos) |> List.flatten; + let branch_ms = List.map(((_, _, m, _)) => m, branch_infos); + let branch_frees = List.map(((_, free, _, _)) => free, branch_infos); + let branch_constraints = + List.map(((_, _, _, c)) => c, branch_infos) |> List.flatten; let self = Typ.Joined(Fun.id, branch_sources); let free = Ctx.union([free_scrut] @ branch_frees); - add(~self, ~free, union_m([m_scrut] @ pat_ms @ branch_ms)); + add( + ~self, + ~free, + union_m([m_scrut] @ pat_ms @ branch_ms), + constraints1 @ pat_constraints @ branch_constraints, + ); }; } and upat_to_info_map = @@ -501,7 +588,7 @@ and upat_to_info_map = ~mode: Typ.mode=Typ.Syn, {ids, term} as upat: Term.UPat.t, ) - : (Typ.t, Ctx.t, map) => { + : (Typ.t, Ctx.t, map, Typ.constraints) => { let upat_to_info_map = upat_to_info_map(~is_synswitch); let unknown = Typ.Unknown( @@ -510,21 +597,50 @@ and upat_to_info_map = : Internal(Term.UPat.rep_id(upat)), ); let cls = Term.UPat.cls_of_term(term); - let add = (~self, ~ctx, m) => ( - typ_after_fix(mode, self, Term.UPat.rep_id(upat)), - ctx, - add_info(ids, InfoPat({cls, self, mode, ctx, term: upat}), m), - ); - let atomic = self => add(~self, ~ctx, Id.Map.empty); + let add = (~self: Typ.self, ~ctx, m, constraints) => { + let joined_constraints = + switch (self) { + | Joined(wrap, sources) => + sources |> Typ.source_tys |> List.map(wrap) |> join_constraints + | _ => [] + }; + ( + typ_after_fix(mode, self, Term.UPat.rep_id(upat)), + ctx, + add_info(ids, InfoPat({cls, self, mode, ctx, term: upat}), m), + joined_constraints @ constraints, + ); + }; + let atomic = self => + add( + ~self, + ~ctx, + Id.Map.empty, + subsumption_constraints( + mode, + typ_after_fix(mode, self, Term.UPat.rep_id(upat)), + ), + ); switch (term) { - | Invalid(msg) => ( - Unknown(Internal(Term.UPat.rep_id(upat))), + | Invalid(msg) => + let final_typ: Typ.t = Unknown(Internal(Term.UPat.rep_id(upat))); + ( + final_typ, ctx, add_info(ids, Invalid(msg), Id.Map.empty), - ) + subsumption_constraints(mode, final_typ), + ); | MultiHole(tms) => - let (_, maps) = tms |> List.map(any_to_info_map(~ctx)) |> List.split; - add(~self=Multi, ~ctx, union_m(maps)); + let info = tms |> List.map(any_to_info_map(~ctx)); + let maps = List.map(((_, m, _)) => m, info); + let constraints = List.map(((_, _, c)) => c, info) |> List.flatten; + let constraints = + subsumption_constraints( + mode, + typ_after_fix(mode, Multi, Term.UPat.rep_id(upat)), + ) + @ constraints; + add(~self=Multi, ~ctx, union_m(maps), constraints); | EmptyHole => atomic(Just(unknown)) | Int(_) => atomic(Just(Int)) | Float(_) => atomic(Just(Float)) @@ -533,22 +649,26 @@ and upat_to_info_map = | String(_) => atomic(Just(String)) | ListLit([]) => atomic(Just(List(Unknown(Anonymous)))) | ListLit(ps) => - let modes = + let (modes, list_of_match_constraints) = List.init(List.length(ps), _ => Typ.matched_list_mode(mode, Term.UPat.rep_id(upat)) - ); + ) + |> List.split; + let match_constraints = List.flatten(list_of_match_constraints); let p_ids = List.map(Term.UPat.rep_id, ps); let (ctx, infos) = List.fold_left2( ((ctx, infos), e, mode) => { - let (_, ctx, _) as info = upat_to_info_map(~ctx, ~mode, e); + let (_, ctx, _, _) as info = upat_to_info_map(~ctx, ~mode, e); (ctx, infos @ [info]); }, (ctx, []), ps, modes, ); - let tys = List.map(((ty, _, _)) => ty, infos); + let tys = List.map(((ty, _, _, _)) => ty, infos); + let ps_constraints = + List.map(((_, _, _, c)) => c, infos) |> List.flatten; let self: Typ.self = switch (Typ.join_all(tys)) { | None => @@ -559,21 +679,34 @@ and upat_to_info_map = | Some(ty) => Just(List(ty)) }; let info: t = InfoPat({cls, self, mode, ctx, term: upat}); - let m = union_m(List.map(((_, _, m)) => m, infos)); + 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, Term.UPat.rep_id(upat)), ctx, m); + ( + typ_after_fix(mode, self, Term.UPat.rep_id(upat)), + ctx, + m, + match_constraints @ ps_constraints, + ); | Cons(hd, tl) => - let mode_e = Typ.matched_list_mode(mode, Term.UPat.rep_id(upat)); - let (ty1, ctx, m_hd) = upat_to_info_map(~ctx, ~mode=mode_e, hd); - let (_, ctx, m_tl) = upat_to_info_map(~ctx, ~mode=Ana(List(ty1)), tl); - add(~self=Just(List(ty1)), ~ctx, union_m([m_hd, m_tl])); + let (mode_e, match_constraints) = + Typ.matched_list_mode(mode, Term.UPat.rep_id(upat)); + let (ty1, ctx, m_hd, constraints1) = + upat_to_info_map(~ctx, ~mode=mode_e, hd); + let (_, ctx, m_tl, constraints2) = + upat_to_info_map(~ctx, ~mode=Ana(List(ty1)), tl); + add( + ~self=Just(List(ty1)), + ~ctx, + union_m([m_hd, m_tl]), + match_constraints @ constraints1 @ constraints2, + ); | Tag(name) => switch (BuiltinADTs.get_tag_typ(name)) { | None => atomic(Free(Tag)) | Some(typ) => atomic(Just(typ)) } - | Wild => atomic(Just(unknown)) + | Wild => atomic(Just(Unknown(Anonymous))) | Var(name) => let upat_rep_id = Term.UPat.rep_id(upat); let typ = @@ -583,36 +716,56 @@ and upat_to_info_map = upat_rep_id, ); let entry = Ctx.VarEntry({name, id: upat_rep_id, typ}); - add(~self=Just(unknown), ~ctx=Ctx.extend(entry, ctx), Id.Map.empty); + add( + ~self=Just(unknown), + ~ctx=Ctx.extend(entry, ctx), + Id.Map.empty, + subsumption_constraints(mode, typ), + ); | Tuple(ps) => - let modes = Typ.matched_prod_mode(mode, List.length(ps)); + let (modes, match_constraints) = + Typ.matched_prod_mode(mode, List.length(ps)); 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, e); (ctx, infos @ [info]); }, (ctx, []), ps, modes, ); - let self = Typ.Just(Prod(List.map(((ty, _, _)) => ty, infos))); - let m = union_m(List.map(((_, _, m)) => m, infos)); - add(~self, ~ctx, m); + let self = Typ.Just(Prod(List.map(((ty, _, _, _)) => ty, infos))); + let m = union_m(List.map(((_, _, m, _)) => m, infos)); + let ps_constraints = + List.map(((_, _, _, c)) => c, infos) |> List.flatten; + add(~self, ~ctx, m, match_constraints @ ps_constraints); | Parens(p) => - let (ty, ctx, m) = upat_to_info_map(~ctx, ~mode, p); - add(~self=Just(ty), ~ctx, m); + let (ty, ctx, m, constraints) = upat_to_info_map(~ctx, ~mode, p); + add(~self=Just(ty), ~ctx, m, constraints); | 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_in, ty_out) = Typ.matched_arrow(ty_fn, Term.UPat.rep_id(upat)); - let (_, ctx, m_arg) = upat_to_info_map(~ctx, ~mode=Ana(ty_in), arg); - add(~self=Just(ty_out), ~ctx, union_m([m_fn, m_arg])); + let (ty_fn, ctx, m_fn, constraints1) = + upat_to_info_map(~ctx, ~mode=Typ.ap_mode, fn); + let ((ty_in, ty_out), match_constraints) = + Typ.matched_arrow(ty_fn, Term.UPat.rep_id(upat)); + let (_, ctx, m_arg, constraints2) = + upat_to_info_map(~ctx, ~mode=Ana(ty_in), arg); + add( + ~self=Just(ty_out), + ~ctx, + union_m([m_fn, m_arg]), + match_constraints + @ constraints1 + @ constraints2 + @ subsumption_constraints(mode, ty_out), + ); | 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); - add(~self=Just(ty_ann), ~ctx, union_m([m, m_typ])); + let (_ty, ctx, m, constraints) = + upat_to_info_map(~ctx, ~mode=Ana(ty_ann), p); + add(~self=Just(ty_ann), ~ctx, union_m([m, m_typ]), constraints); }; } and utyp_to_info_map = ({ids, term} as utyp: Term.UTyp.t): (Typ.t, map) => { @@ -651,8 +804,8 @@ and utyp_to_info_map = ({ids, term} as utyp: Term.UTyp.t): (Typ.t, map) => { } | MultiHole(tms) => // TODO thread ctx through to multihole terms once ctx is available - let (_, maps) = - tms |> List.map(any_to_info_map(~ctx=Ctx.empty)) |> List.split; + let info = tms |> List.map(any_to_info_map(~ctx=Ctx.empty)); + let maps = List.map(((_, m, _)) => m, info); just(union_m(maps)); }; }; @@ -661,7 +814,7 @@ let mk_map = Core.Memo.general( ~cache_size_bound=1000, e => { - let (_, _, map) = + let (_, _, map, _constraints) = uexp_to_info_map(~ctx=Builtins.ctx(Builtins.Pervasives.builtins), e); map; }, diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index 1c112452f0..0cd5b6d1f4 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -219,7 +219,10 @@ let matched_arrow = (ty: t, termId: Id.t): ((t, t), constraints) => { Unknown(Inference(Matched_Arrow_Left, prov)), Unknown(Inference(Matched_Arrow_Right, prov)), ); - ((arrow_lhs, arrow_rhs), [(Unknown(prov), Arrow(arrow_lhs, arrow_rhs))]); + ( + (arrow_lhs, arrow_rhs), + [(Unknown(prov), Arrow(arrow_lhs, arrow_rhs))], + ); }; switch (ty) { | Arrow(ty_in, ty_out) => ((ty_in, ty_out), []) @@ -228,7 +231,8 @@ let matched_arrow = (ty: t, termId: Id.t): ((t, t), constraints) => { }; }; -let matched_arrow_mode = (mode: mode, termId: Id.t): ((mode, mode), constraints) => { +let matched_arrow_mode = + (mode: mode, termId: Id.t): ((mode, mode), constraints) => { switch (mode) { | SynFun | Syn => ((Syn, Syn), []) @@ -241,9 +245,9 @@ let matched_arrow_mode = (mode: mode, termId: Id.t): ((mode, mode), constraints) let matched_list = (ty: t, termId: Id.t): (t, constraints) => { let matched_list_of_prov = prov => { let list_elts_typ = Unknown(Inference(Matched_List, prov)); - (list_elts_typ, [(Unknown(prov), List(list_elts_typ))]) + (list_elts_typ, [(Unknown(prov), List(list_elts_typ))]); }; - + switch (ty) { | List(ty) => (ty, []) | Unknown(prov) => matched_list_of_prov(prov) @@ -255,31 +259,40 @@ let matched_list_mode = (mode: mode, termId: Id.t): (mode, constraints) => { switch (mode) { | SynFun | Syn => (Syn, []) - | Ana(ty) => + | Ana(ty) => let (ty_elts, constraints) = matched_list(ty, termId); - (Ana(ty_elts), constraints) + (Ana(ty_elts), constraints); }; }; let rec matched_prod_mode = (mode: mode, length): (list(mode), constraints) => { - let binary_matched_prod_of_prov = (prov: type_provenance): ((t, t), equivalence) => { + let binary_matched_prod_of_prov = + (prov: type_provenance): ((t, t), equivalence) => { let (left_ty, right_ty) = ( - Unknown(Inference(Matched_Prod_Left, prov)), - Unknown(Inference(Matched_Prod_Right, prov)) + Unknown(Inference(Matched_Prod_Left, prov)), + Unknown(Inference(Matched_Prod_Right, prov)), ); ((left_ty, right_ty), (Unknown(prov), Prod([left_ty, right_ty]))); }; switch (mode, length) { | (Ana(Unknown(prov)), 2) => - let ((left_ty, right_ty), equivalence) = binary_matched_prod_of_prov(prov); - ([Ana(left_ty), Ana(right_ty)], [equivalence]) + let ((left_ty, right_ty), equivalence) = + binary_matched_prod_of_prov(prov); + ([Ana(left_ty), Ana(right_ty)], [equivalence]); | (Ana(Unknown(prov)), _) when length > 2 => - let ((left_ty, right_ty), equivalence) = binary_matched_prod_of_prov(prov); - let (modes_of_rest, constraints_of_rest) = matched_prod_mode(Ana(right_ty), length - 1); - ([Ana(left_ty), ...modes_of_rest], [equivalence, ...constraints_of_rest]) - | (Ana(Prod(ana_tys)), _) when List.length(ana_tys) == length => - (List.map(ty => Ana(ty), ana_tys), []) + let ((left_ty, right_ty), equivalence) = + binary_matched_prod_of_prov(prov); + let (modes_of_rest, constraints_of_rest) = + matched_prod_mode(Ana(right_ty), length - 1); + ( + [Ana(left_ty), ...modes_of_rest], + [equivalence, ...constraints_of_rest], + ); + | (Ana(Prod(ana_tys)), _) when List.length(ana_tys) == length => ( + List.map(ty => Ana(ty), ana_tys), + [], + ) | _ => (List.init(length, _ => Syn), []) }; }; From 5ad3ee9b5a868bb2df6141bd3e252bde654badad Mon Sep 17 00:00:00 2001 From: RaefM Date: Sat, 31 Dec 2022 04:35:06 -0500 Subject: [PATCH 007/129] adds all the inference modules; unlinked to UI or log in this commit --- src/haz3lcore/inference/EqClass.re | 368 +++++++++++++++++++++ src/haz3lcore/inference/EqGraph.re | 83 +++++ src/haz3lcore/inference/EqGraph.rei | 11 + src/haz3lcore/inference/ITyp.re | 75 +++++ src/haz3lcore/inference/Inference.re | 60 ++++ src/haz3lcore/inference/InferenceResult.re | 103 ++++++ src/haz3lcore/inference/MutableEqClass.re | 208 ++++++++++++ src/haz3lcore/inference/MutableEqClass.rei | 22 ++ 8 files changed, 930 insertions(+) create mode 100644 src/haz3lcore/inference/EqClass.re create mode 100644 src/haz3lcore/inference/EqGraph.re create mode 100644 src/haz3lcore/inference/EqGraph.rei create mode 100644 src/haz3lcore/inference/ITyp.re create mode 100644 src/haz3lcore/inference/Inference.re create mode 100644 src/haz3lcore/inference/InferenceResult.re create mode 100644 src/haz3lcore/inference/MutableEqClass.re create mode 100644 src/haz3lcore/inference/MutableEqClass.rei diff --git a/src/haz3lcore/inference/EqClass.re b/src/haz3lcore/inference/EqClass.re new file mode 100644 index 0000000000..67e476fac4 --- /dev/null +++ b/src/haz3lcore/inference/EqClass.re @@ -0,0 +1,368 @@ +open Util; +open OptUtil.Syntax; +open Sexplib.Std; + +[@deriving (show({with_path: false}), sexp)] +type base_typ = + | BUnit + | BInt + | BFloat + | BBool + | BString + | BUnknown(Typ.type_provenance); + +[@deriving (show({with_path: false}), sexp)] +type unary_ctor = + | CList; + +[@deriving (show({with_path: false}), sexp)] +type binary_ctor = + | CArrow + | CProd + | CSum; + +[@deriving (show({with_path: false}), sexp)] +type t = list(eq_typ) +and eq_typ = + | Base(base_typ) + | Mapped(unary_ctor, t) + | Compound(binary_ctor, t, t); + +let mk_as_binary_ctor = (ctor: binary_ctor, ty1: ITyp.t, ty2: ITyp.t): ITyp.t => { + switch (ctor) { + | CArrow => Arrow(ty1, ty2) + | CProd => Prod(ty1, ty2) + | CSum => Sum(ty1, ty2) + }; +}; + +let rec ityp_to_eq_typ: ITyp.t => eq_typ = + fun + | Unknown(prov) => Base(BUnknown(prov)) + | Int => Base(BInt) + | Unit => Base(BUnit) + | Float => Base(BFloat) + | Bool => Base(BBool) + | String => Base(BString) + | Arrow(ty1, ty2) => + Compound(CArrow, [ityp_to_eq_typ(ty1)], [ityp_to_eq_typ(ty2)]) + | Prod(ty1, ty2) => + Compound(CProd, [ityp_to_eq_typ(ty1)], [ityp_to_eq_typ(ty2)]) + | Sum(ty1, ty2) => + Compound(CProd, [ityp_to_eq_typ(ty1)], [ityp_to_eq_typ(ty2)]) + | List(ty) => Mapped(CList, [ityp_to_eq_typ(ty)]); + +let typ_to_eq_typ: Typ.t => eq_typ = + typ => { + typ |> ITyp.typ_to_ityp |> ityp_to_eq_typ; + }; + +let base_typ_to_ityp: base_typ => ITyp.t = + fun + | BInt => Int + | BFloat => Float + | BBool => Bool + | BString => String + | BUnit => Unit + | BUnknown(prov) => Unknown(prov); + +let rec extend_with_eq_class = (target: t, eq_class_extension: t) => { + switch (eq_class_extension) { + | [] => target + | [eq_typ_extension, ...extension_tl] => + let target = extend_with_eq_typ(target, eq_typ_extension); + extend_with_eq_class(target, extension_tl); + }; +} +and extend_with_eq_typ = (target: t, eq_typ_extension: eq_typ) => { + switch (target) { + | [] => [eq_typ_extension] + | [target_hd, ...target_tl] => + let extend_target_tl: unit => t = ( + () => { + [target_hd, ...extend_with_eq_typ(target_tl, eq_typ_extension)]; + } + ); + switch (target_hd, eq_typ_extension) { + | (_, Base(_)) => + target_hd == eq_typ_extension ? target : extend_target_tl() + | (Mapped(hd_ctor, hd_eq_class), Mapped(eq_typ_ctor, eq_class)) => + hd_ctor == eq_typ_ctor + ? [ + Mapped(hd_ctor, extend_with_eq_class(hd_eq_class, eq_class)), + ...target_tl, + ] + : extend_target_tl() + | ( + Compound(hd_ctor, hd_eq_class_lt, hd_eq_class_rt), + Compound(eq_typ_ctor, eq_class_lt, eq_class_rt), + ) => + if (hd_ctor == eq_typ_ctor) { + let hd_eq_class_lt = + extend_with_eq_class(hd_eq_class_lt, eq_class_lt); + let hd_eq_class_rt = + extend_with_eq_class(hd_eq_class_rt, eq_class_rt); + [Compound(hd_ctor, hd_eq_class_lt, hd_eq_class_rt), ...target_tl]; + } else { + extend_target_tl(); + } + | (Base(_) | Mapped(_), Compound(_)) + | (Base(_) | Compound(_), Mapped(_)) => extend_target_tl() + }; + }; +}; + +type split_result = + | Success + | Error(split_error_status) +and split_error_status = + | Unsplittable + | WrongCtor; + +let split_eq_typ: eq_typ => option((t, t)) = + fun + | Mapped(_) + | Base(_) => None + | Compound(_, eq_class1, eq_class2) => Some((eq_class1, eq_class2)); + +// not currently in use +let split_eq_class = (ctor_used: binary_ctor, eq_class: t) => { + let split_result_of: eq_typ => split_result = + fun + | Base(ty) => + switch (ty) { + | BUnknown(_) => Success + | _ => Error(Unsplittable) + } + | Mapped(_) => Error(Unsplittable) + | Compound(ctor, _, _) => ctor_used == ctor ? Success : Error(WrongCtor); + + let accumulate_splits = + ((acc_class_lt, acc_class_rt): (t, t), eq_typ: eq_typ) => { + switch (split_eq_typ(eq_typ)) { + | None => (acc_class_lt, acc_class_rt) + | Some((eq_class_lt, eq_class_rt)) => + let acc_class_lt = extend_with_eq_class(acc_class_lt, eq_class_lt); + let acc_class_rt = extend_with_eq_class(acc_class_rt, eq_class_rt); + (acc_class_lt, acc_class_rt); + }; + }; + + let (eq_class_lt, eq_class_rt) = + List.fold_left(accumulate_splits, ([], []), eq_class); + + // Unsplittable errors take precedence over WrongCtor due to strictly more severe error handling + let rec check_ctor = + (eq_class: t, wrong_ctor_error_found: bool): split_result => { + switch (eq_class) { + | [] => wrong_ctor_error_found ? Error(WrongCtor) : Success + | [hd, ...tl] => + switch (split_result_of(hd)) { + | Error(Unsplittable) as e => e + | Error(WrongCtor) => check_ctor(tl, true) + | _ => check_ctor(tl, wrong_ctor_error_found) + } + }; + }; + + (check_ctor(eq_class, false), eq_class_lt, eq_class_rt); +}; + +let fuse = (ctor_used: binary_ctor, eq_class_lt: t, eq_class_rt: t) => { + Compound(ctor_used, eq_class_lt, eq_class_rt); +}; + +let rec target_typ_is_in_eq_class = (target_typ: eq_typ, eq_class: t): bool => { + // is target_typ ∈ eq_class? this would make them equal (via transitivity) + switch (eq_class) { + | [] => false + | [hd, ...tl] => + target_typ_is_in_eq_typ(target_typ, hd) + || target_typ_is_in_eq_class(target_typ, tl) + }; +} +and target_typ_is_in_eq_typ = (target_typ: eq_typ, eq_typ: eq_typ): bool => { + switch (target_typ, eq_typ) { + | (_, Base(_)) => target_typ == eq_typ + | (Mapped(target_ctor, target_eq_class), Mapped(ctor, eq_class)) => + target_ctor == ctor + && target_class_is_in_eq_class(target_eq_class, eq_class) + | ( + Compound(target_ctor, target_class_lt, target_class_rt), + Compound(ctor, eq_class_lt, eq_class_rt), + ) => + target_ctor == ctor + && target_class_is_in_eq_class(target_class_lt, eq_class_lt) + && target_class_is_in_eq_class(target_class_rt, eq_class_rt) + | (Base(_) | Compound(_), Mapped(_)) + | (Base(_) | Mapped(_), Compound(_)) => false + }; +} +and target_class_is_in_eq_class = (target_class: t, eq_class: t): bool => { + // is target_class ∈ eq_class? this would make them equal (via transitivity) + let target_typ_contained = (target_typ: eq_typ): bool => { + target_typ_is_in_eq_class(target_typ, eq_class); + }; + List.for_all(target_typ_contained, target_class); +}; + +let rec target_typ_used_in_eq_class = (target_typ: eq_typ, eq_class: t): bool => { + // is [target_typ] ⊆ eq_class? + switch (eq_class) { + | [] => false + | [hd, ...tl] => + target_typ_used_in_eq_typ(target_typ, hd) + || target_typ_used_in_eq_class(target_typ, tl) + }; +} +and target_typ_used_in_eq_typ = (target_typ: eq_typ, eq_typ: eq_typ): bool => { + // target used inside, or is represented by the eq_typ itself + switch (target_typ, eq_typ) { + | (_, Base(_)) => target_typ == eq_typ + | (Mapped(_), Mapped(_, eq_class)) => + target_typ_used_in_eq_class(target_typ, eq_class) + || target_typ_is_in_eq_typ(target_typ, eq_typ) + | (Compound(_), Compound(_, eq_class_lt, eq_class_rt)) => + target_typ_used_in_eq_class(target_typ, eq_class_lt) + || target_typ_used_in_eq_class(target_typ, eq_class_rt) + || target_typ_is_in_eq_typ(target_typ, eq_typ) + | (Base(_) | Compound(_), Mapped(_, eq_class)) => + target_typ_used_in_eq_class(target_typ, eq_class) + | (Base(_) | Mapped(_), Compound(_, eq_class_lt, eq_class_rt)) => + target_typ_is_in_eq_class(target_typ, eq_class_lt) + || target_typ_is_in_eq_class(target_typ, eq_class_rt) + }; +} +and target_class_used_in_eq_class = (target_class: t, eq_class: t): bool => { + // is target_class ⊆ eq_class? + let target_typ_used = (target_typ: eq_typ): bool => { + target_typ_used_in_eq_class(target_typ, eq_class); + }; + // every target typ must be used in the eq class for the whole target class to have been used + List.for_all(target_typ_used, target_class); +}; + +let rec target_typ_in_domain_but_not_equal = + (eq_class: t, target_typ: eq_typ): bool => { + List.exists(target_typ_in_domain_but_not_equal_typ(target_typ), eq_class); +} +and target_typ_in_domain_but_not_equal_typ = + (target_typ: eq_typ, eq_typ: eq_typ): bool => { + // is target_typ ⊂ eq_typ? + // NOTE: + // target_typ != eq_typ ^ target_typ ⊆ eq_typ + // => target_typ ⊂ eq_typ + !target_typ_is_in_eq_typ(target_typ, eq_typ) + && target_typ_used_in_eq_typ(target_typ, eq_typ); +}; + +let is_known: eq_typ => bool = + fun + | Base(BUnknown(_)) => false + | _ => true; + +let rec filter_unneeded_holes_class = + (comp: eq_typ => bool, remove: bool, eq_class: t): t => { + switch (eq_class) { + | [] => [] + | [hd, ...tl] => + let (had_hole, filtered_hd_opt) = + filter_unneeded_holes_typ(comp, remove, hd); + let remove = had_hole || remove; + switch (filtered_hd_opt) { + | None => filter_unneeded_holes_class(comp, remove, tl) + | Some(filtered_hd) => [ + filtered_hd, + ...filter_unneeded_holes_class(comp, remove, tl), + ] + }; + }; +} +and filter_unneeded_holes_typ = + (comp: eq_typ => bool, remove: bool, eq_typ: eq_typ) + : (bool, option(eq_typ)) => { + switch (eq_typ) { + | Base(btyp) => + switch (btyp) { + | BUnknown(_) => + let eq_tp_opt = remove ? None : Some(eq_typ); + (true, eq_tp_opt); + | _ => (false, Some(eq_typ)) + } + | Mapped(ctor, eq_class) => + let delete_holes = List.exists(comp, eq_class); + let eq_class = filter_unneeded_holes_class(comp, delete_holes, eq_class); + (false, Some(Mapped(ctor, eq_class))); + | Compound(ctor, eq_class_lt, eq_class_rt) => + let delete_holes_lt = List.exists(comp, eq_class_lt); + let delete_holes_rt = List.exists(comp, eq_class_rt); + let eq_class_lt = + filter_unneeded_holes_class(comp, delete_holes_lt, eq_class_lt); + let eq_class_rt = + filter_unneeded_holes_class(comp, delete_holes_rt, eq_class_rt); + (false, Some(Compound(ctor, eq_class_lt, eq_class_rt))); + }; +}; + +let filter_unneeded_holes = (comp: eq_typ => bool, eq_class: t): t => { + let delete_holes = List.exists(comp, eq_class); + filter_unneeded_holes_class(comp, delete_holes, eq_class); +}; + +let rec filtered_eq_class_to_typ: t => option(ITyp.t) = + fun + | [] => None + | [Base(btyp)] => Some(btyp |> base_typ_to_ityp) + | [Compound(ctor, eq_class_lt, eq_class_rt)] => { + let* typ1 = filtered_eq_class_to_typ(eq_class_lt); + let+ typ2 = filtered_eq_class_to_typ(eq_class_rt); + mk_as_binary_ctor(ctor, typ1, typ2); + } + | _ => None; + +let comp_eq_typ = (eq_typ1: eq_typ, eq_typ2: eq_typ): int => { + let strip_id_from_prov: Typ.type_provenance => float = + fun + | SynSwitch(id) + | TypeHole(id) + | Internal(id) => + id == 0 ? (-2.0) : Float.sub(0.0, Float.div(1.0, float_of_int(id))) + | _ => 0.0; + + let eq_typ_to_float: eq_typ => float = + fun + | Base(BInt) + | Base(BUnit) + | Base(BFloat) + | Base(BString) + | Base(BBool) => 1.0 + | Base(BUnknown(prov)) => strip_id_from_prov(prov) + | Compound(_) => 2.0 + | Mapped(_) => 3.0; + + Stdlib.compare(eq_typ_to_float(eq_typ1), eq_typ_to_float(eq_typ2)); +}; + +let rec sort_eq_class = (eq_class: t): t => { + let eq_class = List.fast_sort(comp_eq_typ, eq_class); + sort_eq_class_explore(eq_class); +} +and sort_eq_class_explore = (eq_class: t): t => { + switch (eq_class) { + | [] => [] + | [hd, ...tl] => + switch (hd) { + | Base(_) => [hd, ...sort_eq_class_explore(tl)] + | Mapped(ctor, eq_class_arg) => + let sorted_class = sort_eq_class(eq_class_arg); + [Mapped(ctor, sorted_class), ...sort_eq_class(tl)]; + | Compound(ctor, eq_class_lt, eq_class_rt) => + let sorted_class_lt = sort_eq_class(eq_class_lt); + let sorted_class_rt = sort_eq_class(eq_class_rt); + [ + Compound(ctor, sorted_class_lt, sorted_class_rt), + ...sort_eq_class_explore(tl), + ]; + } + }; +}; diff --git a/src/haz3lcore/inference/EqGraph.re b/src/haz3lcore/inference/EqGraph.re new file mode 100644 index 0000000000..ac25eb42fa --- /dev/null +++ b/src/haz3lcore/inference/EqGraph.re @@ -0,0 +1,83 @@ +type t = Hashtbl.t(ITyp.t, MutableEqClass.t); + +let expected_size: int = 50; + +let create = (): t => { + Hashtbl.create(expected_size); +}; + +let add = (eq_graph: t, key: ITyp.t, mut_eq_class: MutableEqClass.t): unit => { + switch (Hashtbl.find_opt(eq_graph, key)) { + | Some(curr_mut_eq_class) => + MutableEqClass.union(curr_mut_eq_class, mut_eq_class) + | None => Hashtbl.add(eq_graph, key, mut_eq_class) + }; +}; + +let add_typ_as_node = (eq_graph: t, typ: ITyp.t): unit => { + let (keys, values) = MutableEqClass.derive_nested_keys_and_eq_classes(typ); + List.iter2(add(eq_graph), keys, values); +}; + +let equate_nodes = (eq_graph: t, typ1: ITyp.t, typ2: ITyp.t): unit => { + let elem1 = Hashtbl.find(eq_graph, typ1); + let elem2 = Hashtbl.find(eq_graph, typ2); + + MutableEqClass.union(elem1, elem2); +}; + +let equate_node_to_primitive_typ = + (eq_graph: t, node_key: ITyp.t, equated_typ: ITyp.t): unit => { + let curr_eq_class = Hashtbl.find(eq_graph, node_key); + let mut_eq_typs_extension = + [equated_typ |> EqClass.ityp_to_eq_typ] + |> MutableEqClass.eq_class_to_mut_eq_class; + + MutableEqClass.union(curr_eq_class, mut_eq_typs_extension); +}; + +let get_keys_in_eq_class = (eq_graph: t, eq_class: EqClass.t): list(ITyp.t) => { + let add_key_to_acc = (key: ITyp.t, _: MutableEqClass.t, acc: list(ITyp.t)) => { + [key, ...acc]; + }; + let keys = Hashtbl.fold(add_key_to_acc, eq_graph, []); + let is_in_eq_class = (key: ITyp.t) => { + let key_eq_typ = EqClass.ityp_to_eq_typ(key); + EqClass.target_typ_is_in_eq_class(key_eq_typ, eq_class); + }; + List.filter(is_in_eq_class, keys); +}; + +let fail_occurs_check = (eq_graph: t, t1: ITyp.t, t2: ITyp.t): bool => { + let c1 = Hashtbl.find(eq_graph, t1); + let c2 = Hashtbl.find(eq_graph, t2); + + let (snapshot1, err1) = MutableEqClass.snapshot_class(c1); + let (snapshot2, err2) = MutableEqClass.snapshot_class(c2); + + switch (err1, err2) { + | (Some(MutableEqClass.Occurs), _) + | (_, Some(MutableEqClass.Occurs)) => true + | _ => + let keys_in_snapshot1 = get_keys_in_eq_class(eq_graph, snapshot1); + let keys_in_snapshot2 = get_keys_in_eq_class(eq_graph, snapshot2); + + List.exists( + EqClass.target_typ_in_domain_but_not_equal(snapshot1), + List.map(EqClass.ityp_to_eq_typ, keys_in_snapshot2), + ) + || List.exists( + EqClass.target_typ_in_domain_but_not_equal(snapshot2), + List.map(EqClass.ityp_to_eq_typ, keys_in_snapshot1), + ); + }; +}; + +let make_occurs_check = (eq_graph: t, t1: ITyp.t, t2: ITyp.t): unit => + if (fail_occurs_check(eq_graph, t1, t2)) { + let elem1 = Hashtbl.find(eq_graph, t1); + let elem2 = Hashtbl.find(eq_graph, t2); + + MutableEqClass.mark_failed_occurs(elem1); + MutableEqClass.mark_failed_occurs(elem2); + }; diff --git a/src/haz3lcore/inference/EqGraph.rei b/src/haz3lcore/inference/EqGraph.rei new file mode 100644 index 0000000000..7c01c27d64 --- /dev/null +++ b/src/haz3lcore/inference/EqGraph.rei @@ -0,0 +1,11 @@ +type t = Hashtbl.t(ITyp.t, MutableEqClass.t); + +let create: unit => t; + +let add_typ_as_node: (t, ITyp.t) => unit; + +let equate_nodes: (t, ITyp.t, ITyp.t) => unit; + +let equate_node_to_primitive_typ: (t, ITyp.t, ITyp.t) => unit; + +let make_occurs_check: (t, ITyp.t, ITyp.t) => unit; diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re new file mode 100644 index 0000000000..bbf0f3f062 --- /dev/null +++ b/src/haz3lcore/inference/ITyp.re @@ -0,0 +1,75 @@ +open Sexplib.Std; +exception TypeVarUnsupported; + +[@deriving (show({with_path: false}), sexp, yojson)] +type t = + | Unknown(Typ.type_provenance) + | Unit + | Int + | Float + | Bool + | String + | List(t) + | Arrow(t, t) + | Sum(t, t) + | Prod(t, t); + +[@deriving (show({with_path: false}), sexp, yojson)] +type equivalence = (t, t) +and constraints = list(equivalence); + +// HACK: +// In order to ensure difference hole provenenances with the same +// id chart to the same set of results, convert synswitch provs to internal +// Do not change TypeHole, as we will filter on that condition later. +let rec prov_to_iprov: Typ.type_provenance => Typ.type_provenance = + fun + | SynSwitch(u) => Internal(u) + | Inference(mprov, prov) => Inference(mprov, prov_to_iprov(prov)) + | _ as prov => prov; + +let rec typ_to_ityp: Typ.t => t = + fun + | Unknown(prov) => Unknown(prov_to_iprov(prov)) + | Int => Int + | Float => Float + | Bool => Bool + | String => String + | List(tys) => List(typ_to_ityp(tys)) + | Arrow(t1, t2) => Arrow(typ_to_ityp(t1), typ_to_ityp(t2)) + | Sum(t1, t2) => Sum(typ_to_ityp(t1), typ_to_ityp(t2)) + | Prod([single]) => typ_to_ityp(single) + | Prod([hd_ty, ...tl_tys]) => + Prod(typ_to_ityp(hd_ty), typ_to_ityp(Prod(tl_tys))) + | Prod([]) => Unit + | Var(_) => raise(TypeVarUnsupported); + +let rec ityp_to_typ: t => Typ.t = + fun + | Unknown(prov) => Unknown(prov) + | Int => Int + | Float => Float + | Bool => Bool + | String => String + | List(ity) => List(ityp_to_typ(ity)) + | Arrow(t1, t2) => Arrow(ityp_to_typ(t1), ityp_to_typ(t2)) + | Sum(t1, t2) => Sum(ityp_to_typ(t1), ityp_to_typ(t2)) + | Unit => Prod([]) + | Prod(t1, t2) => Prod([ityp_to_typ(t1), ityp_to_typ(t2)]); + +let to_ityp_constraints = (constraints: Typ.constraints): constraints => { + constraints + |> List.filter(((t1, t2)) => + t1 != Typ.Unknown(Anonymous) && t2 != Typ.Unknown(Anonymous) + ) + |> List.map(((t1, t2)) => (typ_to_ityp(t1), typ_to_ityp(t2))); +}; + +let rec contains_hole = (ty: t): bool => + switch (ty) { + | Unknown(_) => true + | Arrow(ty1, ty2) + | Sum(ty1, ty2) + | Prod(ty1, ty2) => contains_hole(ty1) || contains_hole(ty2) + | _ => false + }; diff --git a/src/haz3lcore/inference/Inference.re b/src/haz3lcore/inference/Inference.re new file mode 100644 index 0000000000..083ae8381d --- /dev/null +++ b/src/haz3lcore/inference/Inference.re @@ -0,0 +1,60 @@ +// NOTE: Current formulation does not unify constraints comparing inconsistent constructors. +// Unifying these would cause EqClasses to be potentially considered invalid without any +// inconsistencies within them, which is a confusing result to represent to a user and may +// pollute other equivalence classes with unhelpful error statuses that static inference can +// already give better results on. +// We decide here that we will only draw inference results on holes and the things these holes +// are compared to through their neighborhood of implied consistencies as governed by attempted +// consistency checks in synthesis and analysis. +let rec unify = (eq_graph: EqGraph.t, constraints: ITyp.constraints): unit => { + List.iter(unify_one(eq_graph), constraints); +} +and unify_one = (eq_graph: EqGraph.t, typs: (ITyp.t, ITyp.t)): unit => { + switch (typs) { + | (List(ty1), List(ty2)) => unify_one(eq_graph, (ty1, ty2)) + | (Arrow(ty1_lhs, ty1_rhs), Arrow(ty2_lhs, ty2_rhs)) + | (Prod(ty1_lhs, ty1_rhs), Prod(ty2_lhs, ty2_rhs)) + | (Sum(ty1_lhs, ty1_rhs), Sum(ty2_lhs, ty2_rhs)) => + unify(eq_graph, [(ty1_lhs, ty2_lhs), (ty1_rhs, ty2_rhs)]) + | (Unknown(_) as hole, t) + | (t, Unknown(_) as hole) => + EqGraph.add_typ_as_node(eq_graph, hole); + + if (ITyp.contains_hole(t)) { + // if the type it is being constrained to is a potential node, add it then equate the two nodes + EqGraph.add_typ_as_node(eq_graph, t); + EqGraph.make_occurs_check(eq_graph, t, hole); + EqGraph.equate_nodes(eq_graph, t, hole); + } else { + // otherwise, simply add t to hole's EqClass without making a new node + EqGraph.equate_node_to_primitive_typ( + eq_graph, + hole, + t, + ); + }; + | _ => () + }; +}; + +let unify_and_report_status = + (constraints: Typ.constraints): list(InferenceResult.t) => { + let inference_eq_graph = EqGraph.create(); + let constraints = ITyp.to_ityp_constraints(constraints); + + unify(inference_eq_graph, constraints); + + let acc_results = + ( + key: ITyp.t, + mut_eq_class: MutableEqClass.t, + acc: list(InferenceResult.t), + ) + : list(InferenceResult.t) => { + [(key, InferenceResult.condense(mut_eq_class)), ...acc]; + }; + + let unsorted_results = Hashtbl.fold(acc_results, inference_eq_graph, []); + + List.fast_sort(InferenceResult.comp_results, unsorted_results); +}; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re new file mode 100644 index 0000000000..fe68a6357e --- /dev/null +++ b/src/haz3lcore/inference/InferenceResult.re @@ -0,0 +1,103 @@ +type status = + | Solved(ITyp.t) + | Unsolved(EqClass.t); + +type t = (ITyp.t, status); + +let status_to_string: status => string = + fun + | Solved(ityp) => + String.concat( + " ", + ["Solved: ", ityp |> ITyp.sexp_of_t |> Sexplib.Sexp.to_string_hum], + ) + | Unsolved(eqClass) => + String.concat( + " ", + [ + "Unsolved: ", + eqClass |> EqClass.sexp_of_t |> Sexplib.Sexp.to_string_hum, + ], + ); + +let t_to_string = ((ityp, status)) => { + String.concat( + " ", + [ + "{For hole", + ityp |> ITyp.sexp_of_t |> Sexplib.Sexp.to_string_hum, + "result is", + status_to_string(status), + "}\n", + ], + ); +}; + +let list_of_t_to_string = (statuses: list(t)): string => { + let acc_str = (acc: string, elt: t) => { + String.concat(" ", [acc, "\n", t_to_string(elt)]); + }; + List.fold_left(acc_str, "", statuses); +}; + +let print_statuses = (statuses: list(t)): unit => { + let print_t = (t: t) => { + t |> t_to_string |> print_endline; + }; + List.iter(print_t, statuses); +}; + +let condense = (eq_class: MutableEqClass.t): status => { + let (eq_class, err) = MutableEqClass.snapshot_class(eq_class); + let sorted_eq_class = EqClass.sort_eq_class(eq_class); + let filtered_eq_class = + EqClass.filter_unneeded_holes(EqClass.is_known, sorted_eq_class); + + switch (err) { + | Some(_) => Unsolved(filtered_eq_class) + | None => + let solved_opt = EqClass.filtered_eq_class_to_typ(filtered_eq_class); + switch (solved_opt) { + | Some(typ) => Solved(typ) + | None => Unsolved(filtered_eq_class) + }; + }; +}; + +let rec prov_to_priority = (prov: Typ.type_provenance): int => { + switch (prov) { + | Anonymous => (-1) + | SynSwitch(id) + | TypeHole(id) + | Internal(id) => id + | Inference(_, prov) => prov_to_priority(prov) + }; +}; + +let rec convert_leftmost_to_priority = (typ: ITyp.t): int => { + switch (typ) { + | Int + | Unit + | Float + | String + | Bool => (-1) + | Unknown(prov) => prov_to_priority(prov) + | List(elt_typ) => convert_leftmost_to_priority(elt_typ) + | Arrow(typ_lhs, typ_rhs) + | Prod(typ_lhs, typ_rhs) + | Sum(typ_lhs, typ_rhs) => + let lhs = convert_leftmost_to_priority(typ_lhs); + let rhs = convert_leftmost_to_priority(typ_rhs); + switch (lhs, rhs) { + | ((-1), (-1)) => (-1) + | ((-1), _) => rhs + | _ => lhs + }; + }; +}; + +let comp_results = ((ty1, _): t, (ty2, _): t): int => { + let priority1 = convert_leftmost_to_priority(ty1); + let priority2 = convert_leftmost_to_priority(ty2); + Stdlib.compare(priority1, priority2); +}; diff --git a/src/haz3lcore/inference/MutableEqClass.re b/src/haz3lcore/inference/MutableEqClass.re new file mode 100644 index 0000000000..fd6703d016 --- /dev/null +++ b/src/haz3lcore/inference/MutableEqClass.re @@ -0,0 +1,208 @@ +type error_status = + | Occurs; + +type t = UnionFind.elem((mut_eq_typs, option(error_status))) +and mut_eq_typs = list(mut_eq_typ) +and mut_eq_typ = + | Base(EqClass.base_typ) + | Mapped(EqClass.unary_ctor, t) + | Compound(EqClass.binary_ctor, t, t); + +let wrap_without_error = (typs: mut_eq_typs): t => { + (typs, None) |> UnionFind.make; +}; + +let unwrap_and_remove_error = (t: t): mut_eq_typs => { + let (typs, _) = UnionFind.get(t); + typs; +}; + +let combine_error_status = + (err1: option(error_status), err2: option(error_status)) => { + switch (err1, err2) { + | (None, None) => None + | (Some(Occurs), Some(Occurs)) + | (Some(Occurs), None) + | (None, Some(Occurs)) => Some(Occurs) + }; +}; + +let get_combined_error_status_of_classes = + (t1: t, t2: t): option(error_status) => { + let (_, err1) = UnionFind.get(t1); + let (_, err2) = UnionFind.get(t2); + + combine_error_status(err1, err2); +}; + +let rec snapshot_class = + (mut_eq_class: t): (EqClass.t, option(error_status)) => { + let (typs, err1) = UnionFind.get(mut_eq_class); + let (eq_class, err2) = snapshot_typs(typs); + (eq_class, combine_error_status(err1, err2)); +} +and snapshot_typs = + (mut_eq_typs: mut_eq_typs): (EqClass.t, option(error_status)) => { + switch (mut_eq_typs) { + | [] => ([], None) + | [hd, ...tl] => + let (eq_typ_hd, err_hd) = snapshot_typ(hd); + let (eq_class_tl, err_tl) = snapshot_typs(tl); + ([eq_typ_hd, ...eq_class_tl], combine_error_status(err_hd, err_tl)); + }; +} +and snapshot_typ = + (mut_eq_typ: mut_eq_typ): (EqClass.eq_typ, option(error_status)) => { + switch (mut_eq_typ) { + | Base(b) => (EqClass.Base(b), None) + | Compound(ctor, mut_eq_class_lhs, mut_eq_class_rhs) => + let (eq_class_lhs, err_lhs) = snapshot_class(mut_eq_class_lhs); + let (eq_class_rhs, err_rhs) = snapshot_class(mut_eq_class_rhs); + ( + EqClass.Compound(ctor, eq_class_lhs, eq_class_rhs), + combine_error_status(err_lhs, err_rhs), + ); + | Mapped(ctor, mut_eq_class) => + let (eq_class, err) = snapshot_class(mut_eq_class); + (EqClass.Mapped(ctor, eq_class), err); + }; +}; + +let rec eq_class_to_mut_eq_class = (eq_class: EqClass.t): t => { + List.map(eq_typ_to_mut_eq_typ, eq_class) |> wrap_without_error; +} +and eq_typ_to_mut_eq_typ = (eq_typ: EqClass.eq_typ): mut_eq_typ => { + switch (eq_typ) { + | Base(base_typ) => Base(base_typ) + | Mapped(ctor, eq_class) => + Mapped(ctor, eq_class_to_mut_eq_class(eq_class)) + | Compound(ctor, eq_class_lhs, eq_class_rhs) => + Compound( + ctor, + eq_class_to_mut_eq_class(eq_class_lhs), + eq_class_to_mut_eq_class(eq_class_rhs), + ) + }; +}; + +let rec preorder_elem_traversal_mut_eq_class = (mut_eq_class: t): list(t) => { + [ + mut_eq_class, + ...mut_eq_class + |> unwrap_and_remove_error + |> List.map(preorder_traversal_mut_eq_typ) + |> List.flatten, + ]; +} +and preorder_traversal_mut_eq_typ = (mut_eq_typ: mut_eq_typ): list(t) => { + switch (mut_eq_typ) { + | Base(_) => [] + | Mapped(_, eq_class) => preorder_elem_traversal_mut_eq_class(eq_class) + | Compound(_, lhs, rhs) => + preorder_elem_traversal_mut_eq_class(lhs) + @ preorder_elem_traversal_mut_eq_class(rhs) + }; +}; + +let rec preorder_key_traversal_typ = (ty: ITyp.t): list(ITyp.t) => { + switch (ty) { + | Int + | Unit + | Float + | String + | Bool + | Unknown(_) => [ty] + | Arrow(ty_lhs, ty_rhs) + | Prod(ty_lhs, ty_rhs) + | Sum(ty_lhs, ty_rhs) => [ + ty, + ...preorder_key_traversal_typ(ty_lhs) + @ preorder_key_traversal_typ(ty_rhs), + ] + | List(ty) => [ty, ...preorder_key_traversal_typ(ty)] + }; +}; + +let derive_nested_keys_and_eq_classes = + (key: ITyp.t): (list(ITyp.t), list(t)) => { + let mut_eq_class = + [key |> EqClass.ityp_to_eq_typ] |> eq_class_to_mut_eq_class; + + let preorder_typs = preorder_key_traversal_typ(key); + let preorder_elems = preorder_elem_traversal_mut_eq_class(mut_eq_class); + + List.combine(preorder_typs, preorder_elems) + |> List.filter(((k, _)) => ITyp.contains_hole(k)) + |> List.split; +}; + +let rec extend_class_with_class = (target: t, extension: t): t => { + let merged_typs = + extend_typs_with_typs( + unwrap_and_remove_error(target), + unwrap_and_remove_error(extension), + ); + let final_rep = UnionFind.union(target, extension); + UnionFind.set( + final_rep, + (merged_typs, get_combined_error_status_of_classes(target, extension)), + ); + final_rep; +} +and extend_typs_with_typs = + (target: mut_eq_typs, extension: mut_eq_typs): mut_eq_typs => { + switch (extension) { + | [] => target + | [eq_typ_extension, ...extension_tl] => + let target = extend_typs_with_typ(target, eq_typ_extension); + extend_typs_with_typs(target, extension_tl); + }; +} +and extend_typs_with_typ = + (target: mut_eq_typs, eq_typ_extension: mut_eq_typ): mut_eq_typs => { + switch (target) { + | [] => [eq_typ_extension] + | [target_hd, ...target_tl] => + let extend_target_tl: unit => mut_eq_typs = ( + () => { + [target_hd, ...extend_typs_with_typ(target_tl, eq_typ_extension)]; + } + ); + switch (target_hd, eq_typ_extension) { + | (_, Base(_)) => + target_hd == eq_typ_extension ? target : extend_target_tl() + | (Mapped(hd_ctor, hd_eq_class), Mapped(eq_typ_ctor, eq_class)) => + hd_ctor == eq_typ_ctor + ? [ + Mapped(hd_ctor, extend_class_with_class(hd_eq_class, eq_class)), + ...target_tl, + ] + : extend_target_tl() + | ( + Compound(hd_ctor, hd_eq_class_lt, hd_eq_class_rt), + Compound(eq_typ_ctor, eq_class_lt, eq_class_rt), + ) => + if (hd_ctor == eq_typ_ctor) { + let hd_eq_class_lt = + extend_class_with_class(hd_eq_class_lt, eq_class_lt); + let hd_eq_class_rt = + extend_class_with_class(hd_eq_class_rt, eq_class_rt); + [Compound(hd_ctor, hd_eq_class_lt, hd_eq_class_rt), ...target_tl]; + } else { + extend_target_tl(); + } + | (Base(_) | Mapped(_), Compound(_)) + | (Base(_) | Compound(_), Mapped(_)) => extend_target_tl() + }; + }; +}; + +let union = (t1: t, t2: t): unit => { + let _ = extend_class_with_class(t1, t2); + (); +}; + +let mark_failed_occurs = (mut_eq_class: t): unit => { + let (curr_typs, _) = UnionFind.get(mut_eq_class); + UnionFind.set(mut_eq_class, (curr_typs, Some(Occurs))); +}; diff --git a/src/haz3lcore/inference/MutableEqClass.rei b/src/haz3lcore/inference/MutableEqClass.rei new file mode 100644 index 0000000000..b9e83363d9 --- /dev/null +++ b/src/haz3lcore/inference/MutableEqClass.rei @@ -0,0 +1,22 @@ +type error_status = + | Occurs; + +type t = UnionFind.elem((mut_eq_typs, option(error_status))) +and mut_eq_typs = list(mut_eq_typ) +and mut_eq_typ = + | Base(EqClass.base_typ) + | Mapped(EqClass.unary_ctor, t) + | Compound(EqClass.binary_ctor, t, t); + +let snapshot_class: t => (EqClass.t, option(error_status)); +let snapshot_typs: mut_eq_typs => (EqClass.t, option(error_status)); +let snapshot_typ: mut_eq_typ => (EqClass.eq_typ, option(error_status)); + +let eq_class_to_mut_eq_class: EqClass.t => t; +let eq_typ_to_mut_eq_typ: EqClass.eq_typ => mut_eq_typ; + +let derive_nested_keys_and_eq_classes: ITyp.t => (list(ITyp.t), list(t)); + +let union: (t, t) => unit; + +let mark_failed_occurs: t => unit; From 431c20f3338fb61828dfb510170d8525bdde7f4c Mon Sep 17 00:00:00 2001 From: RaefM Date: Tue, 3 Jan 2023 01:44:22 -0500 Subject: [PATCH 008/129] links inference to UI. currently untested. changes existing code in Measured.re (offset of grout set based on associated annotation, if any) and in Code.re (text for grout set to annotation, if any) --- src/haz3lcore/Measured.re | 10 +++- src/haz3lcore/inference/EqClass.re | 41 ++++++++++++++ src/haz3lcore/inference/ITyp.re | 17 +++++- src/haz3lcore/inference/InferenceResult.re | 65 ++++++++++------------ src/haz3lcore/statics/Statics.re | 15 +++++ src/haz3lweb/view/BackpackView.re | 5 +- src/haz3lweb/view/Code.re | 47 ++++++++++++---- 7 files changed, 152 insertions(+), 48 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index f94966e628..41f163f2f5 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -284,6 +284,8 @@ let is_indented_map = (seg: Segment.t) => { let of_segment = (~old: t=empty, ~touched=Touched.empty, seg: Segment.t): t => { let is_indented = is_indented_map(seg); + let (term, _) = MakeTerm.go(seg); + let annotation_map = Statics.mk_annotations(term); // recursive across seg's bidelimited containers let rec go_nested = @@ -369,7 +371,13 @@ let of_segment = (~old: t=empty, ~touched=Touched.empty, seg: Segment.t): t => { let map = map |> add_w(w, {origin, last}); (contained_indent, last, map); | Grout(g) => - let last = {...origin, col: origin.col + 1}; + let annotation_offset = + g.id + |> InferenceResult.get_annotation_of_id(annotation_map) + |> OptUtil.get(() => " ") + |> String.length; + + let last = {...origin, col: origin.col + annotation_offset}; let map = map |> add_g(g, {origin, last}); (contained_indent, last, map); | Tile(t) => diff --git a/src/haz3lcore/inference/EqClass.re b/src/haz3lcore/inference/EqClass.re index 67e476fac4..dea80a8926 100644 --- a/src/haz3lcore/inference/EqClass.re +++ b/src/haz3lcore/inference/EqClass.re @@ -366,3 +366,44 @@ and sort_eq_class_explore = (eq_class: t): t => { } }; }; + +let string_of_btyp = (btyp: base_typ): string => { + btyp |> base_typ_to_ityp |> ITyp.string_of_ityp; +}; + +let rec string_of_eq_class = (eq_class: t): string => + switch (eq_class) { + | [] => "" + | [hd, ...tl] => + let hd_str = string_of_eq_typ(hd); + String.concat("//", [hd_str, string_of_eq_class(tl)]); + } +and string_of_eq_typ = (eq_typ: eq_typ) => + switch (eq_typ) { + | Base(btyp) => string_of_btyp(btyp) + | Compound(ctor, eq_class_lt, eq_class_rt) => + let ctor_string = + switch (ctor) { + | CArrow => " -> " + | CProd => " * " + | CSum => " + " + }; + + String.concat( + "", + [ + string_of_eq_class(eq_class_lt), + ctor_string, + "(", + string_of_eq_class(eq_class_rt), + ")", + ], + ); + | Mapped(ctor, eq_class) => + let (end_text, start_text) = + switch (ctor) { + | CList => ("[", "]") + }; + + String.concat("", [start_text, string_of_eq_class(eq_class), end_text]); + }; diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index bbf0f3f062..cb61525ecc 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -42,7 +42,7 @@ let rec typ_to_ityp: Typ.t => t = | Prod([hd_ty, ...tl_tys]) => Prod(typ_to_ityp(hd_ty), typ_to_ityp(Prod(tl_tys))) | Prod([]) => Unit - | Var(_) => raise(TypeVarUnsupported); + | Var(_) => Unknown(Anonymous); let rec ityp_to_typ: t => Typ.t = fun @@ -73,3 +73,18 @@ let rec contains_hole = (ty: t): bool => | Prod(ty1, ty2) => contains_hole(ty1) || contains_hole(ty2) | _ => false }; + +let rec string_of_ityp = (ityp: t): string => { + switch (ityp) { + | Unknown(_) => "?" + | Unit => "Unit" + | Int => "Int" + | Float => "Float" + | Bool => "Bool" + | String => "String" + | List(t) => "[" ++ string_of_ityp(t) ++ "]" + | Arrow(t1, t2) => string_of_ityp(t1) ++ " -> " ++ string_of_ityp(t2) + | Sum(t1, t2) => string_of_ityp(t1) ++ " + " ++ string_of_ityp(t2) + | Prod(t1, t2) => string_of_ityp(t1) ++ " x " ++ string_of_ityp(t2) + }; +}; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index fe68a6357e..f36d51abdb 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -4,47 +4,42 @@ type status = type t = (ITyp.t, status); -let status_to_string: status => string = - fun - | Solved(ityp) => - String.concat( - " ", - ["Solved: ", ityp |> ITyp.sexp_of_t |> Sexplib.Sexp.to_string_hum], - ) - | Unsolved(eqClass) => - String.concat( - " ", - [ - "Unsolved: ", - eqClass |> EqClass.sexp_of_t |> Sexplib.Sexp.to_string_hum, - ], - ); +type annotation_map = list((Id.t, string)); -let t_to_string = ((ityp, status)) => { - String.concat( - " ", - [ - "{For hole", - ityp |> ITyp.sexp_of_t |> Sexplib.Sexp.to_string_hum, - "result is", - status_to_string(status), - "}\n", - ], - ); -}; +let get_annotations = (inference_results: list(t)): annotation_map => { + let status_to_string = (status: status): string => { + switch (status) { + | Solved(ityp) => ITyp.string_of_ityp(ityp) + | Unsolved(eq_class) => EqClass.string_of_eq_class(eq_class) + }; + }; -let list_of_t_to_string = (statuses: list(t)): string => { - let acc_str = (acc: string, elt: t) => { - String.concat(" ", [acc, "\n", t_to_string(elt)]); + let id_and_annotation_if_type_hole = (result: t): option((Id.t, string)) => { + switch (result) { + | (Unknown(TypeHole(id)), status) => + Some((id, status_to_string(status))) + | _ => None + }; }; - List.fold_left(acc_str, "", statuses); + + List.filter_map(id_and_annotation_if_type_hole, inference_results); }; -let print_statuses = (statuses: list(t)): unit => { - let print_t = (t: t) => { - t |> t_to_string |> print_endline; +let get_annotation_of_id = + (annotation_map: annotation_map, id: Id.t): option(string) => { + let get_annotation_if_for_id = ((k, v)) => k == id ? Some(v) : None; + + let get_annotation_text = + (possible_annotations: list(string)): option(string) => { + switch (possible_annotations) { + | [] => None + | [hd, ..._tl] => Some(hd) + }; }; - List.iter(print_t, statuses); + + annotation_map + |> List.filter_map(get_annotation_if_for_id) + |> get_annotation_text; }; let condense = (eq_class: MutableEqClass.t): status => { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 185971103b..c58f40ba4e 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -816,10 +816,25 @@ let mk_map = e => { let (_, _, map, _constraints) = uexp_to_info_map(~ctx=Builtins.ctx(Builtins.Pervasives.builtins), e); + map; }, ); +let mk_annotations = + Core.Memo.general( + ~cache_size_bound=1000, + e => { + let (_, _, _info_map, constraints) = + uexp_to_info_map(~ctx=Builtins.ctx(Builtins.Pervasives.builtins), e); + + let inference_results = Inference.unify_and_report_status(constraints); + let annotation_map = InferenceResult.get_annotations(inference_results); + + annotation_map; + }, + ); + let get_binding_site = (id: Id.t, statics_map: map): option(Id.t) => { open OptUtil.Syntax; let* opt = Id.Map.find_opt(id, statics_map); diff --git a/src/haz3lweb/view/BackpackView.re b/src/haz3lweb/view/BackpackView.re index b10cd24724..5e9657699a 100644 --- a/src/haz3lweb/view/BackpackView.re +++ b/src/haz3lweb/view/BackpackView.re @@ -15,6 +15,8 @@ let backpack_sel_view = let map = Measured.of_segment(content); let settings = Model.settings_init; }); + let (term, _) = MakeTerm.go(content); + let annotation_map = Statics.mk_annotations(term); // TODO(andrew): Maybe use init sort at caret to prime this div( ~attr= @@ -32,7 +34,8 @@ let backpack_sel_view = ), ]), // zwsp necessary for containing box to stretch to contain trailing newline - Text.of_segment(~no_sorts=true, content) @ [text(Unicode.zwsp)], + Text.of_segment(~no_sorts=true, content, annotation_map) + @ [text(Unicode.zwsp)], ); }; diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 085fe8786f..507e51861f 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -30,7 +30,9 @@ let of_delim = (sort: Sort.t, is_consistent, t: Piece.tile, i: int): list(Node.t) => of_delim'((sort, is_consistent, Tile.is_complete(t), t.label, i)); -let of_grout = [Node.text(Unicode.nbsp)]; +let of_grout = (annotation: option(string)) => [ + annotation |> OptUtil.get(() => Unicode.nbsp) |> Node.text, +]; let of_whitespace = Core.Memo.general( @@ -56,7 +58,13 @@ module Text = (M: { }) => { let m = p => Measured.find_p(p, M.map); let rec of_segment = - (~no_sorts=false, ~sort=Sort.root, seg: Segment.t): list(Node.t) => { + ( + ~no_sorts=false, + ~sort=Sort.root, + seg: Segment.t, + annotation_map: InferenceResult.annotation_map, + ) + : list(Node.t) => { //note: no_sorts flag is used for backback let expected_sorts = no_sorts @@ -69,17 +77,32 @@ module Text = (M: { }; seg |> List.mapi((i, p) => (i, p)) - |> List.concat_map(((i, p)) => of_piece(sort_of_p_idx(i), p)); + |> List.concat_map(((i, p)) => + of_piece(sort_of_p_idx(i), p, annotation_map) + ); } - and of_piece = (expected_sort: Sort.t, p: Piece.t): list(Node.t) => { + and of_piece = + ( + expected_sort: Sort.t, + p: Piece.t, + annotation_map: InferenceResult.annotation_map, + ) + : list(Node.t) => { switch (p) { - | Tile(t) => of_tile(expected_sort, t) - | Grout(_) => of_grout + | Tile(t) => of_tile(expected_sort, t, annotation_map) + | Grout(g) => + g.id |> InferenceResult.get_annotation_of_id(annotation_map) |> of_grout | Whitespace({content, _}) => of_whitespace((M.settings.whitespace_icons, m(p).last.col, content)) }; } - and of_tile = (expected_sort: Sort.t, t: Tile.t): list(Node.t) => { + and of_tile = + ( + expected_sort: Sort.t, + t: Tile.t, + annotation_map: InferenceResult.annotation_map, + ) + : list(Node.t) => { let children_and_sorts = List.mapi( (i, (l, child, r)) => @@ -90,7 +113,7 @@ module Text = (M: { let is_consistent = Sort.consistent(t.mold.out, expected_sort); Aba.mk(t.shards, children_and_sorts) |> Aba.join(of_delim(t.mold.out, is_consistent, t), ((seg, sort)) => - of_segment(~sort, seg) + of_segment(~sort, seg, annotation_map) ) |> List.concat; }; @@ -120,9 +143,11 @@ let simple_view = (~unselected, ~map, ~settings: Model.settings): Node.t => { let map = map; let settings = settings; }); + let (term, _) = MakeTerm.go(unselected); + let annotation_map = Statics.mk_annotations(term); div( ~attr=Attr.class_("code"), - [span_c("code-text", Text.of_segment(unselected))], + [span_c("code-text", Text.of_segment(unselected, annotation_map))], ); }; @@ -140,9 +165,11 @@ let view = let map = measured; let settings = settings; }); + let (term, _) = MakeTerm.go(unselected); + let annotation_map = Statics.mk_annotations(term); let unselected = TimeUtil.measure_time("Code.view/unselected", settings.benchmark, () => - Text.of_segment(unselected) + Text.of_segment(unselected, annotation_map) ); let holes = TimeUtil.measure_time("Code.view/holes", settings.benchmark, () => From 94669dd2187ae2ec81c700e2562a44f23e8d921d Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 15 Jan 2023 15:02:16 -0500 Subject: [PATCH 009/129] makes annotation maps mutable. merges mk_map and mk_annotations --- src/haz3lcore/Measured.re | 2 +- src/haz3lcore/inference/InferenceResult.re | 50 +++++++++++++++------- src/haz3lcore/statics/Statics.re | 29 +++++++------ src/haz3lcore/zipper/action/Perform.re | 2 +- src/haz3lweb/SchoolExercise.re | 12 +++--- src/haz3lweb/ScratchSlide.re | 2 +- src/haz3lweb/util/EditorUtil.re | 2 +- src/haz3lweb/view/BackpackView.re | 2 +- src/haz3lweb/view/Cell.re | 2 +- src/haz3lweb/view/Code.re | 4 +- src/haz3lweb/view/LangDoc.re | 4 +- src/haz3lweb/view/SchoolMode.re | 2 +- src/haz3lweb/view/ScratchMode.re | 2 +- 13 files changed, 68 insertions(+), 47 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index 41f163f2f5..8b40cfeba0 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -285,7 +285,7 @@ let is_indented_map = (seg: Segment.t) => { let of_segment = (~old: t=empty, ~touched=Touched.empty, seg: Segment.t): t => { let is_indented = is_indented_map(seg); let (term, _) = MakeTerm.go(seg); - let annotation_map = Statics.mk_annotations(term); + let (_, annotation_map) = Statics.mk_map(term); // recursive across seg's bidelimited containers let rec go_nested = diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index f36d51abdb..8e18bac13f 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -1,45 +1,63 @@ +open Util.OptUtil.Syntax; + type status = | Solved(ITyp.t) | Unsolved(EqClass.t); type t = (ITyp.t, status); -type annotation_map = list((Id.t, string)); +type annotation_map = Hashtbl.t(Id.t, string); + +let empty_annotations = (): annotation_map => Hashtbl.create(20); let get_annotations = (inference_results: list(t)): annotation_map => { - let status_to_string = (status: status): string => { + let status_to_string = (status: status): option(string) => { switch (status) { - | Solved(ityp) => ITyp.string_of_ityp(ityp) - | Unsolved(eq_class) => EqClass.string_of_eq_class(eq_class) + | Solved(Unknown(_)) => None // it isn't useful to say something is unknown + | Solved(ityp) => Some(ITyp.string_of_ityp(ityp)) + | Unsolved(_eq_class) => None + // Some(EqClass.string_of_eq_class(eq_class)) // use if known eq_class desired }; }; let id_and_annotation_if_type_hole = (result: t): option((Id.t, string)) => { switch (result) { | (Unknown(TypeHole(id)), status) => - Some((id, status_to_string(status))) + let* annotation = status_to_string(status); + Some((id, annotation)); | _ => None }; }; - List.filter_map(id_and_annotation_if_type_hole, inference_results); + let elts = + List.filter_map(id_and_annotation_if_type_hole, inference_results); + let new_map = Hashtbl.create(List.length(elts)); + + List.iter(((id, annot)) => Hashtbl.add(new_map, id, annot), elts); + + new_map; }; let get_annotation_of_id = (annotation_map: annotation_map, id: Id.t): option(string) => { - let get_annotation_if_for_id = ((k, v)) => k == id ? Some(v) : None; + Hashtbl.find_opt(annotation_map, id); +}; - let get_annotation_text = - (possible_annotations: list(string)): option(string) => { - switch (possible_annotations) { - | [] => None - | [hd, ..._tl] => Some(hd) - }; +let merge_annotation_maps = (old_map, new_map): unit => { + let add_new_elt = (new_k, new_v) => { + Hashtbl.replace(old_map, new_k, new_v); }; + Hashtbl.iter(add_new_elt, new_map); +}; - annotation_map - |> List.filter_map(get_annotation_if_for_id) - |> get_annotation_text; +let log_attempt_at_mk_map = (loc, result) => { + switch (result) { + | exception exc => + print_endline("From " ++ loc); + print_endline(Printexc.to_string(exc)); + raise(exc); + | _ => result + }; }; let condense = (eq_class: MutableEqClass.t): status => { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index c58f40ba4e..3fa12f67cf 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -814,27 +814,30 @@ let mk_map = Core.Memo.general( ~cache_size_bound=1000, e => { - let (_, _, map, _constraints) = - uexp_to_info_map(~ctx=Builtins.ctx(Builtins.Pervasives.builtins), e); - - map; - }, - ); - -let mk_annotations = - Core.Memo.general( - ~cache_size_bound=1000, - e => { - let (_, _, _info_map, constraints) = + let (_, _, info_map, constraints) = uexp_to_info_map(~ctx=Builtins.ctx(Builtins.Pervasives.builtins), e); let inference_results = Inference.unify_and_report_status(constraints); let annotation_map = InferenceResult.get_annotations(inference_results); - annotation_map; + (info_map, annotation_map); }, ); +// let mk_annotations = +// Core.Memo.general( +// ~cache_size_bound=1000, +// e => { +// let (_, _, _info_map, constraints) = +// uexp_to_info_map(~ctx=Builtins.ctx(Builtins.Pervasives.builtins), e); + +// let inference_results = Inference.unify_and_report_status(constraints); +// let annotation_map = InferenceResult.get_annotations(inference_results); + +// annotation_map; +// }, +// ); + let get_binding_site = (id: Id.t, statics_map: map): option(Id.t) => { open OptUtil.Syntax; let* opt = Id.Map.find_opt(id, statics_map); diff --git a/src/haz3lcore/zipper/action/Perform.re b/src/haz3lcore/zipper/action/Perform.re index 6e9c74ad04..085db92095 100644 --- a/src/haz3lcore/zipper/action/Perform.re +++ b/src/haz3lcore/zipper/action/Perform.re @@ -42,7 +42,7 @@ let go_z = let idx = Indicated.index(z); let (term, _) = MakeTerm.go(Zipper.unselect_and_zip(z)); - let statics = Statics.mk_map(term); + let (statics, _) = Statics.mk_map(term); ( switch (jump_target) { diff --git a/src/haz3lweb/SchoolExercise.re b/src/haz3lweb/SchoolExercise.re index aa3d1c684d..901b417389 100644 --- a/src/haz3lweb/SchoolExercise.re +++ b/src/haz3lweb/SchoolExercise.re @@ -570,17 +570,17 @@ type stitched_statics = stitched(StaticsItem.t); let stitch_static = ({eds, _}: state): stitched_statics => { let (test_validation_term, _) = EditorUtil.stitch([eds.prelude, eds.correct_impl, eds.your_tests.tests]); - let test_validation_map = Statics.mk_map(test_validation_term); + let (test_validation_map, _) = Statics.mk_map(test_validation_term); let test_validation = StaticsItem.{term: test_validation_term, info_map: test_validation_map}; let (user_impl_term, _) = EditorUtil.stitch([eds.prelude, eds.your_impl]); - let user_impl_map = Statics.mk_map(user_impl_term); + let (user_impl_map, _) = Statics.mk_map(user_impl_term); let user_impl = StaticsItem.{term: user_impl_term, info_map: user_impl_map}; let (user_tests_term, _) = EditorUtil.stitch([eds.prelude, eds.your_impl, eds.your_tests.tests]); - let user_tests_map = Statics.mk_map(user_tests_term); + let (user_tests_map, _) = Statics.mk_map(user_tests_term); let user_tests = StaticsItem.{term: user_tests_term, info_map: user_tests_map}; @@ -590,7 +590,7 @@ let stitch_static = ({eds, _}: state): stitched_statics => { eds.correct_impl, eds.hidden_tests.tests, ]); - let instructor_info_map = Statics.mk_map(instructor_term); + let (instructor_info_map, _) = Statics.mk_map(instructor_term); let instructor = StaticsItem.{term: instructor_term, info_map: instructor_info_map}; @@ -599,7 +599,7 @@ let stitch_static = ({eds, _}: state): stitched_statics => { ({impl, _}) => { let (term, _) = EditorUtil.stitch([eds.prelude, impl, eds.your_tests.tests]); - let info_map = Statics.mk_map(term); + let (info_map, _) = Statics.mk_map(term); StaticsItem.{term, info_map}; }, eds.hidden_bugs, @@ -607,7 +607,7 @@ let stitch_static = ({eds, _}: state): stitched_statics => { let (hidden_tests_term, _) = EditorUtil.stitch([eds.prelude, eds.your_impl, eds.hidden_tests.tests]); - let hidden_tests_map = Statics.mk_map(hidden_tests_term); + let (hidden_tests_map, _) = Statics.mk_map(hidden_tests_term); let hidden_tests = StaticsItem.{term: hidden_tests_term, info_map: hidden_tests_map}; diff --git a/src/haz3lweb/ScratchSlide.re b/src/haz3lweb/ScratchSlide.re index 0b51f8957b..f0176d936b 100644 --- a/src/haz3lweb/ScratchSlide.re +++ b/src/haz3lweb/ScratchSlide.re @@ -16,7 +16,7 @@ let scratch_key = "scratch"; let spliced_elabs = ((_, editor)) => { let seg = Editor.get_seg(editor); let (term, _) = MakeTerm.go(seg); - let info_map = Statics.mk_map(term); + let (info_map, _) = Statics.mk_map(term); [(scratch_key, Interface.elaborate(info_map, term))]; }; diff --git a/src/haz3lweb/util/EditorUtil.re b/src/haz3lweb/util/EditorUtil.re index bc307c0a5a..0ad38eaa54 100644 --- a/src/haz3lweb/util/EditorUtil.re +++ b/src/haz3lweb/util/EditorUtil.re @@ -48,7 +48,7 @@ let info_map = (editor: Editor.t) => { let zipper = editor.state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let info_map = Statics.mk_map(term); + let (info_map, _) = Statics.mk_map(term); info_map; }; diff --git a/src/haz3lweb/view/BackpackView.re b/src/haz3lweb/view/BackpackView.re index 5e9657699a..f6cabb569e 100644 --- a/src/haz3lweb/view/BackpackView.re +++ b/src/haz3lweb/view/BackpackView.re @@ -16,7 +16,7 @@ let backpack_sel_view = let settings = Model.settings_init; }); let (term, _) = MakeTerm.go(content); - let annotation_map = Statics.mk_annotations(term); + let (_, annotation_map) = Statics.mk_map(term); // TODO(andrew): Maybe use init sort at caret to prime this div( ~attr= diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index 4dd25aa037..a9c15c172d 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -309,7 +309,7 @@ let editor_view = let get_elab = (editor: Editor.t): DHExp.t => { let seg = Editor.get_seg(editor); let (term, _) = MakeTerm.go(seg); - let info_map = Statics.mk_map(term); + let (info_map, _) = Statics.mk_map(term); Interface.elaborate(info_map, term); }; diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 507e51861f..951dbccfb6 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -144,7 +144,7 @@ let simple_view = (~unselected, ~map, ~settings: Model.settings): Node.t => { let settings = settings; }); let (term, _) = MakeTerm.go(unselected); - let annotation_map = Statics.mk_annotations(term); + let (_, annotation_map) = Statics.mk_map(term); div( ~attr=Attr.class_("code"), [span_c("code-text", Text.of_segment(unselected, annotation_map))], @@ -166,7 +166,7 @@ let view = let settings = settings; }); let (term, _) = MakeTerm.go(unselected); - let annotation_map = Statics.mk_annotations(term); + let (_, annotation_map) = Statics.mk_map(term); let unselected = TimeUtil.measure_time("Code.view/unselected", settings.benchmark, () => Text.of_segment(unselected, annotation_map) diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index 7b27d72878..2631c08319 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -222,7 +222,7 @@ let deco = let map = map; let show_backpack_targets = false; let (term, terms) = MakeTerm.go(unselected); - let info_map = Statics.mk_map(term); + let (info_map, _) = Statics.mk_map(term); let term_ranges = TermRanges.mk(unselected); let tiles = TileMap.mk(unselected); }); @@ -417,7 +417,7 @@ let example_view = let code_view = Code.simple_view(~unselected=term, ~map=map_code, ~settings); let (uhexp, _) = MakeTerm.go(term); - let info_map = Statics.mk_map(uhexp); + let (info_map, _) = Statics.mk_map(uhexp); let result_view = switch (Interface.evaluation_result(info_map, uhexp)) { | None => [] diff --git a/src/haz3lweb/view/SchoolMode.re b/src/haz3lweb/view/SchoolMode.re index 1a28723cf2..b2e75ca55f 100644 --- a/src/haz3lweb/view/SchoolMode.re +++ b/src/haz3lweb/view/SchoolMode.re @@ -73,7 +73,7 @@ let view = let color_highlighting: option(ColorSteps.colorMap) = if (langDocMessages.highlight && langDocMessages.show) { let (term, _) = MakeTerm.go(Zipper.unselect_and_zip(focal_zipper)); - let map = Statics.mk_map(term); + let (map, _) = Statics.mk_map(term); Some( LangDoc.get_color_map( ~doc=langDocMessages, diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 6868a11b81..01d40437e9 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -19,7 +19,7 @@ let view = let zipper = editor.state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let info_map = Statics.mk_map(term); + let (info_map, _) = Statics.mk_map(term); let color_highlighting: option(ColorSteps.colorMap) = if (langDocMessages.highlight && langDocMessages.show) { From 7dd160dc05b630e41fff9fdbd64bbda2df891daa Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 15 Jan 2023 15:14:30 -0500 Subject: [PATCH 010/129] makes annotations be accumulated in a single source --- src/haz3lcore/Measured.re | 4 +- src/haz3lcore/inference/InferenceResult.re | 12 +++--- src/haz3lcore/statics/Statics.re | 18 ++------- src/haz3lcore/zipper/action/Perform.re | 2 +- src/haz3lweb/SchoolExercise.re | 12 +++--- src/haz3lweb/ScratchSlide.re | 2 +- src/haz3lweb/util/EditorUtil.re | 2 +- src/haz3lweb/view/BackpackView.re | 5 +-- src/haz3lweb/view/Cell.re | 2 +- src/haz3lweb/view/Code.re | 43 +++++----------------- src/haz3lweb/view/LangDoc.re | 4 +- src/haz3lweb/view/SchoolMode.re | 2 +- src/haz3lweb/view/ScratchMode.re | 2 +- 13 files changed, 34 insertions(+), 76 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index 8b40cfeba0..4c9bd683b7 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -284,8 +284,6 @@ let is_indented_map = (seg: Segment.t) => { let of_segment = (~old: t=empty, ~touched=Touched.empty, seg: Segment.t): t => { let is_indented = is_indented_map(seg); - let (term, _) = MakeTerm.go(seg); - let (_, annotation_map) = Statics.mk_map(term); // recursive across seg's bidelimited containers let rec go_nested = @@ -373,7 +371,7 @@ let of_segment = (~old: t=empty, ~touched=Touched.empty, seg: Segment.t): t => { | Grout(g) => let annotation_offset = g.id - |> InferenceResult.get_annotation_of_id(annotation_map) + |> InferenceResult.get_annotation_of_id |> OptUtil.get(() => " ") |> String.length; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 8e18bac13f..9c2e6160d3 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -10,13 +10,14 @@ type annotation_map = Hashtbl.t(Id.t, string); let empty_annotations = (): annotation_map => Hashtbl.create(20); +let accumulated_annotations = empty_annotations(); + let get_annotations = (inference_results: list(t)): annotation_map => { let status_to_string = (status: status): option(string) => { switch (status) { | Solved(Unknown(_)) => None // it isn't useful to say something is unknown | Solved(ityp) => Some(ITyp.string_of_ityp(ityp)) | Unsolved(_eq_class) => None - // Some(EqClass.string_of_eq_class(eq_class)) // use if known eq_class desired }; }; @@ -38,14 +39,13 @@ let get_annotations = (inference_results: list(t)): annotation_map => { new_map; }; -let get_annotation_of_id = - (annotation_map: annotation_map, id: Id.t): option(string) => { - Hashtbl.find_opt(annotation_map, id); +let get_annotation_of_id = (id: Id.t): option(string) => { + Hashtbl.find_opt(accumulated_annotations, id); }; -let merge_annotation_maps = (old_map, new_map): unit => { +let add_on_new_annotations = (new_map): unit => { let add_new_elt = (new_k, new_v) => { - Hashtbl.replace(old_map, new_k, new_v); + Hashtbl.replace(accumulated_annotations, new_k, new_v); }; Hashtbl.iter(add_new_elt, new_map); }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 3fa12f67cf..d576d3a918 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -820,24 +820,12 @@ let mk_map = let inference_results = Inference.unify_and_report_status(constraints); let annotation_map = InferenceResult.get_annotations(inference_results); - (info_map, annotation_map); + InferenceResult.add_on_new_annotations(annotation_map); + + info_map; }, ); -// let mk_annotations = -// Core.Memo.general( -// ~cache_size_bound=1000, -// e => { -// let (_, _, _info_map, constraints) = -// uexp_to_info_map(~ctx=Builtins.ctx(Builtins.Pervasives.builtins), e); - -// let inference_results = Inference.unify_and_report_status(constraints); -// let annotation_map = InferenceResult.get_annotations(inference_results); - -// annotation_map; -// }, -// ); - let get_binding_site = (id: Id.t, statics_map: map): option(Id.t) => { open OptUtil.Syntax; let* opt = Id.Map.find_opt(id, statics_map); diff --git a/src/haz3lcore/zipper/action/Perform.re b/src/haz3lcore/zipper/action/Perform.re index 085db92095..6e9c74ad04 100644 --- a/src/haz3lcore/zipper/action/Perform.re +++ b/src/haz3lcore/zipper/action/Perform.re @@ -42,7 +42,7 @@ let go_z = let idx = Indicated.index(z); let (term, _) = MakeTerm.go(Zipper.unselect_and_zip(z)); - let (statics, _) = Statics.mk_map(term); + let statics = Statics.mk_map(term); ( switch (jump_target) { diff --git a/src/haz3lweb/SchoolExercise.re b/src/haz3lweb/SchoolExercise.re index 901b417389..aa3d1c684d 100644 --- a/src/haz3lweb/SchoolExercise.re +++ b/src/haz3lweb/SchoolExercise.re @@ -570,17 +570,17 @@ type stitched_statics = stitched(StaticsItem.t); let stitch_static = ({eds, _}: state): stitched_statics => { let (test_validation_term, _) = EditorUtil.stitch([eds.prelude, eds.correct_impl, eds.your_tests.tests]); - let (test_validation_map, _) = Statics.mk_map(test_validation_term); + let test_validation_map = Statics.mk_map(test_validation_term); let test_validation = StaticsItem.{term: test_validation_term, info_map: test_validation_map}; let (user_impl_term, _) = EditorUtil.stitch([eds.prelude, eds.your_impl]); - let (user_impl_map, _) = Statics.mk_map(user_impl_term); + let user_impl_map = Statics.mk_map(user_impl_term); let user_impl = StaticsItem.{term: user_impl_term, info_map: user_impl_map}; let (user_tests_term, _) = EditorUtil.stitch([eds.prelude, eds.your_impl, eds.your_tests.tests]); - let (user_tests_map, _) = Statics.mk_map(user_tests_term); + let user_tests_map = Statics.mk_map(user_tests_term); let user_tests = StaticsItem.{term: user_tests_term, info_map: user_tests_map}; @@ -590,7 +590,7 @@ let stitch_static = ({eds, _}: state): stitched_statics => { eds.correct_impl, eds.hidden_tests.tests, ]); - let (instructor_info_map, _) = Statics.mk_map(instructor_term); + let instructor_info_map = Statics.mk_map(instructor_term); let instructor = StaticsItem.{term: instructor_term, info_map: instructor_info_map}; @@ -599,7 +599,7 @@ let stitch_static = ({eds, _}: state): stitched_statics => { ({impl, _}) => { let (term, _) = EditorUtil.stitch([eds.prelude, impl, eds.your_tests.tests]); - let (info_map, _) = Statics.mk_map(term); + let info_map = Statics.mk_map(term); StaticsItem.{term, info_map}; }, eds.hidden_bugs, @@ -607,7 +607,7 @@ let stitch_static = ({eds, _}: state): stitched_statics => { let (hidden_tests_term, _) = EditorUtil.stitch([eds.prelude, eds.your_impl, eds.hidden_tests.tests]); - let (hidden_tests_map, _) = Statics.mk_map(hidden_tests_term); + let hidden_tests_map = Statics.mk_map(hidden_tests_term); let hidden_tests = StaticsItem.{term: hidden_tests_term, info_map: hidden_tests_map}; diff --git a/src/haz3lweb/ScratchSlide.re b/src/haz3lweb/ScratchSlide.re index f0176d936b..0b51f8957b 100644 --- a/src/haz3lweb/ScratchSlide.re +++ b/src/haz3lweb/ScratchSlide.re @@ -16,7 +16,7 @@ let scratch_key = "scratch"; let spliced_elabs = ((_, editor)) => { let seg = Editor.get_seg(editor); let (term, _) = MakeTerm.go(seg); - let (info_map, _) = Statics.mk_map(term); + let info_map = Statics.mk_map(term); [(scratch_key, Interface.elaborate(info_map, term))]; }; diff --git a/src/haz3lweb/util/EditorUtil.re b/src/haz3lweb/util/EditorUtil.re index 0ad38eaa54..bc307c0a5a 100644 --- a/src/haz3lweb/util/EditorUtil.re +++ b/src/haz3lweb/util/EditorUtil.re @@ -48,7 +48,7 @@ let info_map = (editor: Editor.t) => { let zipper = editor.state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (info_map, _) = Statics.mk_map(term); + let info_map = Statics.mk_map(term); info_map; }; diff --git a/src/haz3lweb/view/BackpackView.re b/src/haz3lweb/view/BackpackView.re index f6cabb569e..b10cd24724 100644 --- a/src/haz3lweb/view/BackpackView.re +++ b/src/haz3lweb/view/BackpackView.re @@ -15,8 +15,6 @@ let backpack_sel_view = let map = Measured.of_segment(content); let settings = Model.settings_init; }); - let (term, _) = MakeTerm.go(content); - let (_, annotation_map) = Statics.mk_map(term); // TODO(andrew): Maybe use init sort at caret to prime this div( ~attr= @@ -34,8 +32,7 @@ let backpack_sel_view = ), ]), // zwsp necessary for containing box to stretch to contain trailing newline - Text.of_segment(~no_sorts=true, content, annotation_map) - @ [text(Unicode.zwsp)], + Text.of_segment(~no_sorts=true, content) @ [text(Unicode.zwsp)], ); }; diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index a9c15c172d..4dd25aa037 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -309,7 +309,7 @@ let editor_view = let get_elab = (editor: Editor.t): DHExp.t => { let seg = Editor.get_seg(editor); let (term, _) = MakeTerm.go(seg); - let (info_map, _) = Statics.mk_map(term); + let info_map = Statics.mk_map(term); Interface.elaborate(info_map, term); }; diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 951dbccfb6..b356f3e6f1 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -58,13 +58,7 @@ module Text = (M: { }) => { let m = p => Measured.find_p(p, M.map); let rec of_segment = - ( - ~no_sorts=false, - ~sort=Sort.root, - seg: Segment.t, - annotation_map: InferenceResult.annotation_map, - ) - : list(Node.t) => { + (~no_sorts=false, ~sort=Sort.root, seg: Segment.t): list(Node.t) => { //note: no_sorts flag is used for backback let expected_sorts = no_sorts @@ -77,32 +71,17 @@ module Text = (M: { }; seg |> List.mapi((i, p) => (i, p)) - |> List.concat_map(((i, p)) => - of_piece(sort_of_p_idx(i), p, annotation_map) - ); + |> List.concat_map(((i, p)) => of_piece(sort_of_p_idx(i), p)); } - and of_piece = - ( - expected_sort: Sort.t, - p: Piece.t, - annotation_map: InferenceResult.annotation_map, - ) - : list(Node.t) => { + and of_piece = (expected_sort: Sort.t, p: Piece.t): list(Node.t) => { switch (p) { - | Tile(t) => of_tile(expected_sort, t, annotation_map) - | Grout(g) => - g.id |> InferenceResult.get_annotation_of_id(annotation_map) |> of_grout + | Tile(t) => of_tile(expected_sort, t) + | Grout(g) => g.id |> InferenceResult.get_annotation_of_id |> of_grout | Whitespace({content, _}) => of_whitespace((M.settings.whitespace_icons, m(p).last.col, content)) }; } - and of_tile = - ( - expected_sort: Sort.t, - t: Tile.t, - annotation_map: InferenceResult.annotation_map, - ) - : list(Node.t) => { + and of_tile = (expected_sort: Sort.t, t: Tile.t): list(Node.t) => { let children_and_sorts = List.mapi( (i, (l, child, r)) => @@ -113,7 +92,7 @@ module Text = (M: { let is_consistent = Sort.consistent(t.mold.out, expected_sort); Aba.mk(t.shards, children_and_sorts) |> Aba.join(of_delim(t.mold.out, is_consistent, t), ((seg, sort)) => - of_segment(~sort, seg, annotation_map) + of_segment(~sort, seg) ) |> List.concat; }; @@ -143,11 +122,9 @@ let simple_view = (~unselected, ~map, ~settings: Model.settings): Node.t => { let map = map; let settings = settings; }); - let (term, _) = MakeTerm.go(unselected); - let (_, annotation_map) = Statics.mk_map(term); div( ~attr=Attr.class_("code"), - [span_c("code-text", Text.of_segment(unselected, annotation_map))], + [span_c("code-text", Text.of_segment(unselected))], ); }; @@ -165,11 +142,9 @@ let view = let map = measured; let settings = settings; }); - let (term, _) = MakeTerm.go(unselected); - let (_, annotation_map) = Statics.mk_map(term); let unselected = TimeUtil.measure_time("Code.view/unselected", settings.benchmark, () => - Text.of_segment(unselected, annotation_map) + Text.of_segment(unselected) ); let holes = TimeUtil.measure_time("Code.view/holes", settings.benchmark, () => diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index 2631c08319..7b27d72878 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -222,7 +222,7 @@ let deco = let map = map; let show_backpack_targets = false; let (term, terms) = MakeTerm.go(unselected); - let (info_map, _) = Statics.mk_map(term); + let info_map = Statics.mk_map(term); let term_ranges = TermRanges.mk(unselected); let tiles = TileMap.mk(unselected); }); @@ -417,7 +417,7 @@ let example_view = let code_view = Code.simple_view(~unselected=term, ~map=map_code, ~settings); let (uhexp, _) = MakeTerm.go(term); - let (info_map, _) = Statics.mk_map(uhexp); + let info_map = Statics.mk_map(uhexp); let result_view = switch (Interface.evaluation_result(info_map, uhexp)) { | None => [] diff --git a/src/haz3lweb/view/SchoolMode.re b/src/haz3lweb/view/SchoolMode.re index b2e75ca55f..1a28723cf2 100644 --- a/src/haz3lweb/view/SchoolMode.re +++ b/src/haz3lweb/view/SchoolMode.re @@ -73,7 +73,7 @@ let view = let color_highlighting: option(ColorSteps.colorMap) = if (langDocMessages.highlight && langDocMessages.show) { let (term, _) = MakeTerm.go(Zipper.unselect_and_zip(focal_zipper)); - let (map, _) = Statics.mk_map(term); + let map = Statics.mk_map(term); Some( LangDoc.get_color_map( ~doc=langDocMessages, diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 01d40437e9..6868a11b81 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -19,7 +19,7 @@ let view = let zipper = editor.state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (info_map, _) = Statics.mk_map(term); + let info_map = Statics.mk_map(term); let color_highlighting: option(ColorSteps.colorMap) = if (langDocMessages.highlight && langDocMessages.show) { From be649cb2efe37b47ed1e9f287acc92c0dc155480 Mon Sep 17 00:00:00 2001 From: RaefM Date: Wed, 18 Jan 2023 13:39:19 -0500 Subject: [PATCH 011/129] fix unsolved annotations bug. adds toggle for turning annotations on and off --- src/haz3lcore/inference/EqClass.re | 1 + src/haz3lcore/inference/InferenceResult.re | 10 ++++++++-- src/haz3lcore/statics/Statics.re | 8 ++++++++ src/haz3lweb/LangDocMessages.re | 17 +++++++++++++++-- src/haz3lweb/view/LangDoc.re | 11 +++++++++++ src/haz3lweb/view/SchoolMode.re | 2 ++ src/haz3lweb/view/ScratchMode.re | 2 ++ 7 files changed, 47 insertions(+), 4 deletions(-) diff --git a/src/haz3lcore/inference/EqClass.re b/src/haz3lcore/inference/EqClass.re index dea80a8926..378fea2f6f 100644 --- a/src/haz3lcore/inference/EqClass.re +++ b/src/haz3lcore/inference/EqClass.re @@ -374,6 +374,7 @@ let string_of_btyp = (btyp: base_typ): string => { let rec string_of_eq_class = (eq_class: t): string => switch (eq_class) { | [] => "" + | [hd] => string_of_eq_typ(hd) | [hd, ...tl] => let hd_str = string_of_eq_typ(hd); String.concat("//", [hd_str, string_of_eq_class(tl)]); diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 9c2e6160d3..949d4bf6d3 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -12,12 +12,18 @@ let empty_annotations = (): annotation_map => Hashtbl.create(20); let accumulated_annotations = empty_annotations(); +let annotations_enabled = ref(true); + +let update_annoation_mode = annot_mode => { + annotations_enabled := annot_mode; +}; + let get_annotations = (inference_results: list(t)): annotation_map => { let status_to_string = (status: status): option(string) => { switch (status) { | Solved(Unknown(_)) => None // it isn't useful to say something is unknown | Solved(ityp) => Some(ITyp.string_of_ityp(ityp)) - | Unsolved(_eq_class) => None + | Unsolved(eq_class) => Some(EqClass.string_of_eq_class(eq_class)) }; }; @@ -40,7 +46,7 @@ let get_annotations = (inference_results: list(t)): annotation_map => { }; let get_annotation_of_id = (id: Id.t): option(string) => { - Hashtbl.find_opt(accumulated_annotations, id); + annotations_enabled^ ? Hashtbl.find_opt(accumulated_annotations, id) : None; }; let add_on_new_annotations = (new_map): unit => { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index d576d3a918..332ced573c 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -820,6 +820,14 @@ let mk_map = let inference_results = Inference.unify_and_report_status(constraints); let annotation_map = InferenceResult.get_annotations(inference_results); + print_endline("\nCONSTRAINTS\n--------"); + print_endline( + Typ.sexp_of_constraints(constraints) |> Sexplib.Sexp.to_string_hum, + ); + + print_endline("\nANNOTS\n-------"); + Hashtbl.iter((_, annot) => print_endline(annot), annotation_map); + InferenceResult.add_on_new_annotations(annotation_map); info_map; diff --git a/src/haz3lweb/LangDocMessages.re b/src/haz3lweb/LangDocMessages.re index 24053441fb..5c59cdb2db 100644 --- a/src/haz3lweb/LangDocMessages.re +++ b/src/haz3lweb/LangDocMessages.re @@ -3177,6 +3177,7 @@ let var_typ: form = { type t = { show: bool, highlight: bool, + annotations: bool, specificity_open: bool, forms: list(form), groups: list((string, form_group)), @@ -3248,6 +3249,7 @@ let init_options = options => { let init = { show: true, highlight: true, + annotations: true, specificity_open: false, forms: [ // Expressions @@ -3768,6 +3770,7 @@ let init = { type update = | ToggleShow | ToggleHighlight + | ToggleAnnotations | SpecificityOpen(bool) | ToggleExplanationFeedback(string, feedback_option) | ToggleExampleFeedback(string, string, feedback_option) @@ -3780,6 +3783,10 @@ let set_update = (docLangMessages: t, u: update): t => { ...docLangMessages, highlight: !docLangMessages.highlight, } + | ToggleAnnotations => { + ...docLangMessages, + annotations: !docLangMessages.annotations, + } | SpecificityOpen(b) => {...docLangMessages, specificity_open: b} | ToggleExplanationFeedback(id, feedback_option) => let form = get_form(id, docLangMessages.forms); @@ -3850,13 +3857,14 @@ type persistent_form_group = { type persistent_state = { show: bool, highlight: bool, + annotations: bool, specificity_open: bool, forms: list(persistent_form), groups: list(persistent_form_group), }; let persist = - ({show, highlight, specificity_open, forms, groups, _}: t) + ({show, highlight, annotations, specificity_open, forms, groups, _}: t) : persistent_state => { let persist_example = ({sub_id, feedback, _}: example): persistent_example => { {sub_id, feedback}; @@ -3873,6 +3881,7 @@ let persist = { show, highlight, + annotations, specificity_open, forms: List.map(persist_form, forms), groups: @@ -3886,7 +3895,10 @@ let persist = // TODO Make more robust to added messages let unpersist = - ({show, highlight, specificity_open, forms, groups}: persistent_state): t => { + ( + {show, highlight, annotations, specificity_open, forms, groups}: persistent_state, + ) + : t => { let unpersist_examples = (persistent_examples, examples) => { List.map( ({sub_id, feedback}: persistent_example) => { @@ -3929,6 +3941,7 @@ let unpersist = { show, highlight, + annotations, specificity_open, forms: forms_unpersist, groups: groups_unpersist, diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index 7b27d72878..50ee926ce7 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -2808,6 +2808,17 @@ let view = ), ) ), + toggle( + ~tooltip="Toggle inference suggestions", + "𝜏", + doc.annotations, + _ => + inject( + Update.UpdateLangDocMessages( + LangDocMessages.ToggleAnnotations, + ), + ) + ), div( ~attr= Attr.many([ diff --git a/src/haz3lweb/view/SchoolMode.re b/src/haz3lweb/view/SchoolMode.re index 1a28723cf2..a7852de6dd 100644 --- a/src/haz3lweb/view/SchoolMode.re +++ b/src/haz3lweb/view/SchoolMode.re @@ -70,6 +70,8 @@ let view = let (focal_zipper, focal_info_map) = SchoolExercise.focus(exercise, stitched_dynamics); + InferenceResult.update_annoation_mode(langDocMessages.annotations); + let color_highlighting: option(ColorSteps.colorMap) = if (langDocMessages.highlight && langDocMessages.show) { let (term, _) = MakeTerm.go(Zipper.unselect_and_zip(focal_zipper)); diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 6868a11b81..821f40a9bc 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -21,6 +21,8 @@ let view = let (term, _) = MakeTerm.go(unselected); let info_map = Statics.mk_map(term); + InferenceResult.update_annoation_mode(langDocMessages.annotations); + let color_highlighting: option(ColorSteps.colorMap) = if (langDocMessages.highlight && langDocMessages.show) { Some( From c48b065d1ee01e32482474ff648ad25190178c98 Mon Sep 17 00:00:00 2001 From: RaefM Date: Wed, 18 Jan 2023 18:34:54 -0500 Subject: [PATCH 012/129] adjusts coloring of annotations. removes empty hole svg when annotations present. fixes issues with lists in inference --- src/haz3lcore/inference/EqClass.re | 12 ++++++- src/haz3lcore/inference/ITyp.re | 5 +-- src/haz3lcore/inference/InferenceResult.re | 39 +++++++++++++--------- src/haz3lcore/inference/MutableEqClass.re | 2 +- src/haz3lcore/statics/Statics.re | 8 ----- src/haz3lweb/view/Code.re | 39 ++++++++++++++-------- src/haz3lweb/www/style.css | 11 ++++++ 7 files changed, 73 insertions(+), 43 deletions(-) diff --git a/src/haz3lcore/inference/EqClass.re b/src/haz3lcore/inference/EqClass.re index 378fea2f6f..8a1ab18409 100644 --- a/src/haz3lcore/inference/EqClass.re +++ b/src/haz3lcore/inference/EqClass.re @@ -36,6 +36,12 @@ let mk_as_binary_ctor = (ctor: binary_ctor, ty1: ITyp.t, ty2: ITyp.t): ITyp.t => }; }; +let mk_as_unary_ctor = (ctor: unary_ctor, ty: ITyp.t): ITyp.t => { + switch (ctor) { + | CList => List(ty) + }; +}; + let rec ityp_to_eq_typ: ITyp.t => eq_typ = fun | Unknown(prov) => Base(BUnknown(prov)) @@ -318,6 +324,10 @@ let rec filtered_eq_class_to_typ: t => option(ITyp.t) = let+ typ2 = filtered_eq_class_to_typ(eq_class_rt); mk_as_binary_ctor(ctor, typ1, typ2); } + | [Mapped(ctor, eq_class)] => { + let+ elt_typ = filtered_eq_class_to_typ(eq_class); + mk_as_unary_ctor(ctor, elt_typ); + } | _ => None; let comp_eq_typ = (eq_typ1: eq_typ, eq_typ2: eq_typ): int => { @@ -401,7 +411,7 @@ and string_of_eq_typ = (eq_typ: eq_typ) => ], ); | Mapped(ctor, eq_class) => - let (end_text, start_text) = + let (start_text, end_text) = switch (ctor) { | CList => ("[", "]") }; diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index cb61525ecc..bca39a8d34 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -18,10 +18,6 @@ type t = type equivalence = (t, t) and constraints = list(equivalence); -// HACK: -// In order to ensure difference hole provenenances with the same -// id chart to the same set of results, convert synswitch provs to internal -// Do not change TypeHole, as we will filter on that condition later. let rec prov_to_iprov: Typ.type_provenance => Typ.type_provenance = fun | SynSwitch(u) => Internal(u) @@ -71,6 +67,7 @@ let rec contains_hole = (ty: t): bool => | Arrow(ty1, ty2) | Sum(ty1, ty2) | Prod(ty1, ty2) => contains_hole(ty1) || contains_hole(ty2) + | List(l_ty) => contains_hole(l_ty) | _ => false }; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 949d4bf6d3..286592ee4d 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -6,7 +6,7 @@ type status = type t = (ITyp.t, status); -type annotation_map = Hashtbl.t(Id.t, string); +type annotation_map = Hashtbl.t(Id.t, (status, string)); let empty_annotations = (): annotation_map => Hashtbl.create(20); @@ -27,11 +27,12 @@ let get_annotations = (inference_results: list(t)): annotation_map => { }; }; - let id_and_annotation_if_type_hole = (result: t): option((Id.t, string)) => { + let id_and_annotation_if_type_hole = + (result: t): option((Id.t, (status, string))) => { switch (result) { | (Unknown(TypeHole(id)), status) => let* annotation = status_to_string(status); - Some((id, annotation)); + Some((id, (status, annotation))); | _ => None }; }; @@ -45,9 +46,24 @@ let get_annotations = (inference_results: list(t)): annotation_map => { new_map; }; -let get_annotation_of_id = (id: Id.t): option(string) => { - annotations_enabled^ ? Hashtbl.find_opt(accumulated_annotations, id) : None; -}; +let get_annotation_of_id = (id: Id.t): option(string) => + if (annotations_enabled^) { + let+ (_, annotation) = Hashtbl.find_opt(accumulated_annotations, id); + annotation; + } else { + None; + }; + +let get_style_of_id = (id: Id.t): option(string) => + if (annotations_enabled^) { + let+ (status, _) = Hashtbl.find_opt(accumulated_annotations, id); + switch (status) { + | Solved(_) => "solved-annotation" + | Unsolved(_) => "unsolved-annotation" + }; + } else { + None; + }; let add_on_new_annotations = (new_map): unit => { let add_new_elt = (new_k, new_v) => { @@ -56,19 +72,10 @@ let add_on_new_annotations = (new_map): unit => { Hashtbl.iter(add_new_elt, new_map); }; -let log_attempt_at_mk_map = (loc, result) => { - switch (result) { - | exception exc => - print_endline("From " ++ loc); - print_endline(Printexc.to_string(exc)); - raise(exc); - | _ => result - }; -}; - let condense = (eq_class: MutableEqClass.t): status => { let (eq_class, err) = MutableEqClass.snapshot_class(eq_class); let sorted_eq_class = EqClass.sort_eq_class(eq_class); + let filtered_eq_class = EqClass.filter_unneeded_holes(EqClass.is_known, sorted_eq_class); diff --git a/src/haz3lcore/inference/MutableEqClass.re b/src/haz3lcore/inference/MutableEqClass.re index fd6703d016..61c85c7b81 100644 --- a/src/haz3lcore/inference/MutableEqClass.re +++ b/src/haz3lcore/inference/MutableEqClass.re @@ -119,7 +119,7 @@ let rec preorder_key_traversal_typ = (ty: ITyp.t): list(ITyp.t) => { ...preorder_key_traversal_typ(ty_lhs) @ preorder_key_traversal_typ(ty_rhs), ] - | List(ty) => [ty, ...preorder_key_traversal_typ(ty)] + | List(list_ty) => [ty, ...preorder_key_traversal_typ(list_ty)] }; }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 332ced573c..d576d3a918 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -820,14 +820,6 @@ let mk_map = let inference_results = Inference.unify_and_report_status(constraints); let annotation_map = InferenceResult.get_annotations(inference_results); - print_endline("\nCONSTRAINTS\n--------"); - print_endline( - Typ.sexp_of_constraints(constraints) |> Sexplib.Sexp.to_string_hum, - ); - - print_endline("\nANNOTS\n-------"); - Hashtbl.iter((_, annot) => print_endline(annot), annotation_map); - InferenceResult.add_on_new_annotations(annotation_map); info_map; diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index b356f3e6f1..767dcff654 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -30,9 +30,19 @@ let of_delim = (sort: Sort.t, is_consistent, t: Piece.tile, i: int): list(Node.t) => of_delim'((sort, is_consistent, Tile.is_complete(t), t.label, i)); -let of_grout = (annotation: option(string)) => [ - annotation |> OptUtil.get(() => Unicode.nbsp) |> Node.text, -]; +let of_grout = (id: Id.t) => { + let annot_style = InferenceResult.get_style_of_id(id); + let nodes = [ + id + |> InferenceResult.get_annotation_of_id + |> OptUtil.get(() => Unicode.nbsp) + |> Node.text, + ]; + switch (annot_style) { + | Some(cname) => [span_c(cname, nodes)] + | None => nodes + }; +}; let of_whitespace = Core.Memo.general( @@ -76,7 +86,7 @@ module Text = (M: { and of_piece = (expected_sort: Sort.t, p: Piece.t): list(Node.t) => { switch (p) { | Tile(t) => of_tile(expected_sort, t) - | Grout(g) => g.id |> InferenceResult.get_annotation_of_id |> of_grout + | Grout(g) => of_grout(g.id) | Whitespace({content, _}) => of_whitespace((M.settings.whitespace_icons, m(p).last.col, content)) }; @@ -105,15 +115,18 @@ let rec holes = fun | Piece.Whitespace(_) => [] | Tile(t) => List.concat_map(holes(~map, ~font_metrics), t.children) - | Grout(g) => [ - EmptyHoleDec.view( - ~font_metrics, // TODO(d) fix sort - { - measurement: Measured.find_g(g, map), - mold: Mold.of_grout(g, Any), - }, - ), - ], + | Grout(g) => + InferenceResult.get_annotation_of_id(g.id) == None + ? [ + EmptyHoleDec.view( + ~font_metrics, // TODO(d) fix sort + { + measurement: Measured.find_g(g, map), + mold: Mold.of_grout(g, Any), + }, + ), + ] + : [], ); let simple_view = (~unselected, ~map, ~settings: Model.settings): Node.t => { diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index b5ff208191..135f55f9d7 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -693,6 +693,17 @@ body { font-weight: bold; } +/* INFERENCE ANNOTATIONS */ + +.solved-annotation { + color: grey; +} + +.unsolved-annotation { + color: grey; + background-color:rgb(233, 172, 164); +} + /* TOKEN COLORS */ .code .token.mono {} From d75fb756cec82e587e0fd13ada1c93263c3f8817 Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 19 Jan 2023 12:25:16 -0500 Subject: [PATCH 013/129] fix bug with things solved as unknown retaining their annotations from previous edits --- src/haz3lcore/inference/InferenceResult.re | 30 ++++++++++++---------- src/haz3lweb/view/Code.re | 3 ++- 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 286592ee4d..7d39ffaf9c 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -1,12 +1,10 @@ -open Util.OptUtil.Syntax; - type status = | Solved(ITyp.t) | Unsolved(EqClass.t); type t = (ITyp.t, status); -type annotation_map = Hashtbl.t(Id.t, (status, string)); +type annotation_map = Hashtbl.t(Id.t, (status, option(string))); let empty_annotations = (): annotation_map => Hashtbl.create(20); @@ -21,18 +19,17 @@ let update_annoation_mode = annot_mode => { let get_annotations = (inference_results: list(t)): annotation_map => { let status_to_string = (status: status): option(string) => { switch (status) { - | Solved(Unknown(_)) => None // it isn't useful to say something is unknown + | Solved(Unknown(_)) => None | Solved(ityp) => Some(ITyp.string_of_ityp(ityp)) | Unsolved(eq_class) => Some(EqClass.string_of_eq_class(eq_class)) }; }; let id_and_annotation_if_type_hole = - (result: t): option((Id.t, (status, string))) => { + (result: t): option((Id.t, (status, option(string)))) => { switch (result) { | (Unknown(TypeHole(id)), status) => - let* annotation = status_to_string(status); - Some((id, (status, annotation))); + Some((id, (status, status_to_string(status)))) | _ => None }; }; @@ -48,18 +45,25 @@ let get_annotations = (inference_results: list(t)): annotation_map => { let get_annotation_of_id = (id: Id.t): option(string) => if (annotations_enabled^) { - let+ (_, annotation) = Hashtbl.find_opt(accumulated_annotations, id); - annotation; + switch (Hashtbl.find_opt(accumulated_annotations, id)) { + | Some((_status, annot_opt)) => annot_opt + | None => None + }; } else { None; }; let get_style_of_id = (id: Id.t): option(string) => if (annotations_enabled^) { - let+ (status, _) = Hashtbl.find_opt(accumulated_annotations, id); - switch (status) { - | Solved(_) => "solved-annotation" - | Unsolved(_) => "unsolved-annotation" + let status_opt = Hashtbl.find_opt(accumulated_annotations, id); + switch (status_opt) { + | Some((status, _annotation)) => + switch (status) { + | Solved(Unknown(_)) => None + | Solved(_) => Some("solved-annotation") + | Unsolved(_) => Some("unsolved-annotation") + } + | None => None }; } else { None; diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 767dcff654..7ba976ba41 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -116,7 +116,8 @@ let rec holes = | Piece.Whitespace(_) => [] | Tile(t) => List.concat_map(holes(~map, ~font_metrics), t.children) | Grout(g) => - InferenceResult.get_annotation_of_id(g.id) == None + ! InferenceResult.annotations_enabled^ + || InferenceResult.get_annotation_of_id(g.id) == None ? [ EmptyHoleDec.view( ~font_metrics, // TODO(d) fix sort From fece0e9cef496f7023438a09997da160935e0ec1 Mon Sep 17 00:00:00 2001 From: RaefM Date: Wed, 25 Jan 2023 00:10:14 -0500 Subject: [PATCH 014/129] fix occurs stack overflowing. clear annotations on slide clear --- src/haz3lcore/inference/EqGraph.re | 4 +-- src/haz3lcore/inference/Inference.re | 2 +- src/haz3lcore/inference/InferenceResult.re | 8 +++-- src/haz3lcore/inference/MutableEqClass.re | 42 +++++++++++++++------- src/haz3lcore/inference/MutableEqClass.rei | 4 +-- src/haz3lweb/Update.re | 1 + 6 files changed, 40 insertions(+), 21 deletions(-) diff --git a/src/haz3lcore/inference/EqGraph.re b/src/haz3lcore/inference/EqGraph.re index ac25eb42fa..12dea05b58 100644 --- a/src/haz3lcore/inference/EqGraph.re +++ b/src/haz3lcore/inference/EqGraph.re @@ -52,8 +52,8 @@ let fail_occurs_check = (eq_graph: t, t1: ITyp.t, t2: ITyp.t): bool => { let c1 = Hashtbl.find(eq_graph, t1); let c2 = Hashtbl.find(eq_graph, t2); - let (snapshot1, err1) = MutableEqClass.snapshot_class(c1); - let (snapshot2, err2) = MutableEqClass.snapshot_class(c2); + let (snapshot1, err1) = MutableEqClass.snapshot_class(c1, t1); + let (snapshot2, err2) = MutableEqClass.snapshot_class(c2, t2); switch (err1, err2) { | (Some(MutableEqClass.Occurs), _) diff --git a/src/haz3lcore/inference/Inference.re b/src/haz3lcore/inference/Inference.re index 083ae8381d..dfeef56a91 100644 --- a/src/haz3lcore/inference/Inference.re +++ b/src/haz3lcore/inference/Inference.re @@ -51,7 +51,7 @@ let unify_and_report_status = acc: list(InferenceResult.t), ) : list(InferenceResult.t) => { - [(key, InferenceResult.condense(mut_eq_class)), ...acc]; + [(key, InferenceResult.condense(mut_eq_class, key)), ...acc]; }; let unsorted_results = Hashtbl.fold(acc_results, inference_eq_graph, []); diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 7d39ffaf9c..5709a0832d 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -76,8 +76,12 @@ let add_on_new_annotations = (new_map): unit => { Hashtbl.iter(add_new_elt, new_map); }; -let condense = (eq_class: MutableEqClass.t): status => { - let (eq_class, err) = MutableEqClass.snapshot_class(eq_class); +let clear_annotations = () => { + Hashtbl.reset(accumulated_annotations); +}; + +let condense = (eq_class: MutableEqClass.t, key: ITyp.t): status => { + let (eq_class, err) = MutableEqClass.snapshot_class(eq_class, key); let sorted_eq_class = EqClass.sort_eq_class(eq_class); let filtered_eq_class = diff --git a/src/haz3lcore/inference/MutableEqClass.re b/src/haz3lcore/inference/MutableEqClass.re index 61c85c7b81..1d799a1f29 100644 --- a/src/haz3lcore/inference/MutableEqClass.re +++ b/src/haz3lcore/inference/MutableEqClass.re @@ -36,34 +36,47 @@ let get_combined_error_status_of_classes = }; let rec snapshot_class = - (mut_eq_class: t): (EqClass.t, option(error_status)) => { + (mut_eq_class: t, occurs_rep: ITyp.t) + : (EqClass.t, option(error_status)) => { let (typs, err1) = UnionFind.get(mut_eq_class); - let (eq_class, err2) = snapshot_typs(typs); + let (eq_class, err2) = snapshot_typs(typs, mut_eq_class, occurs_rep); (eq_class, combine_error_status(err1, err2)); } +and snapshot_class_from_child = + (mut_eq_class: t, parent: t, occurs_rep: ITyp.t) + : (EqClass.t, option(error_status)) => { + UnionFind.eq(mut_eq_class, parent) + ? ([occurs_rep |> EqClass.ityp_to_eq_typ], Some(Occurs)) + : snapshot_class(mut_eq_class, occurs_rep); +} and snapshot_typs = - (mut_eq_typs: mut_eq_typs): (EqClass.t, option(error_status)) => { + (mut_eq_typs: mut_eq_typs, parent: t, occurs_rep: ITyp.t) + : (EqClass.t, option(error_status)) => { switch (mut_eq_typs) { | [] => ([], None) | [hd, ...tl] => - let (eq_typ_hd, err_hd) = snapshot_typ(hd); - let (eq_class_tl, err_tl) = snapshot_typs(tl); + let (eq_typ_hd, err_hd) = snapshot_typ(hd, parent, occurs_rep); + let (eq_class_tl, err_tl) = snapshot_typs(tl, parent, occurs_rep); ([eq_typ_hd, ...eq_class_tl], combine_error_status(err_hd, err_tl)); }; } and snapshot_typ = - (mut_eq_typ: mut_eq_typ): (EqClass.eq_typ, option(error_status)) => { + (mut_eq_typ: mut_eq_typ, parent: t, occurs_rep: ITyp.t) + : (EqClass.eq_typ, option(error_status)) => { switch (mut_eq_typ) { | Base(b) => (EqClass.Base(b), None) | Compound(ctor, mut_eq_class_lhs, mut_eq_class_rhs) => - let (eq_class_lhs, err_lhs) = snapshot_class(mut_eq_class_lhs); - let (eq_class_rhs, err_rhs) = snapshot_class(mut_eq_class_rhs); + let (eq_class_lhs, err_lhs) = + snapshot_class_from_child(mut_eq_class_lhs, parent, occurs_rep); + let (eq_class_rhs, err_rhs) = + snapshot_class_from_child(mut_eq_class_rhs, parent, occurs_rep); ( EqClass.Compound(ctor, eq_class_lhs, eq_class_rhs), combine_error_status(err_lhs, err_rhs), ); | Mapped(ctor, mut_eq_class) => - let (eq_class, err) = snapshot_class(mut_eq_class); + let (eq_class, err) = + snapshot_class_from_child(mut_eq_class, parent, occurs_rep); (EqClass.Mapped(ctor, eq_class), err); }; }; @@ -197,10 +210,13 @@ and extend_typs_with_typ = }; }; -let union = (t1: t, t2: t): unit => { - let _ = extend_class_with_class(t1, t2); - (); -}; +let union = (t1: t, t2: t): unit => + if (UnionFind.eq(t1, t2)) { + (); + } else { + let _ = extend_class_with_class(t1, t2); + (); + }; let mark_failed_occurs = (mut_eq_class: t): unit => { let (curr_typs, _) = UnionFind.get(mut_eq_class); diff --git a/src/haz3lcore/inference/MutableEqClass.rei b/src/haz3lcore/inference/MutableEqClass.rei index b9e83363d9..85e1da7ea3 100644 --- a/src/haz3lcore/inference/MutableEqClass.rei +++ b/src/haz3lcore/inference/MutableEqClass.rei @@ -8,9 +8,7 @@ and mut_eq_typ = | Mapped(EqClass.unary_ctor, t) | Compound(EqClass.binary_ctor, t, t); -let snapshot_class: t => (EqClass.t, option(error_status)); -let snapshot_typs: mut_eq_typs => (EqClass.t, option(error_status)); -let snapshot_typ: mut_eq_typ => (EqClass.eq_typ, option(error_status)); +let snapshot_class: (t, ITyp.t) => (EqClass.t, option(error_status)); let eq_class_to_mut_eq_class: EqClass.t => t; let eq_typ_to_mut_eq_typ: EqClass.eq_typ => mut_eq_typ; diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index ddeaee9c4f..554fc2ea1b 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -274,6 +274,7 @@ let apply = }; }; save_editors(model); + InferenceResult.clear_annotations(); Ok(model); | SwitchSlide(n) => switch (model.editors) { From e298ce159eae9f6a0d559da54922556dfe8c34f2 Mon Sep 17 00:00:00 2001 From: RaefM Date: Wed, 25 Jan 2023 02:28:51 -0500 Subject: [PATCH 015/129] moves unsolved annotations to the cursorinspector; replaces code annotation with red emptyholedec svg --- src/haz3lcore/inference/InferenceResult.re | 41 +++++++++++++-------- src/haz3lweb/view/Code.re | 42 +++++++++------------- src/haz3lweb/view/CursorInspector.re | 20 +++++++++++ src/haz3lweb/view/dec/EmptyHoleDec.re | 22 +++++++----- src/haz3lweb/www/style.css | 12 +++++-- 5 files changed, 85 insertions(+), 52 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 5709a0832d..e394db3bc9 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -1,3 +1,5 @@ +open Util.OptUtil.Syntax; + type status = | Solved(ITyp.t) | Unsolved(EqClass.t); @@ -21,7 +23,7 @@ let get_annotations = (inference_results: list(t)): annotation_map => { switch (status) { | Solved(Unknown(_)) => None | Solved(ityp) => Some(ITyp.string_of_ityp(ityp)) - | Unsolved(eq_class) => Some(EqClass.string_of_eq_class(eq_class)) + | Unsolved(_eq_class) => None }; }; @@ -45,25 +47,34 @@ let get_annotations = (inference_results: list(t)): annotation_map => { let get_annotation_of_id = (id: Id.t): option(string) => if (annotations_enabled^) { - switch (Hashtbl.find_opt(accumulated_annotations, id)) { - | Some((_status, annot_opt)) => annot_opt - | None => None - }; + let* (_status, annot_opt) = + Hashtbl.find_opt(accumulated_annotations, id); + annot_opt; } else { None; }; -let get_style_of_id = (id: Id.t): option(string) => +let svg_display_settings = (id: Id.t): (bool, bool) => { + switch (Hashtbl.find_opt(accumulated_annotations, id)) { + | Some((status, _)) => + switch (status) { + | Solved(Unknown(_)) => (true, false) + | Solved(_) => (false, false) + | Unsolved(_) => (true, true) + } + | None => (true, false) + }; +}; + +let get_cursor_inspect_result = (id: Id.t): option((bool, string)) => if (annotations_enabled^) { - let status_opt = Hashtbl.find_opt(accumulated_annotations, id); - switch (status_opt) { - | Some((status, _annotation)) => - switch (status) { - | Solved(Unknown(_)) => None - | Solved(_) => Some("solved-annotation") - | Unsolved(_) => Some("unsolved-annotation") - } - | None => None + let* (status, annot_opt) = Hashtbl.find_opt(accumulated_annotations, id); + switch (status) { + | Unsolved(eq_class) => + Some((false, EqClass.string_of_eq_class(eq_class))) + | Solved(_) => + let* annot = annot_opt; + Some((true, annot)); }; } else { None; diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 7ba976ba41..f81957a9f5 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -30,19 +30,12 @@ let of_delim = (sort: Sort.t, is_consistent, t: Piece.tile, i: int): list(Node.t) => of_delim'((sort, is_consistent, Tile.is_complete(t), t.label, i)); -let of_grout = (id: Id.t) => { - let annot_style = InferenceResult.get_style_of_id(id); - let nodes = [ - id - |> InferenceResult.get_annotation_of_id - |> OptUtil.get(() => Unicode.nbsp) - |> Node.text, - ]; - switch (annot_style) { - | Some(cname) => [span_c(cname, nodes)] - | None => nodes - }; -}; +let of_grout = (id: Id.t) => [ + id + |> InferenceResult.get_annotation_of_id + |> OptUtil.get(() => Unicode.nbsp) + |> Node.text, +]; let of_whitespace = Core.Memo.general( @@ -115,19 +108,16 @@ let rec holes = fun | Piece.Whitespace(_) => [] | Tile(t) => List.concat_map(holes(~map, ~font_metrics), t.children) - | Grout(g) => - ! InferenceResult.annotations_enabled^ - || InferenceResult.get_annotation_of_id(g.id) == None - ? [ - EmptyHoleDec.view( - ~font_metrics, // TODO(d) fix sort - { - measurement: Measured.find_g(g, map), - mold: Mold.of_grout(g, Any), - }, - ), - ] - : [], + | Grout(g) => [ + EmptyHoleDec.view( + ~font_metrics, // TODO(d) fix sort + g.id, + { + measurement: Measured.find_g(g, map), + mold: Mold.of_grout(g, Any), + }, + ), + ], ); let simple_view = (~unselected, ~map, ~settings: Model.settings): Node.t => { diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 8901671f02..8ea228e67a 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -199,6 +199,25 @@ let extra_view = (visible: bool, id: int, ci: Haz3lcore.Statics.t): Node.t => [id_view(id), cls_view(ci)], ); +let view_of_global_inference_info = (id: int) => { + switch (Haz3lcore.InferenceResult.get_cursor_inspect_result(id)) { + | Some((true, solution)) => + div( + ~attr=clss([infoc, "typ"]), + [text("and has inferred type "), text(solution)], + ) + | Some((false, error_message)) => + div( + ~attr=clss(["infoc", "typ"]), + [ + text("and has inferred type "), + span_c("unsolved-cursor-inspect", [text(error_message)]), + ], + ) + | None => div([]) + }; +}; + let toggle_context_and_print_ci = (~inject: Update.t => 'a, ci, _) => { print_endline(Haz3lcore.Statics.show(ci)); switch (ci) { @@ -233,6 +252,7 @@ let inspector_view = [ extra_view(settings.context_inspector, id, ci), view_of_info(~inject, ~show_lang_doc, ci), + view_of_global_inference_info(id), CtxInspector.inspector_view(~inject, ~settings, id, ci), ], ); diff --git a/src/haz3lweb/view/dec/EmptyHoleDec.re b/src/haz3lweb/view/dec/EmptyHoleDec.re index 5de62c902e..39a6e25e8a 100644 --- a/src/haz3lweb/view/dec/EmptyHoleDec.re +++ b/src/haz3lweb/view/dec/EmptyHoleDec.re @@ -25,7 +25,7 @@ let path = (tip_l, tip_r, offset, s: float) => { }; let view = - (~font_metrics, {measurement: {origin, _}, mold}: Profile.t): Node.t => { + (~font_metrics, id, {measurement: {origin, _}, mold}: Profile.t): Node.t => { let sort = mold.out; let c_cls = Sort.to_string(sort); let (tip_l, tip_r): (Haz3lcore.Nib.Shape.t, Haz3lcore.Nib.Shape.t) = @@ -34,11 +34,17 @@ let view = {sort, shape: tip_l}, {sort, shape: tip_r}, ); - DecUtil.code_svg( - ~font_metrics, - ~origin, - ~base_cls=["empty-hole"], - ~path_cls=["empty-hole-path", c_cls], - path(tip_l, tip_r, 0., 0.28), - ); + let (svg_enabled, unsolved_path_class) = + InferenceResult.annotations_enabled^ + ? InferenceResult.svg_display_settings(id) : (true, None); + let svg_path_class = unsolved_path_class ? "unsolved-empty-hole-path" : "empty-hole-path"; + svg_enabled + ? DecUtil.code_svg( + ~font_metrics, + ~origin, + ~base_cls=["empty-hole"], + ~path_cls=[svg_path_class, c_cls], + path(tip_l, tip_r, 0., 0.28), + ) + : Node.none; }; diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index 135f55f9d7..639df1aa2f 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -573,6 +573,13 @@ body { vector-effect: non-scaling-stroke; } +.unsolved-empty-hole-path { + fill: #f0d1d1; + stroke: #dba7a7; + stroke-width: 0.75px; + vector-effect: non-scaling-stroke; +} + .selection { position: relative; } @@ -699,9 +706,8 @@ body { color: grey; } -.unsolved-annotation { - color: grey; - background-color:rgb(233, 172, 164); +.unsolved-cursor-inspect { + color: red; } /* TOKEN COLORS */ From 2927ce551b12d2062a4ed0c993057ed918cb4d81 Mon Sep 17 00:00:00 2001 From: RaefM Date: Wed, 25 Jan 2023 02:31:59 -0500 Subject: [PATCH 016/129] quick fix to compiler error --- src/haz3lweb/view/dec/EmptyHoleDec.re | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/haz3lweb/view/dec/EmptyHoleDec.re b/src/haz3lweb/view/dec/EmptyHoleDec.re index 39a6e25e8a..d2351d4545 100644 --- a/src/haz3lweb/view/dec/EmptyHoleDec.re +++ b/src/haz3lweb/view/dec/EmptyHoleDec.re @@ -36,8 +36,9 @@ let view = ); let (svg_enabled, unsolved_path_class) = InferenceResult.annotations_enabled^ - ? InferenceResult.svg_display_settings(id) : (true, None); - let svg_path_class = unsolved_path_class ? "unsolved-empty-hole-path" : "empty-hole-path"; + ? InferenceResult.svg_display_settings(id) : (true, false); + let svg_path_class = + unsolved_path_class ? "unsolved-empty-hole-path" : "empty-hole-path"; svg_enabled ? DecUtil.code_svg( ~font_metrics, From b03f2c889a7e7be4b5a8e4c530d1be2025a2a74e Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Thu, 26 Jan 2023 00:31:27 -0600 Subject: [PATCH 017/129] fixed issue where cursor is misdrawn after hole suggestions change --- src/haz3lweb/view/Cell.re | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index 4dd25aa037..3858bf6b96 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -272,7 +272,9 @@ let editor_view = let zipper = editor.state.zipper; let segment = Zipper.zip(zipper); let unselected = Zipper.unselect_and_zip(zipper); - let measured = editor.state.meta.measured; + // Recalculate measured after inference is run, since type hole suggestions shift cursor. + // let measured = editor.state.meta.measured; + let measured = Editor.Meta.init(zipper).measured; let code_base_view = Code.view(~font_metrics, ~segment, ~unselected, ~measured, ~settings); let deco_view = From ead7b45156904eb451ad59eb0907d29504b86c23 Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 26 Jan 2023 00:51:37 -0500 Subject: [PATCH 018/129] fix printing of annotations types to be consistent; fix annotation colors --- src/haz3lcore/Measured.re | 9 ++--- src/haz3lcore/inference/EqClass.re | 12 ++++--- src/haz3lcore/inference/ITyp.re | 15 --------- src/haz3lcore/inference/InferenceResult.re | 39 +++++++++------------- src/haz3lcore/statics/Typ.re | 32 ++++++++++++++++++ src/haz3lweb/view/Cell.re | 3 +- src/haz3lweb/view/Code.re | 23 +++++++++---- src/haz3lweb/www/style.css | 2 +- 8 files changed, 78 insertions(+), 57 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index 4c9bd683b7..e3cea1bd5d 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -370,10 +370,11 @@ let of_segment = (~old: t=empty, ~touched=Touched.empty, seg: Segment.t): t => { (contained_indent, last, map); | Grout(g) => let annotation_offset = - g.id - |> InferenceResult.get_annotation_of_id - |> OptUtil.get(() => " ") - |> String.length; + switch (InferenceResult.get_solution_of_id(g.id)) { + | Some(ityp) => + ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> String.length + | None => 1 + }; let last = {...origin, col: origin.col + annotation_offset}; let map = map |> add_g(g, {origin, last}); diff --git a/src/haz3lcore/inference/EqClass.re b/src/haz3lcore/inference/EqClass.re index 8a1ab18409..32bcdcd1c8 100644 --- a/src/haz3lcore/inference/EqClass.re +++ b/src/haz3lcore/inference/EqClass.re @@ -378,7 +378,7 @@ and sort_eq_class_explore = (eq_class: t): t => { }; let string_of_btyp = (btyp: base_typ): string => { - btyp |> base_typ_to_ityp |> ITyp.string_of_ityp; + btyp |> base_typ_to_ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string; }; let rec string_of_eq_class = (eq_class: t): string => @@ -393,21 +393,23 @@ and string_of_eq_typ = (eq_typ: eq_typ) => switch (eq_typ) { | Base(btyp) => string_of_btyp(btyp) | Compound(ctor, eq_class_lt, eq_class_rt) => - let ctor_string = + let (ctor_start, ctor_string, ctor_end) = switch (ctor) { - | CArrow => " -> " - | CProd => " * " - | CSum => " + " + | CArrow => ("", " -> ", "") + | CProd => ("(", ", ", ")") + | CSum => ("", " + ", "") }; String.concat( "", [ + ctor_start, string_of_eq_class(eq_class_lt), ctor_string, "(", string_of_eq_class(eq_class_rt), ")", + ctor_end, ], ); | Mapped(ctor, eq_class) => diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index bca39a8d34..29466d066e 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -70,18 +70,3 @@ let rec contains_hole = (ty: t): bool => | List(l_ty) => contains_hole(l_ty) | _ => false }; - -let rec string_of_ityp = (ityp: t): string => { - switch (ityp) { - | Unknown(_) => "?" - | Unit => "Unit" - | Int => "Int" - | Float => "Float" - | Bool => "Bool" - | String => "String" - | List(t) => "[" ++ string_of_ityp(t) ++ "]" - | Arrow(t1, t2) => string_of_ityp(t1) ++ " -> " ++ string_of_ityp(t2) - | Sum(t1, t2) => string_of_ityp(t1) ++ " + " ++ string_of_ityp(t2) - | Prod(t1, t2) => string_of_ityp(t1) ++ " x " ++ string_of_ityp(t2) - }; -}; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index e394db3bc9..2848e912b6 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -6,7 +6,7 @@ type status = type t = (ITyp.t, status); -type annotation_map = Hashtbl.t(Id.t, (status, option(string))); +type annotation_map = Hashtbl.t(Id.t, status); let empty_annotations = (): annotation_map => Hashtbl.create(20); @@ -19,25 +19,14 @@ let update_annoation_mode = annot_mode => { }; let get_annotations = (inference_results: list(t)): annotation_map => { - let status_to_string = (status: status): option(string) => { - switch (status) { - | Solved(Unknown(_)) => None - | Solved(ityp) => Some(ITyp.string_of_ityp(ityp)) - | Unsolved(_eq_class) => None - }; - }; - - let id_and_annotation_if_type_hole = - (result: t): option((Id.t, (status, option(string)))) => { + let id_and_status_if_type_hole = (result: t): option((Id.t, status)) => { switch (result) { - | (Unknown(TypeHole(id)), status) => - Some((id, (status, status_to_string(status)))) + | (Unknown(TypeHole(id)), status) => Some((id, status)) | _ => None }; }; - let elts = - List.filter_map(id_and_annotation_if_type_hole, inference_results); + let elts = List.filter_map(id_and_status_if_type_hole, inference_results); let new_map = Hashtbl.create(List.length(elts)); List.iter(((id, annot)) => Hashtbl.add(new_map, id, annot), elts); @@ -45,18 +34,21 @@ let get_annotations = (inference_results: list(t)): annotation_map => { new_map; }; -let get_annotation_of_id = (id: Id.t): option(string) => +let get_solution_of_id = (id: Id.t): option(ITyp.t) => if (annotations_enabled^) { - let* (_status, annot_opt) = - Hashtbl.find_opt(accumulated_annotations, id); - annot_opt; + let* status = Hashtbl.find_opt(accumulated_annotations, id); + switch (status) { + | Solved(Unknown(_)) => None + | Solved(ityp) => Some(ityp) + | Unsolved(_) => None + }; } else { None; }; let svg_display_settings = (id: Id.t): (bool, bool) => { switch (Hashtbl.find_opt(accumulated_annotations, id)) { - | Some((status, _)) => + | Some(status) => switch (status) { | Solved(Unknown(_)) => (true, false) | Solved(_) => (false, false) @@ -68,13 +60,12 @@ let svg_display_settings = (id: Id.t): (bool, bool) => { let get_cursor_inspect_result = (id: Id.t): option((bool, string)) => if (annotations_enabled^) { - let* (status, annot_opt) = Hashtbl.find_opt(accumulated_annotations, id); + let* status = Hashtbl.find_opt(accumulated_annotations, id); switch (status) { | Unsolved(eq_class) => Some((false, EqClass.string_of_eq_class(eq_class))) - | Solved(_) => - let* annot = annot_opt; - Some((true, annot)); + | Solved(ityp) => + Some((true, ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string)) }; } else { None; diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index 0cd5b6d1f4..c58196df23 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -348,3 +348,35 @@ let rec eq = (t1, t2) => | (Var(n1), Var(n2)) => n1 == n2 | (Var(_), _) => false }; + +let prov_to_string: type_provenance => string = + fun + | Inference(_) + | Internal(_) + | Anonymous => "" + | TypeHole(_) => "𝜏" + | SynSwitch(_) => "⇒"; + +let rec typ_to_string = (ty: t): string => + //TODO: parens on ops when ambiguous + switch (ty) { + | Unknown(prov) => "?" ++ prov_to_string(prov) + | Int => "Int" + | Float => "Float" + | String => "String" + | Bool => "Bool" + | Var(name) => name + | List(t) => "[" ++ typ_to_string(t) ++ "]" + | Arrow(t1, t2) => typ_to_string(t1) ++ " -> " ++ typ_to_string(t2) + | Prod([]) => "Unit" + | Prod([_]) => "BadProduct" + | Prod([t0, ...ts]) => + "(" + ++ List.fold_left( + (acc, t) => acc ++ ", " ++ typ_to_string(t), + typ_to_string(t0), + ts, + ) + ++ ")" + | Sum(t1, t2) => typ_to_string(t1) ++ " + " ++ typ_to_string(t2) + }; diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index 3858bf6b96..38f7a3932a 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -272,8 +272,7 @@ let editor_view = let zipper = editor.state.zipper; let segment = Zipper.zip(zipper); let unselected = Zipper.unselect_and_zip(zipper); - // Recalculate measured after inference is run, since type hole suggestions shift cursor. - // let measured = editor.state.meta.measured; + // Recalculate measured after inference is run, since type hole suggestions shift cursor. ALT: editor.state.meta.measured; let measured = Editor.Meta.init(zipper).measured; let code_base_view = Code.view(~font_metrics, ~segment, ~unselected, ~measured, ~settings); diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index f81957a9f5..eea6ddbdff 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -30,12 +30,23 @@ let of_delim = (sort: Sort.t, is_consistent, t: Piece.tile, i: int): list(Node.t) => of_delim'((sort, is_consistent, Tile.is_complete(t), t.label, i)); -let of_grout = (id: Id.t) => [ - id - |> InferenceResult.get_annotation_of_id - |> OptUtil.get(() => Unicode.nbsp) - |> Node.text, -]; +// let of_grout = (id: Id.t) => [ +// id +// |> InferenceResult.get_annotation_of_id +// |> OptUtil.get(() => Unicode.nbsp) +// |> Node.text, +// ]; + +let of_grout = (id: Id.t) => { + let solution_opt = InferenceResult.get_solution_of_id(id); + switch (solution_opt) { + | Some(ityp) => [ + [ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> Node.text] + |> span_c("solved-annotation"), + ] + | None => [Node.text(Unicode.nbsp)] + }; +}; let of_whitespace = Core.Memo.general( diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index 639df1aa2f..8bfdce7214 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -703,7 +703,7 @@ body { /* INFERENCE ANNOTATIONS */ .solved-annotation { - color: grey; + color:rgb(178, 178, 178); } .unsolved-cursor-inspect { From 55f363156a33334235c518d325940f760c24f87e Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 26 Jan 2023 00:57:50 -0500 Subject: [PATCH 019/129] quick change to unsolved printing to make it neater --- src/haz3lcore/inference/EqClass.re | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/haz3lcore/inference/EqClass.re b/src/haz3lcore/inference/EqClass.re index 32bcdcd1c8..ec31d71d22 100644 --- a/src/haz3lcore/inference/EqClass.re +++ b/src/haz3lcore/inference/EqClass.re @@ -395,9 +395,9 @@ and string_of_eq_typ = (eq_typ: eq_typ) => | Compound(ctor, eq_class_lt, eq_class_rt) => let (ctor_start, ctor_string, ctor_end) = switch (ctor) { - | CArrow => ("", " -> ", "") + | CArrow => ("", " -> (", ")") | CProd => ("(", ", ", ")") - | CSum => ("", " + ", "") + | CSum => ("", " + (", ")") }; String.concat( @@ -406,9 +406,7 @@ and string_of_eq_typ = (eq_typ: eq_typ) => ctor_start, string_of_eq_class(eq_class_lt), ctor_string, - "(", string_of_eq_class(eq_class_rt), - ")", ctor_end, ], ); From bdb43df3275658efe098aabd6bbc0c8bb18ceb26 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 29 Jan 2023 07:48:14 -0500 Subject: [PATCH 020/129] comments for our roadmap for non global inf maps --- src/haz3lcore/inference/InferenceResult.re | 43 ++++++++++++++++++++++ src/haz3lcore/statics/Statics.re | 10 +++++ 2 files changed, 53 insertions(+) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 2848e912b6..2debe4c5ac 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -14,6 +14,7 @@ let accumulated_annotations = empty_annotations(); let annotations_enabled = ref(true); +// remove and put in editor too at some point... not needed then let update_annoation_mode = annot_mode => { annotations_enabled := annot_mode; }; @@ -34,6 +35,37 @@ let get_annotations = (inference_results: list(t)): annotation_map => { new_map; }; +// Used in Code.re +// Used in Measured.re +/** + * Major Dest 1: Measured.of_segment + * + * Dest 1.1: BackpackView + * Solution: Pass down + * Source: Cell.editor_view editor + * Invocations in bt to source: + * - BackpackView.backpack_sel_view + * - BackpackView.view + * - Deco.backpack + * - Deco.all + * - Cell.deco + * - Cell.editor_view + * + * Dest 1.2: LangDoc Module + * Solution: ignore via opargs + * + * Dest 1.3: Editor Modules + * Solution: Make Meta.init take oparg; pass dummy for all init + * May want to pass into Meta.init in cell; to do so, use results of 1.1\ + */ +/** + * Major Dest 1: Code.of_grout + * + * Only subdest: Text.of_segment + * This module is only ever invoked from places that have called + * Measured.of_segment (it literally takes its results as a map) + * If it had those results, pass those in! if from langdoc, use dummy + */ let get_solution_of_id = (id: Id.t): option(ITyp.t) => if (annotations_enabled^) { let* status = Hashtbl.find_opt(accumulated_annotations, id); @@ -46,6 +78,11 @@ let get_solution_of_id = (id: Id.t): option(ITyp.t) => None; }; +// Used in EmptyHoleDec.view +/** + * If above already solved: Code.view invoked by Cell.editor_view + * who should already have access to all of the above + */ let svg_display_settings = (id: Id.t): (bool, bool) => { switch (Hashtbl.find_opt(accumulated_annotations, id)) { | Some(status) => @@ -58,6 +95,8 @@ let svg_display_settings = (id: Id.t): (bool, bool) => { }; }; +/*Only called from uppermost levels where editors live anyway +*/ let get_cursor_inspect_result = (id: Id.t): option((bool, string)) => if (annotations_enabled^) { let* status = Hashtbl.find_opt(accumulated_annotations, id); @@ -78,6 +117,10 @@ let add_on_new_annotations = (new_map): unit => { Hashtbl.iter(add_new_elt, new_map); }; +// called from Update.apply, which has access to the entire Model.t +// to update the model state +// update the model.editors which containts Scratch or School states +// which in turn contain discrete editor.t obj let clear_annotations = () => { Hashtbl.reset(accumulated_annotations); }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index d576d3a918..1ab073a5f9 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -810,6 +810,16 @@ and utyp_to_info_map = ({ids, term} as utyp: Term.UTyp.t): (Typ.t, map) => { }; }; +// Needs to populate editor.state sometimes... +// Specifically, if we care about annotations +// I think its only necessary from: +// Perform.go_z (called by someone (Perform.go) with an editor) +// ScratchMode.view (has editor) +// Cell.get_elab (has editor) +// ScratchSlide.spliced_elabs (has editor) +// +// Others from LangDoc, EditorUtil, SchoolMode, SchoolExercises +// omitted due to lack of necessity (want only info_map, or color_map, only for validation, etc) let mk_map = Core.Memo.general( ~cache_size_bound=1000, From 0f9aa93ebd1e42d38ed8fa03f31720c2996c0f86 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Sun, 29 Jan 2023 15:18:59 -0600 Subject: [PATCH 021/129] create annotations in Editor.new_state Editor.new_state calls State.next which calculates measurements. Before calculating measurements, update the annotations with a call to mk_map(). Store annotations in Editor state to avoid using globals. Measurements still work after removing previous change to Cell.re --- src/haz3lcore/inference/InferenceResult.re | 15 +++++++-------- src/haz3lcore/statics/Statics.re | 10 +++++++--- src/haz3lcore/zipper/Editor.re | 6 +++++- src/haz3lweb/view/Cell.re | 3 +-- 4 files changed, 20 insertions(+), 14 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 2debe4c5ac..e58809be20 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -38,8 +38,8 @@ let get_annotations = (inference_results: list(t)): annotation_map => { // Used in Code.re // Used in Measured.re /** - * Major Dest 1: Measured.of_segment - * + * Major Dest 1: Measured.of_segment + * * Dest 1.1: BackpackView * Solution: Pass down * Source: Cell.editor_view editor @@ -50,19 +50,19 @@ let get_annotations = (inference_results: list(t)): annotation_map => { * - Deco.all * - Cell.deco * - Cell.editor_view - * + * * Dest 1.2: LangDoc Module * Solution: ignore via opargs - * + * * Dest 1.3: Editor Modules * Solution: Make Meta.init take oparg; pass dummy for all init * May want to pass into Meta.init in cell; to do so, use results of 1.1\ */ /** * Major Dest 1: Code.of_grout - * + * * Only subdest: Text.of_segment - * This module is only ever invoked from places that have called + * This module is only ever invoked from places that have called * Measured.of_segment (it literally takes its results as a map) * If it had those results, pass those in! if from langdoc, use dummy */ @@ -95,8 +95,7 @@ let svg_display_settings = (id: Id.t): (bool, bool) => { }; }; -/*Only called from uppermost levels where editors live anyway -*/ +//Only called from uppermost levels where editors live anyway let get_cursor_inspect_result = (id: Id.t): option((bool, string)) => if (annotations_enabled^) { let* status = Hashtbl.find_opt(accumulated_annotations, id); diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 1ab073a5f9..8a8079378d 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -817,10 +817,10 @@ and utyp_to_info_map = ({ids, term} as utyp: Term.UTyp.t): (Typ.t, map) => { // ScratchMode.view (has editor) // Cell.get_elab (has editor) // ScratchSlide.spliced_elabs (has editor) -// +// // Others from LangDoc, EditorUtil, SchoolMode, SchoolExercises // omitted due to lack of necessity (want only info_map, or color_map, only for validation, etc) -let mk_map = +let mk_map_and_annotations = Core.Memo.general( ~cache_size_bound=1000, e => { @@ -832,9 +832,13 @@ let mk_map = InferenceResult.add_on_new_annotations(annotation_map); - info_map; + (info_map, annotation_map); }, ); +let mk_map = e => { + let (info_map, _) = mk_map_and_annotations(e); + info_map; +}; let get_binding_site = (id: Id.t, statics_map: map): option(Id.t) => { open OptUtil.Syntax; diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 70d7f76542..e23adf49e4 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -7,6 +7,7 @@ module Meta = { measured: Measured.t, term_ranges: TermRanges.t, col_target: int, + annotation_map: InferenceResult.annotation_map, }; let init = (z: Zipper.t) => { @@ -16,6 +17,7 @@ module Meta = { measured: Measured.of_segment(unselected), term_ranges: TermRanges.mk(unselected), col_target: 0, + annotation_map: InferenceResult.empty_annotations(), }; }; @@ -45,6 +47,8 @@ module Meta = { let {touched, measured, col_target, _} = meta; let touched = Touched.update(Time.tick(), effects, touched); let unselected = Zipper.unselect_and_zip(z); + let (term, _) = MakeTerm.go(unselected); + let (_, annotation_map) = Statics.mk_map_and_annotations(term); let measured = Measured.of_segment(~touched, ~old=measured, unselected); let term_ranges = TermRanges.mk(unselected); let col_target = @@ -53,7 +57,7 @@ module Meta = { | Select(Resize(Local(Up | Down))) => col_target | _ => Zipper.caret_point(measured, z).col }; - {touched, measured, term_ranges, col_target}; + {touched, measured, term_ranges, col_target, annotation_map}; }; }; diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index 38f7a3932a..4dd25aa037 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -272,8 +272,7 @@ let editor_view = let zipper = editor.state.zipper; let segment = Zipper.zip(zipper); let unselected = Zipper.unselect_and_zip(zipper); - // Recalculate measured after inference is run, since type hole suggestions shift cursor. ALT: editor.state.meta.measured; - let measured = Editor.Meta.init(zipper).measured; + let measured = editor.state.meta.measured; let code_base_view = Code.view(~font_metrics, ~segment, ~unselected, ~measured, ~settings); let deco_view = From a2fe31b4929b920b2c3d01e482bc584f8c44858c Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Sun, 29 Jan 2023 15:53:30 -0600 Subject: [PATCH 022/129] removed global annotation_map from Measured, still present in Code.of_grout --- src/haz3lcore/Measured.re | 16 ++++++++++++++-- src/haz3lcore/inference/InferenceResult.re | 12 ++++++++++++ src/haz3lcore/zipper/Editor.re | 8 +++++++- 3 files changed, 33 insertions(+), 3 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index e3cea1bd5d..c00c4c5465 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -282,7 +282,14 @@ let is_indented_map = (seg: Segment.t) => { go(seg); }; -let of_segment = (~old: t=empty, ~touched=Touched.empty, seg: Segment.t): t => { +let of_segment = + ( + ~old: t=empty, + ~touched=Touched.empty, + ~annotation_map=InferenceResult.empty_annotations(), + seg: Segment.t, + ) + : t => { let is_indented = is_indented_map(seg); // recursive across seg's bidelimited containers @@ -370,7 +377,12 @@ let of_segment = (~old: t=empty, ~touched=Touched.empty, seg: Segment.t): t => { (contained_indent, last, map); | Grout(g) => let annotation_offset = - switch (InferenceResult.get_solution_of_id(g.id)) { + switch ( + InferenceResult.get_solution_of_id_no_global( + g.id, + annotation_map, + ) + ) { | Some(ityp) => ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> String.length | None => 1 diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index e58809be20..cc5a88bc70 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -77,6 +77,18 @@ let get_solution_of_id = (id: Id.t): option(ITyp.t) => } else { None; }; +let get_solution_of_id_no_global = + (id: Id.t, annotation_map: annotation_map): option(ITyp.t) => + if (annotations_enabled^) { + let* status = Hashtbl.find_opt(annotation_map, id); + switch (status) { + | Solved(Unknown(_)) => None + | Solved(ityp) => Some(ityp) + | Unsolved(_) => None + }; + } else { + None; + }; // Used in EmptyHoleDec.view /** diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index e23adf49e4..9320372a4e 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -49,7 +49,13 @@ module Meta = { let unselected = Zipper.unselect_and_zip(z); let (term, _) = MakeTerm.go(unselected); let (_, annotation_map) = Statics.mk_map_and_annotations(term); - let measured = Measured.of_segment(~touched, ~old=measured, unselected); + let measured = + Measured.of_segment( + ~touched, + ~old=measured, + ~annotation_map, + unselected, + ); let term_ranges = TermRanges.mk(unselected); let col_target = switch (a) { From 493febf2d315a0449420e22e6029a8e0d9aad02b Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Sun, 29 Jan 2023 16:32:36 -0600 Subject: [PATCH 023/129] removed global annotation_map from Code.of_grout --- src/haz3lweb/view/BackpackView.re | 16 +++++++- src/haz3lweb/view/Cell.re | 13 +++++- src/haz3lweb/view/Code.re | 67 +++++++++++++++++++++++-------- src/haz3lweb/view/Deco.re | 9 ++++- src/haz3lweb/view/LangDoc.re | 49 ++++++++++++++++++---- src/haz3lweb/view/Page.re | 3 ++ src/haz3lweb/view/SchoolMode.re | 11 ++++- src/haz3lweb/view/ScratchMode.re | 3 ++ 8 files changed, 142 insertions(+), 29 deletions(-) diff --git a/src/haz3lweb/view/BackpackView.re b/src/haz3lweb/view/BackpackView.re index b10cd24724..d2e0774115 100644 --- a/src/haz3lweb/view/BackpackView.re +++ b/src/haz3lweb/view/BackpackView.re @@ -4,6 +4,7 @@ open Haz3lcore; let backpack_sel_view = ( + ~annotation_map: InferenceResult.annotation_map, x_off: float, y_off: float, scale: float, @@ -13,6 +14,7 @@ let backpack_sel_view = module Text = Code.Text({ let map = Measured.of_segment(content); + let annotation_map = annotation_map; let settings = Model.settings_init; }); // TODO(andrew): Maybe use init sort at caret to prime this @@ -32,12 +34,14 @@ let backpack_sel_view = ), ]), // zwsp necessary for containing box to stretch to contain trailing newline - Text.of_segment(~no_sorts=true, content) @ [text(Unicode.zwsp)], + Text.of_segment(~no_sorts=true, ~annotation_map, content) + @ [text(Unicode.zwsp)], ); }; let view = ( + ~annotation_map: InferenceResult.annotation_map, ~font_metrics: FontMetrics.t, ~origin: Measured.Point.t, {backpack, _} as z: Zipper.t, @@ -95,7 +99,15 @@ let view = let scale = scale_fn(idx); let x_offset = x_fn(idx); let new_y_offset = y_offset -. dy_fn(idx, base_height); - let v = backpack_sel_view(x_offset, new_y_offset, scale, opacity, s); + let v = + backpack_sel_view( + ~annotation_map, + x_offset, + new_y_offset, + scale, + opacity, + s, + ); let new_idx = idx + 1; let new_opacity = opacity -. opacity_reduction; //TODO(andrew): am i making this difficult by going backwards? diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index 4dd25aa037..06bedeb27d 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -164,6 +164,7 @@ let deco = ~show_backpack_targets, ~selected, ~info_map, + ~annotation_map: InferenceResult.annotation_map, ~test_results: option(Interface.test_results), ~color_highlighting: option(ColorSteps.colorMap), ) => { @@ -175,6 +176,7 @@ let deco = let show_backpack_targets = show_backpack_targets; let (_term, terms) = MakeTerm.go(unselected); let info_map = info_map; + let annotation_map = annotation_map; let term_ranges = TermRanges.mk(unselected); let tiles = TileMap.mk(unselected); }); @@ -273,8 +275,16 @@ let editor_view = let segment = Zipper.zip(zipper); let unselected = Zipper.unselect_and_zip(zipper); let measured = editor.state.meta.measured; + let annotation_map = editor.state.meta.annotation_map; let code_base_view = - Code.view(~font_metrics, ~segment, ~unselected, ~measured, ~settings); + Code.view( + ~annotation_map, + ~font_metrics, + ~segment, + ~unselected, + ~measured, + ~settings, + ); let deco_view = deco( ~zipper, @@ -284,6 +294,7 @@ let editor_view = ~show_backpack_targets, ~selected, ~info_map, + ~annotation_map, ~test_results, ~color_highlighting, ); diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index eea6ddbdff..3845b91c9d 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -37,8 +37,9 @@ let of_delim = // |> Node.text, // ]; -let of_grout = (id: Id.t) => { - let solution_opt = InferenceResult.get_solution_of_id(id); +let of_grout = (~annotation_map: InferenceResult.annotation_map, id: Id.t) => { + let solution_opt = + InferenceResult.get_solution_of_id_no_global(id, annotation_map); switch (solution_opt) { | Some(ityp) => [ [ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> Node.text] @@ -66,13 +67,23 @@ let of_whitespace = } ); -module Text = (M: { - let map: Measured.t; - let settings: Model.settings; - }) => { +module Text = + ( + M: { + let map: Measured.t; + let annotation_map: InferenceResult.annotation_map; + let settings: Model.settings; + }, + ) => { let m = p => Measured.find_p(p, M.map); let rec of_segment = - (~no_sorts=false, ~sort=Sort.root, seg: Segment.t): list(Node.t) => { + ( + ~no_sorts=false, + ~sort=Sort.root, + ~annotation_map=M.annotation_map, + seg: Segment.t, + ) + : list(Node.t) => { //note: no_sorts flag is used for backback let expected_sorts = no_sorts @@ -85,17 +96,31 @@ module Text = (M: { }; seg |> List.mapi((i, p) => (i, p)) - |> List.concat_map(((i, p)) => of_piece(sort_of_p_idx(i), p)); + |> List.concat_map(((i, p)) => + of_piece(~annotation_map, sort_of_p_idx(i), p) + ); } - and of_piece = (expected_sort: Sort.t, p: Piece.t): list(Node.t) => { + and of_piece = + ( + ~annotation_map: InferenceResult.annotation_map, + expected_sort: Sort.t, + p: Piece.t, + ) + : list(Node.t) => { switch (p) { - | Tile(t) => of_tile(expected_sort, t) - | Grout(g) => of_grout(g.id) + | Tile(t) => of_tile(~annotation_map, expected_sort, t) + | Grout(g) => of_grout(~annotation_map, g.id) | Whitespace({content, _}) => of_whitespace((M.settings.whitespace_icons, m(p).last.col, content)) }; } - and of_tile = (expected_sort: Sort.t, t: Tile.t): list(Node.t) => { + and of_tile = + ( + ~annotation_map: InferenceResult.annotation_map, + expected_sort: Sort.t, + t: Tile.t, + ) + : list(Node.t) => { let children_and_sorts = List.mapi( (i, (l, child, r)) => @@ -106,7 +131,7 @@ module Text = (M: { let is_consistent = Sort.consistent(t.mold.out, expected_sort); Aba.mk(t.shards, children_and_sorts) |> Aba.join(of_delim(t.mold.out, is_consistent, t), ((seg, sort)) => - of_segment(~sort, seg) + of_segment(~sort, ~annotation_map, seg) ) |> List.concat; }; @@ -131,15 +156,23 @@ let rec holes = ], ); -let simple_view = (~unselected, ~map, ~settings: Model.settings): Node.t => { +let simple_view = + ( + ~unselected, + ~map, + ~annotation_map: InferenceResult.annotation_map, + ~settings: Model.settings, + ) + : Node.t => { module Text = Text({ let map = map; + let annotation_map = annotation_map; let settings = settings; }); div( ~attr=Attr.class_("code"), - [span_c("code-text", Text.of_segment(unselected))], + [span_c("code-text", Text.of_segment(~annotation_map, unselected))], ); }; @@ -149,17 +182,19 @@ let view = ~segment, ~unselected, ~measured, + ~annotation_map, ~settings: Model.settings, ) : Node.t => { module Text = Text({ let map = measured; + let annotation_map = annotation_map; let settings = settings; }); let unselected = TimeUtil.measure_time("Code.view/unselected", settings.benchmark, () => - Text.of_segment(unselected) + Text.of_segment(~annotation_map, unselected) ); let holes = TimeUtil.measure_time("Code.view/holes", settings.benchmark, () => diff --git a/src/haz3lweb/view/Deco.re b/src/haz3lweb/view/Deco.re index 2591ba55f3..1637901667 100644 --- a/src/haz3lweb/view/Deco.re +++ b/src/haz3lweb/view/Deco.re @@ -11,6 +11,8 @@ module Deco = let terms: TermMap.t; let term_ranges: TermRanges.t; let info_map: Statics.map; + + let annotation_map: InferenceResult.annotation_map; let tiles: TileMap.t; }, ) => { @@ -206,8 +208,11 @@ module Deco = }; }; - let backback = (z: Zipper.t): list(Node.t) => [ + let backback = + (~annotation_map: InferenceResult.annotation_map, z: Zipper.t) + : list(Node.t) => [ BackpackView.view( + ~annotation_map, ~font_metrics, ~origin=Zipper.caret_point(M.map, z), z, @@ -308,7 +313,7 @@ module Deco = caret(zipper), indicated_piece_deco(zipper), selected_pieces(zipper), - backback(zipper), + backback(~annotation_map=M.annotation_map, zipper), targets'(zipper.backpack, sel_seg), err_holes(zipper), ]); diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index 50ee926ce7..33eef71ae0 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -210,6 +210,7 @@ let deco = ~expandable: option(Id.t), ~unselected, ~map, + ~annotation_map: InferenceResult.annotation_map, ~inject, ~font_metrics, ~options, @@ -220,6 +221,7 @@ let deco = Deco.Deco({ let font_metrics = font_metrics; let map = map; + let annotation_map = annotation_map; let show_backpack_targets = false; let (term, terms) = MakeTerm.go(unselected); let info_map = Statics.mk_map(term); @@ -273,7 +275,12 @@ let deco = (index, (id, segment)) => { let map = Measured.of_segment(segment); let code_view = - Code.simple_view(~unselected=segment, ~map, ~settings); + Code.simple_view( + ~annotation_map, + ~unselected=segment, + ~map, + ~settings, + ); let classes = get_clss(segment); id == form_id ? Node.div( @@ -376,9 +383,11 @@ let syntactic_form_view = ~options, ~group_id, ~form_id, + ~annotation_map, ) => { let map = Measured.of_segment(unselected); - let code_view = Code.simple_view(~unselected, ~map, ~settings); + let code_view = + Code.simple_view(~annotation_map, ~unselected, ~map, ~settings); let deco_view = deco( ~doc, @@ -392,6 +401,7 @@ let syntactic_form_view = ~options, ~group_id, ~form_id, + ~annotation_map, ); div( ~attr=Attr.many([Attr.id(id), Attr.class_("code-container")]), @@ -406,6 +416,7 @@ let example_view = ~settings, ~id, ~examples: list(LangDocMessages.example), + ~annotation_map: InferenceResult.annotation_map, ) => { div( ~attr=Attr.id("examples"), @@ -415,7 +426,12 @@ let example_view = ({term, message, _} as example: LangDocMessages.example) => { let map_code = Measured.of_segment(term); let code_view = - Code.simple_view(~unselected=term, ~map=map_code, ~settings); + Code.simple_view( + ~annotation_map, + ~unselected=term, + ~map=map_code, + ~settings, + ); let (uhexp, _) = MakeTerm.go(term); let info_map = Statics.mk_map(uhexp); let result_view = @@ -493,7 +509,12 @@ type message_mode = | Colorings; let get_doc = - (~docs: LangDocMessages.t, info: option(Statics.t), mode: message_mode) + ( + ~annotation_map: InferenceResult.annotation_map, + ~docs: LangDocMessages.t, + info: option(Statics.t), + mode: message_mode, + ) : (list(Node.t), (list(Node.t), ColorSteps.t), list(Node.t)) => { let default = ( [text("No syntactic form available")], @@ -539,6 +560,7 @@ let get_doc = ~options, ~group_id, ~form_id=doc.id, + ~annotation_map, ); let example_view = example_view( @@ -547,6 +569,7 @@ let get_doc = ~settings, ~id=doc.id, ~examples=doc.examples, + ~annotation_map, ); ([syntactic_form_view], ([explanation], color_map), [example_view]); | Colorings => @@ -2758,7 +2781,12 @@ let section = (~section_clss: string, ~title: string, contents: list(Node.t)) => ); let get_color_map = - (~doc: LangDocMessages.t, index': option(int), info_map: Statics.map) => { + ( + ~annotation_map: InferenceResult.annotation_map, + ~doc: LangDocMessages.t, + index': option(int), + info_map: Statics.map, + ) => { let info: option(Statics.t) = switch (index') { | Some(index) => @@ -2768,7 +2796,8 @@ let get_color_map = } | None => None }; - let (_, (_, (color_map, _)), _) = get_doc(~docs=doc, info, Colorings); + let (_, (_, (color_map, _)), _) = + get_doc(~annotation_map, ~docs=doc, info, Colorings); color_map; }; @@ -2780,6 +2809,7 @@ let view = ~doc: LangDocMessages.t, index': option(int), info_map: Statics.map, + annotation_map: InferenceResult.annotation_map, ) => { let info: option(Statics.t) = switch (index') { @@ -2791,7 +2821,12 @@ let view = | None => None }; let (syn_form, (explanation, _), example) = - get_doc(~docs=doc, info, MessageContent(inject, font_metrics, settings)); + get_doc( + ~annotation_map, + ~docs=doc, + info, + MessageContent(inject, font_metrics, settings), + ); div( ~attr=clss(["lang-doc"]), [ diff --git a/src/haz3lweb/view/Page.re b/src/haz3lweb/view/Page.re index 1d6e0f660f..ce80cc5140 100644 --- a/src/haz3lweb/view/Page.re +++ b/src/haz3lweb/view/Page.re @@ -230,6 +230,8 @@ let main_ui_view = ~toolbar_buttons, ~top_right=overall_score, ); + let annotation_map = + Editors.get_editor(editors).state.meta.annotation_map; [ top_bar_view, SchoolMode.view( @@ -238,6 +240,7 @@ let main_ui_view = ~mousedown, ~show_backpack_targets, school_mode, + ~annotation_map, ), ]; }; diff --git a/src/haz3lweb/view/SchoolMode.re b/src/haz3lweb/view/SchoolMode.re index a7852de6dd..a1fe49f506 100644 --- a/src/haz3lweb/view/SchoolMode.re +++ b/src/haz3lweb/view/SchoolMode.re @@ -49,7 +49,14 @@ let render_cells = (settings: Model.settings, v: list(vis_marked(Node.t))) => { }; let view = - (~inject, ~font_metrics, ~show_backpack_targets, ~mousedown, self: t) => { + ( + ~inject, + ~font_metrics, + ~show_backpack_targets, + ~mousedown, + ~annotation_map, + self: t, + ) => { let { exercise, results: _, @@ -78,6 +85,7 @@ let view = let map = Statics.mk_map(term); Some( LangDoc.get_color_map( + ~annotation_map, ~doc=langDocMessages, Indicated.index(focal_zipper), map, @@ -375,6 +383,7 @@ let view = ~doc=langDocMessages, Indicated.index(focal_zipper), focal_info_map, + annotation_map, ), ] : [] diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 821f40a9bc..b0b15488b2 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -20,6 +20,7 @@ let view = let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); let info_map = Statics.mk_map(term); + let annotation_map = editor.state.meta.annotation_map; InferenceResult.update_annoation_mode(langDocMessages.annotations); @@ -27,6 +28,7 @@ let view = if (langDocMessages.highlight && langDocMessages.show) { Some( LangDoc.get_color_map( + ~annotation_map, ~doc=langDocMessages, Indicated.index(zipper), info_map, @@ -75,6 +77,7 @@ let view = ~doc=langDocMessages, Indicated.index(zipper), info_map, + annotation_map, ), ] : []; From 4c78da2096846d3b8c6716ac7fe7fbd530f7289e Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Sun, 29 Jan 2023 16:38:27 -0600 Subject: [PATCH 024/129] removed globals from svg_display_settings() (makes grout red) --- src/haz3lcore/Measured.re | 5 +--- src/haz3lcore/inference/InferenceResult.re | 29 +++++++++++----------- src/haz3lweb/view/Code.re | 20 +++++++++++---- src/haz3lweb/view/dec/EmptyHoleDec.re | 11 ++++++-- 4 files changed, 40 insertions(+), 25 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index c00c4c5465..977ae3b228 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -378,10 +378,7 @@ let of_segment = | Grout(g) => let annotation_offset = switch ( - InferenceResult.get_solution_of_id_no_global( - g.id, - annotation_map, - ) + InferenceResult.get_solution_of_id(g.id, annotation_map) ) { | Some(ityp) => ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> String.length diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index cc5a88bc70..7dbebb23ed 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -66,18 +66,18 @@ let get_annotations = (inference_results: list(t)): annotation_map => { * Measured.of_segment (it literally takes its results as a map) * If it had those results, pass those in! if from langdoc, use dummy */ -let get_solution_of_id = (id: Id.t): option(ITyp.t) => - if (annotations_enabled^) { - let* status = Hashtbl.find_opt(accumulated_annotations, id); - switch (status) { - | Solved(Unknown(_)) => None - | Solved(ityp) => Some(ityp) - | Unsolved(_) => None - }; - } else { - None; - }; -let get_solution_of_id_no_global = +// let get_solution_of_id = (id: Id.t): option(ITyp.t) => +// if (annotations_enabled^) { +// let* status = Hashtbl.find_opt(accumulated_annotations, id); +// switch (status) { +// | Solved(Unknown(_)) => None +// | Solved(ityp) => Some(ityp) +// | Unsolved(_) => None +// }; +// } else { +// None; +// }; +let get_solution_of_id = (id: Id.t, annotation_map: annotation_map): option(ITyp.t) => if (annotations_enabled^) { let* status = Hashtbl.find_opt(annotation_map, id); @@ -95,8 +95,9 @@ let get_solution_of_id_no_global = * If above already solved: Code.view invoked by Cell.editor_view * who should already have access to all of the above */ -let svg_display_settings = (id: Id.t): (bool, bool) => { - switch (Hashtbl.find_opt(accumulated_annotations, id)) { +let svg_display_settings = + (~annotation_map: annotation_map, id: Id.t): (bool, bool) => { + switch (Hashtbl.find_opt(annotation_map, id)) { | Some(status) => switch (status) { | Solved(Unknown(_)) => (true, false) diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 3845b91c9d..b2ea1428da 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -38,8 +38,7 @@ let of_delim = // ]; let of_grout = (~annotation_map: InferenceResult.annotation_map, id: Id.t) => { - let solution_opt = - InferenceResult.get_solution_of_id_no_global(id, annotation_map); + let solution_opt = InferenceResult.get_solution_of_id(id, annotation_map); switch (solution_opt) { | Some(ityp) => [ [ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> Node.text] @@ -138,14 +137,25 @@ module Text = }; let rec holes = - (~font_metrics, ~map: Measured.t, seg: Segment.t): list(Node.t) => + ( + ~annotation_map: InferenceResult.annotation_map, + ~font_metrics, + ~map: Measured.t, + seg: Segment.t, + ) + : list(Node.t) => seg |> List.concat_map( fun | Piece.Whitespace(_) => [] - | Tile(t) => List.concat_map(holes(~map, ~font_metrics), t.children) + | Tile(t) => + List.concat_map( + holes(~annotation_map, ~map, ~font_metrics), + t.children, + ) | Grout(g) => [ EmptyHoleDec.view( + ~annotation_map, ~font_metrics, // TODO(d) fix sort g.id, { @@ -198,7 +208,7 @@ let view = ); let holes = TimeUtil.measure_time("Code.view/holes", settings.benchmark, () => - holes(~map=measured, ~font_metrics, segment) + holes(~annotation_map, ~map=measured, ~font_metrics, segment) ); div( ~attr=Attr.class_("code"), diff --git a/src/haz3lweb/view/dec/EmptyHoleDec.re b/src/haz3lweb/view/dec/EmptyHoleDec.re index d2351d4545..c540da510f 100644 --- a/src/haz3lweb/view/dec/EmptyHoleDec.re +++ b/src/haz3lweb/view/dec/EmptyHoleDec.re @@ -25,7 +25,13 @@ let path = (tip_l, tip_r, offset, s: float) => { }; let view = - (~font_metrics, id, {measurement: {origin, _}, mold}: Profile.t): Node.t => { + ( + ~annotation_map: InferenceResult.annotation_map, + ~font_metrics, + id, + {measurement: {origin, _}, mold}: Profile.t, + ) + : Node.t => { let sort = mold.out; let c_cls = Sort.to_string(sort); let (tip_l, tip_r): (Haz3lcore.Nib.Shape.t, Haz3lcore.Nib.Shape.t) = @@ -36,7 +42,8 @@ let view = ); let (svg_enabled, unsolved_path_class) = InferenceResult.annotations_enabled^ - ? InferenceResult.svg_display_settings(id) : (true, false); + ? InferenceResult.svg_display_settings(~annotation_map, id) + : (true, false); let svg_path_class = unsolved_path_class ? "unsolved-empty-hole-path" : "empty-hole-path"; svg_enabled From b61229fb3cd36f21321e62a1504bb5255c8bea89 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Sun, 29 Jan 2023 16:48:45 -0600 Subject: [PATCH 025/129] no longer using var accumulated_annotations, still using annotations_enabled flag --- src/haz3lcore/inference/InferenceResult.re | 26 ++++++++++++---------- src/haz3lcore/statics/Statics.re | 2 +- src/haz3lweb/Update.re | 2 +- src/haz3lweb/view/CursorInspector.re | 20 +++++++++++++---- src/haz3lweb/view/SchoolMode.re | 1 + src/haz3lweb/view/ScratchMode.re | 1 + 6 files changed, 34 insertions(+), 18 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 7dbebb23ed..46444c721d 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -10,8 +10,9 @@ type annotation_map = Hashtbl.t(Id.t, status); let empty_annotations = (): annotation_map => Hashtbl.create(20); -let accumulated_annotations = empty_annotations(); +// let accumulated_annotations = empty_annotations(); +// TODO this is the other global let annotations_enabled = ref(true); // remove and put in editor too at some point... not needed then @@ -109,9 +110,10 @@ let svg_display_settings = }; //Only called from uppermost levels where editors live anyway -let get_cursor_inspect_result = (id: Id.t): option((bool, string)) => +let get_cursor_inspect_result = + (~annotation_map: annotation_map, id: Id.t): option((bool, string)) => if (annotations_enabled^) { - let* status = Hashtbl.find_opt(accumulated_annotations, id); + let* status = Hashtbl.find_opt(annotation_map, id); switch (status) { | Unsolved(eq_class) => Some((false, EqClass.string_of_eq_class(eq_class))) @@ -122,20 +124,20 @@ let get_cursor_inspect_result = (id: Id.t): option((bool, string)) => None; }; -let add_on_new_annotations = (new_map): unit => { - let add_new_elt = (new_k, new_v) => { - Hashtbl.replace(accumulated_annotations, new_k, new_v); - }; - Hashtbl.iter(add_new_elt, new_map); -}; +// let add_on_new_annotations = (new_map): unit => { +// let add_new_elt = (new_k, new_v) => { +// Hashtbl.replace(accumulated_annotations, new_k, new_v); +// }; +// Hashtbl.iter(add_new_elt, new_map); +// }; // called from Update.apply, which has access to the entire Model.t // to update the model state // update the model.editors which containts Scratch or School states // which in turn contain discrete editor.t obj -let clear_annotations = () => { - Hashtbl.reset(accumulated_annotations); -}; +// let clear_annotations = () => { +// Hashtbl.reset(accumulated_annotations); +// }; let condense = (eq_class: MutableEqClass.t, key: ITyp.t): status => { let (eq_class, err) = MutableEqClass.snapshot_class(eq_class, key); diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 8a8079378d..d937e04c89 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -830,7 +830,7 @@ let mk_map_and_annotations = let inference_results = Inference.unify_and_report_status(constraints); let annotation_map = InferenceResult.get_annotations(inference_results); - InferenceResult.add_on_new_annotations(annotation_map); + // InferenceResult.add_on_new_annotations(annotation_map); (info_map, annotation_map); }, diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index 554fc2ea1b..3532ff1e1b 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -274,7 +274,7 @@ let apply = }; }; save_editors(model); - InferenceResult.clear_annotations(); + // InferenceResult.clear_annotations(); Ok(model); | SwitchSlide(n) => switch (model.editors) { diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 8ea228e67a..8b1b0ccc70 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -199,8 +199,11 @@ let extra_view = (visible: bool, id: int, ci: Haz3lcore.Statics.t): Node.t => [id_view(id), cls_view(ci)], ); -let view_of_global_inference_info = (id: int) => { - switch (Haz3lcore.InferenceResult.get_cursor_inspect_result(id)) { +let view_of_global_inference_info = + (~annotation_map: Haz3lcore.InferenceResult.annotation_map, id: int) => { + switch ( + Haz3lcore.InferenceResult.get_cursor_inspect_result(~annotation_map, id) + ) { | Some((true, solution)) => div( ~attr=clss([infoc, "typ"]), @@ -234,6 +237,7 @@ let toggle_context_and_print_ci = (~inject: Update.t => 'a, ci, _) => { let inspector_view = ( ~inject, + ~annotation_map: Haz3lcore.InferenceResult.annotation_map, ~settings: Model.settings, ~show_lang_doc: bool, id: int, @@ -252,7 +256,7 @@ let inspector_view = [ extra_view(settings.context_inspector, id, ci), view_of_info(~inject, ~show_lang_doc, ci), - view_of_global_inference_info(id), + view_of_global_inference_info(~annotation_map, id), CtxInspector.inspector_view(~inject, ~settings, id, ci), ], ); @@ -264,6 +268,7 @@ let view = ~show_lang_doc: bool, zipper: Haz3lcore.Zipper.t, info_map: Haz3lcore.Statics.map, + annotation_map: Haz3lcore.InferenceResult.annotation_map, ) => { let backpack = zipper.backpack; if (List.length(backpack) > 0) { @@ -275,7 +280,14 @@ let view = | Some(index) => switch (Haz3lcore.Id.Map.find_opt(index, info_map)) { | Some(ci) => - inspector_view(~inject, ~settings, ~show_lang_doc, index, ci) + inspector_view( + ~inject, + ~annotation_map, + ~settings, + ~show_lang_doc, + index, + ci, + ) | None => div( ~attr=clss(["cursor-inspector"]), diff --git a/src/haz3lweb/view/SchoolMode.re b/src/haz3lweb/view/SchoolMode.re index a1fe49f506..defd3b7a67 100644 --- a/src/haz3lweb/view/SchoolMode.re +++ b/src/haz3lweb/view/SchoolMode.re @@ -347,6 +347,7 @@ let view = ~show_lang_doc=langDocMessages.show, focal_zipper, focal_info_map, + annotation_map, ), ] : []; diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index b0b15488b2..9c51ca7238 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -63,6 +63,7 @@ let view = ~show_lang_doc=langDocMessages.show, zipper, info_map, + annotation_map, ), ] : []; From 1e305f4def8459ea3daded1a707083e465993e02 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Mon, 30 Jan 2023 21:17:08 -0600 Subject: [PATCH 026/129] fix bug where type annotations don't show when editor first loaded --- src/haz3lcore/zipper/Editor.re | 4 +++- src/haz3lweb/view/Printer.re | 7 ++++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 9320372a4e..822de595a5 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -12,12 +12,14 @@ module Meta = { let init = (z: Zipper.t) => { let unselected = Zipper.unselect_and_zip(z); + let (term, _) = MakeTerm.go(unselected); + let (_, annotation_map) = Statics.mk_map_and_annotations(term); { touched: Touched.empty, measured: Measured.of_segment(unselected), term_ranges: TermRanges.mk(unselected), col_target: 0, - annotation_map: InferenceResult.empty_annotations(), + annotation_map, }; }; diff --git a/src/haz3lweb/view/Printer.re b/src/haz3lweb/view/Printer.re index 0646b48c4f..1c6354e71e 100644 --- a/src/haz3lweb/view/Printer.re +++ b/src/haz3lweb/view/Printer.re @@ -110,8 +110,13 @@ let to_log_flat = (~measured, z: Zipper.t): string => { }; let zipper_of_string = - (~zipper_init=Zipper.init(0), id_gen: IdGen.state, str: string) + (~zipper_init=?, id_gen: IdGen.state, str: string) : option((Zipper.t, IdGen.state)) => { + let (zipper_init, id_gen) = + switch (zipper_init) { + | Some(z) => (z, id_gen) + | None => (Zipper.init(id_gen), id_gen + 1) + }; let insert_to_zid: ((Zipper.t, IdGen.state), string) => (Zipper.t, IdGen.state) = ((z, id_gen), c) => { From aa9e6228dcf67761705c913ab0b1bc3ef4a4e959 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Tue, 31 Jan 2023 13:33:46 -0600 Subject: [PATCH 027/129] removed type annotations from editor.state.meta --- src/haz3lcore/zipper/Editor.re | 6 +----- src/haz3lweb/view/Cell.re | 3 ++- src/haz3lweb/view/Page.re | 6 ++++-- src/haz3lweb/view/ScratchMode.re | 3 +-- 4 files changed, 8 insertions(+), 10 deletions(-) diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 822de595a5..2934985988 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -7,19 +7,15 @@ module Meta = { measured: Measured.t, term_ranges: TermRanges.t, col_target: int, - annotation_map: InferenceResult.annotation_map, }; let init = (z: Zipper.t) => { let unselected = Zipper.unselect_and_zip(z); - let (term, _) = MakeTerm.go(unselected); - let (_, annotation_map) = Statics.mk_map_and_annotations(term); { touched: Touched.empty, measured: Measured.of_segment(unselected), term_ranges: TermRanges.mk(unselected), col_target: 0, - annotation_map, }; }; @@ -65,7 +61,7 @@ module Meta = { | Select(Resize(Local(Up | Down))) => col_target | _ => Zipper.caret_point(measured, z).col }; - {touched, measured, term_ranges, col_target, annotation_map}; + {touched, measured, term_ranges, col_target}; }; }; diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index 06bedeb27d..d6cd8116ed 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -274,8 +274,9 @@ let editor_view = let zipper = editor.state.zipper; let segment = Zipper.zip(zipper); let unselected = Zipper.unselect_and_zip(zipper); + let (term, _) = MakeTerm.go(unselected); + let (_, annotation_map) = Statics.mk_map_and_annotations(term); let measured = editor.state.meta.measured; - let annotation_map = editor.state.meta.annotation_map; let code_base_view = Code.view( ~annotation_map, diff --git a/src/haz3lweb/view/Page.re b/src/haz3lweb/view/Page.re index ce80cc5140..d595854094 100644 --- a/src/haz3lweb/view/Page.re +++ b/src/haz3lweb/view/Page.re @@ -230,8 +230,10 @@ let main_ui_view = ~toolbar_buttons, ~top_right=overall_score, ); - let annotation_map = - Editors.get_editor(editors).state.meta.annotation_map; + let zipper = Editors.get_editor(editors).state.zipper; + let unselected = Zipper.unselect_and_zip(zipper); + let (term, _) = MakeTerm.go(unselected); + let (_, annotation_map) = Statics.mk_map_and_annotations(term); [ top_bar_view, SchoolMode.view( diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 9c51ca7238..52eaaa3212 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -19,8 +19,7 @@ let view = let zipper = editor.state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let info_map = Statics.mk_map(term); - let annotation_map = editor.state.meta.annotation_map; + let (info_map, annotation_map) = Statics.mk_map_and_annotations(term); InferenceResult.update_annoation_mode(langDocMessages.annotations); From 677cf8dbfe356faacdc421185e13d1d12f54ae9b Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 2 Feb 2023 14:48:00 -0500 Subject: [PATCH 028/129] remove annotations_enabled global var and refactor names of types --- src/haz3lcore/Measured.re | 7 +- src/haz3lcore/inference/InferenceResult.re | 103 +++++++-------------- src/haz3lcore/statics/Statics.re | 5 +- src/haz3lcore/zipper/Editor.re | 41 ++++++-- src/haz3lcore/zipper/action/Perform.re | 5 +- src/haz3lweb/Update.re | 20 +++- src/haz3lweb/view/BackpackView.re | 10 +- src/haz3lweb/view/Cell.re | 18 +++- src/haz3lweb/view/Code.re | 60 ++++++------ src/haz3lweb/view/CursorInspector.re | 18 ++-- src/haz3lweb/view/Deco.re | 11 ++- src/haz3lweb/view/LangDoc.re | 30 +++--- src/haz3lweb/view/Page.re | 10 +- src/haz3lweb/view/SchoolMode.re | 16 ++-- src/haz3lweb/view/ScratchMode.re | 17 ++-- src/haz3lweb/view/dec/EmptyHoleDec.re | 6 +- 16 files changed, 207 insertions(+), 170 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index 977ae3b228..a30e27b86a 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -286,7 +286,7 @@ let of_segment = ( ~old: t=empty, ~touched=Touched.empty, - ~annotation_map=InferenceResult.empty_annotations(), + ~global_inference_info=InferenceResult.empty_info(), seg: Segment.t, ) : t => { @@ -378,7 +378,10 @@ let of_segment = | Grout(g) => let annotation_offset = switch ( - InferenceResult.get_solution_of_id(g.id, annotation_map) + InferenceResult.get_solution_of_id( + g.id, + global_inference_info, + ) ) { | Some(ityp) => ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> String.length diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 46444c721d..c6d89feda8 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -6,21 +6,24 @@ type status = type t = (ITyp.t, status); -type annotation_map = Hashtbl.t(Id.t, status); +type type_hole_to_solution = Hashtbl.t(Id.t, status); -let empty_annotations = (): annotation_map => Hashtbl.create(20); - -// let accumulated_annotations = empty_annotations(); +type global_inference_info = { + enabled: bool, + solution_statuses: type_hole_to_solution, +}; -// TODO this is the other global -let annotations_enabled = ref(true); +let empty_annotations = (): type_hole_to_solution => Hashtbl.create(20); -// remove and put in editor too at some point... not needed then -let update_annoation_mode = annot_mode => { - annotations_enabled := annot_mode; +let mk_global_inference_info = (enabled, annotations) => { + {enabled, solution_statuses: annotations}; }; -let get_annotations = (inference_results: list(t)): annotation_map => { +let empty_info = (): global_inference_info => + mk_global_inference_info(true, empty_annotations()); + +let get_desired_solutions = + (inference_results: list(t)): type_hole_to_solution => { let id_and_status_if_type_hole = (result: t): option((Id.t, status)) => { switch (result) { | (Unknown(TypeHole(id)), status) => Some((id, status)) @@ -36,52 +39,11 @@ let get_annotations = (inference_results: list(t)): annotation_map => { new_map; }; -// Used in Code.re -// Used in Measured.re -/** - * Major Dest 1: Measured.of_segment - * - * Dest 1.1: BackpackView - * Solution: Pass down - * Source: Cell.editor_view editor - * Invocations in bt to source: - * - BackpackView.backpack_sel_view - * - BackpackView.view - * - Deco.backpack - * - Deco.all - * - Cell.deco - * - Cell.editor_view - * - * Dest 1.2: LangDoc Module - * Solution: ignore via opargs - * - * Dest 1.3: Editor Modules - * Solution: Make Meta.init take oparg; pass dummy for all init - * May want to pass into Meta.init in cell; to do so, use results of 1.1\ - */ -/** - * Major Dest 1: Code.of_grout - * - * Only subdest: Text.of_segment - * This module is only ever invoked from places that have called - * Measured.of_segment (it literally takes its results as a map) - * If it had those results, pass those in! if from langdoc, use dummy - */ -// let get_solution_of_id = (id: Id.t): option(ITyp.t) => -// if (annotations_enabled^) { -// let* status = Hashtbl.find_opt(accumulated_annotations, id); -// switch (status) { -// | Solved(Unknown(_)) => None -// | Solved(ityp) => Some(ityp) -// | Unsolved(_) => None -// }; -// } else { -// None; -// }; let get_solution_of_id = - (id: Id.t, annotation_map: annotation_map): option(ITyp.t) => - if (annotations_enabled^) { - let* status = Hashtbl.find_opt(annotation_map, id); + (id: Id.t, global_inference_info: global_inference_info): option(ITyp.t) => + if (global_inference_info.enabled) { + let* status = + Hashtbl.find_opt(global_inference_info.solution_statuses, id); switch (status) { | Solved(Unknown(_)) => None | Solved(ityp) => Some(ityp) @@ -97,23 +59,28 @@ let get_solution_of_id = * who should already have access to all of the above */ let svg_display_settings = - (~annotation_map: annotation_map, id: Id.t): (bool, bool) => { - switch (Hashtbl.find_opt(annotation_map, id)) { - | Some(status) => - switch (status) { - | Solved(Unknown(_)) => (true, false) - | Solved(_) => (false, false) - | Unsolved(_) => (true, true) - } - | None => (true, false) + (~global_inference_info: global_inference_info, id: Id.t): (bool, bool) => + if (global_inference_info.enabled) { + switch (Hashtbl.find_opt(global_inference_info.solution_statuses, id)) { + | Some(status) => + switch (status) { + | Solved(Unknown(_)) => (true, false) + | Solved(_) => (false, false) + | Unsolved(_) => (true, true) + } + | None => (true, false) + }; + } else { + (true, false); }; -}; //Only called from uppermost levels where editors live anyway let get_cursor_inspect_result = - (~annotation_map: annotation_map, id: Id.t): option((bool, string)) => - if (annotations_enabled^) { - let* status = Hashtbl.find_opt(annotation_map, id); + (~global_inference_info: global_inference_info, id: Id.t) + : option((bool, string)) => + if (global_inference_info.enabled) { + let* status = + Hashtbl.find_opt(global_inference_info.solution_statuses, id); switch (status) { | Unsolved(eq_class) => Some((false, EqClass.string_of_eq_class(eq_class))) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index d937e04c89..4f367b5b41 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -828,11 +828,12 @@ let mk_map_and_annotations = uexp_to_info_map(~ctx=Builtins.ctx(Builtins.Pervasives.builtins), e); let inference_results = Inference.unify_and_report_status(constraints); - let annotation_map = InferenceResult.get_annotations(inference_results); + let global_inference_solutions = + InferenceResult.get_desired_solutions(inference_results); // InferenceResult.add_on_new_annotations(annotation_map); - (info_map, annotation_map); + (info_map, global_inference_solutions); }, ); let mk_map = e => { diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 2934985988..1278c3a7bc 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -41,17 +41,30 @@ module Meta = { let t_of_yojson = _ => failwith("Editor.Meta.t_of_yojson"); let next = - (~effects: list(Effect.t)=[], a: Action.t, z: Zipper.t, meta: t): t => { + ( + ~effects: list(Effect.t)=[], + a: Action.t, + z: Zipper.t, + meta: t, + inference_enabled, + ) + : t => { let {touched, measured, col_target, _} = meta; let touched = Touched.update(Time.tick(), effects, touched); let unselected = Zipper.unselect_and_zip(z); let (term, _) = MakeTerm.go(unselected); - let (_, annotation_map) = Statics.mk_map_and_annotations(term); + // TODO Raef: add in flow for the enabled flag + let (_, global_inference_solutions) = + Statics.mk_map_and_annotations(term); let measured = Measured.of_segment( ~touched, ~old=measured, - ~annotation_map, + ~global_inference_info= + InferenceResult.mk_global_inference_info( + inference_enabled, + global_inference_solutions, + ), unselected, ); let term_ranges = TermRanges.mk(unselected); @@ -75,9 +88,16 @@ module State = { let init = zipper => {zipper, meta: Meta.init(zipper)}; - let next = (~effects: list(Effect.t)=[], a: Action.t, z: Zipper.t, state) => { + let next = + ( + ~effects: list(Effect.t)=[], + a: Action.t, + z: Zipper.t, + state, + inference_enabled, + ) => { zipper: z, - meta: Meta.next(~effects, a, z, state.meta), + meta: Meta.next(~effects, a, z, state.meta, inference_enabled), }; }; @@ -127,8 +147,15 @@ let update_z_opt = (f: Zipper.t => option(Zipper.t), ed: t) => { }; let new_state = - (~effects: list(Effect.t)=[], a: Action.t, z: Zipper.t, ed: t): t => { - let state = State.next(~effects, a, z, ed.state); + ( + ~effects: list(Effect.t)=[], + a: Action.t, + z: Zipper.t, + ed: t, + inference_enabled, + ) + : t => { + let state = State.next(~effects, a, z, ed.state, inference_enabled); let history = History.add(a, ed.state, ed.history); {state, history, read_only: ed.read_only}; }; diff --git a/src/haz3lcore/zipper/action/Perform.re b/src/haz3lcore/zipper/action/Perform.re index 6e9c74ad04..bb6507ea2d 100644 --- a/src/haz3lcore/zipper/action/Perform.re +++ b/src/haz3lcore/zipper/action/Perform.re @@ -109,7 +109,7 @@ let go_z = }; let go = - (a: Action.t, ed: Editor.t, id_gen: IdGen.state) + (a: Action.t, ed: Editor.t, id_gen: IdGen.state, inference_enabled) : Action.Result.t((Editor.t, IdGen.state)) => if (ed.read_only && is_write_action(a)) { Result.Ok((ed, id_gen)); @@ -118,6 +118,7 @@ let go = let Editor.State.{zipper, meta} = ed.state; Effect.s_clear(); let+ (z, id_gen) = go_z(~meta, a, zipper, id_gen); - let ed = Editor.new_state(~effects=Effect.s^, a, z, ed); + let ed = + Editor.new_state(~effects=Effect.s^, a, z, ed, inference_enabled); (ed, id_gen); }; diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index 3532ff1e1b..5bb1e29a12 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -204,7 +204,9 @@ let perform_action = (model: Model.t, a: Action.t, _state: State.t, ~schedule_action as _) : Result.t(Model.t) => { let (id, ed_init) = Editors.get_editor_and_id(model.editors); - switch (Haz3lcore.Perform.go(a, ed_init, id)) { + switch ( + Haz3lcore.Perform.go(a, ed_init, id, model.langDocMessages.annotations) + ) { | Error(err) => Error(FailedToPerform(err)) | Ok((ed, id)) => Ok({...model, editors: Editors.put_editor_and_id(id, ed, model.editors)}) @@ -334,7 +336,13 @@ let apply = | None => Error(CantPaste) | Some((z, id)) => //TODO: add correct action to history (Pick_up is wrong) - let ed = Haz3lcore.Editor.new_state(Pick_up, z, ed); + let ed = + Haz3lcore.Editor.new_state( + Pick_up, + z, + ed, + model.langDocMessages.annotations, + ); Ok({ ...model, editors: Editors.put_editor_and_id(id, ed, model.editors), @@ -351,7 +359,13 @@ let apply = | None => Error(CantReset) | Some((z, id)) => //TODO: add correct action to history (Pick_up is wrong) - let editor = Haz3lcore.Editor.new_state(Pick_up, z, ed); + let editor = + Haz3lcore.Editor.new_state( + Pick_up, + z, + ed, + model.langDocMessages.annotations, + ); let editors = Editors.put_editor_and_id(id, editor, model.editors); Ok({...model, editors}); }; diff --git a/src/haz3lweb/view/BackpackView.re b/src/haz3lweb/view/BackpackView.re index d2e0774115..0735f7e080 100644 --- a/src/haz3lweb/view/BackpackView.re +++ b/src/haz3lweb/view/BackpackView.re @@ -4,7 +4,7 @@ open Haz3lcore; let backpack_sel_view = ( - ~annotation_map: InferenceResult.annotation_map, + ~global_inference_info: InferenceResult.global_inference_info, x_off: float, y_off: float, scale: float, @@ -14,7 +14,7 @@ let backpack_sel_view = module Text = Code.Text({ let map = Measured.of_segment(content); - let annotation_map = annotation_map; + let global_inference_info = global_inference_info; let settings = Model.settings_init; }); // TODO(andrew): Maybe use init sort at caret to prime this @@ -34,14 +34,14 @@ let backpack_sel_view = ), ]), // zwsp necessary for containing box to stretch to contain trailing newline - Text.of_segment(~no_sorts=true, ~annotation_map, content) + Text.of_segment(~no_sorts=true, ~global_inference_info, content) @ [text(Unicode.zwsp)], ); }; let view = ( - ~annotation_map: InferenceResult.annotation_map, + ~global_inference_info: InferenceResult.global_inference_info, ~font_metrics: FontMetrics.t, ~origin: Measured.Point.t, {backpack, _} as z: Zipper.t, @@ -101,7 +101,7 @@ let view = let new_y_offset = y_offset -. dy_fn(idx, base_height); let v = backpack_sel_view( - ~annotation_map, + ~global_inference_info, x_offset, new_y_offset, scale, diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index d6cd8116ed..df62bfe4c1 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -164,7 +164,7 @@ let deco = ~show_backpack_targets, ~selected, ~info_map, - ~annotation_map: InferenceResult.annotation_map, + ~global_inference_info: InferenceResult.global_inference_info, ~test_results: option(Interface.test_results), ~color_highlighting: option(ColorSteps.colorMap), ) => { @@ -176,7 +176,7 @@ let deco = let show_backpack_targets = show_backpack_targets; let (_term, terms) = MakeTerm.go(unselected); let info_map = info_map; - let annotation_map = annotation_map; + let global_inference_info = global_inference_info; let term_ranges = TermRanges.mk(unselected); let tiles = TileMap.mk(unselected); }); @@ -267,6 +267,7 @@ let editor_view = ~test_results: option(Interface.test_results), ~footer: option(Node.t), ~color_highlighting: option(ColorSteps.colorMap), + ~langDocMessages: LangDocMessages.t, editor: Editor.t, ) => { //~eval_result: option(option(DHExp.t)) @@ -275,11 +276,16 @@ let editor_view = let segment = Zipper.zip(zipper); let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, annotation_map) = Statics.mk_map_and_annotations(term); + let (_, global_inference_solutions) = Statics.mk_map_and_annotations(term); let measured = editor.state.meta.measured; + let global_inference_info = + InferenceResult.mk_global_inference_info( + langDocMessages.annotations, + global_inference_solutions, + ); let code_base_view = Code.view( - ~annotation_map, + ~global_inference_info, ~font_metrics, ~segment, ~unselected, @@ -295,7 +301,7 @@ let editor_view = ~show_backpack_targets, ~selected, ~info_map, - ~annotation_map, + ~global_inference_info, ~test_results, ~color_highlighting, ); @@ -340,6 +346,7 @@ let editor_with_result_view = ~code_id: string, ~info_map: Statics.map, ~result: ModelResult.simple, + ~langDocMessages, editor: Editor.t, ) => { let test_results = ModelResult.unwrap_test_results(result); @@ -361,6 +368,7 @@ let editor_with_result_view = ~test_results, ~footer=Some(eval_result_footer), ~color_highlighting, + ~langDocMessages, editor, ); }; diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index b2ea1428da..b9f6047493 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -37,8 +37,10 @@ let of_delim = // |> Node.text, // ]; -let of_grout = (~annotation_map: InferenceResult.annotation_map, id: Id.t) => { - let solution_opt = InferenceResult.get_solution_of_id(id, annotation_map); +let of_grout = + (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) => { + let solution_opt = + InferenceResult.get_solution_of_id(id, global_inference_info); switch (solution_opt) { | Some(ityp) => [ [ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> Node.text] @@ -70,7 +72,7 @@ module Text = ( M: { let map: Measured.t; - let annotation_map: InferenceResult.annotation_map; + let global_inference_info: InferenceResult.global_inference_info; let settings: Model.settings; }, ) => { @@ -79,7 +81,7 @@ module Text = ( ~no_sorts=false, ~sort=Sort.root, - ~annotation_map=M.annotation_map, + ~global_inference_info=M.global_inference_info, seg: Segment.t, ) : list(Node.t) => { @@ -96,29 +98,21 @@ module Text = seg |> List.mapi((i, p) => (i, p)) |> List.concat_map(((i, p)) => - of_piece(~annotation_map, sort_of_p_idx(i), p) + of_piece(~global_inference_info, sort_of_p_idx(i), p) ); } and of_piece = - ( - ~annotation_map: InferenceResult.annotation_map, - expected_sort: Sort.t, - p: Piece.t, - ) + (~global_inference_info, expected_sort: Sort.t, p: Piece.t) : list(Node.t) => { switch (p) { - | Tile(t) => of_tile(~annotation_map, expected_sort, t) - | Grout(g) => of_grout(~annotation_map, g.id) + | Tile(t) => of_tile(~global_inference_info, expected_sort, t) + | Grout(g) => of_grout(~global_inference_info, g.id) | Whitespace({content, _}) => of_whitespace((M.settings.whitespace_icons, m(p).last.col, content)) }; } and of_tile = - ( - ~annotation_map: InferenceResult.annotation_map, - expected_sort: Sort.t, - t: Tile.t, - ) + (~global_inference_info, expected_sort: Sort.t, t: Tile.t) : list(Node.t) => { let children_and_sorts = List.mapi( @@ -130,7 +124,7 @@ module Text = let is_consistent = Sort.consistent(t.mold.out, expected_sort); Aba.mk(t.shards, children_and_sorts) |> Aba.join(of_delim(t.mold.out, is_consistent, t), ((seg, sort)) => - of_segment(~sort, ~annotation_map, seg) + of_segment(~sort, ~global_inference_info, seg) ) |> List.concat; }; @@ -138,7 +132,7 @@ module Text = let rec holes = ( - ~annotation_map: InferenceResult.annotation_map, + ~global_inference_info, ~font_metrics, ~map: Measured.t, seg: Segment.t, @@ -150,12 +144,12 @@ let rec holes = | Piece.Whitespace(_) => [] | Tile(t) => List.concat_map( - holes(~annotation_map, ~map, ~font_metrics), + holes(~global_inference_info, ~map, ~font_metrics), t.children, ) | Grout(g) => [ EmptyHoleDec.view( - ~annotation_map, + ~global_inference_info, ~font_metrics, // TODO(d) fix sort g.id, { @@ -167,22 +161,22 @@ let rec holes = ); let simple_view = - ( - ~unselected, - ~map, - ~annotation_map: InferenceResult.annotation_map, - ~settings: Model.settings, - ) + (~unselected, ~map, ~global_inference_info, ~settings: Model.settings) : Node.t => { module Text = Text({ let map = map; - let annotation_map = annotation_map; + let global_inference_info = global_inference_info; let settings = settings; }); div( ~attr=Attr.class_("code"), - [span_c("code-text", Text.of_segment(~annotation_map, unselected))], + [ + span_c( + "code-text", + Text.of_segment(~global_inference_info, unselected), + ), + ], ); }; @@ -192,23 +186,23 @@ let view = ~segment, ~unselected, ~measured, - ~annotation_map, + ~global_inference_info, ~settings: Model.settings, ) : Node.t => { module Text = Text({ let map = measured; - let annotation_map = annotation_map; + let global_inference_info = global_inference_info; let settings = settings; }); let unselected = TimeUtil.measure_time("Code.view/unselected", settings.benchmark, () => - Text.of_segment(~annotation_map, unselected) + Text.of_segment(~global_inference_info, unselected) ); let holes = TimeUtil.measure_time("Code.view/holes", settings.benchmark, () => - holes(~annotation_map, ~map=measured, ~font_metrics, segment) + holes(~global_inference_info, ~map=measured, ~font_metrics, segment) ); div( ~attr=Attr.class_("code"), diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 8b1b0ccc70..adfe6a9db2 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -200,9 +200,15 @@ let extra_view = (visible: bool, id: int, ci: Haz3lcore.Statics.t): Node.t => ); let view_of_global_inference_info = - (~annotation_map: Haz3lcore.InferenceResult.annotation_map, id: int) => { + ( + ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, + id: int, + ) => { switch ( - Haz3lcore.InferenceResult.get_cursor_inspect_result(~annotation_map, id) + Haz3lcore.InferenceResult.get_cursor_inspect_result( + ~global_inference_info, + id, + ) ) { | Some((true, solution)) => div( @@ -237,7 +243,7 @@ let toggle_context_and_print_ci = (~inject: Update.t => 'a, ci, _) => { let inspector_view = ( ~inject, - ~annotation_map: Haz3lcore.InferenceResult.annotation_map, + ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, ~settings: Model.settings, ~show_lang_doc: bool, id: int, @@ -256,7 +262,7 @@ let inspector_view = [ extra_view(settings.context_inspector, id, ci), view_of_info(~inject, ~show_lang_doc, ci), - view_of_global_inference_info(~annotation_map, id), + view_of_global_inference_info(~global_inference_info, id), CtxInspector.inspector_view(~inject, ~settings, id, ci), ], ); @@ -268,7 +274,7 @@ let view = ~show_lang_doc: bool, zipper: Haz3lcore.Zipper.t, info_map: Haz3lcore.Statics.map, - annotation_map: Haz3lcore.InferenceResult.annotation_map, + global_inference_info: Haz3lcore.InferenceResult.global_inference_info, ) => { let backpack = zipper.backpack; if (List.length(backpack) > 0) { @@ -282,7 +288,7 @@ let view = | Some(ci) => inspector_view( ~inject, - ~annotation_map, + ~global_inference_info, ~settings, ~show_lang_doc, index, diff --git a/src/haz3lweb/view/Deco.re b/src/haz3lweb/view/Deco.re index 1637901667..b81564e0e7 100644 --- a/src/haz3lweb/view/Deco.re +++ b/src/haz3lweb/view/Deco.re @@ -12,7 +12,7 @@ module Deco = let term_ranges: TermRanges.t; let info_map: Statics.map; - let annotation_map: InferenceResult.annotation_map; + let global_inference_info: InferenceResult.global_inference_info; let tiles: TileMap.t; }, ) => { @@ -209,10 +209,13 @@ module Deco = }; let backback = - (~annotation_map: InferenceResult.annotation_map, z: Zipper.t) + ( + ~global_inference_info: InferenceResult.global_inference_info, + z: Zipper.t, + ) : list(Node.t) => [ BackpackView.view( - ~annotation_map, + ~global_inference_info, ~font_metrics, ~origin=Zipper.caret_point(M.map, z), z, @@ -313,7 +316,7 @@ module Deco = caret(zipper), indicated_piece_deco(zipper), selected_pieces(zipper), - backback(~annotation_map=M.annotation_map, zipper), + backback(~global_inference_info=M.global_inference_info, zipper), targets'(zipper.backpack, sel_seg), err_holes(zipper), ]); diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index 33eef71ae0..056377a47a 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -210,7 +210,7 @@ let deco = ~expandable: option(Id.t), ~unselected, ~map, - ~annotation_map: InferenceResult.annotation_map, + ~global_inference_info: InferenceResult.global_inference_info, ~inject, ~font_metrics, ~options, @@ -221,7 +221,7 @@ let deco = Deco.Deco({ let font_metrics = font_metrics; let map = map; - let annotation_map = annotation_map; + let global_inference_info = global_inference_info; let show_backpack_targets = false; let (term, terms) = MakeTerm.go(unselected); let info_map = Statics.mk_map(term); @@ -276,7 +276,7 @@ let deco = let map = Measured.of_segment(segment); let code_view = Code.simple_view( - ~annotation_map, + ~global_inference_info, ~unselected=segment, ~map, ~settings, @@ -383,11 +383,11 @@ let syntactic_form_view = ~options, ~group_id, ~form_id, - ~annotation_map, + ~global_inference_info, ) => { let map = Measured.of_segment(unselected); let code_view = - Code.simple_view(~annotation_map, ~unselected, ~map, ~settings); + Code.simple_view(~global_inference_info, ~unselected, ~map, ~settings); let deco_view = deco( ~doc, @@ -401,7 +401,7 @@ let syntactic_form_view = ~options, ~group_id, ~form_id, - ~annotation_map, + ~global_inference_info, ); div( ~attr=Attr.many([Attr.id(id), Attr.class_("code-container")]), @@ -416,7 +416,7 @@ let example_view = ~settings, ~id, ~examples: list(LangDocMessages.example), - ~annotation_map: InferenceResult.annotation_map, + ~global_inference_info: InferenceResult.global_inference_info, ) => { div( ~attr=Attr.id("examples"), @@ -427,7 +427,7 @@ let example_view = let map_code = Measured.of_segment(term); let code_view = Code.simple_view( - ~annotation_map, + ~global_inference_info, ~unselected=term, ~map=map_code, ~settings, @@ -510,7 +510,7 @@ type message_mode = let get_doc = ( - ~annotation_map: InferenceResult.annotation_map, + ~global_inference_info: InferenceResult.global_inference_info, ~docs: LangDocMessages.t, info: option(Statics.t), mode: message_mode, @@ -560,7 +560,7 @@ let get_doc = ~options, ~group_id, ~form_id=doc.id, - ~annotation_map, + ~global_inference_info, ); let example_view = example_view( @@ -569,7 +569,7 @@ let get_doc = ~settings, ~id=doc.id, ~examples=doc.examples, - ~annotation_map, + ~global_inference_info, ); ([syntactic_form_view], ([explanation], color_map), [example_view]); | Colorings => @@ -2782,7 +2782,7 @@ let section = (~section_clss: string, ~title: string, contents: list(Node.t)) => let get_color_map = ( - ~annotation_map: InferenceResult.annotation_map, + ~global_inference_info: InferenceResult.global_inference_info, ~doc: LangDocMessages.t, index': option(int), info_map: Statics.map, @@ -2797,7 +2797,7 @@ let get_color_map = | None => None }; let (_, (_, (color_map, _)), _) = - get_doc(~annotation_map, ~docs=doc, info, Colorings); + get_doc(~global_inference_info, ~docs=doc, info, Colorings); color_map; }; @@ -2809,7 +2809,7 @@ let view = ~doc: LangDocMessages.t, index': option(int), info_map: Statics.map, - annotation_map: InferenceResult.annotation_map, + global_inference_info: InferenceResult.global_inference_info, ) => { let info: option(Statics.t) = switch (index') { @@ -2822,7 +2822,7 @@ let view = }; let (syn_form, (explanation, _), example) = get_doc( - ~annotation_map, + ~global_inference_info, ~docs=doc, info, MessageContent(inject, font_metrics, settings), diff --git a/src/haz3lweb/view/Page.re b/src/haz3lweb/view/Page.re index d595854094..47f29bc0ad 100644 --- a/src/haz3lweb/view/Page.re +++ b/src/haz3lweb/view/Page.re @@ -233,7 +233,13 @@ let main_ui_view = let zipper = Editors.get_editor(editors).state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, annotation_map) = Statics.mk_map_and_annotations(term); + let (_, global_inference_solutions) = + Statics.mk_map_and_annotations(term); + let global_inference_info = + InferenceResult.mk_global_inference_info( + langDocMessages.annotations, + global_inference_solutions, + ); [ top_bar_view, SchoolMode.view( @@ -242,7 +248,7 @@ let main_ui_view = ~mousedown, ~show_backpack_targets, school_mode, - ~annotation_map, + ~global_inference_info, ), ]; }; diff --git a/src/haz3lweb/view/SchoolMode.re b/src/haz3lweb/view/SchoolMode.re index defd3b7a67..5423f14d56 100644 --- a/src/haz3lweb/view/SchoolMode.re +++ b/src/haz3lweb/view/SchoolMode.re @@ -54,7 +54,7 @@ let view = ~font_metrics, ~show_backpack_targets, ~mousedown, - ~annotation_map, + ~global_inference_info: InferenceResult.global_inference_info, self: t, ) => { let { @@ -76,8 +76,11 @@ let view = } = stitched_dynamics; let (focal_zipper, focal_info_map) = SchoolExercise.focus(exercise, stitched_dynamics); - - InferenceResult.update_annoation_mode(langDocMessages.annotations); + let global_inference_info = + InferenceResult.mk_global_inference_info( + langDocMessages.annotations, + global_inference_info.solution_statuses, + ); let color_highlighting: option(ColorSteps.colorMap) = if (langDocMessages.highlight && langDocMessages.show) { @@ -85,7 +88,7 @@ let view = let map = Statics.mk_map(term); Some( LangDoc.get_color_map( - ~annotation_map, + ~global_inference_info, ~doc=langDocMessages, Indicated.index(focal_zipper), map, @@ -107,6 +110,7 @@ let view = ], ~settings, ~color_highlighting, + ~langDocMessages, ); }; @@ -347,7 +351,7 @@ let view = ~show_lang_doc=langDocMessages.show, focal_zipper, focal_info_map, - annotation_map, + global_inference_info, ), ] : []; @@ -384,7 +388,7 @@ let view = ~doc=langDocMessages, Indicated.index(focal_zipper), focal_info_map, - annotation_map, + global_inference_info, ), ] : [] diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 52eaaa3212..3627242fd6 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -19,15 +19,19 @@ let view = let zipper = editor.state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (info_map, annotation_map) = Statics.mk_map_and_annotations(term); - - InferenceResult.update_annoation_mode(langDocMessages.annotations); + let (info_map, global_inference_solutions) = + Statics.mk_map_and_annotations(term); + let global_inference_info = + InferenceResult.mk_global_inference_info( + langDocMessages.annotations, + global_inference_solutions, + ); let color_highlighting: option(ColorSteps.colorMap) = if (langDocMessages.highlight && langDocMessages.show) { Some( LangDoc.get_color_map( - ~annotation_map, + ~global_inference_info, ~doc=langDocMessages, Indicated.index(zipper), info_map, @@ -51,6 +55,7 @@ let view = ~color_highlighting, ~info_map, ~result, + ~langDocMessages, editor, ); let ci_view = @@ -62,7 +67,7 @@ let view = ~show_lang_doc=langDocMessages.show, zipper, info_map, - annotation_map, + global_inference_info, ), ] : []; @@ -77,7 +82,7 @@ let view = ~doc=langDocMessages, Indicated.index(zipper), info_map, - annotation_map, + global_inference_info, ), ] : []; diff --git a/src/haz3lweb/view/dec/EmptyHoleDec.re b/src/haz3lweb/view/dec/EmptyHoleDec.re index c540da510f..de3617e512 100644 --- a/src/haz3lweb/view/dec/EmptyHoleDec.re +++ b/src/haz3lweb/view/dec/EmptyHoleDec.re @@ -26,7 +26,7 @@ let path = (tip_l, tip_r, offset, s: float) => { let view = ( - ~annotation_map: InferenceResult.annotation_map, + ~global_inference_info: InferenceResult.global_inference_info, ~font_metrics, id, {measurement: {origin, _}, mold}: Profile.t, @@ -41,9 +41,7 @@ let view = {sort, shape: tip_r}, ); let (svg_enabled, unsolved_path_class) = - InferenceResult.annotations_enabled^ - ? InferenceResult.svg_display_settings(~annotation_map, id) - : (true, false); + InferenceResult.svg_display_settings(~global_inference_info, id); let svg_path_class = unsolved_path_class ? "unsolved-empty-hole-path" : "empty-hole-path"; svg_enabled From 2a37937185e653b72eb4315ca824a0dfc41434ef Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 2 Feb 2023 16:11:04 -0500 Subject: [PATCH 029/129] add accept suggestions on clicking enter when to the right of a solved annotation --- src/haz3lcore/inference/ITyp.re | 10 +++++++- src/haz3lcore/inference/InferenceResult.re | 25 ++++---------------- src/haz3lweb/Keyboard.re | 27 +++++++++++++++++++++- 3 files changed, 40 insertions(+), 22 deletions(-) diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index 29466d066e..6fc9741a89 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -40,6 +40,13 @@ let rec typ_to_ityp: Typ.t => t = | Prod([]) => Unit | Var(_) => Unknown(Anonymous); +let unwrap_if_prod = (typ: Typ.t): list(Typ.t) => { + switch (typ) { + | Prod([hd, ...tl]) => [hd, ...tl] + | _ => [typ] + }; +}; + let rec ityp_to_typ: t => Typ.t = fun | Unknown(prov) => Unknown(prov) @@ -51,7 +58,8 @@ let rec ityp_to_typ: t => Typ.t = | Arrow(t1, t2) => Arrow(ityp_to_typ(t1), ityp_to_typ(t2)) | Sum(t1, t2) => Sum(ityp_to_typ(t1), ityp_to_typ(t2)) | Unit => Prod([]) - | Prod(t1, t2) => Prod([ityp_to_typ(t1), ityp_to_typ(t2)]); + | Prod(t1, t2) => + Prod([ityp_to_typ(t1)] @ (t2 |> ityp_to_typ |> unwrap_if_prod)); let to_ityp_constraints = (constraints: Typ.constraints): constraints => { constraints diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index c6d89feda8..15949b4aa0 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -53,11 +53,6 @@ let get_solution_of_id = None; }; -// Used in EmptyHoleDec.view -/** - * If above already solved: Code.view invoked by Cell.editor_view - * who should already have access to all of the above - */ let svg_display_settings = (~global_inference_info: global_inference_info, id: Id.t): (bool, bool) => if (global_inference_info.enabled) { @@ -74,7 +69,6 @@ let svg_display_settings = (true, false); }; -//Only called from uppermost levels where editors live anyway let get_cursor_inspect_result = (~global_inference_info: global_inference_info, id: Id.t) : option((bool, string)) => @@ -91,20 +85,11 @@ let get_cursor_inspect_result = None; }; -// let add_on_new_annotations = (new_map): unit => { -// let add_new_elt = (new_k, new_v) => { -// Hashtbl.replace(accumulated_annotations, new_k, new_v); -// }; -// Hashtbl.iter(add_new_elt, new_map); -// }; - -// called from Update.apply, which has access to the entire Model.t -// to update the model state -// update the model.editors which containts Scratch or School states -// which in turn contain discrete editor.t obj -// let clear_annotations = () => { -// Hashtbl.reset(accumulated_annotations); -// }; +let get_recommended_string = + (~global_inference_info: global_inference_info, id: Id.t): option(string) => { + let+ ityp = get_solution_of_id(id, global_inference_info); + ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string; +}; let condense = (eq_class: MutableEqClass.t, key: ITyp.t): status => { let (eq_class, err) = MutableEqClass.snapshot_class(eq_class, key); diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 9de1edb880..896366670a 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -22,6 +22,14 @@ let update_double_tap = (model: Model.t): list(Update.t) => { let handle_key_event = (k: Key.t, ~model: Model.t): list(Update.t) => { let zipper = Editors.get_zipper(model.editors); + let unselected = Zipper.unselect_and_zip(zipper); + let (term, _) = MakeTerm.go(unselected); + let (_, global_inference_solutions) = Statics.mk_map_and_annotations(term); + let global_inference_info = + InferenceResult.mk_global_inference_info( + model.langDocMessages.annotations, + global_inference_solutions, + ); let restricted = Backpack.restricted(zipper.backpack); let now = a => [Update.PerformAction(a) /*Update.UpdateDoubleTap(None)*/]; let now_save_u = u => Update.[u, Save] /*UpdateDoubleTap(None)*/; @@ -71,7 +79,24 @@ let handle_key_event = (k: Key.t, ~model: Model.t): list(Update.t) => { | (_, "Shift") => update_double_tap(model) | (_, "Enter") => //TODO(andrew): using funky char to avoid weird regexp issues with using \n - now_save(Insert(Whitespace.linebreak)) + let retrieve_string = (): option(string) => { + open Util.OptUtil.Syntax; + let* (p, _) = Zipper.representative_piece(zipper); + InferenceResult.get_recommended_string( + ~global_inference_info, + Piece.id(p), + ); + }; + switch (retrieve_string()) { + | Some(typ_string) => + let explode = s => + List.init(String.length(s), i => String.make(1, s.[i])); + typ_string + |> explode + |> List.map(str => now_save(Insert(str))) + |> List.flatten; + | None => now_save(Insert(Whitespace.linebreak)) + }; | _ when Form.is_valid_char(key) && String.length(key) == 1 => /* TODO(andrew): length==1 is hack to prevent things like F5 which are now valid tokens and also weird From a2e767dc0385d6190694bfed2cbd33eef5d2cf27 Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 2 Feb 2023 22:58:32 -0500 Subject: [PATCH 030/129] small fix related to hole molds --- src/haz3lweb/Keyboard.re | 1 + 1 file changed, 1 insertion(+) diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 896366670a..125decf32f 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -93,6 +93,7 @@ let handle_key_event = (k: Key.t, ~model: Model.t): list(Update.t) => { List.init(String.length(s), i => String.make(1, s.[i])); typ_string |> explode + |> List.filter(s => s != "?") |> List.map(str => now_save(Insert(str))) |> List.flatten; | None => now_save(Insert(Whitespace.linebreak)) From 9fd56304e4c1a1e64aeee13ca6887b27c5f9af37 Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 9 Feb 2023 00:58:34 -0500 Subject: [PATCH 031/129] remove prov specific typing in annotations (makes acceptance suggestion weird) --- src/haz3lcore/statics/Typ.re | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index c58196df23..e3f5b78a4a 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -349,18 +349,10 @@ let rec eq = (t1, t2) => | (Var(_), _) => false }; -let prov_to_string: type_provenance => string = - fun - | Inference(_) - | Internal(_) - | Anonymous => "" - | TypeHole(_) => "𝜏" - | SynSwitch(_) => "⇒"; - let rec typ_to_string = (ty: t): string => //TODO: parens on ops when ambiguous switch (ty) { - | Unknown(prov) => "?" ++ prov_to_string(prov) + | Unknown(_) => "?" | Int => "Int" | Float => "Float" | String => "String" From a4a1f6822e2eb7192c12aa71b49e250169f88558 Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 9 Feb 2023 02:13:14 -0500 Subject: [PATCH 032/129] add documentation (housed in rei files where possible) and did some cleanup --- src/haz3lcore/inference/EqClass.re | 12 +++++++++++- src/haz3lcore/inference/EqGraph.rei | 12 ++++++++++++ src/haz3lcore/inference/Inference.re | 20 ++++++++++++-------- src/haz3lcore/inference/InferenceResult.re | 4 ++-- src/haz3lcore/inference/MutableEqClass.rei | 13 +++++++++++++ src/haz3lcore/statics/Statics.re | 17 +++-------------- src/haz3lcore/zipper/Editor.re | 2 +- src/haz3lweb/Keyboard.re | 3 ++- src/haz3lweb/view/Cell.re | 3 ++- src/haz3lweb/view/Page.re | 2 +- src/haz3lweb/view/ScratchMode.re | 2 +- 11 files changed, 60 insertions(+), 30 deletions(-) diff --git a/src/haz3lcore/inference/EqClass.re b/src/haz3lcore/inference/EqClass.re index ec31d71d22..f4ce8fbb56 100644 --- a/src/haz3lcore/inference/EqClass.re +++ b/src/haz3lcore/inference/EqClass.re @@ -2,6 +2,16 @@ open Util; open OptUtil.Syntax; open Sexplib.Std; +/** + * An EqClass.t is a condensed representation of a list of types. + * It can be a single type, or a composition of other EqClass.t + * + * We use EqClass to maintain all possible combinations of solutions during unification + * and properly report errors/solutions without combinatorial explosion. + * Inconsistent types and types failing an occurs check can be added to the same EqClass without issue, + * preventing unification from ever having to crash. + */ + [@deriving (show({with_path: false}), sexp)] type base_typ = | BUnit @@ -131,7 +141,7 @@ let split_eq_typ: eq_typ => option((t, t)) = | Base(_) => None | Compound(_, eq_class1, eq_class2) => Some((eq_class1, eq_class2)); -// not currently in use +// not currently in use but kept for utility let split_eq_class = (ctor_used: binary_ctor, eq_class: t) => { let split_result_of: eq_typ => split_result = fun diff --git a/src/haz3lcore/inference/EqGraph.rei b/src/haz3lcore/inference/EqGraph.rei index 7c01c27d64..ff5e248c01 100644 --- a/src/haz3lcore/inference/EqGraph.rei +++ b/src/haz3lcore/inference/EqGraph.rei @@ -1,3 +1,15 @@ +/** + * An EqGraph is effectively a map from different types (which for inference, must always contain holes) + * to their current equivalence classes. In some senses, the EqGraph is a condensed representation + * of an undirected graph where all nodes are types and edges constitute equivalences. + * + * For more context: + * The set of all constraints accumulated in static type inference constitutes a series of edges between + * types that can be used to create a graph. + * Consider the connected component a type is a member of. The solution associated with any + * type in a connected component is the least upper bound of all types within it (if it exists). + */ + type t = Hashtbl.t(ITyp.t, MutableEqClass.t); let create: unit => t; diff --git a/src/haz3lcore/inference/Inference.re b/src/haz3lcore/inference/Inference.re index dfeef56a91..c7e3268e61 100644 --- a/src/haz3lcore/inference/Inference.re +++ b/src/haz3lcore/inference/Inference.re @@ -1,11 +1,15 @@ -// NOTE: Current formulation does not unify constraints comparing inconsistent constructors. -// Unifying these would cause EqClasses to be potentially considered invalid without any -// inconsistencies within them, which is a confusing result to represent to a user and may -// pollute other equivalence classes with unhelpful error statuses that static inference can -// already give better results on. -// We decide here that we will only draw inference results on holes and the things these holes -// are compared to through their neighborhood of implied consistencies as governed by attempted -// consistency checks in synthesis and analysis. +/** + * NOTE: + * Current formulation does not unify constraints comparing inconsistent constructors. + * Unifying these would cause EqClasses to be potentially considered invalid without any + * inconsistencies within them, which is a confusing result to represent to a user and may + * pollute other equivalence classes with unhelpful error statuses that static inference can + * already give better results on. + * We decide here that we will only draw inference results on holes and the things these holes + * are compared to through their neighborhood of implied consistencies as governed by attempted + * consistency checks in synthesis and analysis. + */ +// A unification algorithm based on Hindley-Milner unification adjusted so it does not fail let rec unify = (eq_graph: EqGraph.t, constraints: ITyp.constraints): unit => { List.iter(unify_one(eq_graph), constraints); } diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 15949b4aa0..171f483b89 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -13,14 +13,14 @@ type global_inference_info = { solution_statuses: type_hole_to_solution, }; -let empty_annotations = (): type_hole_to_solution => Hashtbl.create(20); +let empty_solutions = (): type_hole_to_solution => Hashtbl.create(20); let mk_global_inference_info = (enabled, annotations) => { {enabled, solution_statuses: annotations}; }; let empty_info = (): global_inference_info => - mk_global_inference_info(true, empty_annotations()); + mk_global_inference_info(true, empty_solutions()); let get_desired_solutions = (inference_results: list(t)): type_hole_to_solution => { diff --git a/src/haz3lcore/inference/MutableEqClass.rei b/src/haz3lcore/inference/MutableEqClass.rei index 85e1da7ea3..4744c356d2 100644 --- a/src/haz3lcore/inference/MutableEqClass.rei +++ b/src/haz3lcore/inference/MutableEqClass.rei @@ -1,3 +1,16 @@ +/** + * A mutable version of the EqClass.t type that allows extension via UnionFind + * such that if one foo: MutableEqClass.t is extended (or unioned) with + * bar: MutableEqClass.t, both EqClasses and all sub-EqClasses contained + * within them are union-found with each other. + * Consequently, if either foo or bar are extended with another MutableEqClass, + * both will have access to the fully updated EqClass without need to dfs + * (as will their children). + * + * NOTE: Preferred usage when not extending/unioning is to call MutableEqClass.snapshot_class + * to get an immutable EqClass and perform computation on that instead to avoid bugs. + */ + type error_status = | Occurs; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 8ac64f179d..7e971298f4 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -810,17 +810,7 @@ and utyp_to_info_map = ({ids, term} as utyp: Term.UTyp.t): (Typ.t, map) => { }; }; -// Needs to populate editor.state sometimes... -// Specifically, if we care about annotations -// I think its only necessary from: -// Perform.go_z (called by someone (Perform.go) with an editor) -// ScratchMode.view (has editor) -// Cell.get_elab (has editor) -// ScratchSlide.spliced_elabs (has editor) -// -// Others from LangDoc, EditorUtil, SchoolMode, SchoolExercises -// omitted due to lack of necessity (want only info_map, or color_map, only for validation, etc) -let mk_map_and_annotations = +let mk_map_and_inference_solutions = Core.Memo.general( ~cache_size_bound=1000, e => { @@ -831,13 +821,12 @@ let mk_map_and_annotations = let global_inference_solutions = InferenceResult.get_desired_solutions(inference_results); - // InferenceResult.add_on_new_annotations(annotation_map); - (info_map, global_inference_solutions); }, ); + let mk_map = e => { - let (info_map, _) = mk_map_and_annotations(e); + let (info_map, _) = mk_map_and_inference_solutions(e); info_map; }; diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 1278c3a7bc..2029a1c94b 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -55,7 +55,7 @@ module Meta = { let (term, _) = MakeTerm.go(unselected); // TODO Raef: add in flow for the enabled flag let (_, global_inference_solutions) = - Statics.mk_map_and_annotations(term); + Statics.mk_map_and_inference_solutions(term); let measured = Measured.of_segment( ~touched, diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 1169437e60..430f654ae5 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -24,7 +24,8 @@ let handle_key_event = (k: Key.t, ~model: Model.t): list(Update.t) => { let zipper = Editors.get_zipper(model.editors); let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, global_inference_solutions) = Statics.mk_map_and_annotations(term); + let (_, global_inference_solutions) = + Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( model.langDocMessages.annotations, diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index df62bfe4c1..e898ea65c6 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -276,7 +276,8 @@ let editor_view = let segment = Zipper.zip(zipper); let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, global_inference_solutions) = Statics.mk_map_and_annotations(term); + let (_, global_inference_solutions) = + Statics.mk_map_and_inference_solutions(term); let measured = editor.state.meta.measured; let global_inference_info = InferenceResult.mk_global_inference_info( diff --git a/src/haz3lweb/view/Page.re b/src/haz3lweb/view/Page.re index e205d4a790..840da3836b 100644 --- a/src/haz3lweb/view/Page.re +++ b/src/haz3lweb/view/Page.re @@ -234,7 +234,7 @@ let main_ui_view = let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); let (_, global_inference_solutions) = - Statics.mk_map_and_annotations(term); + Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 7e70866167..ebdb77f482 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -20,7 +20,7 @@ let view = let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); let (info_map, global_inference_solutions) = - Statics.mk_map_and_annotations(term); + Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, From 24a96d9157b6d2dde616ca5559031ab7c67368cc Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Mon, 27 Feb 2023 23:32:07 -0600 Subject: [PATCH 033/129] updated UI --- src/haz3lcore/inference/EqClass.re | 14 ++++++++++---- src/haz3lcore/inference/InferenceResult.re | 19 +++++++++++++++++++ src/haz3lweb/view/Code.re | 12 +++++++----- src/haz3lweb/view/CursorInspector.re | 4 ++-- src/haz3lweb/view/Type.re | 4 ++-- src/haz3lweb/view/dec/EmptyHoleDec.re | 22 +++++++++++++++------- src/haz3lweb/www/style.css | 6 +++++- 7 files changed, 60 insertions(+), 21 deletions(-) diff --git a/src/haz3lcore/inference/EqClass.re b/src/haz3lcore/inference/EqClass.re index f4ce8fbb56..68e672c18f 100644 --- a/src/haz3lcore/inference/EqClass.re +++ b/src/haz3lcore/inference/EqClass.re @@ -397,7 +397,13 @@ let rec string_of_eq_class = (eq_class: t): string => | [hd] => string_of_eq_typ(hd) | [hd, ...tl] => let hd_str = string_of_eq_typ(hd); - String.concat("//", [hd_str, string_of_eq_class(tl)]); + String.concat(" // ", [hd_str, string_of_eq_class(tl)]); + } +and string_of_eq_class_no_nesting = (eq_class: t): string => + switch (eq_class) { + | [] => "" + | [hd] => string_of_eq_typ(hd) + | [_hd, ..._tl] => "?" } and string_of_eq_typ = (eq_typ: eq_typ) => switch (eq_typ) { @@ -405,7 +411,7 @@ and string_of_eq_typ = (eq_typ: eq_typ) => | Compound(ctor, eq_class_lt, eq_class_rt) => let (ctor_start, ctor_string, ctor_end) = switch (ctor) { - | CArrow => ("", " -> (", ")") + | CArrow => ("(", " -> ", ")") | CProd => ("(", ", ", ")") | CSum => ("", " + (", ")") }; @@ -414,9 +420,9 @@ and string_of_eq_typ = (eq_typ: eq_typ) => "", [ ctor_start, - string_of_eq_class(eq_class_lt), + string_of_eq_class_no_nesting(eq_class_lt), ctor_string, - string_of_eq_class(eq_class_rt), + string_of_eq_class_no_nesting(eq_class_rt), ctor_end, ], ); diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 171f483b89..e9cb47683d 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -39,6 +39,25 @@ let get_desired_solutions = new_map; }; +type solution = + | Solved(ITyp.t) + | Unsolved + | NotTypeHole; + +let get_solution_of_id2 = + (id: Id.t, global_inference_info: global_inference_info): solution => + if (global_inference_info.enabled) { + let status = + Hashtbl.find_opt(global_inference_info.solution_statuses, id); + switch (status) { + | Some(Solved(ityp)) => Solved(ityp) + | Some(Unsolved(_)) => Unsolved + | None => NotTypeHole + }; + } else { + NotTypeHole; + }; + let get_solution_of_id = (id: Id.t, global_inference_info: global_inference_info): option(ITyp.t) => if (global_inference_info.enabled) { diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 8228f74343..7af0c39a68 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -39,14 +39,16 @@ let of_delim = let of_grout = (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) => { - let solution_opt = - InferenceResult.get_solution_of_id(id, global_inference_info); - switch (solution_opt) { - | Some(ityp) => [ + let solution: InferenceResult.solution = + InferenceResult.get_solution_of_id2(id, global_inference_info); + switch (solution) { + | Solved(Unknown(_)) + | NotTypeHole => [Node.text(Unicode.nbsp)] + | Solved(ityp) => [ [ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> Node.text] |> span_c("solved-annotation"), ] - | None => [Node.text(Unicode.nbsp)] + | Unsolved => [["?" |> Node.text] |> span_c("unsolved-annotation")] }; }; diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index d124d252b3..0b3e1daa68 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -217,9 +217,9 @@ let view_of_global_inference_info = ) | Some((false, error_message)) => div( - ~attr=clss(["infoc", "typ"]), + ~attr=clss([infoc, "typ"]), [ - text("and has inferred type "), + text("and has conflicting constraints: "), span_c("unsolved-cursor-inspect", [text(error_message)]), ], ) diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 17e453de78..9da9bd80f8 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -9,8 +9,8 @@ let prov_view: Haz3lcore.Typ.type_provenance => Node.t = fun | Inference(_) => div([]) | Internal(_) => div([]) - | TypeHole(_) => - div(~attr=clss(["typ-mod", "type-hole"]), [text("𝜏")]) + | TypeHole(_) => div([]) + // div(~attr=clss(["typ-mod", "type-hole"]), [text("𝜏")]) | SynSwitch(_) => div(~attr=clss(["typ-mod", "syn-switch"]), [text("⇒")]) | Anonymous => div([]); diff --git a/src/haz3lweb/view/dec/EmptyHoleDec.re b/src/haz3lweb/view/dec/EmptyHoleDec.re index de3617e512..1ecd80c5aa 100644 --- a/src/haz3lweb/view/dec/EmptyHoleDec.re +++ b/src/haz3lweb/view/dec/EmptyHoleDec.re @@ -45,12 +45,20 @@ let view = let svg_path_class = unsolved_path_class ? "unsolved-empty-hole-path" : "empty-hole-path"; svg_enabled - ? DecUtil.code_svg( - ~font_metrics, - ~origin, - ~base_cls=["empty-hole"], - ~path_cls=[svg_path_class, c_cls], - path(tip_l, tip_r, 0., 0.28), - ) + ? unsolved_path_class + ? DecUtil.code_svg( + ~font_metrics, + ~origin, + ~base_cls=["empty-hole"], + ~path_cls=[svg_path_class, c_cls], + path(tip_l, tip_r, 0., 0.58), + ) + : DecUtil.code_svg( + ~font_metrics, + ~origin, + ~base_cls=["empty-hole"], + ~path_cls=[svg_path_class, c_cls], + path(tip_l, tip_r, 0., 0.28), + ) : Node.none; }; diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index 31f72fb261..83db46302d 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -703,7 +703,11 @@ body { /* INFERENCE ANNOTATIONS */ .solved-annotation { - color:rgb(178, 178, 178); + color: rgb(178, 178, 178); +} + +.unsolved-annotation { + color: rgb(168, 66, 66); } .unsolved-cursor-inspect { From ea15b866d093adc6457b841d578643f4be7ccf4f Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Mon, 27 Feb 2023 23:39:26 -0600 Subject: [PATCH 034/129] dotted line around unsolved type hole --- src/haz3lweb/www/style.css | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index 83db46302d..c84306b360 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -575,8 +575,9 @@ body { .unsolved-empty-hole-path { fill: #f0d1d1; - stroke: #dba7a7; - stroke-width: 0.75px; + stroke: var(--err-color); + stroke-width: 1.2px; + stroke-dasharray: 1, 1; vector-effect: non-scaling-stroke; } From e2645a1d95cfa6750a60426ec4a377b0919e8230 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Tue, 28 Feb 2023 23:12:15 -0600 Subject: [PATCH 035/129] removed ? from CI and added ! to unsolved hole in editor --- src/haz3lweb/view/Code.re | 2 +- src/haz3lweb/view/CursorInspector.re | 97 +++++++++++++++++----------- src/haz3lweb/view/Type.re | 11 ++-- src/haz3lweb/www/style.css | 10 ++- 4 files changed, 73 insertions(+), 47 deletions(-) diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 7af0c39a68..7e77a24a68 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -48,7 +48,7 @@ let of_grout = [ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> Node.text] |> span_c("solved-annotation"), ] - | Unsolved => [["?" |> Node.text] |> span_c("unsolved-annotation")] + | Unsolved => [["!" |> Node.text] |> span_c("unsolved-annotation")] }; }; diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 0b3e1daa68..0f31c42e05 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -133,8 +133,43 @@ let term_tag = (~inject, ~show_lang_doc, is_err, sort) => { ); }; +let view_of_global_inference_info = + ( + ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, + id: int, + ) => { + switch ( + Haz3lcore.InferenceResult.get_cursor_inspect_result( + ~global_inference_info, + id, + ) + ) { + | Some((true, solution)) => + div( + ~attr=clss([infoc, "typ"]), + [text("has inferred type "), text(solution)], + ) + | Some((false, error_message)) => + div( + ~attr=clss([infoc, "typ"]), + [ + text("has conflicting constraints: "), + span_c("unsolved-cursor-inspect", [text(error_message)]), + ], + ) + | None => div([]) + }; +}; + let view_of_info = - (~inject, ~show_lang_doc: bool, ci: Haz3lcore.Statics.t): Node.t => { + ( + ~inject, + ~show_lang_doc: bool, + ~global_inference_info, + id: int, + ci: Haz3lcore.Statics.t, + ) + : Node.t => { let is_err = Haz3lcore.Statics.is_error(ci); switch (ci) { | Invalid(msg) => @@ -169,14 +204,27 @@ let view_of_info = ], ) | InfoTyp({self: Just(ty), _}) => - div( - ~attr=clss([infoc, "typ"]), - [ - term_tag(~inject, ~show_lang_doc, is_err, "typ"), - text("is"), - Type.view(ty), - ], - ) + switch ( + Haz3lcore.InferenceResult.get_solution_of_id2(id, global_inference_info) + ) { + | NotTypeHole => + div( + ~attr=clss([infoc, "typ"]), + [ + term_tag(~inject, ~show_lang_doc, is_err, "typ"), + text("is"), + Type.view(ty), + ], + ) + | _ => + div( + ~attr=clss([infoc, "typ"]), + [ + term_tag(~inject, ~show_lang_doc, is_err, "typ"), + view_of_global_inference_info(~global_inference_info, id), + ], + ) + } | InfoTyp({self: _, _}) => failwith("CursorInspector: Impossible type error") | InfoRul(_) => @@ -199,34 +247,6 @@ let extra_view = (visible: bool, id: int, ci: Haz3lcore.Statics.t): Node.t => [id_view(id), cls_view(ci)], ); -let view_of_global_inference_info = - ( - ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, - id: int, - ) => { - switch ( - Haz3lcore.InferenceResult.get_cursor_inspect_result( - ~global_inference_info, - id, - ) - ) { - | Some((true, solution)) => - div( - ~attr=clss([infoc, "typ"]), - [text("and has inferred type "), text(solution)], - ) - | Some((false, error_message)) => - div( - ~attr=clss([infoc, "typ"]), - [ - text("and has conflicting constraints: "), - span_c("unsolved-cursor-inspect", [text(error_message)]), - ], - ) - | None => div([]) - }; -}; - let toggle_context_and_print_ci = (~inject: Update.t => 'a, ci, _) => { print_endline(Haz3lcore.Statics.show(ci)); switch (ci) { @@ -261,8 +281,7 @@ let inspector_view = ]), [ extra_view(settings.context_inspector, id, ci), - view_of_info(~inject, ~show_lang_doc, ci), - view_of_global_inference_info(~global_inference_info, id), + view_of_info(~inject, ~show_lang_doc, ~global_inference_info, id, ci), CtxInspector.inspector_view(~inject, ~settings, id, ci), ], ); diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 9da9bd80f8..f4676d8b0c 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -18,11 +18,12 @@ let prov_view: Haz3lcore.Typ.type_provenance => Node.t = let rec view = (ty: Haz3lcore.Typ.t): Node.t => //TODO: parens on ops when ambiguous switch (ty) { - | Unknown(prov) => - div( - ~attr=clss(["typ-view", "atom", "unknown"]), - [text("?"), prov_view(prov)], - ) + | Unknown(_) => + // div( + // ~attr=clss(["typ-view", "atom", "unknown"]), + // [text("?"), prov_view(prov)], + // ) + div(~attr=clss(["typ-view", "atom", "unknown"]), [text("")]) | Int => ty_view("Int", "Int") | Float => ty_view("Float", "Float") | String => ty_view("String", "String") diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index c84306b360..f72a4ebee7 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -574,11 +574,17 @@ body { } .unsolved-empty-hole-path { - fill: #f0d1d1; + /* fill: #f0d1d1; stroke: var(--err-color); stroke-width: 1.2px; stroke-dasharray: 1, 1; + vector-effect: non-scaling-stroke; */ + fill: #d001; + stroke-dasharray: 1, 1; + stroke: var(--err-color); + stroke-width: 1.2px; vector-effect: non-scaling-stroke; + /* mix-blend-mode: color;*/ } .selection { @@ -708,7 +714,7 @@ body { } .unsolved-annotation { - color: rgb(168, 66, 66); + color: rgb(229, 30, 30); } .unsolved-cursor-inspect { From 7d5925a4d229a6978507b602514c0da6f2bec411 Mon Sep 17 00:00:00 2001 From: RaefM Date: Wed, 1 Mar 2023 18:23:40 -0500 Subject: [PATCH 036/129] renames eqclasses to potential type sets --- src/haz3lcore/inference/EqClass.re | 436 --------------- src/haz3lcore/inference/EqGraph.re | 83 --- src/haz3lcore/inference/Inference.re | 40 +- src/haz3lcore/inference/InferenceResult.re | 34 +- src/haz3lcore/inference/MutableEqClass.re | 224 -------- src/haz3lcore/inference/MutableEqClass.rei | 33 -- .../inference/MutablePotentialTypeSet.re | 265 +++++++++ .../inference/MutablePotentialTypeSet.rei | 35 ++ src/haz3lcore/inference/PTSGraph.re | 103 ++++ .../inference/{EqGraph.rei => PTSGraph.rei} | 6 +- src/haz3lcore/inference/PotentialTypeSet.re | 525 ++++++++++++++++++ 11 files changed, 974 insertions(+), 810 deletions(-) delete mode 100644 src/haz3lcore/inference/EqClass.re delete mode 100644 src/haz3lcore/inference/EqGraph.re delete mode 100644 src/haz3lcore/inference/MutableEqClass.re delete mode 100644 src/haz3lcore/inference/MutableEqClass.rei create mode 100644 src/haz3lcore/inference/MutablePotentialTypeSet.re create mode 100644 src/haz3lcore/inference/MutablePotentialTypeSet.rei create mode 100644 src/haz3lcore/inference/PTSGraph.re rename src/haz3lcore/inference/{EqGraph.rei => PTSGraph.rei} (82%) create mode 100644 src/haz3lcore/inference/PotentialTypeSet.re diff --git a/src/haz3lcore/inference/EqClass.re b/src/haz3lcore/inference/EqClass.re deleted file mode 100644 index 68e672c18f..0000000000 --- a/src/haz3lcore/inference/EqClass.re +++ /dev/null @@ -1,436 +0,0 @@ -open Util; -open OptUtil.Syntax; -open Sexplib.Std; - -/** - * An EqClass.t is a condensed representation of a list of types. - * It can be a single type, or a composition of other EqClass.t - * - * We use EqClass to maintain all possible combinations of solutions during unification - * and properly report errors/solutions without combinatorial explosion. - * Inconsistent types and types failing an occurs check can be added to the same EqClass without issue, - * preventing unification from ever having to crash. - */ - -[@deriving (show({with_path: false}), sexp)] -type base_typ = - | BUnit - | BInt - | BFloat - | BBool - | BString - | BUnknown(Typ.type_provenance); - -[@deriving (show({with_path: false}), sexp)] -type unary_ctor = - | CList; - -[@deriving (show({with_path: false}), sexp)] -type binary_ctor = - | CArrow - | CProd - | CSum; - -[@deriving (show({with_path: false}), sexp)] -type t = list(eq_typ) -and eq_typ = - | Base(base_typ) - | Mapped(unary_ctor, t) - | Compound(binary_ctor, t, t); - -let mk_as_binary_ctor = (ctor: binary_ctor, ty1: ITyp.t, ty2: ITyp.t): ITyp.t => { - switch (ctor) { - | CArrow => Arrow(ty1, ty2) - | CProd => Prod(ty1, ty2) - | CSum => Sum(ty1, ty2) - }; -}; - -let mk_as_unary_ctor = (ctor: unary_ctor, ty: ITyp.t): ITyp.t => { - switch (ctor) { - | CList => List(ty) - }; -}; - -let rec ityp_to_eq_typ: ITyp.t => eq_typ = - fun - | Unknown(prov) => Base(BUnknown(prov)) - | Int => Base(BInt) - | Unit => Base(BUnit) - | Float => Base(BFloat) - | Bool => Base(BBool) - | String => Base(BString) - | Arrow(ty1, ty2) => - Compound(CArrow, [ityp_to_eq_typ(ty1)], [ityp_to_eq_typ(ty2)]) - | Prod(ty1, ty2) => - Compound(CProd, [ityp_to_eq_typ(ty1)], [ityp_to_eq_typ(ty2)]) - | Sum(ty1, ty2) => - Compound(CProd, [ityp_to_eq_typ(ty1)], [ityp_to_eq_typ(ty2)]) - | List(ty) => Mapped(CList, [ityp_to_eq_typ(ty)]); - -let typ_to_eq_typ: Typ.t => eq_typ = - typ => { - typ |> ITyp.typ_to_ityp |> ityp_to_eq_typ; - }; - -let base_typ_to_ityp: base_typ => ITyp.t = - fun - | BInt => Int - | BFloat => Float - | BBool => Bool - | BString => String - | BUnit => Unit - | BUnknown(prov) => Unknown(prov); - -let rec extend_with_eq_class = (target: t, eq_class_extension: t) => { - switch (eq_class_extension) { - | [] => target - | [eq_typ_extension, ...extension_tl] => - let target = extend_with_eq_typ(target, eq_typ_extension); - extend_with_eq_class(target, extension_tl); - }; -} -and extend_with_eq_typ = (target: t, eq_typ_extension: eq_typ) => { - switch (target) { - | [] => [eq_typ_extension] - | [target_hd, ...target_tl] => - let extend_target_tl: unit => t = ( - () => { - [target_hd, ...extend_with_eq_typ(target_tl, eq_typ_extension)]; - } - ); - switch (target_hd, eq_typ_extension) { - | (_, Base(_)) => - target_hd == eq_typ_extension ? target : extend_target_tl() - | (Mapped(hd_ctor, hd_eq_class), Mapped(eq_typ_ctor, eq_class)) => - hd_ctor == eq_typ_ctor - ? [ - Mapped(hd_ctor, extend_with_eq_class(hd_eq_class, eq_class)), - ...target_tl, - ] - : extend_target_tl() - | ( - Compound(hd_ctor, hd_eq_class_lt, hd_eq_class_rt), - Compound(eq_typ_ctor, eq_class_lt, eq_class_rt), - ) => - if (hd_ctor == eq_typ_ctor) { - let hd_eq_class_lt = - extend_with_eq_class(hd_eq_class_lt, eq_class_lt); - let hd_eq_class_rt = - extend_with_eq_class(hd_eq_class_rt, eq_class_rt); - [Compound(hd_ctor, hd_eq_class_lt, hd_eq_class_rt), ...target_tl]; - } else { - extend_target_tl(); - } - | (Base(_) | Mapped(_), Compound(_)) - | (Base(_) | Compound(_), Mapped(_)) => extend_target_tl() - }; - }; -}; - -type split_result = - | Success - | Error(split_error_status) -and split_error_status = - | Unsplittable - | WrongCtor; - -let split_eq_typ: eq_typ => option((t, t)) = - fun - | Mapped(_) - | Base(_) => None - | Compound(_, eq_class1, eq_class2) => Some((eq_class1, eq_class2)); - -// not currently in use but kept for utility -let split_eq_class = (ctor_used: binary_ctor, eq_class: t) => { - let split_result_of: eq_typ => split_result = - fun - | Base(ty) => - switch (ty) { - | BUnknown(_) => Success - | _ => Error(Unsplittable) - } - | Mapped(_) => Error(Unsplittable) - | Compound(ctor, _, _) => ctor_used == ctor ? Success : Error(WrongCtor); - - let accumulate_splits = - ((acc_class_lt, acc_class_rt): (t, t), eq_typ: eq_typ) => { - switch (split_eq_typ(eq_typ)) { - | None => (acc_class_lt, acc_class_rt) - | Some((eq_class_lt, eq_class_rt)) => - let acc_class_lt = extend_with_eq_class(acc_class_lt, eq_class_lt); - let acc_class_rt = extend_with_eq_class(acc_class_rt, eq_class_rt); - (acc_class_lt, acc_class_rt); - }; - }; - - let (eq_class_lt, eq_class_rt) = - List.fold_left(accumulate_splits, ([], []), eq_class); - - // Unsplittable errors take precedence over WrongCtor due to strictly more severe error handling - let rec check_ctor = - (eq_class: t, wrong_ctor_error_found: bool): split_result => { - switch (eq_class) { - | [] => wrong_ctor_error_found ? Error(WrongCtor) : Success - | [hd, ...tl] => - switch (split_result_of(hd)) { - | Error(Unsplittable) as e => e - | Error(WrongCtor) => check_ctor(tl, true) - | _ => check_ctor(tl, wrong_ctor_error_found) - } - }; - }; - - (check_ctor(eq_class, false), eq_class_lt, eq_class_rt); -}; - -let fuse = (ctor_used: binary_ctor, eq_class_lt: t, eq_class_rt: t) => { - Compound(ctor_used, eq_class_lt, eq_class_rt); -}; - -let rec target_typ_is_in_eq_class = (target_typ: eq_typ, eq_class: t): bool => { - // is target_typ ∈ eq_class? this would make them equal (via transitivity) - switch (eq_class) { - | [] => false - | [hd, ...tl] => - target_typ_is_in_eq_typ(target_typ, hd) - || target_typ_is_in_eq_class(target_typ, tl) - }; -} -and target_typ_is_in_eq_typ = (target_typ: eq_typ, eq_typ: eq_typ): bool => { - switch (target_typ, eq_typ) { - | (_, Base(_)) => target_typ == eq_typ - | (Mapped(target_ctor, target_eq_class), Mapped(ctor, eq_class)) => - target_ctor == ctor - && target_class_is_in_eq_class(target_eq_class, eq_class) - | ( - Compound(target_ctor, target_class_lt, target_class_rt), - Compound(ctor, eq_class_lt, eq_class_rt), - ) => - target_ctor == ctor - && target_class_is_in_eq_class(target_class_lt, eq_class_lt) - && target_class_is_in_eq_class(target_class_rt, eq_class_rt) - | (Base(_) | Compound(_), Mapped(_)) - | (Base(_) | Mapped(_), Compound(_)) => false - }; -} -and target_class_is_in_eq_class = (target_class: t, eq_class: t): bool => { - // is target_class ∈ eq_class? this would make them equal (via transitivity) - let target_typ_contained = (target_typ: eq_typ): bool => { - target_typ_is_in_eq_class(target_typ, eq_class); - }; - List.for_all(target_typ_contained, target_class); -}; - -let rec target_typ_used_in_eq_class = (target_typ: eq_typ, eq_class: t): bool => { - // is [target_typ] ⊆ eq_class? - switch (eq_class) { - | [] => false - | [hd, ...tl] => - target_typ_used_in_eq_typ(target_typ, hd) - || target_typ_used_in_eq_class(target_typ, tl) - }; -} -and target_typ_used_in_eq_typ = (target_typ: eq_typ, eq_typ: eq_typ): bool => { - // target used inside, or is represented by the eq_typ itself - switch (target_typ, eq_typ) { - | (_, Base(_)) => target_typ == eq_typ - | (Mapped(_), Mapped(_, eq_class)) => - target_typ_used_in_eq_class(target_typ, eq_class) - || target_typ_is_in_eq_typ(target_typ, eq_typ) - | (Compound(_), Compound(_, eq_class_lt, eq_class_rt)) => - target_typ_used_in_eq_class(target_typ, eq_class_lt) - || target_typ_used_in_eq_class(target_typ, eq_class_rt) - || target_typ_is_in_eq_typ(target_typ, eq_typ) - | (Base(_) | Compound(_), Mapped(_, eq_class)) => - target_typ_used_in_eq_class(target_typ, eq_class) - | (Base(_) | Mapped(_), Compound(_, eq_class_lt, eq_class_rt)) => - target_typ_is_in_eq_class(target_typ, eq_class_lt) - || target_typ_is_in_eq_class(target_typ, eq_class_rt) - }; -} -and target_class_used_in_eq_class = (target_class: t, eq_class: t): bool => { - // is target_class ⊆ eq_class? - let target_typ_used = (target_typ: eq_typ): bool => { - target_typ_used_in_eq_class(target_typ, eq_class); - }; - // every target typ must be used in the eq class for the whole target class to have been used - List.for_all(target_typ_used, target_class); -}; - -let rec target_typ_in_domain_but_not_equal = - (eq_class: t, target_typ: eq_typ): bool => { - List.exists(target_typ_in_domain_but_not_equal_typ(target_typ), eq_class); -} -and target_typ_in_domain_but_not_equal_typ = - (target_typ: eq_typ, eq_typ: eq_typ): bool => { - // is target_typ ⊂ eq_typ? - // NOTE: - // target_typ != eq_typ ^ target_typ ⊆ eq_typ - // => target_typ ⊂ eq_typ - !target_typ_is_in_eq_typ(target_typ, eq_typ) - && target_typ_used_in_eq_typ(target_typ, eq_typ); -}; - -let is_known: eq_typ => bool = - fun - | Base(BUnknown(_)) => false - | _ => true; - -let rec filter_unneeded_holes_class = - (comp: eq_typ => bool, remove: bool, eq_class: t): t => { - switch (eq_class) { - | [] => [] - | [hd, ...tl] => - let (had_hole, filtered_hd_opt) = - filter_unneeded_holes_typ(comp, remove, hd); - let remove = had_hole || remove; - switch (filtered_hd_opt) { - | None => filter_unneeded_holes_class(comp, remove, tl) - | Some(filtered_hd) => [ - filtered_hd, - ...filter_unneeded_holes_class(comp, remove, tl), - ] - }; - }; -} -and filter_unneeded_holes_typ = - (comp: eq_typ => bool, remove: bool, eq_typ: eq_typ) - : (bool, option(eq_typ)) => { - switch (eq_typ) { - | Base(btyp) => - switch (btyp) { - | BUnknown(_) => - let eq_tp_opt = remove ? None : Some(eq_typ); - (true, eq_tp_opt); - | _ => (false, Some(eq_typ)) - } - | Mapped(ctor, eq_class) => - let delete_holes = List.exists(comp, eq_class); - let eq_class = filter_unneeded_holes_class(comp, delete_holes, eq_class); - (false, Some(Mapped(ctor, eq_class))); - | Compound(ctor, eq_class_lt, eq_class_rt) => - let delete_holes_lt = List.exists(comp, eq_class_lt); - let delete_holes_rt = List.exists(comp, eq_class_rt); - let eq_class_lt = - filter_unneeded_holes_class(comp, delete_holes_lt, eq_class_lt); - let eq_class_rt = - filter_unneeded_holes_class(comp, delete_holes_rt, eq_class_rt); - (false, Some(Compound(ctor, eq_class_lt, eq_class_rt))); - }; -}; - -let filter_unneeded_holes = (comp: eq_typ => bool, eq_class: t): t => { - let delete_holes = List.exists(comp, eq_class); - filter_unneeded_holes_class(comp, delete_holes, eq_class); -}; - -let rec filtered_eq_class_to_typ: t => option(ITyp.t) = - fun - | [] => None - | [Base(btyp)] => Some(btyp |> base_typ_to_ityp) - | [Compound(ctor, eq_class_lt, eq_class_rt)] => { - let* typ1 = filtered_eq_class_to_typ(eq_class_lt); - let+ typ2 = filtered_eq_class_to_typ(eq_class_rt); - mk_as_binary_ctor(ctor, typ1, typ2); - } - | [Mapped(ctor, eq_class)] => { - let+ elt_typ = filtered_eq_class_to_typ(eq_class); - mk_as_unary_ctor(ctor, elt_typ); - } - | _ => None; - -let comp_eq_typ = (eq_typ1: eq_typ, eq_typ2: eq_typ): int => { - let strip_id_from_prov: Typ.type_provenance => float = - fun - | SynSwitch(id) - | TypeHole(id) - | Internal(id) => - id == 0 ? (-2.0) : Float.sub(0.0, Float.div(1.0, float_of_int(id))) - | _ => 0.0; - - let eq_typ_to_float: eq_typ => float = - fun - | Base(BInt) - | Base(BUnit) - | Base(BFloat) - | Base(BString) - | Base(BBool) => 1.0 - | Base(BUnknown(prov)) => strip_id_from_prov(prov) - | Compound(_) => 2.0 - | Mapped(_) => 3.0; - - Stdlib.compare(eq_typ_to_float(eq_typ1), eq_typ_to_float(eq_typ2)); -}; - -let rec sort_eq_class = (eq_class: t): t => { - let eq_class = List.fast_sort(comp_eq_typ, eq_class); - sort_eq_class_explore(eq_class); -} -and sort_eq_class_explore = (eq_class: t): t => { - switch (eq_class) { - | [] => [] - | [hd, ...tl] => - switch (hd) { - | Base(_) => [hd, ...sort_eq_class_explore(tl)] - | Mapped(ctor, eq_class_arg) => - let sorted_class = sort_eq_class(eq_class_arg); - [Mapped(ctor, sorted_class), ...sort_eq_class(tl)]; - | Compound(ctor, eq_class_lt, eq_class_rt) => - let sorted_class_lt = sort_eq_class(eq_class_lt); - let sorted_class_rt = sort_eq_class(eq_class_rt); - [ - Compound(ctor, sorted_class_lt, sorted_class_rt), - ...sort_eq_class_explore(tl), - ]; - } - }; -}; - -let string_of_btyp = (btyp: base_typ): string => { - btyp |> base_typ_to_ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string; -}; - -let rec string_of_eq_class = (eq_class: t): string => - switch (eq_class) { - | [] => "" - | [hd] => string_of_eq_typ(hd) - | [hd, ...tl] => - let hd_str = string_of_eq_typ(hd); - String.concat(" // ", [hd_str, string_of_eq_class(tl)]); - } -and string_of_eq_class_no_nesting = (eq_class: t): string => - switch (eq_class) { - | [] => "" - | [hd] => string_of_eq_typ(hd) - | [_hd, ..._tl] => "?" - } -and string_of_eq_typ = (eq_typ: eq_typ) => - switch (eq_typ) { - | Base(btyp) => string_of_btyp(btyp) - | Compound(ctor, eq_class_lt, eq_class_rt) => - let (ctor_start, ctor_string, ctor_end) = - switch (ctor) { - | CArrow => ("(", " -> ", ")") - | CProd => ("(", ", ", ")") - | CSum => ("", " + (", ")") - }; - - String.concat( - "", - [ - ctor_start, - string_of_eq_class_no_nesting(eq_class_lt), - ctor_string, - string_of_eq_class_no_nesting(eq_class_rt), - ctor_end, - ], - ); - | Mapped(ctor, eq_class) => - let (start_text, end_text) = - switch (ctor) { - | CList => ("[", "]") - }; - - String.concat("", [start_text, string_of_eq_class(eq_class), end_text]); - }; diff --git a/src/haz3lcore/inference/EqGraph.re b/src/haz3lcore/inference/EqGraph.re deleted file mode 100644 index 12dea05b58..0000000000 --- a/src/haz3lcore/inference/EqGraph.re +++ /dev/null @@ -1,83 +0,0 @@ -type t = Hashtbl.t(ITyp.t, MutableEqClass.t); - -let expected_size: int = 50; - -let create = (): t => { - Hashtbl.create(expected_size); -}; - -let add = (eq_graph: t, key: ITyp.t, mut_eq_class: MutableEqClass.t): unit => { - switch (Hashtbl.find_opt(eq_graph, key)) { - | Some(curr_mut_eq_class) => - MutableEqClass.union(curr_mut_eq_class, mut_eq_class) - | None => Hashtbl.add(eq_graph, key, mut_eq_class) - }; -}; - -let add_typ_as_node = (eq_graph: t, typ: ITyp.t): unit => { - let (keys, values) = MutableEqClass.derive_nested_keys_and_eq_classes(typ); - List.iter2(add(eq_graph), keys, values); -}; - -let equate_nodes = (eq_graph: t, typ1: ITyp.t, typ2: ITyp.t): unit => { - let elem1 = Hashtbl.find(eq_graph, typ1); - let elem2 = Hashtbl.find(eq_graph, typ2); - - MutableEqClass.union(elem1, elem2); -}; - -let equate_node_to_primitive_typ = - (eq_graph: t, node_key: ITyp.t, equated_typ: ITyp.t): unit => { - let curr_eq_class = Hashtbl.find(eq_graph, node_key); - let mut_eq_typs_extension = - [equated_typ |> EqClass.ityp_to_eq_typ] - |> MutableEqClass.eq_class_to_mut_eq_class; - - MutableEqClass.union(curr_eq_class, mut_eq_typs_extension); -}; - -let get_keys_in_eq_class = (eq_graph: t, eq_class: EqClass.t): list(ITyp.t) => { - let add_key_to_acc = (key: ITyp.t, _: MutableEqClass.t, acc: list(ITyp.t)) => { - [key, ...acc]; - }; - let keys = Hashtbl.fold(add_key_to_acc, eq_graph, []); - let is_in_eq_class = (key: ITyp.t) => { - let key_eq_typ = EqClass.ityp_to_eq_typ(key); - EqClass.target_typ_is_in_eq_class(key_eq_typ, eq_class); - }; - List.filter(is_in_eq_class, keys); -}; - -let fail_occurs_check = (eq_graph: t, t1: ITyp.t, t2: ITyp.t): bool => { - let c1 = Hashtbl.find(eq_graph, t1); - let c2 = Hashtbl.find(eq_graph, t2); - - let (snapshot1, err1) = MutableEqClass.snapshot_class(c1, t1); - let (snapshot2, err2) = MutableEqClass.snapshot_class(c2, t2); - - switch (err1, err2) { - | (Some(MutableEqClass.Occurs), _) - | (_, Some(MutableEqClass.Occurs)) => true - | _ => - let keys_in_snapshot1 = get_keys_in_eq_class(eq_graph, snapshot1); - let keys_in_snapshot2 = get_keys_in_eq_class(eq_graph, snapshot2); - - List.exists( - EqClass.target_typ_in_domain_but_not_equal(snapshot1), - List.map(EqClass.ityp_to_eq_typ, keys_in_snapshot2), - ) - || List.exists( - EqClass.target_typ_in_domain_but_not_equal(snapshot2), - List.map(EqClass.ityp_to_eq_typ, keys_in_snapshot1), - ); - }; -}; - -let make_occurs_check = (eq_graph: t, t1: ITyp.t, t2: ITyp.t): unit => - if (fail_occurs_check(eq_graph, t1, t2)) { - let elem1 = Hashtbl.find(eq_graph, t1); - let elem2 = Hashtbl.find(eq_graph, t2); - - MutableEqClass.mark_failed_occurs(elem1); - MutableEqClass.mark_failed_occurs(elem2); - }; diff --git a/src/haz3lcore/inference/Inference.re b/src/haz3lcore/inference/Inference.re index c7e3268e61..271cb775f9 100644 --- a/src/haz3lcore/inference/Inference.re +++ b/src/haz3lcore/inference/Inference.re @@ -1,7 +1,7 @@ /** * NOTE: * Current formulation does not unify constraints comparing inconsistent constructors. - * Unifying these would cause EqClasses to be potentially considered invalid without any + * Unifying these would cause PotentialTypeSets to be potentially considered invalid without any * inconsistencies within them, which is a confusing result to represent to a user and may * pollute other equivalence classes with unhelpful error statuses that static inference can * already give better results on. @@ -9,30 +9,30 @@ * are compared to through their neighborhood of implied consistencies as governed by attempted * consistency checks in synthesis and analysis. */ -// A unification algorithm based on Hindley-Milner unification adjusted so it does not fail -let rec unify = (eq_graph: EqGraph.t, constraints: ITyp.constraints): unit => { - List.iter(unify_one(eq_graph), constraints); +// A unification algorithm based on Huet's unification, adjusted so it does not fail +let rec unify = (pts_graph: PTSGraph.t, constraints: ITyp.constraints): unit => { + List.iter(unify_one(pts_graph), constraints); } -and unify_one = (eq_graph: EqGraph.t, typs: (ITyp.t, ITyp.t)): unit => { +and unify_one = (pts_graph: PTSGraph.t, typs: (ITyp.t, ITyp.t)): unit => { switch (typs) { - | (List(ty1), List(ty2)) => unify_one(eq_graph, (ty1, ty2)) + | (List(ty1), List(ty2)) => unify_one(pts_graph, (ty1, ty2)) | (Arrow(ty1_lhs, ty1_rhs), Arrow(ty2_lhs, ty2_rhs)) | (Prod(ty1_lhs, ty1_rhs), Prod(ty2_lhs, ty2_rhs)) | (Sum(ty1_lhs, ty1_rhs), Sum(ty2_lhs, ty2_rhs)) => - unify(eq_graph, [(ty1_lhs, ty2_lhs), (ty1_rhs, ty2_rhs)]) + unify(pts_graph, [(ty1_lhs, ty2_lhs), (ty1_rhs, ty2_rhs)]) | (Unknown(_) as hole, t) | (t, Unknown(_) as hole) => - EqGraph.add_typ_as_node(eq_graph, hole); + PTSGraph.add_typ_as_node(pts_graph, hole); if (ITyp.contains_hole(t)) { - // if the type it is being constrained to is a potential node, add it then equate the two nodes - EqGraph.add_typ_as_node(eq_graph, t); - EqGraph.make_occurs_check(eq_graph, t, hole); - EqGraph.equate_nodes(eq_graph, t, hole); + // if the type it is being constrained to is a potential node, add it then connect the two nodes + PTSGraph.add_typ_as_node(pts_graph, t); + PTSGraph.make_occurs_check(pts_graph, t, hole); + PTSGraph.create_traversable_edge(pts_graph, t, hole); } else { - // otherwise, simply add t to hole's EqClass without making a new node - EqGraph.equate_node_to_primitive_typ( - eq_graph, + // otherwise, simply add t to hole's PotentialTypeSet without making a new node + PTSGraph.create_solution_edge( + pts_graph, hole, t, ); @@ -43,22 +43,22 @@ and unify_one = (eq_graph: EqGraph.t, typs: (ITyp.t, ITyp.t)): unit => { let unify_and_report_status = (constraints: Typ.constraints): list(InferenceResult.t) => { - let inference_eq_graph = EqGraph.create(); + let inference_pts_graph = PTSGraph.create(); let constraints = ITyp.to_ityp_constraints(constraints); - unify(inference_eq_graph, constraints); + unify(inference_pts_graph, constraints); let acc_results = ( key: ITyp.t, - mut_eq_class: MutableEqClass.t, + mut_potential_typ_set: MutablePotentialTypeSet.t, acc: list(InferenceResult.t), ) : list(InferenceResult.t) => { - [(key, InferenceResult.condense(mut_eq_class, key)), ...acc]; + [(key, InferenceResult.condense(mut_potential_typ_set, key)), ...acc]; }; - let unsorted_results = Hashtbl.fold(acc_results, inference_eq_graph, []); + let unsorted_results = Hashtbl.fold(acc_results, inference_pts_graph, []); List.fast_sort(InferenceResult.comp_results, unsorted_results); }; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index e9cb47683d..2b850d6d18 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -2,7 +2,7 @@ open Util.OptUtil.Syntax; type status = | Solved(ITyp.t) - | Unsolved(EqClass.t); + | Unsolved(PotentialTypeSet.t); type t = (ITyp.t, status); @@ -95,8 +95,11 @@ let get_cursor_inspect_result = let* status = Hashtbl.find_opt(global_inference_info.solution_statuses, id); switch (status) { - | Unsolved(eq_class) => - Some((false, EqClass.string_of_eq_class(eq_class))) + | Unsolved(potential_typ_set) => + Some(( + false, + PotentialTypeSet.string_of_potential_typ_set(potential_typ_set), + )) | Solved(ityp) => Some((true, ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string)) }; @@ -110,20 +113,29 @@ let get_recommended_string = ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string; }; -let condense = (eq_class: MutableEqClass.t, key: ITyp.t): status => { - let (eq_class, err) = MutableEqClass.snapshot_class(eq_class, key); - let sorted_eq_class = EqClass.sort_eq_class(eq_class); +let condense = + (potential_typ_set: MutablePotentialTypeSet.t, key: ITyp.t): status => { + let (potential_typ_set, err) = + MutablePotentialTypeSet.snapshot_class(potential_typ_set, key); + let sorted_potential_typ_set = + PotentialTypeSet.sort_potential_typ_set(potential_typ_set); - let filtered_eq_class = - EqClass.filter_unneeded_holes(EqClass.is_known, sorted_eq_class); + let filtered_potential_typ_set = + PotentialTypeSet.filter_unneeded_holes( + PotentialTypeSet.is_known, + sorted_potential_typ_set, + ); switch (err) { - | Some(_) => Unsolved(filtered_eq_class) + | Some(_) => Unsolved(filtered_potential_typ_set) | None => - let solved_opt = EqClass.filtered_eq_class_to_typ(filtered_eq_class); + let solved_opt = + PotentialTypeSet.filtered_potential_typ_set_to_typ( + filtered_potential_typ_set, + ); switch (solved_opt) { | Some(typ) => Solved(typ) - | None => Unsolved(filtered_eq_class) + | None => Unsolved(filtered_potential_typ_set) }; }; }; diff --git a/src/haz3lcore/inference/MutableEqClass.re b/src/haz3lcore/inference/MutableEqClass.re deleted file mode 100644 index 1d799a1f29..0000000000 --- a/src/haz3lcore/inference/MutableEqClass.re +++ /dev/null @@ -1,224 +0,0 @@ -type error_status = - | Occurs; - -type t = UnionFind.elem((mut_eq_typs, option(error_status))) -and mut_eq_typs = list(mut_eq_typ) -and mut_eq_typ = - | Base(EqClass.base_typ) - | Mapped(EqClass.unary_ctor, t) - | Compound(EqClass.binary_ctor, t, t); - -let wrap_without_error = (typs: mut_eq_typs): t => { - (typs, None) |> UnionFind.make; -}; - -let unwrap_and_remove_error = (t: t): mut_eq_typs => { - let (typs, _) = UnionFind.get(t); - typs; -}; - -let combine_error_status = - (err1: option(error_status), err2: option(error_status)) => { - switch (err1, err2) { - | (None, None) => None - | (Some(Occurs), Some(Occurs)) - | (Some(Occurs), None) - | (None, Some(Occurs)) => Some(Occurs) - }; -}; - -let get_combined_error_status_of_classes = - (t1: t, t2: t): option(error_status) => { - let (_, err1) = UnionFind.get(t1); - let (_, err2) = UnionFind.get(t2); - - combine_error_status(err1, err2); -}; - -let rec snapshot_class = - (mut_eq_class: t, occurs_rep: ITyp.t) - : (EqClass.t, option(error_status)) => { - let (typs, err1) = UnionFind.get(mut_eq_class); - let (eq_class, err2) = snapshot_typs(typs, mut_eq_class, occurs_rep); - (eq_class, combine_error_status(err1, err2)); -} -and snapshot_class_from_child = - (mut_eq_class: t, parent: t, occurs_rep: ITyp.t) - : (EqClass.t, option(error_status)) => { - UnionFind.eq(mut_eq_class, parent) - ? ([occurs_rep |> EqClass.ityp_to_eq_typ], Some(Occurs)) - : snapshot_class(mut_eq_class, occurs_rep); -} -and snapshot_typs = - (mut_eq_typs: mut_eq_typs, parent: t, occurs_rep: ITyp.t) - : (EqClass.t, option(error_status)) => { - switch (mut_eq_typs) { - | [] => ([], None) - | [hd, ...tl] => - let (eq_typ_hd, err_hd) = snapshot_typ(hd, parent, occurs_rep); - let (eq_class_tl, err_tl) = snapshot_typs(tl, parent, occurs_rep); - ([eq_typ_hd, ...eq_class_tl], combine_error_status(err_hd, err_tl)); - }; -} -and snapshot_typ = - (mut_eq_typ: mut_eq_typ, parent: t, occurs_rep: ITyp.t) - : (EqClass.eq_typ, option(error_status)) => { - switch (mut_eq_typ) { - | Base(b) => (EqClass.Base(b), None) - | Compound(ctor, mut_eq_class_lhs, mut_eq_class_rhs) => - let (eq_class_lhs, err_lhs) = - snapshot_class_from_child(mut_eq_class_lhs, parent, occurs_rep); - let (eq_class_rhs, err_rhs) = - snapshot_class_from_child(mut_eq_class_rhs, parent, occurs_rep); - ( - EqClass.Compound(ctor, eq_class_lhs, eq_class_rhs), - combine_error_status(err_lhs, err_rhs), - ); - | Mapped(ctor, mut_eq_class) => - let (eq_class, err) = - snapshot_class_from_child(mut_eq_class, parent, occurs_rep); - (EqClass.Mapped(ctor, eq_class), err); - }; -}; - -let rec eq_class_to_mut_eq_class = (eq_class: EqClass.t): t => { - List.map(eq_typ_to_mut_eq_typ, eq_class) |> wrap_without_error; -} -and eq_typ_to_mut_eq_typ = (eq_typ: EqClass.eq_typ): mut_eq_typ => { - switch (eq_typ) { - | Base(base_typ) => Base(base_typ) - | Mapped(ctor, eq_class) => - Mapped(ctor, eq_class_to_mut_eq_class(eq_class)) - | Compound(ctor, eq_class_lhs, eq_class_rhs) => - Compound( - ctor, - eq_class_to_mut_eq_class(eq_class_lhs), - eq_class_to_mut_eq_class(eq_class_rhs), - ) - }; -}; - -let rec preorder_elem_traversal_mut_eq_class = (mut_eq_class: t): list(t) => { - [ - mut_eq_class, - ...mut_eq_class - |> unwrap_and_remove_error - |> List.map(preorder_traversal_mut_eq_typ) - |> List.flatten, - ]; -} -and preorder_traversal_mut_eq_typ = (mut_eq_typ: mut_eq_typ): list(t) => { - switch (mut_eq_typ) { - | Base(_) => [] - | Mapped(_, eq_class) => preorder_elem_traversal_mut_eq_class(eq_class) - | Compound(_, lhs, rhs) => - preorder_elem_traversal_mut_eq_class(lhs) - @ preorder_elem_traversal_mut_eq_class(rhs) - }; -}; - -let rec preorder_key_traversal_typ = (ty: ITyp.t): list(ITyp.t) => { - switch (ty) { - | Int - | Unit - | Float - | String - | Bool - | Unknown(_) => [ty] - | Arrow(ty_lhs, ty_rhs) - | Prod(ty_lhs, ty_rhs) - | Sum(ty_lhs, ty_rhs) => [ - ty, - ...preorder_key_traversal_typ(ty_lhs) - @ preorder_key_traversal_typ(ty_rhs), - ] - | List(list_ty) => [ty, ...preorder_key_traversal_typ(list_ty)] - }; -}; - -let derive_nested_keys_and_eq_classes = - (key: ITyp.t): (list(ITyp.t), list(t)) => { - let mut_eq_class = - [key |> EqClass.ityp_to_eq_typ] |> eq_class_to_mut_eq_class; - - let preorder_typs = preorder_key_traversal_typ(key); - let preorder_elems = preorder_elem_traversal_mut_eq_class(mut_eq_class); - - List.combine(preorder_typs, preorder_elems) - |> List.filter(((k, _)) => ITyp.contains_hole(k)) - |> List.split; -}; - -let rec extend_class_with_class = (target: t, extension: t): t => { - let merged_typs = - extend_typs_with_typs( - unwrap_and_remove_error(target), - unwrap_and_remove_error(extension), - ); - let final_rep = UnionFind.union(target, extension); - UnionFind.set( - final_rep, - (merged_typs, get_combined_error_status_of_classes(target, extension)), - ); - final_rep; -} -and extend_typs_with_typs = - (target: mut_eq_typs, extension: mut_eq_typs): mut_eq_typs => { - switch (extension) { - | [] => target - | [eq_typ_extension, ...extension_tl] => - let target = extend_typs_with_typ(target, eq_typ_extension); - extend_typs_with_typs(target, extension_tl); - }; -} -and extend_typs_with_typ = - (target: mut_eq_typs, eq_typ_extension: mut_eq_typ): mut_eq_typs => { - switch (target) { - | [] => [eq_typ_extension] - | [target_hd, ...target_tl] => - let extend_target_tl: unit => mut_eq_typs = ( - () => { - [target_hd, ...extend_typs_with_typ(target_tl, eq_typ_extension)]; - } - ); - switch (target_hd, eq_typ_extension) { - | (_, Base(_)) => - target_hd == eq_typ_extension ? target : extend_target_tl() - | (Mapped(hd_ctor, hd_eq_class), Mapped(eq_typ_ctor, eq_class)) => - hd_ctor == eq_typ_ctor - ? [ - Mapped(hd_ctor, extend_class_with_class(hd_eq_class, eq_class)), - ...target_tl, - ] - : extend_target_tl() - | ( - Compound(hd_ctor, hd_eq_class_lt, hd_eq_class_rt), - Compound(eq_typ_ctor, eq_class_lt, eq_class_rt), - ) => - if (hd_ctor == eq_typ_ctor) { - let hd_eq_class_lt = - extend_class_with_class(hd_eq_class_lt, eq_class_lt); - let hd_eq_class_rt = - extend_class_with_class(hd_eq_class_rt, eq_class_rt); - [Compound(hd_ctor, hd_eq_class_lt, hd_eq_class_rt), ...target_tl]; - } else { - extend_target_tl(); - } - | (Base(_) | Mapped(_), Compound(_)) - | (Base(_) | Compound(_), Mapped(_)) => extend_target_tl() - }; - }; -}; - -let union = (t1: t, t2: t): unit => - if (UnionFind.eq(t1, t2)) { - (); - } else { - let _ = extend_class_with_class(t1, t2); - (); - }; - -let mark_failed_occurs = (mut_eq_class: t): unit => { - let (curr_typs, _) = UnionFind.get(mut_eq_class); - UnionFind.set(mut_eq_class, (curr_typs, Some(Occurs))); -}; diff --git a/src/haz3lcore/inference/MutableEqClass.rei b/src/haz3lcore/inference/MutableEqClass.rei deleted file mode 100644 index 4744c356d2..0000000000 --- a/src/haz3lcore/inference/MutableEqClass.rei +++ /dev/null @@ -1,33 +0,0 @@ -/** - * A mutable version of the EqClass.t type that allows extension via UnionFind - * such that if one foo: MutableEqClass.t is extended (or unioned) with - * bar: MutableEqClass.t, both EqClasses and all sub-EqClasses contained - * within them are union-found with each other. - * Consequently, if either foo or bar are extended with another MutableEqClass, - * both will have access to the fully updated EqClass without need to dfs - * (as will their children). - * - * NOTE: Preferred usage when not extending/unioning is to call MutableEqClass.snapshot_class - * to get an immutable EqClass and perform computation on that instead to avoid bugs. - */ - -type error_status = - | Occurs; - -type t = UnionFind.elem((mut_eq_typs, option(error_status))) -and mut_eq_typs = list(mut_eq_typ) -and mut_eq_typ = - | Base(EqClass.base_typ) - | Mapped(EqClass.unary_ctor, t) - | Compound(EqClass.binary_ctor, t, t); - -let snapshot_class: (t, ITyp.t) => (EqClass.t, option(error_status)); - -let eq_class_to_mut_eq_class: EqClass.t => t; -let eq_typ_to_mut_eq_typ: EqClass.eq_typ => mut_eq_typ; - -let derive_nested_keys_and_eq_classes: ITyp.t => (list(ITyp.t), list(t)); - -let union: (t, t) => unit; - -let mark_failed_occurs: t => unit; diff --git a/src/haz3lcore/inference/MutablePotentialTypeSet.re b/src/haz3lcore/inference/MutablePotentialTypeSet.re new file mode 100644 index 0000000000..322a7131b4 --- /dev/null +++ b/src/haz3lcore/inference/MutablePotentialTypeSet.re @@ -0,0 +1,265 @@ +type error_status = + | Occurs; + +type t = UnionFind.elem((mut_pot_typs, option(error_status))) +and mut_pot_typs = list(mut_pot_typ) +and mut_pot_typ = + | Base(PotentialTypeSet.base_typ) + | Unary(PotentialTypeSet.unary_ctor, t) + | Binary(PotentialTypeSet.binary_ctor, t, t); + +let wrap_without_error = (typs: mut_pot_typs): t => { + (typs, None) |> UnionFind.make; +}; + +let unwrap_and_remove_error = (t: t): mut_pot_typs => { + let (typs, _) = UnionFind.get(t); + typs; +}; + +let combine_error_status = + (err1: option(error_status), err2: option(error_status)) => { + switch (err1, err2) { + | (None, None) => None + | (Some(Occurs), Some(Occurs)) + | (Some(Occurs), None) + | (None, Some(Occurs)) => Some(Occurs) + }; +}; + +let get_combined_error_status_of_classes = + (t1: t, t2: t): option(error_status) => { + let (_, err1) = UnionFind.get(t1); + let (_, err2) = UnionFind.get(t2); + + combine_error_status(err1, err2); +}; + +let rec snapshot_class = + (mut_potential_typ_set: t, occurs_rep: ITyp.t) + : (PotentialTypeSet.t, option(error_status)) => { + let (typs, err1) = UnionFind.get(mut_potential_typ_set); + let (potential_typ_set, err2) = + snapshot_typs(typs, mut_potential_typ_set, occurs_rep); + (potential_typ_set, combine_error_status(err1, err2)); +} +and snapshot_class_from_child = + (mut_potential_typ_set: t, parent: t, occurs_rep: ITyp.t) + : (PotentialTypeSet.t, option(error_status)) => { + UnionFind.eq(mut_potential_typ_set, parent) + ? ( + [occurs_rep |> PotentialTypeSet.ityp_to_potential_typ], + Some(Occurs), + ) + : snapshot_class(mut_potential_typ_set, occurs_rep); +} +and snapshot_typs = + (mut_pot_typs: mut_pot_typs, parent: t, occurs_rep: ITyp.t) + : (PotentialTypeSet.t, option(error_status)) => { + switch (mut_pot_typs) { + | [] => ([], None) + | [hd, ...tl] => + let (pot_typ_hd, err_hd) = snapshot_typ(hd, parent, occurs_rep); + let (potential_typ_set_tl, err_tl) = + snapshot_typs(tl, parent, occurs_rep); + ( + [pot_typ_hd, ...potential_typ_set_tl], + combine_error_status(err_hd, err_tl), + ); + }; +} +and snapshot_typ = + (mut_pot_typ: mut_pot_typ, parent: t, occurs_rep: ITyp.t) + : (PotentialTypeSet.potential_typ, option(error_status)) => { + switch (mut_pot_typ) { + | Base(b) => (PotentialTypeSet.Base(b), None) + | Binary(ctor, mut_potential_typ_set_lhs, mut_potential_typ_set_rhs) => + let (potential_typ_set_lhs, err_lhs) = + snapshot_class_from_child( + mut_potential_typ_set_lhs, + parent, + occurs_rep, + ); + let (potential_typ_set_rhs, err_rhs) = + snapshot_class_from_child( + mut_potential_typ_set_rhs, + parent, + occurs_rep, + ); + ( + PotentialTypeSet.Binary( + ctor, + potential_typ_set_lhs, + potential_typ_set_rhs, + ), + combine_error_status(err_lhs, err_rhs), + ); + | Unary(ctor, mut_potential_typ_set) => + let (potential_typ_set, err) = + snapshot_class_from_child(mut_potential_typ_set, parent, occurs_rep); + (PotentialTypeSet.Unary(ctor, potential_typ_set), err); + }; +}; + +let rec pot_typ_set_to_mut_pot_typ_set = + (potential_typ_set: PotentialTypeSet.t): t => { + List.map(pot_typ_to_mut_pot_typ, potential_typ_set) |> wrap_without_error; +} +and pot_typ_to_mut_pot_typ = + (pot_typ: PotentialTypeSet.potential_typ): mut_pot_typ => { + switch (pot_typ) { + | Base(base_typ) => Base(base_typ) + | Unary(ctor, potential_typ_set) => + Unary(ctor, pot_typ_set_to_mut_pot_typ_set(potential_typ_set)) + | Binary(ctor, potential_typ_set_lhs, potential_typ_set_rhs) => + Binary( + ctor, + pot_typ_set_to_mut_pot_typ_set(potential_typ_set_lhs), + pot_typ_set_to_mut_pot_typ_set(potential_typ_set_rhs), + ) + }; +}; + +let rec preorder_elem_traversal_mut_potential_typ_set = + (mut_potential_typ_set: t): list(t) => { + [ + mut_potential_typ_set, + ...mut_potential_typ_set + |> unwrap_and_remove_error + |> List.map(preorder_traversal_mut_pot_typ) + |> List.flatten, + ]; +} +and preorder_traversal_mut_pot_typ = (mut_pot_typ: mut_pot_typ): list(t) => { + switch (mut_pot_typ) { + | Base(_) => [] + | Unary(_, potential_typ_set) => + preorder_elem_traversal_mut_potential_typ_set(potential_typ_set) + | Binary(_, lhs, rhs) => + preorder_elem_traversal_mut_potential_typ_set(lhs) + @ preorder_elem_traversal_mut_potential_typ_set(rhs) + }; +}; + +let rec preorder_key_traversal_typ = (ty: ITyp.t): list(ITyp.t) => { + switch (ty) { + | Int + | Unit + | Float + | String + | Bool + | Unknown(_) => [ty] + | Arrow(ty_lhs, ty_rhs) + | Prod(ty_lhs, ty_rhs) + | Sum(ty_lhs, ty_rhs) => [ + ty, + ...preorder_key_traversal_typ(ty_lhs) + @ preorder_key_traversal_typ(ty_rhs), + ] + | List(list_ty) => [ty, ...preorder_key_traversal_typ(list_ty)] + }; +}; + +let derive_nested_keys_and_potential_typ_sets = + (key: ITyp.t): (list(ITyp.t), list(t)) => { + let mut_potential_typ_set = + [key |> PotentialTypeSet.ityp_to_potential_typ] + |> pot_typ_set_to_mut_pot_typ_set; + + let preorder_typs = preorder_key_traversal_typ(key); + let preorder_elems = + preorder_elem_traversal_mut_potential_typ_set(mut_potential_typ_set); + + List.combine(preorder_typs, preorder_elems) + |> List.filter(((k, _)) => ITyp.contains_hole(k)) + |> List.split; +}; + +let rec extend_class_with_class = (target: t, extension: t): t => { + let merged_typs = + extend_typs_with_typs( + unwrap_and_remove_error(target), + unwrap_and_remove_error(extension), + ); + let final_rep = UnionFind.union(target, extension); + UnionFind.set( + final_rep, + (merged_typs, get_combined_error_status_of_classes(target, extension)), + ); + final_rep; +} +and extend_typs_with_typs = + (target: mut_pot_typs, extension: mut_pot_typs): mut_pot_typs => { + switch (extension) { + | [] => target + | [pot_typ_extension, ...extension_tl] => + let target = extend_typs_with_typ(target, pot_typ_extension); + extend_typs_with_typs(target, extension_tl); + }; +} +and extend_typs_with_typ = + (target: mut_pot_typs, pot_typ_extension: mut_pot_typ): mut_pot_typs => { + switch (target) { + | [] => [pot_typ_extension] + | [target_hd, ...target_tl] => + let extend_target_tl: unit => mut_pot_typs = ( + () => { + [target_hd, ...extend_typs_with_typ(target_tl, pot_typ_extension)]; + } + ); + switch (target_hd, pot_typ_extension) { + | (_, Base(_)) => + target_hd == pot_typ_extension ? target : extend_target_tl() + | ( + Unary(hd_ctor, hd_potential_typ_set), + Unary(pot_typ_ctor, potential_typ_set), + ) => + hd_ctor == pot_typ_ctor + ? [ + Unary( + hd_ctor, + extend_class_with_class(hd_potential_typ_set, potential_typ_set), + ), + ...target_tl, + ] + : extend_target_tl() + | ( + Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), + Binary(pot_typ_ctor, potential_typ_set_lt, potential_typ_set_rt), + ) => + if (hd_ctor == pot_typ_ctor) { + let hd_potential_typ_set_lt = + extend_class_with_class( + hd_potential_typ_set_lt, + potential_typ_set_lt, + ); + let hd_potential_typ_set_rt = + extend_class_with_class( + hd_potential_typ_set_rt, + potential_typ_set_rt, + ); + [ + Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), + ...target_tl, + ]; + } else { + extend_target_tl(); + } + | (Base(_) | Unary(_), Binary(_)) + | (Base(_) | Binary(_), Unary(_)) => extend_target_tl() + }; + }; +}; + +let union = (t1: t, t2: t): unit => + if (UnionFind.eq(t1, t2)) { + (); + } else { + let _ = extend_class_with_class(t1, t2); + (); + }; + +let mark_failed_occurs = (mut_potential_typ_set: t): unit => { + let (curr_typs, _) = UnionFind.get(mut_potential_typ_set); + UnionFind.set(mut_potential_typ_set, (curr_typs, Some(Occurs))); +}; diff --git a/src/haz3lcore/inference/MutablePotentialTypeSet.rei b/src/haz3lcore/inference/MutablePotentialTypeSet.rei new file mode 100644 index 0000000000..1a25bc24d7 --- /dev/null +++ b/src/haz3lcore/inference/MutablePotentialTypeSet.rei @@ -0,0 +1,35 @@ +/** + * A mutable version of the PotentialTypeSet.t type that allows extension via UnionFind + * such that if one foo: MutablePotentialTypeSet.t is extended (or unioned) with + * bar: MutablePotentialTypeSet.t, both PotentialTypeSetes and all sub-PotentialTypeSetes contained + * within them are union-found with each other. + * Consequently, if either foo or bar are extended with another MutablePotentialTypeSet, + * both will have access to the fully updated PotentialTypeSet without need to dfs + * (as will their children). + * + * NOTE: Preferred usage when not extending/unioning is to call MutablePotentialTypeSet.snapshot_class + * to get an immutable PotentialTypeSet and perform computation on that instead to avoid bugs. + */ + +type error_status = + | Occurs; + +type t = UnionFind.elem((mut_pot_typs, option(error_status))) +and mut_pot_typs = list(mut_pot_typ) +and mut_pot_typ = + | Base(PotentialTypeSet.base_typ) + | Unary(PotentialTypeSet.unary_ctor, t) + | Binary(PotentialTypeSet.binary_ctor, t, t); + +let snapshot_class: + (t, ITyp.t) => (PotentialTypeSet.t, option(error_status)); + +let pot_typ_set_to_mut_pot_typ_set: PotentialTypeSet.t => t; +let pot_typ_to_mut_pot_typ: PotentialTypeSet.potential_typ => mut_pot_typ; + +let derive_nested_keys_and_potential_typ_sets: + ITyp.t => (list(ITyp.t), list(t)); + +let union: (t, t) => unit; + +let mark_failed_occurs: t => unit; diff --git a/src/haz3lcore/inference/PTSGraph.re b/src/haz3lcore/inference/PTSGraph.re new file mode 100644 index 0000000000..c66ccfe281 --- /dev/null +++ b/src/haz3lcore/inference/PTSGraph.re @@ -0,0 +1,103 @@ +type t = Hashtbl.t(ITyp.t, MutablePotentialTypeSet.t); + +let expected_size: int = 50; + +let create = (): t => { + Hashtbl.create(expected_size); +}; + +let add = + ( + pts_graph: t, + key: ITyp.t, + mut_potential_type_set: MutablePotentialTypeSet.t, + ) + : unit => { + switch (Hashtbl.find_opt(pts_graph, key)) { + | Some(curr_mut_potential_type_set) => + MutablePotentialTypeSet.union( + curr_mut_potential_type_set, + mut_potential_type_set, + ) + | None => Hashtbl.add(pts_graph, key, mut_potential_type_set) + }; +}; + +let add_typ_as_node = (pts_graph: t, typ: ITyp.t): unit => { + let (keys, values) = + MutablePotentialTypeSet.derive_nested_keys_and_potential_typ_sets(typ); + List.iter2(add(pts_graph), keys, values); +}; + +let create_traversable_edge = (pts_graph: t, typ1: ITyp.t, typ2: ITyp.t): unit => { + let elem1 = Hashtbl.find(pts_graph, typ1); + let elem2 = Hashtbl.find(pts_graph, typ2); + + MutablePotentialTypeSet.union(elem1, elem2); +}; + +let create_solution_edge = + (pts_graph: t, node_key: ITyp.t, equated_typ: ITyp.t): unit => { + let curr_potential_type_set = Hashtbl.find(pts_graph, node_key); + let mut_potential_typs_extension = + [equated_typ |> PotentialTypeSet.ityp_to_potential_typ] + |> MutablePotentialTypeSet.pot_typ_set_to_mut_pot_typ_set; + + MutablePotentialTypeSet.union( + curr_potential_type_set, + mut_potential_typs_extension, + ); +}; + +let get_keys_in_potential_type_set = + (pts_graph: t, potential_type_set: PotentialTypeSet.t): list(ITyp.t) => { + let add_key_to_acc = + (key: ITyp.t, _: MutablePotentialTypeSet.t, acc: list(ITyp.t)) => { + [key, ...acc]; + }; + let keys = Hashtbl.fold(add_key_to_acc, pts_graph, []); + let is_in_potential_type_set = (key: ITyp.t) => { + let key_potential_typ = PotentialTypeSet.ityp_to_potential_typ(key); + PotentialTypeSet.target_typ_is_in_potential_typ_set( + key_potential_typ, + potential_type_set, + ); + }; + List.filter(is_in_potential_type_set, keys); +}; + +let fail_occurs_check = (pts_graph: t, t1: ITyp.t, t2: ITyp.t): bool => { + let c1 = Hashtbl.find(pts_graph, t1); + let c2 = Hashtbl.find(pts_graph, t2); + + let (snapshot1, err1) = MutablePotentialTypeSet.snapshot_class(c1, t1); + let (snapshot2, err2) = MutablePotentialTypeSet.snapshot_class(c2, t2); + + switch (err1, err2) { + | (Some(MutablePotentialTypeSet.Occurs), _) + | (_, Some(MutablePotentialTypeSet.Occurs)) => true + | _ => + let keys_in_snapshot1 = + get_keys_in_potential_type_set(pts_graph, snapshot1); + let keys_in_snapshot2 = + get_keys_in_potential_type_set(pts_graph, snapshot2); + + List.exists( + PotentialTypeSet.target_typ_in_domain_but_not_equal(snapshot1), + List.map(PotentialTypeSet.ityp_to_potential_typ, keys_in_snapshot2), + ) + || List.exists( + PotentialTypeSet.target_typ_in_domain_but_not_equal(snapshot2), + List.map(PotentialTypeSet.ityp_to_potential_typ, keys_in_snapshot1), + ); + }; +}; + +let make_occurs_check = (pts_graph: t, t1: ITyp.t, t2: ITyp.t): unit => + if (fail_occurs_check(pts_graph, t1, t2)) { + let elem1 = Hashtbl.find(pts_graph, t1); + let elem2 = Hashtbl.find(pts_graph, t2); + + MutablePotentialTypeSet.mark_failed_occurs(elem1); + MutablePotentialTypeSet.mark_failed_occurs(elem2); + }; diff --git a/src/haz3lcore/inference/EqGraph.rei b/src/haz3lcore/inference/PTSGraph.rei similarity index 82% rename from src/haz3lcore/inference/EqGraph.rei rename to src/haz3lcore/inference/PTSGraph.rei index ff5e248c01..c711d48529 100644 --- a/src/haz3lcore/inference/EqGraph.rei +++ b/src/haz3lcore/inference/PTSGraph.rei @@ -10,14 +10,14 @@ * type in a connected component is the least upper bound of all types within it (if it exists). */ -type t = Hashtbl.t(ITyp.t, MutableEqClass.t); +type t = Hashtbl.t(ITyp.t, MutablePotentialTypeSet.t); let create: unit => t; let add_typ_as_node: (t, ITyp.t) => unit; -let equate_nodes: (t, ITyp.t, ITyp.t) => unit; +let create_traversable_edge: (t, ITyp.t, ITyp.t) => unit; -let equate_node_to_primitive_typ: (t, ITyp.t, ITyp.t) => unit; +let create_solution_edge: (t, ITyp.t, ITyp.t) => unit; let make_occurs_check: (t, ITyp.t, ITyp.t) => unit; diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re new file mode 100644 index 0000000000..5a7386020d --- /dev/null +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -0,0 +1,525 @@ +open Util; +open OptUtil.Syntax; +open Sexplib.Std; + +/** + * An PotentialTypeSet.t is a condensed representation of a list of types. + * It can be a single type, or a composition of other PotentialTypeSet.t + * + * We use PotentialTypeSet to maintain all possible combinations of solutions during unification + * and properly report errors/solutions without combinatorial explosion. + * Inconsistent types and types failing an occurs check can be added to the same PotentialTypeSet without issue, + * preventing unification from ever having to crash. + */ + +[@deriving (show({with_path: false}), sexp)] +type base_typ = + | BUnit + | BInt + | BFloat + | BBool + | BString + | BUnknown(Typ.type_provenance); + +[@deriving (show({with_path: false}), sexp)] +type unary_ctor = + | CList; + +[@deriving (show({with_path: false}), sexp)] +type binary_ctor = + | CArrow + | CProd + | CSum; + +[@deriving (show({with_path: false}), sexp)] +type t = list(potential_typ) +and potential_typ = + | Base(base_typ) + | Unary(unary_ctor, t) + | Binary(binary_ctor, t, t); + +let mk_as_binary_ctor = (ctor: binary_ctor, ty1: ITyp.t, ty2: ITyp.t): ITyp.t => { + switch (ctor) { + | CArrow => Arrow(ty1, ty2) + | CProd => Prod(ty1, ty2) + | CSum => Sum(ty1, ty2) + }; +}; + +let mk_as_unary_ctor = (ctor: unary_ctor, ty: ITyp.t): ITyp.t => { + switch (ctor) { + | CList => List(ty) + }; +}; + +let rec ityp_to_potential_typ: ITyp.t => potential_typ = + fun + | Unknown(prov) => Base(BUnknown(prov)) + | Int => Base(BInt) + | Unit => Base(BUnit) + | Float => Base(BFloat) + | Bool => Base(BBool) + | String => Base(BString) + | Arrow(ty1, ty2) => + Binary( + CArrow, + [ityp_to_potential_typ(ty1)], + [ityp_to_potential_typ(ty2)], + ) + | Prod(ty1, ty2) => + Binary( + CProd, + [ityp_to_potential_typ(ty1)], + [ityp_to_potential_typ(ty2)], + ) + | Sum(ty1, ty2) => + Binary( + CProd, + [ityp_to_potential_typ(ty1)], + [ityp_to_potential_typ(ty2)], + ) + | List(ty) => Unary(CList, [ityp_to_potential_typ(ty)]); + +let typ_to_potential_typ: Typ.t => potential_typ = + typ => { + typ |> ITyp.typ_to_ityp |> ityp_to_potential_typ; + }; + +let base_typ_to_ityp: base_typ => ITyp.t = + fun + | BInt => Int + | BFloat => Float + | BBool => Bool + | BString => String + | BUnit => Unit + | BUnknown(prov) => Unknown(prov); + +let rec extend_with_potential_typ_set = + (target: t, potential_typ_set_extension: t) => { + switch (potential_typ_set_extension) { + | [] => target + | [potential_typ_extension, ...extension_tl] => + let target = extend_with_potential_typ(target, potential_typ_extension); + extend_with_potential_typ_set(target, extension_tl); + }; +} +and extend_with_potential_typ = + (target: t, potential_typ_extension: potential_typ) => { + switch (target) { + | [] => [potential_typ_extension] + | [target_hd, ...target_tl] => + let extend_target_tl: unit => t = ( + () => { + [ + target_hd, + ...extend_with_potential_typ(target_tl, potential_typ_extension), + ]; + } + ); + switch (target_hd, potential_typ_extension) { + | (_, Base(_)) => + target_hd == potential_typ_extension ? target : extend_target_tl() + | ( + Unary(hd_ctor, hd_potential_typ_set), + Unary(potential_typ_ctor, potential_typ_set), + ) => + hd_ctor == potential_typ_ctor + ? [ + Unary( + hd_ctor, + extend_with_potential_typ_set( + hd_potential_typ_set, + potential_typ_set, + ), + ), + ...target_tl, + ] + : extend_target_tl() + | ( + Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), + Binary( + potential_typ_ctor, + potential_typ_set_lt, + potential_typ_set_rt, + ), + ) => + if (hd_ctor == potential_typ_ctor) { + let hd_potential_typ_set_lt = + extend_with_potential_typ_set( + hd_potential_typ_set_lt, + potential_typ_set_lt, + ); + let hd_potential_typ_set_rt = + extend_with_potential_typ_set( + hd_potential_typ_set_rt, + potential_typ_set_rt, + ); + [ + Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), + ...target_tl, + ]; + } else { + extend_target_tl(); + } + | (Base(_) | Unary(_), Binary(_)) + | (Base(_) | Binary(_), Unary(_)) => extend_target_tl() + }; + }; +}; + +type split_result = + | Success + | Error(split_error_status) +and split_error_status = + | Unsplittable + | WrongCtor; + +let split_potential_typ: potential_typ => option((t, t)) = + fun + | Unary(_) + | Base(_) => None + | Binary(_, potential_typ_set1, potential_typ_set2) => + Some((potential_typ_set1, potential_typ_set2)); + +// not currently in use but kept for utility +let split_potential_typ_set = (ctor_used: binary_ctor, potential_typ_set: t) => { + let split_result_of: potential_typ => split_result = + fun + | Base(ty) => + switch (ty) { + | BUnknown(_) => Success + | _ => Error(Unsplittable) + } + | Unary(_) => Error(Unsplittable) + | Binary(ctor, _, _) => ctor_used == ctor ? Success : Error(WrongCtor); + + let accumulate_splits = + ((acc_class_lt, acc_class_rt): (t, t), potential_typ: potential_typ) => { + switch (split_potential_typ(potential_typ)) { + | None => (acc_class_lt, acc_class_rt) + | Some((potential_typ_set_lt, potential_typ_set_rt)) => + let acc_class_lt = + extend_with_potential_typ_set(acc_class_lt, potential_typ_set_lt); + let acc_class_rt = + extend_with_potential_typ_set(acc_class_rt, potential_typ_set_rt); + (acc_class_lt, acc_class_rt); + }; + }; + + let (potential_typ_set_lt, potential_typ_set_rt) = + List.fold_left(accumulate_splits, ([], []), potential_typ_set); + + // Unsplittable errors take precedence over WrongCtor due to strictly more severe error handling + let rec check_ctor = + (potential_typ_set: t, wrong_ctor_error_found: bool): split_result => { + switch (potential_typ_set) { + | [] => wrong_ctor_error_found ? Error(WrongCtor) : Success + | [hd, ...tl] => + switch (split_result_of(hd)) { + | Error(Unsplittable) as e => e + | Error(WrongCtor) => check_ctor(tl, true) + | _ => check_ctor(tl, wrong_ctor_error_found) + } + }; + }; + + ( + check_ctor(potential_typ_set, false), + potential_typ_set_lt, + potential_typ_set_rt, + ); +}; + +let fuse = + (ctor_used: binary_ctor, potential_typ_set_lt: t, potential_typ_set_rt: t) => { + Binary(ctor_used, potential_typ_set_lt, potential_typ_set_rt); +}; + +let rec target_typ_is_in_potential_typ_set = + (target_typ: potential_typ, potential_typ_set: t): bool => { + // is target_typ ∈ potential_typ_set? this would make them equal (via transitivity) + switch (potential_typ_set) { + | [] => false + | [hd, ...tl] => + target_typ_is_in_potential_typ(target_typ, hd) + || target_typ_is_in_potential_typ_set(target_typ, tl) + }; +} +and target_typ_is_in_potential_typ = + (target_typ: potential_typ, potential_typ: potential_typ): bool => { + switch (target_typ, potential_typ) { + | (_, Base(_)) => target_typ == potential_typ + | ( + Unary(target_ctor, target_potential_typ_set), + Unary(ctor, potential_typ_set), + ) => + target_ctor == ctor + && target_class_is_in_potential_typ_set( + target_potential_typ_set, + potential_typ_set, + ) + | ( + Binary(target_ctor, target_class_lt, target_class_rt), + Binary(ctor, potential_typ_set_lt, potential_typ_set_rt), + ) => + target_ctor == ctor + && target_class_is_in_potential_typ_set( + target_class_lt, + potential_typ_set_lt, + ) + && target_class_is_in_potential_typ_set( + target_class_rt, + potential_typ_set_rt, + ) + | (Base(_) | Binary(_), Unary(_)) + | (Base(_) | Unary(_), Binary(_)) => false + }; +} +and target_class_is_in_potential_typ_set = + (target_class: t, potential_typ_set: t): bool => { + // is target_class ∈ potential_typ_set? this would make them equal (via transitivity) + let target_typ_contained = (target_typ: potential_typ): bool => { + target_typ_is_in_potential_typ_set(target_typ, potential_typ_set); + }; + List.for_all(target_typ_contained, target_class); +}; + +let rec target_typ_used_in_potential_typ_set = + (target_typ: potential_typ, potential_typ_set: t): bool => { + // is [target_typ] ⊆ potential_typ_set? + switch (potential_typ_set) { + | [] => false + | [hd, ...tl] => + target_typ_used_in_potential_typ(target_typ, hd) + || target_typ_used_in_potential_typ_set(target_typ, tl) + }; +} +and target_typ_used_in_potential_typ = + (target_typ: potential_typ, potential_typ: potential_typ): bool => { + // target used inside, or is represented by the potential_typ itself + switch (target_typ, potential_typ) { + | (_, Base(_)) => target_typ == potential_typ + | (Unary(_), Unary(_, potential_typ_set)) => + target_typ_used_in_potential_typ_set(target_typ, potential_typ_set) + || target_typ_is_in_potential_typ(target_typ, potential_typ) + | (Binary(_), Binary(_, potential_typ_set_lt, potential_typ_set_rt)) => + target_typ_used_in_potential_typ_set(target_typ, potential_typ_set_lt) + || target_typ_used_in_potential_typ_set(target_typ, potential_typ_set_rt) + || target_typ_is_in_potential_typ(target_typ, potential_typ) + | (Base(_) | Binary(_), Unary(_, potential_typ_set)) => + target_typ_used_in_potential_typ_set(target_typ, potential_typ_set) + | ( + Base(_) | Unary(_), + Binary(_, potential_typ_set_lt, potential_typ_set_rt), + ) => + target_typ_is_in_potential_typ_set(target_typ, potential_typ_set_lt) + || target_typ_is_in_potential_typ_set(target_typ, potential_typ_set_rt) + }; +} +and target_class_used_in_potential_typ_set = + (target_class: t, potential_typ_set: t): bool => { + // is target_class ⊆ potential_typ_set? + let target_typ_used = (target_typ: potential_typ): bool => { + target_typ_used_in_potential_typ_set(target_typ, potential_typ_set); + }; + // every target typ must be used in the eq class for the whole target class to have been used + List.for_all(target_typ_used, target_class); +}; + +let rec target_typ_in_domain_but_not_equal = + (potential_typ_set: t, target_typ: potential_typ): bool => { + List.exists( + target_typ_in_domain_but_not_equal_typ(target_typ), + potential_typ_set, + ); +} +and target_typ_in_domain_but_not_equal_typ = + (target_typ: potential_typ, potential_typ: potential_typ): bool => { + // is target_typ ⊂ potential_typ? + // NOTE: + // target_typ != potential_typ ^ target_typ ⊆ potential_typ + // => target_typ ⊂ potential_typ + !target_typ_is_in_potential_typ(target_typ, potential_typ) + && target_typ_used_in_potential_typ(target_typ, potential_typ); +}; + +let is_known: potential_typ => bool = + fun + | Base(BUnknown(_)) => false + | _ => true; + +let rec filter_unneeded_holes_class = + (comp: potential_typ => bool, remove: bool, potential_typ_set: t): t => { + switch (potential_typ_set) { + | [] => [] + | [hd, ...tl] => + let (had_hole, filtered_hd_opt) = + filter_unneeded_holes_typ(comp, remove, hd); + let remove = had_hole || remove; + switch (filtered_hd_opt) { + | None => filter_unneeded_holes_class(comp, remove, tl) + | Some(filtered_hd) => [ + filtered_hd, + ...filter_unneeded_holes_class(comp, remove, tl), + ] + }; + }; +} +and filter_unneeded_holes_typ = + (comp: potential_typ => bool, remove: bool, potential_typ: potential_typ) + : (bool, option(potential_typ)) => { + switch (potential_typ) { + | Base(btyp) => + switch (btyp) { + | BUnknown(_) => + let eq_tp_opt = remove ? None : Some(potential_typ); + (true, eq_tp_opt); + | _ => (false, Some(potential_typ)) + } + | Unary(ctor, potential_typ_set) => + let delete_holes = List.exists(comp, potential_typ_set); + let potential_typ_set = + filter_unneeded_holes_class(comp, delete_holes, potential_typ_set); + (false, Some(Unary(ctor, potential_typ_set))); + | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => + let delete_holes_lt = List.exists(comp, potential_typ_set_lt); + let delete_holes_rt = List.exists(comp, potential_typ_set_rt); + let potential_typ_set_lt = + filter_unneeded_holes_class( + comp, + delete_holes_lt, + potential_typ_set_lt, + ); + let potential_typ_set_rt = + filter_unneeded_holes_class( + comp, + delete_holes_rt, + potential_typ_set_rt, + ); + (false, Some(Binary(ctor, potential_typ_set_lt, potential_typ_set_rt))); + }; +}; + +let filter_unneeded_holes = + (comp: potential_typ => bool, potential_typ_set: t): t => { + let delete_holes = List.exists(comp, potential_typ_set); + filter_unneeded_holes_class(comp, delete_holes, potential_typ_set); +}; + +let rec filtered_potential_typ_set_to_typ: t => option(ITyp.t) = + fun + | [] => None + | [Base(btyp)] => Some(btyp |> base_typ_to_ityp) + | [Binary(ctor, potential_typ_set_lt, potential_typ_set_rt)] => { + let* typ1 = filtered_potential_typ_set_to_typ(potential_typ_set_lt); + let+ typ2 = filtered_potential_typ_set_to_typ(potential_typ_set_rt); + mk_as_binary_ctor(ctor, typ1, typ2); + } + | [Unary(ctor, potential_typ_set)] => { + let+ elt_typ = filtered_potential_typ_set_to_typ(potential_typ_set); + mk_as_unary_ctor(ctor, elt_typ); + } + | _ => None; + +let comp_potential_typ = + (potential_typ1: potential_typ, potential_typ2: potential_typ): int => { + let strip_id_from_prov: Typ.type_provenance => float = + fun + | SynSwitch(id) + | TypeHole(id) + | Internal(id) => + id == 0 ? (-2.0) : Float.sub(0.0, Float.div(1.0, float_of_int(id))) + | _ => 0.0; + + let potential_typ_to_float: potential_typ => float = + fun + | Base(BInt) + | Base(BUnit) + | Base(BFloat) + | Base(BString) + | Base(BBool) => 1.0 + | Base(BUnknown(prov)) => strip_id_from_prov(prov) + | Binary(_) => 2.0 + | Unary(_) => 3.0; + + Stdlib.compare( + potential_typ_to_float(potential_typ1), + potential_typ_to_float(potential_typ2), + ); +}; + +let rec sort_potential_typ_set = (potential_typ_set: t): t => { + let potential_typ_set = + List.fast_sort(comp_potential_typ, potential_typ_set); + sort_potential_typ_set_explore(potential_typ_set); +} +and sort_potential_typ_set_explore = (potential_typ_set: t): t => { + switch (potential_typ_set) { + | [] => [] + | [hd, ...tl] => + switch (hd) { + | Base(_) => [hd, ...sort_potential_typ_set_explore(tl)] + | Unary(ctor, potential_typ_set_arg) => + let sorted_class = sort_potential_typ_set(potential_typ_set_arg); + [Unary(ctor, sorted_class), ...sort_potential_typ_set(tl)]; + | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => + let sorted_class_lt = sort_potential_typ_set(potential_typ_set_lt); + let sorted_class_rt = sort_potential_typ_set(potential_typ_set_rt); + [ + Binary(ctor, sorted_class_lt, sorted_class_rt), + ...sort_potential_typ_set_explore(tl), + ]; + } + }; +}; + +let string_of_btyp = (btyp: base_typ): string => { + btyp |> base_typ_to_ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string; +}; + +let rec string_of_potential_typ_set = (potential_typ_set: t): string => + switch (potential_typ_set) { + | [] => "" + | [hd] => string_of_potential_typ(hd) + | [hd, ...tl] => + let hd_str = string_of_potential_typ(hd); + String.concat(" // ", [hd_str, string_of_potential_typ_set(tl)]); + } +and string_of_potential_typ_set_no_nesting = (potential_typ_set: t): string => + switch (potential_typ_set) { + | [] => "" + | [hd] => string_of_potential_typ(hd) + | [_hd, ..._tl] => "?" + } +and string_of_potential_typ = (potential_typ: potential_typ) => + switch (potential_typ) { + | Base(btyp) => string_of_btyp(btyp) + | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => + let (ctor_start, ctor_string, ctor_end) = + switch (ctor) { + | CArrow => ("(", " -> ", ")") + | CProd => ("(", ", ", ")") + | CSum => ("", " + (", ")") + }; + + String.concat( + "", + [ + ctor_start, + string_of_potential_typ_set_no_nesting(potential_typ_set_lt), + ctor_string, + string_of_potential_typ_set_no_nesting(potential_typ_set_rt), + ctor_end, + ], + ); + | Unary(ctor, potential_typ_set) => + let (start_text, end_text) = + switch (ctor) { + | CList => ("[", "]") + }; + + String.concat( + "", + [start_text, string_of_potential_typ_set(potential_typ_set), end_text], + ); + }; From afd91e836895d604413379dc5e663766f7ed5c07 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Thu, 23 Mar 2023 18:28:17 -0500 Subject: [PATCH 037/129] fill type hole is atomic action --- src/haz3lweb/Keyboard.re | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index a531e43f3b..ccd112a308 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -71,7 +71,7 @@ let handle_key_event = (k: Key.t, ~model: Model.t): list(Update.t) => { | (Down, "ArrowDown") => now(Select(Resize(Local(Down)))) | (_, "Shift") => update_double_tap(model) | (_, "Enter") => - let retrieve_string = (): option(string) => { + let suggestion_opt = { open Util.OptUtil.Syntax; let* (p, _) = Zipper.representative_piece(zipper); InferenceResult.get_recommended_string( @@ -79,15 +79,15 @@ let handle_key_event = (k: Key.t, ~model: Model.t): list(Update.t) => { Piece.id(p), ); }; - switch (retrieve_string()) { - | Some(typ_string) => + switch (suggestion_opt) { + | Some(typ_filling) => + // question marks (holes) can't be inserted manually, so filter them out let explode = s => List.init(String.length(s), i => String.make(1, s.[i])); - typ_string - |> explode - |> List.filter(s => s != "?") - |> List.map(str => now_save(Insert(str))) - |> List.flatten; + let join = List.fold_left((s, acc) => s ++ acc, ""); + let no_q_marks = + typ_filling |> explode |> List.filter(s => s != "?") |> join; + [UpdateAction.Paste(no_q_marks)]; | None => now_save(Insert(Form.linebreak)) }; | _ when Form.is_valid_char(key) && String.length(key) == 1 => From 444490b703a694b4026f82e54c5824768e7db821 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Thu, 23 Mar 2023 19:24:46 -0500 Subject: [PATCH 038/129] hole filling on click (not hover yet) --- src/haz3lcore/inference/InferenceResult.re | 6 +++--- src/haz3lcore/inference/PotentialTypeSet.re | 3 +++ src/haz3lweb/view/CursorInspector.re | 23 ++++++++++++++------- src/haz3lweb/www/style.css | 12 +++++++++++ 4 files changed, 34 insertions(+), 10 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 2b850d6d18..41c3eb5e82 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -90,7 +90,7 @@ let svg_display_settings = let get_cursor_inspect_result = (~global_inference_info: global_inference_info, id: Id.t) - : option((bool, string)) => + : option((bool, list(string))) => if (global_inference_info.enabled) { let* status = Hashtbl.find_opt(global_inference_info.solution_statuses, id); @@ -98,10 +98,10 @@ let get_cursor_inspect_result = | Unsolved(potential_typ_set) => Some(( false, - PotentialTypeSet.string_of_potential_typ_set(potential_typ_set), + PotentialTypeSet.strings_of_potential_typ_set(potential_typ_set), )) | Solved(ityp) => - Some((true, ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string)) + Some((true, [ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string])) }; } else { None; diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index 5a7386020d..996f658f5f 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -523,3 +523,6 @@ and string_of_potential_typ = (potential_typ: potential_typ) => [start_text, string_of_potential_typ_set(potential_typ_set), end_text], ); }; + +let strings_of_potential_typ_set = (potential_typ_set: t): list(string) => + List.map(string_of_potential_typ, potential_typ_set); diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 0f31c42e05..10bd20bc62 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -135,6 +135,7 @@ let term_tag = (~inject, ~show_lang_doc, is_err, sort) => { let view_of_global_inference_info = ( + ~inject, ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, id: int, ) => { @@ -147,15 +148,23 @@ let view_of_global_inference_info = | Some((true, solution)) => div( ~attr=clss([infoc, "typ"]), - [text("has inferred type "), text(solution)], + [text("has inferred type "), text(List.nth(solution, 0))], ) - | Some((false, error_message)) => + | Some((false, conflicting_typs)) => div( ~attr=clss([infoc, "typ"]), - [ - text("has conflicting constraints: "), - span_c("unsolved-cursor-inspect", [text(error_message)]), - ], + List.map( + typ => + div( + ~attr=clss(["typ-view-conflict"]), + [ + Widgets.button(text(typ), _mouse_event => + inject(Update.Paste(typ)) + ), + ], + ), + conflicting_typs, + ), ) | None => div([]) }; @@ -221,7 +230,7 @@ let view_of_info = ~attr=clss([infoc, "typ"]), [ term_tag(~inject, ~show_lang_doc, is_err, "typ"), - view_of_global_inference_info(~global_inference_info, id), + view_of_global_inference_info(~inject, ~global_inference_info, id), ], ) } diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index 754e2824c0..42dca87fbc 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -1079,6 +1079,18 @@ svg.tile-selected { gap: 0.5em; } +.typ-view-conflict { + color: var(--err-color); + user-select: none; + display: inline-block; + background-color: #edebdc; + border-radius: 2em; + cursor: pointer; + border: solid 1px #edebdc; + padding: 0em 0.1em 0em 0.1em; + box-shadow: inset 1px 1px 9px -3px rgb(4 4 4 / 8%), 1px 2px 6px -2px rgb(0 0 0 / 1%); +} + .typ-view.atom { color: var(--typ-text-color); display: flex; From 0c8f67805f04f5dc12d5bb633ba6044f39a44d06 Mon Sep 17 00:00:00 2001 From: RaefM Date: Fri, 24 Mar 2023 12:39:39 -0400 Subject: [PATCH 039/129] makes the buttons for cursorinspector suggestions hoverable to see results if it were to be accepted --- src/haz3lcore/inference/PotentialTypeSet.re | 10 ++- src/haz3lweb/view/CursorInspector.re | 98 +++++++++++++++------ src/haz3lweb/view/Widgets.re | 20 +++++ 3 files changed, 96 insertions(+), 32 deletions(-) diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index 996f658f5f..7989b81373 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -497,9 +497,9 @@ and string_of_potential_typ = (potential_typ: potential_typ) => | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => let (ctor_start, ctor_string, ctor_end) = switch (ctor) { - | CArrow => ("(", " -> ", ")") + | CArrow => ("", " -> ", "") | CProd => ("(", ", ", ")") - | CSum => ("", " + (", ")") + | CSum => ("", " + ", "") }; String.concat( @@ -520,7 +520,11 @@ and string_of_potential_typ = (potential_typ: potential_typ) => String.concat( "", - [start_text, string_of_potential_typ_set(potential_typ_set), end_text], + [ + start_text, + string_of_potential_typ_set_no_nesting(potential_typ_set), + end_text, + ], ); }; diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 10bd20bc62..d3a14f2b7d 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -133,6 +133,26 @@ let term_tag = (~inject, ~show_lang_doc, is_err, sort) => { ); }; +module State = { + type t = { + considering_suggestion: ref(bool), + last_inspector: ref(Node.t), + }; + + let init = () => { + considering_suggestion: ref(false), + last_inspector: ref(div([])), + }; + + let curr_state = init(); + + let get_considering_suggestion = () => curr_state.considering_suggestion^; + let set_considering_suggestion = v => curr_state.considering_suggestion := v; + + let get_last_inspector = () => curr_state.last_inspector^; + let set_last_inspector = v => curr_state.last_inspector := v; +}; + let view_of_global_inference_info = ( ~inject, @@ -158,8 +178,23 @@ let view_of_global_inference_info = div( ~attr=clss(["typ-view-conflict"]), [ - Widgets.button(text(typ), _mouse_event => - inject(Update.Paste(typ)) + Widgets.hoverable_button( + text(typ), + _mouse_event => { + State.set_considering_suggestion(false); + inject(Update.Mouseup); + }, + _mouse_event => { + State.set_considering_suggestion(true); + inject(Update.Paste(typ)); + }, + _mouse_event => + if (State.get_considering_suggestion()) { + State.set_considering_suggestion(false); + inject(Update.Undo); + } else { + inject(Update.Mouseup); + }, ), ], ), @@ -305,37 +340,42 @@ let view = global_inference_info: Haz3lcore.InferenceResult.global_inference_info, ) => { let backpack = zipper.backpack; - if (List.length(backpack) > 0) { - div([]); - } else { - let index = Haz3lcore.Indicated.index(zipper); + let curr_view = + if (State.get_considering_suggestion()) { + State.get_last_inspector(); + } else if (List.length(backpack) > 0) { + div([]); + } else { + let index = Haz3lcore.Indicated.index(zipper); - switch (index) { - | Some(index) => - switch (Haz3lcore.Id.Map.find_opt(index, info_map)) { - | Some(ci) => - inspector_view( - ~inject, - ~global_inference_info, - ~settings, - ~show_lang_doc, - index, - ci, - ) + switch (index) { + | Some(index) => + switch (Haz3lcore.Id.Map.find_opt(index, info_map)) { + | Some(ci) => + inspector_view( + ~inject, + ~global_inference_info, + ~settings, + ~show_lang_doc, + index, + ci, + ) + | None => + div( + ~attr=clss(["cursor-inspector"]), + [div(~attr=clss(["icon"]), [Icons.magnify]), text("")], + ) + } | None => div( ~attr=clss(["cursor-inspector"]), - [div(~attr=clss(["icon"]), [Icons.magnify]), text("")], + [ + div(~attr=clss(["icon"]), [Icons.magnify]), + text("No Indicated Index"), + ], ) - } - | None => - div( - ~attr=clss(["cursor-inspector"]), - [ - div(~attr=clss(["icon"]), [Icons.magnify]), - text("No Indicated Index"), - ], - ) + }; }; - }; + State.set_last_inspector(curr_view); + curr_view; }; diff --git a/src/haz3lweb/view/Widgets.re b/src/haz3lweb/view/Widgets.re index 483846afe2..7fca409dae 100644 --- a/src/haz3lweb/view/Widgets.re +++ b/src/haz3lweb/view/Widgets.re @@ -13,6 +13,26 @@ let button = (~tooltip="", icon, action) => [icon], ); +let hoverable_button = + ( + ~tooltip="", + icon, + on_mousedown_action, + on_mouseover_action, + on_mouseleave_action, + ) => + div( + ~attr= + Attr.many([ + clss(["icon"]), + Attr.on_mousedown(on_mousedown_action), + Attr.on_mouseover(on_mouseover_action), + Attr.on_mouseleave(on_mouseleave_action), + Attr.title(tooltip), + ]), + [icon], + ); + let button_d = (~tooltip="", icon, action, ~disabled: bool) => div( ~attr= From 5f81e86a9bca0d5175d9fbea8a3ff5b66650c6c8 Mon Sep 17 00:00:00 2001 From: RaefM Date: Fri, 24 Mar 2023 12:53:29 -0400 Subject: [PATCH 040/129] made buttons brighter on hover --- src/haz3lcore/inference/PotentialTypeSet.re | 2 +- src/haz3lweb/www/style.css | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index 7989b81373..50b8b25791 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -497,7 +497,7 @@ and string_of_potential_typ = (potential_typ: potential_typ) => | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => let (ctor_start, ctor_string, ctor_end) = switch (ctor) { - | CArrow => ("", " -> ", "") + | CArrow => ("(", " -> ", ")") | CProd => ("(", ", ", ")") | CSum => ("", " + ", "") }; diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index 42dca87fbc..fd97f5f42c 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -1091,6 +1091,10 @@ svg.tile-selected { box-shadow: inset 1px 1px 9px -3px rgb(4 4 4 / 8%), 1px 2px 6px -2px rgb(0 0 0 / 1%); } +.typ-view-conflict:hover { + background-color: #ffffff; +} + .typ-view.atom { color: var(--typ-text-color); display: flex; From 14cb043abd4079f9bdf19df321191e37ae64523a Mon Sep 17 00:00:00 2001 From: RaefM Date: Sat, 8 Apr 2023 10:22:00 -0400 Subject: [PATCH 041/129] refactor and combine certain functions --- src/haz3lcore/Measured.re | 9 ++- src/haz3lcore/inference/InferenceResult.re | 86 ++++++++++----------- src/haz3lcore/inference/PotentialTypeSet.re | 29 +++---- src/haz3lweb/Keyboard.re | 23 +++--- src/haz3lweb/view/Code.re | 60 +++++++------- src/haz3lweb/view/CursorInspector.re | 58 ++++++++++++-- src/haz3lweb/view/SchoolMode.re | 1 + src/haz3lweb/view/ScratchMode.re | 1 + src/haz3lweb/view/Widgets.re | 4 +- src/haz3lweb/view/dec/EmptyHoleDec.re | 43 ++++------- 10 files changed, 173 insertions(+), 141 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index c4ffc8034e..e3c135ed1e 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -380,14 +380,15 @@ let of_segment = | Grout(g) => let annotation_offset = switch ( - InferenceResult.get_solution_of_id( + InferenceResult.get_suggestion_for_id( g.id, global_inference_info, ) ) { - | Some(ityp) => - ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> String.length - | None => 1 + | Solvable(suggestion_string) + | NestedInconsistency(suggestion_string) => + String.length(suggestion_string) + | NoSuggestion(_) => 1 }; let last = {...origin, col: origin.col + annotation_offset}; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 41c3eb5e82..9d5e0db7dc 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -39,54 +39,54 @@ let get_desired_solutions = new_map; }; -type solution = - | Solved(ITyp.t) - | Unsolved - | NotTypeHole; - -let get_solution_of_id2 = - (id: Id.t, global_inference_info: global_inference_info): solution => - if (global_inference_info.enabled) { - let status = - Hashtbl.find_opt(global_inference_info.solution_statuses, id); - switch (status) { - | Some(Solved(ityp)) => Solved(ityp) - | Some(Unsolved(_)) => Unsolved - | None => NotTypeHole - }; - } else { - NotTypeHole; - }; - -let get_solution_of_id = - (id: Id.t, global_inference_info: global_inference_info): option(ITyp.t) => +type suggestion = + | Solvable(string) + | NestedInconsistency(string) + | NoSuggestion(reason_for_silence) +and reason_for_silence = + | SuggestionsDisabled + | NonTypeHoleId + | OnlyHoleSolutions + | InconsistentSet; + +let get_suggestion_for_id = + (id: Id.t, global_inference_info: global_inference_info): suggestion => if (global_inference_info.enabled) { - let* status = + let status_opt = Hashtbl.find_opt(global_inference_info.solution_statuses, id); - switch (status) { - | Solved(Unknown(_)) => None - | Solved(ityp) => Some(ityp) - | Unsolved(_) => None + switch (status_opt) { + | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) + | Some(Solved(ityp)) => + Solvable(ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string) + | Some(Unsolved([potential_typ])) => + NestedInconsistency( + PotentialTypeSet.string_of_potential_typ(true, potential_typ), + ) + | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) + | None => NoSuggestion(NonTypeHoleId) }; } else { - None; + NoSuggestion(SuggestionsDisabled); }; let svg_display_settings = - (~global_inference_info: global_inference_info, id: Id.t): (bool, bool) => - if (global_inference_info.enabled) { - switch (Hashtbl.find_opt(global_inference_info.solution_statuses, id)) { - | Some(status) => - switch (status) { - | Solved(Unknown(_)) => (true, false) - | Solved(_) => (false, false) - | Unsolved(_) => (true, true) - } - | None => (true, false) + (~global_inference_info: global_inference_info, id: Id.t): (bool, bool) => { + let (show_svg, is_unsolved) = + if (global_inference_info.enabled) { + switch (Hashtbl.find_opt(global_inference_info.solution_statuses, id)) { + | Some(status) => + switch (status) { + | Solved(Unknown(_)) => (true, false) + | Solved(_) => (false, false) + | Unsolved(_) => (true, true) + } + | None => (true, false) + }; + } else { + (true, false); }; - } else { - (true, false); - }; + (show_svg, is_unsolved); +}; let get_cursor_inspect_result = (~global_inference_info: global_inference_info, id: Id.t) @@ -107,12 +107,6 @@ let get_cursor_inspect_result = None; }; -let get_recommended_string = - (~global_inference_info: global_inference_info, id: Id.t): option(string) => { - let+ ityp = get_solution_of_id(id, global_inference_info); - ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string; -}; - let condense = (potential_typ_set: MutablePotentialTypeSet.t, key: ITyp.t): status => { let (potential_typ_set, err) = diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index 50b8b25791..c7346df4ca 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -477,38 +477,31 @@ let string_of_btyp = (btyp: base_typ): string => { btyp |> base_typ_to_ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string; }; -let rec string_of_potential_typ_set = (potential_typ_set: t): string => +let rec string_of_potential_typ_set_no_nesting = + (outermost, potential_typ_set: t): string => switch (potential_typ_set) { | [] => "" - | [hd] => string_of_potential_typ(hd) - | [hd, ...tl] => - let hd_str = string_of_potential_typ(hd); - String.concat(" // ", [hd_str, string_of_potential_typ_set(tl)]); - } -and string_of_potential_typ_set_no_nesting = (potential_typ_set: t): string => - switch (potential_typ_set) { - | [] => "" - | [hd] => string_of_potential_typ(hd) - | [_hd, ..._tl] => "?" + | [hd] => string_of_potential_typ(outermost, hd) + | [_hd, ..._tl] => "!" } -and string_of_potential_typ = (potential_typ: potential_typ) => +and string_of_potential_typ = (outermost: bool, potential_typ: potential_typ) => switch (potential_typ) { | Base(btyp) => string_of_btyp(btyp) | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => let (ctor_start, ctor_string, ctor_end) = switch (ctor) { - | CArrow => ("(", " -> ", ")") + | CArrow => outermost ? ("", " -> ", "") : ("(", " -> ", ")") | CProd => ("(", ", ", ")") - | CSum => ("", " + ", "") + | CSum => outermost ? ("", " + ", "") : ("(", " + ", ")") }; String.concat( "", [ ctor_start, - string_of_potential_typ_set_no_nesting(potential_typ_set_lt), + string_of_potential_typ_set_no_nesting(false, potential_typ_set_lt), ctor_string, - string_of_potential_typ_set_no_nesting(potential_typ_set_rt), + string_of_potential_typ_set_no_nesting(false, potential_typ_set_rt), ctor_end, ], ); @@ -522,11 +515,11 @@ and string_of_potential_typ = (potential_typ: potential_typ) => "", [ start_text, - string_of_potential_typ_set_no_nesting(potential_typ_set), + string_of_potential_typ_set_no_nesting(false, potential_typ_set), end_text, ], ); }; let strings_of_potential_typ_set = (potential_typ_set: t): list(string) => - List.map(string_of_potential_typ, potential_typ_set); + List.map(string_of_potential_typ(true), potential_typ_set); diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index ccd112a308..38763dbd81 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -1,4 +1,5 @@ open Haz3lcore; +open Util; let is_printable = s => Re.Str.(string_match(regexp("^[ -~]$"), s, 0)); let is_digit = s => Re.Str.(string_match(regexp("^[0-9]$"), s, 0)); @@ -73,22 +74,24 @@ let handle_key_event = (k: Key.t, ~model: Model.t): list(Update.t) => { | (_, "Enter") => let suggestion_opt = { open Util.OptUtil.Syntax; - let* (p, _) = Zipper.representative_piece(zipper); - InferenceResult.get_recommended_string( - ~global_inference_info, + let+ (p, _) = Zipper.representative_piece(zipper); + InferenceResult.get_suggestion_for_id( Piece.id(p), + global_inference_info, ); }; switch (suggestion_opt) { - | Some(typ_filling) => + | Some(Solvable(typ_filling)) + | Some(NestedInconsistency(typ_filling)) => // question marks (holes) can't be inserted manually, so filter them out - let explode = s => - List.init(String.length(s), i => String.make(1, s.[i])); let join = List.fold_left((s, acc) => s ++ acc, ""); - let no_q_marks = - typ_filling |> explode |> List.filter(s => s != "?") |> join; - [UpdateAction.Paste(no_q_marks)]; - | None => now_save(Insert(Form.linebreak)) + let no_hole_marks = + typ_filling + |> StringUtil.to_list + |> List.filter(s => s != "?" && s != "!") + |> join; + [UpdateAction.Paste(no_hole_marks)]; + | _ => now_save(Insert(Form.linebreak)) }; | _ when Form.is_valid_char(key) && String.length(key) == 1 => /* TODO(andrew): length==1 is hack to prevent things diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 2ee9c3ee76..afda974995 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -30,25 +30,23 @@ let of_delim = (sort: Sort.t, is_consistent, t: Piece.tile, i: int): list(Node.t) => of_delim'((sort, is_consistent, Tile.is_complete(t), t.label, i)); -// let of_grout = (id: Id.t) => [ -// id -// |> InferenceResult.get_annotation_of_id -// |> OptUtil.get(() => Unicode.nbsp) -// |> Node.text, -// ]; - let of_grout = (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) => { - let solution: InferenceResult.solution = - InferenceResult.get_solution_of_id2(id, global_inference_info); - switch (solution) { - | Solved(Unknown(_)) - | NotTypeHole => [Node.text(Unicode.nbsp)] - | Solved(ityp) => [ - [ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string |> Node.text] - |> span_c("solved-annotation"), + let suggestion: InferenceResult.suggestion = + InferenceResult.get_suggestion_for_id(id, global_inference_info); + switch (suggestion) { + | NoSuggestion(SuggestionsDisabled) + | NoSuggestion(NonTypeHoleId) + | NoSuggestion(OnlyHoleSolutions) => [Node.text(Unicode.nbsp)] + | Solvable(suggestion_string) => [ + [Node.text(suggestion_string)] |> span_c("solved-annotation"), + ] + | NestedInconsistency(suggestion_string) => [ + [Node.text(suggestion_string)] |> span_c("unsolved-annotation"), + ] + | NoSuggestion(InconsistentSet) => [ + [Node.text("!")] |> span_c("unsolved-annotation"), ] - | Unsolved => [["!" |> Node.text] |> span_c("unsolved-annotation")] }; }; @@ -151,17 +149,25 @@ let rec holes = holes(~global_inference_info, ~map, ~font_metrics), t.children, ) - | Grout(g) => [ - EmptyHoleDec.view( - ~global_inference_info, - ~font_metrics, // TODO(d) fix sort - g.id, - { - measurement: Measured.find_g(g, map), - mold: Mold.of_grout(g, Any), - }, - ), - ], + | Grout(g) => { + let (show_dec, is_unsolved) = + InferenceResult.svg_display_settings( + ~global_inference_info, + g.id, + ); + show_dec + ? [ + EmptyHoleDec.view( + ~font_metrics, // TODO(d) fix sort + is_unsolved, + { + measurement: Measured.find_g(g, map), + mold: Mold.of_grout(g, Any), + }, + ), + ] + : []; + }, ); let simple_view = diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index d3a14f2b7d..958a84f7ff 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -156,9 +156,37 @@ module State = { let view_of_global_inference_info = ( ~inject, + ~font_metrics, ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, id: int, ) => { + let text_with_holes = (text_string: string): list(t) => { + let is_hole_delimeter = (char) => char == "!" || char == "?"; + let acc_node_chunks = (acc: list((bool, string)), next_letter: string): list((bool, string)) => { + switch (acc) { + | [] => [(is_hole_delimeter(next_letter), next_letter)] + | [(false, str), ...tl] => [(false, str ++ next_letter), ...tl] + | [hd, ...tl] => [(is_hole_delimeter(next_letter), next_letter), hd, ...tl] + } + } + let chunks_to_node_list = (acc: list(t), next_chunk: (bool, string)): list(t) => { + let (is_hole_chunk, chunk_text) = next_chunk; + if (is_hole_chunk) { + if (chunk_text == "?") { + [EmptyHoleDec.view(~font_metrics, false, ?), ...acc] + } else { + [EmptyHoleDec.view(~font_metrics, true, ?), ...acc] + } + } else { + [text(chunk_text), ...acc] + } + } + text_string + |> StringUtil.to_list + |> List.fold_left(acc_node_chunks, []) + |> List.fold_left(chunks_to_node_list, []) + |> List.rev + } switch ( Haz3lcore.InferenceResult.get_cursor_inspect_result( ~global_inference_info, @@ -168,9 +196,16 @@ let view_of_global_inference_info = | Some((true, solution)) => div( ~attr=clss([infoc, "typ"]), - [text("has inferred type "), text(List.nth(solution, 0))], + [text("has inferred type "), ...text_with_holes(List.nth(solution, 0))], ) + | Some((false, [typ_with_nested_conflict])) => + print_endline("in the single case"); + div( + ~attr=clss([infoc, "typ-view-conflict"]), + text_with_holes(typ_with_nested_conflict), + ); | Some((false, conflicting_typs)) => + List.iter(print_endline, conflicting_typs); div( ~attr=clss([infoc, "typ"]), List.map( @@ -179,7 +214,7 @@ let view_of_global_inference_info = ~attr=clss(["typ-view-conflict"]), [ Widgets.hoverable_button( - text(typ), + text_with_holes(typ), _mouse_event => { State.set_considering_suggestion(false); inject(Update.Mouseup); @@ -200,7 +235,7 @@ let view_of_global_inference_info = ), conflicting_typs, ), - ) + ); | None => div([]) }; }; @@ -208,6 +243,7 @@ let view_of_global_inference_info = let view_of_info = ( ~inject, + ~font_metrics, ~show_lang_doc: bool, ~global_inference_info, id: int, @@ -249,9 +285,14 @@ let view_of_info = ) | InfoTyp({self: Just(ty), _}) => switch ( - Haz3lcore.InferenceResult.get_solution_of_id2(id, global_inference_info) + Haz3lcore.InferenceResult.get_suggestion_for_id( + id, + global_inference_info, + ) ) { - | NotTypeHole => + | NoSuggestion(SuggestionsDisabled) + | NoSuggestion(NonTypeHoleId) + | NoSuggestion(OnlyHoleSolutions) => div( ~attr=clss([infoc, "typ"]), [ @@ -265,7 +306,7 @@ let view_of_info = ~attr=clss([infoc, "typ"]), [ term_tag(~inject, ~show_lang_doc, is_err, "typ"), - view_of_global_inference_info(~inject, ~global_inference_info, id), + view_of_global_inference_info(~inject, ~font_metrics, ~global_inference_info, id), ], ) } @@ -307,6 +348,7 @@ let toggle_context_and_print_ci = (~inject: Update.t => 'a, ci, _) => { let inspector_view = ( ~inject, + ~font_metrics, ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, ~settings: ModelSettings.t, ~show_lang_doc: bool, @@ -325,7 +367,7 @@ let inspector_view = ]), [ extra_view(settings.context_inspector, id, ci), - view_of_info(~inject, ~show_lang_doc, ~global_inference_info, id, ci), + view_of_info(~inject, ~font_metrics, ~show_lang_doc, ~global_inference_info, id, ci), CtxInspector.inspector_view(~inject, ~settings, id, ci), ], ); @@ -334,6 +376,7 @@ let view = ( ~inject, ~settings, + ~font_metrics, ~show_lang_doc: bool, zipper: Haz3lcore.Zipper.t, info_map: Haz3lcore.Statics.map, @@ -354,6 +397,7 @@ let view = | Some(ci) => inspector_view( ~inject, + ~font_metrics, ~global_inference_info, ~settings, ~show_lang_doc, diff --git a/src/haz3lweb/view/SchoolMode.re b/src/haz3lweb/view/SchoolMode.re index ab44f3ed70..a9275e1b58 100644 --- a/src/haz3lweb/view/SchoolMode.re +++ b/src/haz3lweb/view/SchoolMode.re @@ -348,6 +348,7 @@ let view = CursorInspector.view( ~inject, ~settings, + ~font_metrics, ~show_lang_doc=langDocMessages.show, focal_zipper, focal_info_map, diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 314c3ded7c..e44080cd9b 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -64,6 +64,7 @@ let view = CursorInspector.view( ~inject, ~settings, + ~font_metrics, ~show_lang_doc=langDocMessages.show, zipper, info_map, diff --git a/src/haz3lweb/view/Widgets.re b/src/haz3lweb/view/Widgets.re index 7fca409dae..5bb5eac14c 100644 --- a/src/haz3lweb/view/Widgets.re +++ b/src/haz3lweb/view/Widgets.re @@ -16,7 +16,7 @@ let button = (~tooltip="", icon, action) => let hoverable_button = ( ~tooltip="", - icon, + icon: list(t), on_mousedown_action, on_mouseover_action, on_mouseleave_action, @@ -30,7 +30,7 @@ let hoverable_button = Attr.on_mouseleave(on_mouseleave_action), Attr.title(tooltip), ]), - [icon], + icon, ); let button_d = (~tooltip="", icon, action, ~disabled: bool) => diff --git a/src/haz3lweb/view/dec/EmptyHoleDec.re b/src/haz3lweb/view/dec/EmptyHoleDec.re index b58b65e9d4..a06d0385da 100644 --- a/src/haz3lweb/view/dec/EmptyHoleDec.re +++ b/src/haz3lweb/view/dec/EmptyHoleDec.re @@ -25,12 +25,7 @@ let path = (tip_l, tip_r, offset, s: float) => { }; let view = - ( - ~global_inference_info: InferenceResult.global_inference_info, - ~font_metrics, - id, - {measurement, mold}: Profile.t, - ) + (~font_metrics, is_unsolved: bool, {measurement, mold}: Profile.t) : Node.t => { let sort = mold.out; let c_cls = Sort.to_string(sort); @@ -40,25 +35,19 @@ let view = {sort, shape: tip_l}, {sort, shape: tip_r}, ); - let (svg_enabled, unsolved_path_class) = - InferenceResult.svg_display_settings(~global_inference_info, id); - let svg_path_class = - unsolved_path_class ? "unsolved-empty-hole-path" : "empty-hole-path"; - svg_enabled - ? unsolved_path_class - ? DecUtil.code_svg_sized( - ~font_metrics, - ~measurement, - ~base_cls=["empty-hole"], - ~path_cls=[svg_path_class, c_cls], - path(tip_l, tip_r, 0., 0.58), - ) - : DecUtil.code_svg_sized( - ~font_metrics, - ~measurement, - ~base_cls=["empty-hole"], - ~path_cls=[svg_path_class, c_cls], - path(tip_l, tip_r, 0., 0.28), - ) - : Node.none; + is_unsolved + ? DecUtil.code_svg_sized( + ~font_metrics, + ~measurement, + ~base_cls=["empty-hole"], + ~path_cls=["unsolved-empty-hole-path", c_cls], + path(tip_l, tip_r, 0., 0.58), + ) + : DecUtil.code_svg_sized( + ~font_metrics, + ~measurement, + ~base_cls=["empty-hole"], + ~path_cls=["empty-hole-path", c_cls], + path(tip_l, tip_r, 0., 0.28), + ); }; From b4dbdf7bec8f1727bf311ce3c0e6b7c1fb207364 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sat, 8 Apr 2023 10:55:48 -0400 Subject: [PATCH 042/129] wip --- src/haz3lweb/view/dec/DecUtil.re | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/src/haz3lweb/view/dec/DecUtil.re b/src/haz3lweb/view/dec/DecUtil.re index 593ea6336a..710dd23aad 100644 --- a/src/haz3lweb/view/dec/DecUtil.re +++ b/src/haz3lweb/view/dec/DecUtil.re @@ -70,6 +70,35 @@ let code_svg_sized = ) => { let (left, top) = (origin.col, origin.row); let (width, height) = (last.col - origin.col, last.row - origin.row + 1); + print_endline(string_of_int(width)); + print_endline(string_of_int(height)); + let style = pos_str(~d={left, top, width, height}, ~fudge, font_metrics); + create_svg( + "svg", + ~attr= + Attr.many([ + Attr.classes(base_cls), + Attr.create("style", style), + Attr.create("viewBox", Printf.sprintf("0 0 %d %d", width, height)), + Attr.create("preserveAspectRatio", "none"), + ]), + [SvgUtil.Path.view(~attrs=[Attr.classes(path_cls)], paths)], + ); +}; + +let code_svg_sized2 = + ( + ~font_metrics: FontMetrics.t, + ~measurement as {origin, last}: Haz3lcore.Measured.measurement, + ~base_cls=[], + ~path_cls=[], + ~fudge: fdims=fzero, + paths: list(SvgUtil.Path.cmd), + ) => { + let (left, top) = (origin.col, origin.row); + let (width, height) = (last.col - origin.col, last.row - origin.row + 1); + print_endline(string_of_int(width)); + print_endline(string_of_int(height)); let style = pos_str(~d={left, top, width, height}, ~fudge, font_metrics); create_svg( "svg", From c471ad62bdd72f55694b7134005e8c359d9e9374 Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 11 May 2023 22:20:06 -0400 Subject: [PATCH 043/129] refactor inference results code to be more consistent --- src/haz3lcore/inference/InferenceResult.re | 20 +-- src/haz3lweb/view/CursorInspector.re | 162 +++++++++++++++------ src/haz3lweb/view/SchoolMode.re | 2 +- src/haz3lweb/view/ScratchMode.re | 2 +- src/haz3lweb/view/dec/DecUtil.re | 18 ++- src/haz3lweb/view/dec/EmptyHoleDec.re | 4 +- 6 files changed, 141 insertions(+), 67 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 9d5e0db7dc..3a426c8067 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -71,19 +71,15 @@ let get_suggestion_for_id = let svg_display_settings = (~global_inference_info: global_inference_info, id: Id.t): (bool, bool) => { + // Determines if a hexagon (svg) should be used to represent a type hole, and if so, how it should look let (show_svg, is_unsolved) = - if (global_inference_info.enabled) { - switch (Hashtbl.find_opt(global_inference_info.solution_statuses, id)) { - | Some(status) => - switch (status) { - | Solved(Unknown(_)) => (true, false) - | Solved(_) => (false, false) - | Unsolved(_) => (true, true) - } - | None => (true, false) - }; - } else { - (true, false); + switch (get_suggestion_for_id(id, global_inference_info)) { + | Solvable(_) => (false, false) + | NestedInconsistency(_) => (false, true) + | NoSuggestion(SuggestionsDisabled) + | NoSuggestion(OnlyHoleSolutions) => (true, false) + | NoSuggestion(NonTypeHoleId) => (false, false) + | NoSuggestion(InconsistentSet) => (true, true) }; (show_svg, is_unsolved); }; diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 958a84f7ff..e698ad348a 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -153,40 +153,109 @@ module State = { let set_last_inspector = v => curr_state.last_inspector := v; }; +// let view_of_global_inference_info = +// ( +// ~inject, +// ~font_metrics, +// ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, +// id: int, +// ) => { +// let text_with_holes = (text_string: string): list(t) => { +// let is_hole_delimeter = char => char == "!" || char == "?"; +// let acc_node_chunks = +// (acc: list((bool, string)), next_letter: string) +// : list((bool, string)) => { +// switch (acc) { +// | [] => [(is_hole_delimeter(next_letter), next_letter)] +// | [(false, str), ...tl] => [(false, str ++ next_letter), ...tl] +// | [hd, ...tl] => [ +// (is_hole_delimeter(next_letter), next_letter), +// hd, +// ...tl, +// ] +// }; +// }; +// let chunks_to_node_list = +// (acc: list(t), next_chunk: (bool, string)): list(t) => { +// let (is_hole_chunk, chunk_text) = next_chunk; +// if (is_hole_chunk) { +// if (chunk_text == "?") { +// [EmptyHoleDec.view(~font_metrics, false), ...acc]; +// } else { +// [EmptyHoleDec.view(~font_metrics, true), ...acc]; +// }; +// } else { +// [text(chunk_text), ...acc]; +// }; +// }; +// text_string +// |> StringUtil.to_list +// |> List.fold_left(acc_node_chunks, []) +// |> List.fold_left(chunks_to_node_list, []) +// |> List.rev; +// }; +// switch ( +// Haz3lcore.InferenceResult.get_cursor_inspect_result( +// ~global_inference_info, +// id, +// ) +// ) { +// | Some((true, solution)) => +// div( +// ~attr=clss([infoc, "typ"]), +// [ +// text("has inferred type "), +// ...text_with_holes(List.nth(solution, 0)), +// ], +// ) +// | Some((false, [typ_with_nested_conflict])) => +// print_endline("in the single case"); +// div( +// ~attr=clss([infoc, "typ-view-conflict"]), +// text_with_holes(typ_with_nested_conflict), +// ); +// | Some((false, conflicting_typs)) => +// List.iter(print_endline, conflicting_typs); +// div( +// ~attr=clss([infoc, "typ"]), +// List.map( +// typ => +// div( +// ~attr=clss(["typ-view-conflict"]), +// [ +// Widgets.hoverable_button( +// text_with_holes(typ), +// _mouse_event => { +// State.set_considering_suggestion(false); +// inject(Update.Mouseup); +// }, +// _mouse_event => { +// State.set_considering_suggestion(true); +// inject(Update.Paste(typ)); +// }, +// _mouse_event => +// if (State.get_considering_suggestion()) { +// State.set_considering_suggestion(false); +// inject(Update.Undo); +// } else { +// inject(Update.Mouseup); +// }, +// ), +// ], +// ), +// conflicting_typs, +// ), +// ); +// | None => div([]) +// }; +// }; + let view_of_global_inference_info = ( ~inject, - ~font_metrics, ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, id: int, ) => { - let text_with_holes = (text_string: string): list(t) => { - let is_hole_delimeter = (char) => char == "!" || char == "?"; - let acc_node_chunks = (acc: list((bool, string)), next_letter: string): list((bool, string)) => { - switch (acc) { - | [] => [(is_hole_delimeter(next_letter), next_letter)] - | [(false, str), ...tl] => [(false, str ++ next_letter), ...tl] - | [hd, ...tl] => [(is_hole_delimeter(next_letter), next_letter), hd, ...tl] - } - } - let chunks_to_node_list = (acc: list(t), next_chunk: (bool, string)): list(t) => { - let (is_hole_chunk, chunk_text) = next_chunk; - if (is_hole_chunk) { - if (chunk_text == "?") { - [EmptyHoleDec.view(~font_metrics, false, ?), ...acc] - } else { - [EmptyHoleDec.view(~font_metrics, true, ?), ...acc] - } - } else { - [text(chunk_text), ...acc] - } - } - text_string - |> StringUtil.to_list - |> List.fold_left(acc_node_chunks, []) - |> List.fold_left(chunks_to_node_list, []) - |> List.rev - } switch ( Haz3lcore.InferenceResult.get_cursor_inspect_result( ~global_inference_info, @@ -196,16 +265,9 @@ let view_of_global_inference_info = | Some((true, solution)) => div( ~attr=clss([infoc, "typ"]), - [text("has inferred type "), ...text_with_holes(List.nth(solution, 0))], + [text("has inferred type "), text(List.nth(solution, 0))], ) - | Some((false, [typ_with_nested_conflict])) => - print_endline("in the single case"); - div( - ~attr=clss([infoc, "typ-view-conflict"]), - text_with_holes(typ_with_nested_conflict), - ); | Some((false, conflicting_typs)) => - List.iter(print_endline, conflicting_typs); div( ~attr=clss([infoc, "typ"]), List.map( @@ -214,7 +276,7 @@ let view_of_global_inference_info = ~attr=clss(["typ-view-conflict"]), [ Widgets.hoverable_button( - text_with_holes(typ), + [text(typ)], _mouse_event => { State.set_considering_suggestion(false); inject(Update.Mouseup); @@ -235,7 +297,7 @@ let view_of_global_inference_info = ), conflicting_typs, ), - ); + ) | None => div([]) }; }; @@ -243,7 +305,7 @@ let view_of_global_inference_info = let view_of_info = ( ~inject, - ~font_metrics, + // ~font_metrics, ~show_lang_doc: bool, ~global_inference_info, id: int, @@ -306,7 +368,12 @@ let view_of_info = ~attr=clss([infoc, "typ"]), [ term_tag(~inject, ~show_lang_doc, is_err, "typ"), - view_of_global_inference_info(~inject, ~font_metrics, ~global_inference_info, id), + view_of_global_inference_info( + ~inject, + // ~font_metrics, + ~global_inference_info, + id, + ), ], ) } @@ -348,7 +415,7 @@ let toggle_context_and_print_ci = (~inject: Update.t => 'a, ci, _) => { let inspector_view = ( ~inject, - ~font_metrics, + // ~font_metrics, ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, ~settings: ModelSettings.t, ~show_lang_doc: bool, @@ -367,7 +434,14 @@ let inspector_view = ]), [ extra_view(settings.context_inspector, id, ci), - view_of_info(~inject, ~font_metrics, ~show_lang_doc, ~global_inference_info, id, ci), + view_of_info( + ~inject, + // ~font_metrics, + ~show_lang_doc, + ~global_inference_info, + id, + ci, + ), CtxInspector.inspector_view(~inject, ~settings, id, ci), ], ); @@ -376,7 +450,7 @@ let view = ( ~inject, ~settings, - ~font_metrics, + // ~font_metrics, ~show_lang_doc: bool, zipper: Haz3lcore.Zipper.t, info_map: Haz3lcore.Statics.map, @@ -397,7 +471,7 @@ let view = | Some(ci) => inspector_view( ~inject, - ~font_metrics, + // ~font_metrics, ~global_inference_info, ~settings, ~show_lang_doc, diff --git a/src/haz3lweb/view/SchoolMode.re b/src/haz3lweb/view/SchoolMode.re index a9275e1b58..b983937f13 100644 --- a/src/haz3lweb/view/SchoolMode.re +++ b/src/haz3lweb/view/SchoolMode.re @@ -348,7 +348,7 @@ let view = CursorInspector.view( ~inject, ~settings, - ~font_metrics, + // ~font_metrics, ~show_lang_doc=langDocMessages.show, focal_zipper, focal_info_map, diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index e44080cd9b..108e34aca0 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -64,7 +64,7 @@ let view = CursorInspector.view( ~inject, ~settings, - ~font_metrics, + // ~font_metrics, ~show_lang_doc=langDocMessages.show, zipper, info_map, diff --git a/src/haz3lweb/view/dec/DecUtil.re b/src/haz3lweb/view/dec/DecUtil.re index 710dd23aad..20e2c9dc1b 100644 --- a/src/haz3lweb/view/dec/DecUtil.re +++ b/src/haz3lweb/view/dec/DecUtil.re @@ -59,6 +59,14 @@ let pos_str = (~d: dims, ~fudge: fdims=fzero, font_metrics: FontMetrics.t) => Float.of_int(d.height) *. (font_metrics.row_height +. fudge.height), ); +let pos_str_relative = + (~width, ~height, ~fudge: fdims=fzero, font_metrics: FontMetrics.t) => + Printf.sprintf( + "position: relative; width: %fpx; height: %fpx;", + Float.of_int(width) *. (font_metrics.col_width +. fudge.width), + Float.of_int(height) *. (font_metrics.row_height +. fudge.height), + ); + let code_svg_sized = ( ~font_metrics: FontMetrics.t, @@ -86,20 +94,16 @@ let code_svg_sized = ); }; -let code_svg_sized2 = +let code_svg_sized_relative = ( ~font_metrics: FontMetrics.t, - ~measurement as {origin, last}: Haz3lcore.Measured.measurement, ~base_cls=[], ~path_cls=[], ~fudge: fdims=fzero, paths: list(SvgUtil.Path.cmd), ) => { - let (left, top) = (origin.col, origin.row); - let (width, height) = (last.col - origin.col, last.row - origin.row + 1); - print_endline(string_of_int(width)); - print_endline(string_of_int(height)); - let style = pos_str(~d={left, top, width, height}, ~fudge, font_metrics); + let (width, height) = (1, 1); + let style = pos_str_relative(~width, ~height, ~fudge, font_metrics); create_svg( "svg", ~attr= diff --git a/src/haz3lweb/view/dec/EmptyHoleDec.re b/src/haz3lweb/view/dec/EmptyHoleDec.re index a06d0385da..962b506381 100644 --- a/src/haz3lweb/view/dec/EmptyHoleDec.re +++ b/src/haz3lweb/view/dec/EmptyHoleDec.re @@ -25,8 +25,7 @@ let path = (tip_l, tip_r, offset, s: float) => { }; let view = - (~font_metrics, is_unsolved: bool, {measurement, mold}: Profile.t) - : Node.t => { + (~font_metrics, is_unsolved, {measurement, mold}: Profile.t): Node.t => { let sort = mold.out; let c_cls = Sort.to_string(sort); let (tip_l, tip_r): (Haz3lcore.Nib.Shape.t, Haz3lcore.Nib.Shape.t) = @@ -35,6 +34,7 @@ let view = {sort, shape: tip_l}, {sort, shape: tip_r}, ); + is_unsolved ? DecUtil.code_svg_sized( ~font_metrics, From db487be04806967f790fb673e11688652d871b1a Mon Sep 17 00:00:00 2001 From: RaefM Date: Mon, 22 May 2023 12:01:20 +0530 Subject: [PATCH 044/129] CI hexagons looking good- grout suggestions being funky with lines and coloration but hexagons appearing --- src/haz3lcore/Measured.re | 9 +- src/haz3lcore/inference/InferenceResult.re | 92 +++++--------- src/haz3lcore/inference/PotentialTypeSet.re | 38 ++++++ src/haz3lcore/inference/SuggestionTyp.re | 1 + src/haz3lweb/Keyboard.re | 2 +- src/haz3lweb/view/BackpackView.re | 9 +- src/haz3lweb/view/Code.re | 70 +++++++---- src/haz3lweb/view/CursorInspector.re | 131 +++----------------- src/haz3lweb/view/InferenceView.re | 71 +++++++++++ src/haz3lweb/view/LangDoc.re | 10 +- src/haz3lweb/view/SchoolMode.re | 2 +- src/haz3lweb/view/ScratchMode.re | 2 +- src/haz3lweb/view/Type.re | 121 ++++++++++++++++-- src/haz3lweb/view/dec/DecUtil.re | 3 +- src/haz3lweb/view/dec/EmptyHoleDec.re | 25 ++++ 15 files changed, 367 insertions(+), 219 deletions(-) create mode 100644 src/haz3lcore/inference/SuggestionTyp.re create mode 100644 src/haz3lweb/view/InferenceView.re diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index e3c135ed1e..526ca3f397 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -380,14 +380,19 @@ let of_segment = | Grout(g) => let annotation_offset = switch ( - InferenceResult.get_suggestion_for_id( + InferenceResult.get_suggestion_text_for_id( g.id, global_inference_info, ) ) { | Solvable(suggestion_string) | NestedInconsistency(suggestion_string) => - String.length(suggestion_string) + print_endline("Suggestions: "); + print_endline(suggestion_string); + print_endline( + suggestion_string |> String.length |> string_of_int, + ); + String.length(suggestion_string); | NoSuggestion(_) => 1 }; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 3a426c8067..d97c9e3332 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -1,5 +1,3 @@ -open Util.OptUtil.Syntax; - type status = | Solved(ITyp.t) | Unsolved(PotentialTypeSet.t); @@ -13,35 +11,9 @@ type global_inference_info = { solution_statuses: type_hole_to_solution, }; -let empty_solutions = (): type_hole_to_solution => Hashtbl.create(20); - -let mk_global_inference_info = (enabled, annotations) => { - {enabled, solution_statuses: annotations}; -}; - -let empty_info = (): global_inference_info => - mk_global_inference_info(true, empty_solutions()); - -let get_desired_solutions = - (inference_results: list(t)): type_hole_to_solution => { - let id_and_status_if_type_hole = (result: t): option((Id.t, status)) => { - switch (result) { - | (Unknown(TypeHole(id)), status) => Some((id, status)) - | _ => None - }; - }; - - let elts = List.filter_map(id_and_status_if_type_hole, inference_results); - let new_map = Hashtbl.create(List.length(elts)); - - List.iter(((id, annot)) => Hashtbl.add(new_map, id, annot), elts); - - new_map; -}; - -type suggestion = - | Solvable(string) - | NestedInconsistency(string) +type suggestion('a) = + | Solvable('a) + | NestedInconsistency('a) | NoSuggestion(reason_for_silence) and reason_for_silence = | SuggestionsDisabled @@ -49,8 +21,9 @@ and reason_for_silence = | OnlyHoleSolutions | InconsistentSet; -let get_suggestion_for_id = - (id: Id.t, global_inference_info: global_inference_info): suggestion => +let get_suggestion_text_for_id = + (id: Id.t, global_inference_info: global_inference_info) + : suggestion(string) => if (global_inference_info.enabled) { let status_opt = Hashtbl.find_opt(global_inference_info.solution_statuses, id); @@ -69,40 +42,35 @@ let get_suggestion_for_id = NoSuggestion(SuggestionsDisabled); }; -let svg_display_settings = - (~global_inference_info: global_inference_info, id: Id.t): (bool, bool) => { - // Determines if a hexagon (svg) should be used to represent a type hole, and if so, how it should look - let (show_svg, is_unsolved) = - switch (get_suggestion_for_id(id, global_inference_info)) { - | Solvable(_) => (false, false) - | NestedInconsistency(_) => (false, true) - | NoSuggestion(SuggestionsDisabled) - | NoSuggestion(OnlyHoleSolutions) => (true, false) - | NoSuggestion(NonTypeHoleId) => (false, false) - | NoSuggestion(InconsistentSet) => (true, true) - }; - (show_svg, is_unsolved); +let hole_nib: Nib.t = {shape: Convex, sort: Any}; +let hole_mold: Mold.t = {out: Any, in_: [], nibs: (hole_nib, hole_nib)}; + +let empty_solutions = (): type_hole_to_solution => Hashtbl.create(20); + +let mk_global_inference_info = (enabled, annotations) => { + {enabled, solution_statuses: annotations}; }; -let get_cursor_inspect_result = - (~global_inference_info: global_inference_info, id: Id.t) - : option((bool, list(string))) => - if (global_inference_info.enabled) { - let* status = - Hashtbl.find_opt(global_inference_info.solution_statuses, id); - switch (status) { - | Unsolved(potential_typ_set) => - Some(( - false, - PotentialTypeSet.strings_of_potential_typ_set(potential_typ_set), - )) - | Solved(ityp) => - Some((true, [ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string])) +let empty_info = (): global_inference_info => + mk_global_inference_info(true, empty_solutions()); + +let get_desired_solutions = + (inference_results: list(t)): type_hole_to_solution => { + let id_and_status_if_type_hole = (result: t): option((Id.t, status)) => { + switch (result) { + | (Unknown(TypeHole(id)), status) => Some((id, status)) + | _ => None }; - } else { - None; }; + let elts = List.filter_map(id_and_status_if_type_hole, inference_results); + let new_map = Hashtbl.create(List.length(elts)); + + List.iter(((id, annot)) => Hashtbl.add(new_map, id, annot), elts); + + new_map; +}; + let condense = (potential_typ_set: MutablePotentialTypeSet.t, key: ITyp.t): status => { let (potential_typ_set, err) = diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index c7346df4ca..8235a75456 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -477,6 +477,44 @@ let string_of_btyp = (btyp: base_typ): string => { btyp |> base_typ_to_ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string; }; +let rec potential_typ_set_to_ityp_unroll = (id: Id.t, pts: t): list(ITyp.t) => { + switch (pts) { + // TODO: raef and anand: fix this to distinguish between solved and unsolved holes + | [] => [ITyp.Unknown(Internal(id))] + | [hd] => [potential_typ_to_ityp(id, hd)] + | _ => List.map(potential_typ_to_ityp(id), pts) + }; +} +and potential_typ_set_to_ityp_no_unroll = (id: Id.t, pts: t): ITyp.t => { + switch (pts) { + // TODO: raef and anand: fix this to distinguish between solved and unsolved holes + | [] => ITyp.Unknown(Anonymous) + | [hd] => potential_typ_to_ityp(id, hd) + | _ => ITyp.Unknown(Anonymous) + }; +} +and potential_typ_to_ityp = (id: Id.t, ptyp: potential_typ): ITyp.t => { + switch (ptyp) { + | Base(btyp) => base_typ_to_ityp(btyp) + | Unary(CList, t) => ITyp.List(potential_typ_set_to_ityp_no_unroll(id, t)) + | Binary(CArrow, t1, t2) => + ITyp.Arrow( + potential_typ_set_to_ityp_no_unroll(id, t1), + potential_typ_set_to_ityp_no_unroll(id, t2), + ) + | Binary(CProd, t1, t2) => + ITyp.Prod( + potential_typ_set_to_ityp_no_unroll(id, t1), + potential_typ_set_to_ityp_no_unroll(id, t2), + ) + | Binary(CSum, t1, t2) => + ITyp.Sum( + potential_typ_set_to_ityp_no_unroll(id, t1), + potential_typ_set_to_ityp_no_unroll(id, t2), + ) + }; +}; + let rec string_of_potential_typ_set_no_nesting = (outermost, potential_typ_set: t): string => switch (potential_typ_set) { diff --git a/src/haz3lcore/inference/SuggestionTyp.re b/src/haz3lcore/inference/SuggestionTyp.re new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/src/haz3lcore/inference/SuggestionTyp.re @@ -0,0 +1 @@ + diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 38763dbd81..f712b8d999 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -75,7 +75,7 @@ let handle_key_event = (k: Key.t, ~model: Model.t): list(Update.t) => { let suggestion_opt = { open Util.OptUtil.Syntax; let+ (p, _) = Zipper.representative_piece(zipper); - InferenceResult.get_suggestion_for_id( + InferenceResult.get_suggestion_text_for_id( Piece.id(p), global_inference_info, ); diff --git a/src/haz3lweb/view/BackpackView.re b/src/haz3lweb/view/BackpackView.re index 3fd3d5c9ba..c812ea6984 100644 --- a/src/haz3lweb/view/BackpackView.re +++ b/src/haz3lweb/view/BackpackView.re @@ -4,6 +4,7 @@ open Haz3lcore; let backpack_sel_view = ( + ~font_metrics, ~global_inference_info: InferenceResult.global_inference_info, x_off: float, y_off: float, @@ -34,7 +35,12 @@ let backpack_sel_view = ), ]), // zwsp necessary for containing box to stretch to contain trailing newline - Text.of_segment(~no_sorts=true, ~global_inference_info, content) + Text.of_segment( + ~no_sorts=true, + ~font_metrics, + ~global_inference_info, + content, + ) @ [text(Unicode.zwsp)], ); }; @@ -101,6 +107,7 @@ let view = let new_y_offset = y_offset -. dy_fn(idx, base_height); let v = backpack_sel_view( + ~font_metrics, ~global_inference_info, x_offset, new_y_offset, diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index afda974995..93b925f8db 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -31,18 +31,25 @@ let of_delim = of_delim'((sort, is_consistent, Tile.is_complete(t), t.label, i)); let of_grout = - (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) => { - let suggestion: InferenceResult.suggestion = - InferenceResult.get_suggestion_for_id(id, global_inference_info); + ( + ~font_metrics, + ~global_inference_info: InferenceResult.global_inference_info, + id: Id.t, + ) => { + let suggestion: InferenceResult.suggestion(Node.t) = + InferenceView.get_suggestion_ui_for_id( + ~font_metrics, + id, + global_inference_info, + false, + ); switch (suggestion) { | NoSuggestion(SuggestionsDisabled) | NoSuggestion(NonTypeHoleId) | NoSuggestion(OnlyHoleSolutions) => [Node.text(Unicode.nbsp)] - | Solvable(suggestion_string) => [ - [Node.text(suggestion_string)] |> span_c("solved-annotation"), - ] - | NestedInconsistency(suggestion_string) => [ - [Node.text(suggestion_string)] |> span_c("unsolved-annotation"), + | Solvable(suggestion_node) + | NestedInconsistency(suggestion_node) => [ + [suggestion_node] |> span_c("solved-annotation"), ] | NoSuggestion(InconsistentSet) => [ [Node.text("!")] |> span_c("unsolved-annotation"), @@ -83,6 +90,7 @@ module Text = ( ~no_sorts=false, ~sort=Sort.root, + ~font_metrics, ~global_inference_info=M.global_inference_info, seg: Segment.t, ) @@ -100,21 +108,32 @@ module Text = seg |> List.mapi((i, p) => (i, p)) |> List.concat_map(((i, p)) => - of_piece(~global_inference_info, sort_of_p_idx(i), p) + of_piece(~font_metrics, ~global_inference_info, sort_of_p_idx(i), p) ); } and of_piece = - (~global_inference_info, expected_sort: Sort.t, p: Piece.t) + ( + ~font_metrics, + ~global_inference_info, + expected_sort: Sort.t, + p: Piece.t, + ) : list(Node.t) => { switch (p) { - | Tile(t) => of_tile(~global_inference_info, expected_sort, t) - | Grout(g) => of_grout(~global_inference_info, g.id) + | Tile(t) => + of_tile(~font_metrics, ~global_inference_info, expected_sort, t) + | Grout(g) => of_grout(~font_metrics, ~global_inference_info, g.id) | Secondary({content, _}) => of_secondary((M.settings.secondary_icons, m(p).last.col, content)) }; } and of_tile = - (~global_inference_info, expected_sort: Sort.t, t: Tile.t) + ( + ~font_metrics, + ~global_inference_info, + expected_sort: Sort.t, + t: Tile.t, + ) : list(Node.t) => { let children_and_sorts = List.mapi( @@ -126,7 +145,7 @@ module Text = let is_consistent = Sort.consistent(t.mold.out, expected_sort); Aba.mk(t.shards, children_and_sorts) |> Aba.join(of_delim(t.mold.out, is_consistent, t), ((seg, sort)) => - of_segment(~sort, ~global_inference_info, seg) + of_segment(~sort, ~font_metrics, ~global_inference_info, seg) ) |> List.concat; }; @@ -134,8 +153,8 @@ module Text = let rec holes = ( - ~global_inference_info, ~font_metrics, + ~global_inference_info, ~map: Measured.t, seg: Segment.t, ) @@ -151,10 +170,7 @@ let rec holes = ) | Grout(g) => { let (show_dec, is_unsolved) = - InferenceResult.svg_display_settings( - ~global_inference_info, - g.id, - ); + InferenceView.svg_display_settings(~global_inference_info, g.id); show_dec ? [ EmptyHoleDec.view( @@ -171,7 +187,13 @@ let rec holes = ); let simple_view = - (~unselected, ~map, ~global_inference_info, ~settings: ModelSettings.t) + ( + ~unselected, + ~map, + ~font_metrics, + ~global_inference_info, + ~settings: ModelSettings.t, + ) : Node.t => { module Text = Text({ @@ -184,7 +206,7 @@ let simple_view = [ span_c( "code-text", - Text.of_segment(~global_inference_info, unselected), + Text.of_segment(~font_metrics, ~global_inference_info, unselected), ), ], ); @@ -192,7 +214,7 @@ let simple_view = let view = ( - ~font_metrics, + ~font_metrics: FontMetrics.t, ~segment, ~unselected, ~measured, @@ -208,11 +230,11 @@ let view = }); let unselected = TimeUtil.measure_time("Code.view/unselected", settings.benchmark, () => - Text.of_segment(~global_inference_info, unselected) + Text.of_segment(~font_metrics, ~global_inference_info, unselected) ); let holes = TimeUtil.measure_time("Code.view/holes", settings.benchmark, () => - holes(~global_inference_info, ~map=measured, ~font_metrics, segment) + holes(~font_metrics, ~global_inference_info, ~map=measured, segment) ); div( ~attr=Attr.class_("code"), diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index e698ad348a..a3fb9f5f87 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -153,119 +153,24 @@ module State = { let set_last_inspector = v => curr_state.last_inspector := v; }; -// let view_of_global_inference_info = -// ( -// ~inject, -// ~font_metrics, -// ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, -// id: int, -// ) => { -// let text_with_holes = (text_string: string): list(t) => { -// let is_hole_delimeter = char => char == "!" || char == "?"; -// let acc_node_chunks = -// (acc: list((bool, string)), next_letter: string) -// : list((bool, string)) => { -// switch (acc) { -// | [] => [(is_hole_delimeter(next_letter), next_letter)] -// | [(false, str), ...tl] => [(false, str ++ next_letter), ...tl] -// | [hd, ...tl] => [ -// (is_hole_delimeter(next_letter), next_letter), -// hd, -// ...tl, -// ] -// }; -// }; -// let chunks_to_node_list = -// (acc: list(t), next_chunk: (bool, string)): list(t) => { -// let (is_hole_chunk, chunk_text) = next_chunk; -// if (is_hole_chunk) { -// if (chunk_text == "?") { -// [EmptyHoleDec.view(~font_metrics, false), ...acc]; -// } else { -// [EmptyHoleDec.view(~font_metrics, true), ...acc]; -// }; -// } else { -// [text(chunk_text), ...acc]; -// }; -// }; -// text_string -// |> StringUtil.to_list -// |> List.fold_left(acc_node_chunks, []) -// |> List.fold_left(chunks_to_node_list, []) -// |> List.rev; -// }; -// switch ( -// Haz3lcore.InferenceResult.get_cursor_inspect_result( -// ~global_inference_info, -// id, -// ) -// ) { -// | Some((true, solution)) => -// div( -// ~attr=clss([infoc, "typ"]), -// [ -// text("has inferred type "), -// ...text_with_holes(List.nth(solution, 0)), -// ], -// ) -// | Some((false, [typ_with_nested_conflict])) => -// print_endline("in the single case"); -// div( -// ~attr=clss([infoc, "typ-view-conflict"]), -// text_with_holes(typ_with_nested_conflict), -// ); -// | Some((false, conflicting_typs)) => -// List.iter(print_endline, conflicting_typs); -// div( -// ~attr=clss([infoc, "typ"]), -// List.map( -// typ => -// div( -// ~attr=clss(["typ-view-conflict"]), -// [ -// Widgets.hoverable_button( -// text_with_holes(typ), -// _mouse_event => { -// State.set_considering_suggestion(false); -// inject(Update.Mouseup); -// }, -// _mouse_event => { -// State.set_considering_suggestion(true); -// inject(Update.Paste(typ)); -// }, -// _mouse_event => -// if (State.get_considering_suggestion()) { -// State.set_considering_suggestion(false); -// inject(Update.Undo); -// } else { -// inject(Update.Mouseup); -// }, -// ), -// ], -// ), -// conflicting_typs, -// ), -// ); -// | None => div([]) -// }; -// }; - let view_of_global_inference_info = ( ~inject, + ~font_metrics: FontMetrics.t, ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, id: int, ) => { - switch ( - Haz3lcore.InferenceResult.get_cursor_inspect_result( - ~global_inference_info, - id, - ) - ) { + let font_metrics = Some(font_metrics); + switch (InferenceView.get_cursor_inspect_result(~global_inference_info, id)) { | Some((true, solution)) => div( ~attr=clss([infoc, "typ"]), - [text("has inferred type "), text(List.nth(solution, 0))], + [Type.view(~font_metrics, List.nth(solution, 0))], + ) + | Some((false, [typ_with_nested_conflict])) => + div( + ~attr=clss([infoc, "typ"]), + [Type.view(~font_metrics, typ_with_nested_conflict)], ) | Some((false, conflicting_typs)) => div( @@ -276,14 +181,14 @@ let view_of_global_inference_info = ~attr=clss(["typ-view-conflict"]), [ Widgets.hoverable_button( - [text(typ)], + [Type.view(~font_metrics, typ)], _mouse_event => { State.set_considering_suggestion(false); inject(Update.Mouseup); }, _mouse_event => { State.set_considering_suggestion(true); - inject(Update.Paste(typ)); + inject(Update.Paste(Haz3lcore.Typ.typ_to_string(typ))); }, _mouse_event => if (State.get_considering_suggestion()) { @@ -305,7 +210,7 @@ let view_of_global_inference_info = let view_of_info = ( ~inject, - // ~font_metrics, + ~font_metrics, ~show_lang_doc: bool, ~global_inference_info, id: int, @@ -347,7 +252,7 @@ let view_of_info = ) | InfoTyp({self: Just(ty), _}) => switch ( - Haz3lcore.InferenceResult.get_suggestion_for_id( + Haz3lcore.InferenceResult.get_suggestion_text_for_id( id, global_inference_info, ) @@ -370,7 +275,7 @@ let view_of_info = term_tag(~inject, ~show_lang_doc, is_err, "typ"), view_of_global_inference_info( ~inject, - // ~font_metrics, + ~font_metrics, ~global_inference_info, id, ), @@ -415,7 +320,7 @@ let toggle_context_and_print_ci = (~inject: Update.t => 'a, ci, _) => { let inspector_view = ( ~inject, - // ~font_metrics, + ~font_metrics, ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, ~settings: ModelSettings.t, ~show_lang_doc: bool, @@ -436,7 +341,7 @@ let inspector_view = extra_view(settings.context_inspector, id, ci), view_of_info( ~inject, - // ~font_metrics, + ~font_metrics, ~show_lang_doc, ~global_inference_info, id, @@ -450,7 +355,7 @@ let view = ( ~inject, ~settings, - // ~font_metrics, + ~font_metrics, ~show_lang_doc: bool, zipper: Haz3lcore.Zipper.t, info_map: Haz3lcore.Statics.map, @@ -471,7 +376,7 @@ let view = | Some(ci) => inspector_view( ~inject, - // ~font_metrics, + ~font_metrics, ~global_inference_info, ~settings, ~show_lang_doc, diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re new file mode 100644 index 0000000000..3c82443d97 --- /dev/null +++ b/src/haz3lweb/view/InferenceView.re @@ -0,0 +1,71 @@ +open Util.OptUtil.Syntax; +open Virtual_dom.Vdom; +open Haz3lcore; + +let get_suggestion_ui_for_id = + ( + ~font_metrics, + id: Id.t, + global_inference_info: InferenceResult.global_inference_info, + colored_ui: bool, + ) + : InferenceResult.suggestion(Node.t) => + if (global_inference_info.enabled) { + let status_opt = + Hashtbl.find_opt(global_inference_info.solution_statuses, id); + switch (status_opt) { + | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) + | Some(Solved(ityp)) => + Solvable( + ityp + |> ITyp.ityp_to_typ + |> Type.view(~font_metrics=Some(font_metrics)), + ) + | Some(Unsolved([potential_typ])) => + NestedInconsistency( + potential_typ |> Type.view_of_ptyp(~font_metrics, true, colored_ui), + ) + | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) + | None => NoSuggestion(NonTypeHoleId) + }; + } else { + NoSuggestion(SuggestionsDisabled); + }; + +let svg_display_settings = + (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) + : (bool, bool) => { + // Determines if a hexagon (svg) should be used to represent a type hole, and if so, how it should look + let (show_svg, is_unsolved) = + switch ( + InferenceResult.get_suggestion_text_for_id(id, global_inference_info) + ) { + | Solvable(_) => (false, false) + | NestedInconsistency(_) => (false, true) + | NoSuggestion(SuggestionsDisabled) + | NoSuggestion(OnlyHoleSolutions) => (true, false) + | NoSuggestion(NonTypeHoleId) => (false, false) + | NoSuggestion(InconsistentSet) => (true, true) + }; + (show_svg, is_unsolved); +}; + +let get_cursor_inspect_result = + (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) + : option((bool, list(Typ.t))) => + if (global_inference_info.enabled) { + let* status = + Hashtbl.find_opt(global_inference_info.solution_statuses, id); + switch (status) { + | Unsolved(potential_typ_set) => + Some(( + false, + potential_typ_set + |> PotentialTypeSet.potential_typ_set_to_ityp_unroll(id) + |> List.map(ITyp.ityp_to_typ), + )) + | Solved(ityp) => Some((true, [ityp |> ITyp.ityp_to_typ])) + }; + } else { + None; + }; diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index fa37c21c34..7e27439985 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -276,6 +276,7 @@ let deco = let map = Measured.of_segment(segment); let code_view = Code.simple_view( + ~font_metrics, ~global_inference_info, ~unselected=segment, ~map, @@ -387,7 +388,13 @@ let syntactic_form_view = ) => { let map = Measured.of_segment(unselected); let code_view = - Code.simple_view(~global_inference_info, ~unselected, ~map, ~settings); + Code.simple_view( + ~font_metrics, + ~global_inference_info, + ~unselected, + ~map, + ~settings, + ); let deco_view = deco( ~doc, @@ -427,6 +434,7 @@ let example_view = let map_code = Measured.of_segment(term); let code_view = Code.simple_view( + ~font_metrics, ~global_inference_info, ~unselected=term, ~map=map_code, diff --git a/src/haz3lweb/view/SchoolMode.re b/src/haz3lweb/view/SchoolMode.re index b983937f13..a9275e1b58 100644 --- a/src/haz3lweb/view/SchoolMode.re +++ b/src/haz3lweb/view/SchoolMode.re @@ -348,7 +348,7 @@ let view = CursorInspector.view( ~inject, ~settings, - // ~font_metrics, + ~font_metrics, ~show_lang_doc=langDocMessages.show, focal_zipper, focal_info_map, diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 108e34aca0..e44080cd9b 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -64,7 +64,7 @@ let view = CursorInspector.view( ~inject, ~settings, - // ~font_metrics, + ~font_metrics, ~show_lang_doc=langDocMessages.show, zipper, info_map, diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 2576a9b2bc..e101ef45db 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -1,6 +1,7 @@ open Virtual_dom.Vdom; open Node; open Util.Web; +open Haz3lcore; let ty_view = (cls: string, s: string): Node.t => div(~attr=clss(["typ-view", cls]), [text(s)]); @@ -15,15 +16,28 @@ let prov_view: Haz3lcore.Typ.type_provenance => Node.t = div(~attr=clss(["typ-mod", "syn-switch"]), [text("⇒")]) | Anonymous => div([]); -let rec view = (ty: Haz3lcore.Typ.t): Node.t => +let rec view = + (~font_metrics: option(FontMetrics.t)=None, ty: Haz3lcore.Typ.t) + : Node.t => //TODO: parens on ops when ambiguous switch (ty) { | Unknown(_) => - // div( - // ~attr=clss(["typ-view", "atom", "unknown"]), - // [text("?"), prov_view(prov)], - // ) - div(~attr=clss(["typ-view", "atom", "unknown"]), [text("")]) + switch (font_metrics) { + | Some(font_metrics) => + div( + ~attr=clss(["typ-view", "atom", "unknown"]), + [ + EmptyHoleDec.relative_view( + ~font_metrics, + false, + Haz3lcore.InferenceResult.hole_mold, + ), + ], + ) + // div(~attr=clss(["typ-view", "atom", "unknown"]), [text("")]) + | _ => div(~attr=clss(["typ-view", "atom", "unknown"]), [text("")]) + } + | Int => ty_view("Int", "Int") | Float => ty_view("Float", "Float") | String => ty_view("String", "String") @@ -32,12 +46,12 @@ let rec view = (ty: Haz3lcore.Typ.t): Node.t => | List(t) => div( ~attr=clss(["typ-view", "atom", "List"]), - [text("["), view(t), text("]")], + [text("["), view(~font_metrics, t), text("]")], ) | Arrow(t1, t2) => div( ~attr=clss(["typ-view", "Arrow"]), - [view(t1), text("->"), view(t2)], + [view(~font_metrics, t1), text("->"), view(~font_metrics, t2)], ) | Prod([]) => div(~attr=clss(["typ-view", "Prod"]), [text("()")]) | Prod([_]) => @@ -49,12 +63,97 @@ let rec view = (ty: Haz3lcore.Typ.t): Node.t => text("("), div( ~attr=clss(["typ-view", "Prod"]), - [view(t0)] - @ (List.map(t => [text(","), view(t)], ts) |> List.flatten), + [view(~font_metrics, t0)] + @ ( + List.map(t => [text(","), view(~font_metrics, t)], ts) + |> List.flatten + ), ), text(")"), ], ) | Sum(t1, t2) => - div(~attr=clss(["typ-view", "Sum"]), [view(t1), text("+"), view(t2)]) + div( + ~attr=clss(["typ-view", "Sum"]), + [view(~font_metrics, t1), text("+"), view(~font_metrics, t2)], + ) }; + +let rec view_of_pts = + ( + ~font_metrics, + outermost, + with_cls, + potential_typ_set: PotentialTypeSet.t, + ) + : Node.t => { + switch (potential_typ_set) { + | [] => view(Typ.Unknown(Anonymous)) + | [hd] => view_of_ptyp(~font_metrics, outermost, with_cls, hd) + | _ => + div( + ~attr=clss(with_cls ? ["typ-view", "atom", "unknown"] : []), + [ + EmptyHoleDec.relative_view( + ~font_metrics, + true, + Haz3lcore.InferenceResult.hole_mold, + ), + ], + ) + }; +} +and view_of_ptyp = + ( + ~font_metrics, + outermost: bool, + with_cls: bool, + potential_typ: PotentialTypeSet.potential_typ, + ) + : Node.t => + switch (potential_typ) { + | Base(btyp) => view_of_btyp(btyp, with_cls) + | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => + let (ctor_start, ctor_string, ctor_end, cls) = + switch (ctor) { + | CArrow => + outermost + ? ("", " -> ", "", ["typ-view", "Arrow"]) + : ("(", " -> ", ")", ["typ-view", "Arrow"]) + | CProd => ("(", ", ", ")", ["typ-view", "Sum"]) + | CSum => + outermost + ? ("", " + ", "", ["typ-view", "Sum"]) + : ("(", " + ", ")", ["typ-view", "Sum"]) + }; + let cls = with_cls ? cls : []; + div( + ~attr=clss(cls), + [ + text(ctor_start), + view_of_pts(~font_metrics, false, with_cls, potential_typ_set_lt), + text(ctor_string), + view_of_pts(~font_metrics, false, with_cls, potential_typ_set_rt), + text(ctor_end), + ], + ); + | Unary(ctor, potential_typ_set) => + let (start_text, end_text, cls) = + switch (ctor) { + | CList => ("[", "]", ["typ-view", "atom", "List"]) + }; + let cls = with_cls ? cls : []; + div( + ~attr=clss(cls), + [ + text(start_text), + view_of_pts(~font_metrics, false, with_cls, potential_typ_set), + text(end_text), + ], + ); + } +and view_of_btyp = (btyp: PotentialTypeSet.base_typ, with_cls: bool): Node.t => { + with_cls + ? btyp |> PotentialTypeSet.string_of_btyp |> text + : btyp |> PotentialTypeSet.base_typ_to_ityp |> ITyp.ityp_to_typ |> view; +}; diff --git a/src/haz3lweb/view/dec/DecUtil.re b/src/haz3lweb/view/dec/DecUtil.re index 20e2c9dc1b..b30cf4d753 100644 --- a/src/haz3lweb/view/dec/DecUtil.re +++ b/src/haz3lweb/view/dec/DecUtil.re @@ -78,8 +78,6 @@ let code_svg_sized = ) => { let (left, top) = (origin.col, origin.row); let (width, height) = (last.col - origin.col, last.row - origin.row + 1); - print_endline(string_of_int(width)); - print_endline(string_of_int(height)); let style = pos_str(~d={left, top, width, height}, ~fudge, font_metrics); create_svg( "svg", @@ -102,6 +100,7 @@ let code_svg_sized_relative = ~fudge: fdims=fzero, paths: list(SvgUtil.Path.cmd), ) => { + // let (left, top) = (origin.col, origin.row); let (width, height) = (1, 1); let style = pos_str_relative(~width, ~height, ~fudge, font_metrics); create_svg( diff --git a/src/haz3lweb/view/dec/EmptyHoleDec.re b/src/haz3lweb/view/dec/EmptyHoleDec.re index 962b506381..b566ee17a2 100644 --- a/src/haz3lweb/view/dec/EmptyHoleDec.re +++ b/src/haz3lweb/view/dec/EmptyHoleDec.re @@ -51,3 +51,28 @@ let view = path(tip_l, tip_r, 0., 0.28), ); }; + +let relative_view = (~font_metrics, is_unsolved, mold: Mold.t): Node.t => { + let sort = mold.out; + let c_cls = Sort.to_string(sort); + let (tip_l, tip_r): (Haz3lcore.Nib.Shape.t, Haz3lcore.Nib.Shape.t) = + Util.TupleUtil.map2(Haz3lcore.Nib.shape, mold.nibs); + let (tip_l, tip_r): (Haz3lcore.Nib.t, Haz3lcore.Nib.t) = ( + {sort, shape: tip_l}, + {sort, shape: tip_r}, + ); + + is_unsolved + ? DecUtil.code_svg_sized_relative( + ~font_metrics, + ~base_cls=["empty-hole"], + ~path_cls=["unsolved-empty-hole-path", c_cls], + path(tip_l, tip_r, 0., 0.58), + ) + : DecUtil.code_svg_sized_relative( + ~font_metrics, + ~base_cls=["empty-hole"], + ~path_cls=["empty-hole-path", c_cls], + path(tip_l, tip_r, 0., 0.28), + ); +}; From 86ac43f6ba8429308c5c3bd8d04de95866e0f141 Mon Sep 17 00:00:00 2001 From: RaefM Date: Mon, 12 Jun 2023 14:12:11 -0400 Subject: [PATCH 045/129] fixes issues with svg in suggestions but introduces new issue with the positioning of words relative to the svg.... also need to update type.view and typ.typ_to_string to unambiguously parenthesize ops like PTS does --- src/haz3lcore/Measured.re | 8 +- src/haz3lweb/view/InferenceView.re | 13 ++- src/haz3lweb/view/Type.re | 122 +++++++++++++++++------------ 3 files changed, 84 insertions(+), 59 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index 526ca3f397..1398dd7bca 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -386,13 +386,7 @@ let of_segment = ) ) { | Solvable(suggestion_string) - | NestedInconsistency(suggestion_string) => - print_endline("Suggestions: "); - print_endline(suggestion_string); - print_endline( - suggestion_string |> String.length |> string_of_int, - ); - String.length(suggestion_string); + | NestedInconsistency(suggestion_string) => String.length(suggestion_string); | NoSuggestion(_) => 1 }; diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index 3c82443d97..589087e841 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -19,12 +19,17 @@ let get_suggestion_ui_for_id = Solvable( ityp |> ITyp.ityp_to_typ - |> Type.view(~font_metrics=Some(font_metrics)), + |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), ) | Some(Unsolved([potential_typ])) => - NestedInconsistency( - potential_typ |> Type.view_of_ptyp(~font_metrics, true, colored_ui), - ) + let ptyp_node = + Type.view_of_potential_typ( + ~font_metrics, + ~with_cls=colored_ui, + true, + potential_typ, + ); + NestedInconsistency(ptyp_node); | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) | None => NoSuggestion(NonTypeHoleId) }; diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index e101ef45db..acab87b0af 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -3,23 +3,17 @@ open Node; open Util.Web; open Haz3lcore; -let ty_view = (cls: string, s: string): Node.t => - div(~attr=clss(["typ-view", cls]), [text(s)]); - -let prov_view: Haz3lcore.Typ.type_provenance => Node.t = - fun - | Inference(_) => div([]) - | Internal(_) => div([]) - | TypeHole(_) => div([]) - // div(~attr=clss(["typ-mod", "type-hole"]), [text("𝜏")]) - | SynSwitch(_) => - div(~attr=clss(["typ-mod", "syn-switch"]), [text("⇒")]) - | Anonymous => div([]); - let rec view = - (~font_metrics: option(FontMetrics.t)=None, ty: Haz3lcore.Typ.t) - : Node.t => + ( + ~font_metrics: option(FontMetrics.t)=None, + ~with_cls: bool=true, + ty: Haz3lcore.Typ.t, + ) + : Node.t => { //TODO: parens on ops when ambiguous + let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); + let ty_view = (cls: string, s: string): Node.t => + div(~attr=clss(["typ-view", cls]), [text(s)]); switch (ty) { | Unknown(_) => switch (font_metrics) { @@ -34,10 +28,8 @@ let rec view = ), ], ) - // div(~attr=clss(["typ-view", "atom", "unknown"]), [text("")]) | _ => div(~attr=clss(["typ-view", "atom", "unknown"]), [text("")]) } - | Int => ty_view("Int", "Int") | Float => ty_view("Float", "Float") | String => ty_view("String", "String") @@ -46,12 +38,16 @@ let rec view = | List(t) => div( ~attr=clss(["typ-view", "atom", "List"]), - [text("["), view(~font_metrics, t), text("]")], + [text("["), view(~font_metrics, ~with_cls, t), text("]")], ) | Arrow(t1, t2) => div( ~attr=clss(["typ-view", "Arrow"]), - [view(~font_metrics, t1), text("->"), view(~font_metrics, t2)], + [ + view(~font_metrics, ~with_cls, t1), + text(" -> "), + view(~font_metrics, ~with_cls, t2), + ], ) | Prod([]) => div(~attr=clss(["typ-view", "Prod"]), [text("()")]) | Prod([_]) => @@ -63,9 +59,12 @@ let rec view = text("("), div( ~attr=clss(["typ-view", "Prod"]), - [view(~font_metrics, t0)] + [view(~font_metrics, ~with_cls, t0)] @ ( - List.map(t => [text(","), view(~font_metrics, t)], ts) + List.map( + t => [text(", "), view(~font_metrics, ~with_cls, t)], + ts, + ) |> List.flatten ), ), @@ -75,24 +74,34 @@ let rec view = | Sum(t1, t2) => div( ~attr=clss(["typ-view", "Sum"]), - [view(~font_metrics, t1), text("+"), view(~font_metrics, t2)], + [ + view(~font_metrics, ~with_cls, t1), + text(" + "), + view(~font_metrics, ~with_cls, t2), + ], ) }; - -let rec view_of_pts = - ( - ~font_metrics, - outermost, - with_cls, - potential_typ_set: PotentialTypeSet.t, - ) - : Node.t => { +} +and view_of_potential_typ_set = + ( + ~font_metrics, + ~with_cls, + outermost, + potential_typ_set: PotentialTypeSet.t, + ) + : Node.t => { + let div = (~attr, nodes) => div(~attr=with_cls ? attr : clss([]), nodes); switch (potential_typ_set) { - | [] => view(Typ.Unknown(Anonymous)) - | [hd] => view_of_ptyp(~font_metrics, outermost, with_cls, hd) + | [] => + view( + ~font_metrics=Some(font_metrics), + ~with_cls, + Typ.Unknown(Anonymous), + ) + | [hd] => view_of_potential_typ(~font_metrics, ~with_cls, outermost, hd) | _ => div( - ~attr=clss(with_cls ? ["typ-view", "atom", "unknown"] : []), + ~attr=clss(["typ-view", "atom", "unknown"]), [ EmptyHoleDec.relative_view( ~font_metrics, @@ -103,16 +112,17 @@ let rec view_of_pts = ) }; } -and view_of_ptyp = +and view_of_potential_typ = ( ~font_metrics, + ~with_cls: bool, outermost: bool, - with_cls: bool, potential_typ: PotentialTypeSet.potential_typ, ) - : Node.t => + : Node.t => { + let div = (~attr, nodes) => div(~attr=with_cls ? attr : clss([]), nodes); switch (potential_typ) { - | Base(btyp) => view_of_btyp(btyp, with_cls) + | Base(btyp) => view_of_base_typ(~font_metrics, ~with_cls, btyp) | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => let (ctor_start, ctor_string, ctor_end, cls) = switch (ctor) { @@ -126,14 +136,23 @@ and view_of_ptyp = ? ("", " + ", "", ["typ-view", "Sum"]) : ("(", " + ", ")", ["typ-view", "Sum"]) }; - let cls = with_cls ? cls : []; div( ~attr=clss(cls), [ text(ctor_start), - view_of_pts(~font_metrics, false, with_cls, potential_typ_set_lt), + view_of_potential_typ_set( + ~font_metrics, + ~with_cls, + false, + potential_typ_set_lt, + ), text(ctor_string), - view_of_pts(~font_metrics, false, with_cls, potential_typ_set_rt), + view_of_potential_typ_set( + ~font_metrics, + ~with_cls, + false, + potential_typ_set_rt, + ), text(ctor_end), ], ); @@ -142,18 +161,25 @@ and view_of_ptyp = switch (ctor) { | CList => ("[", "]", ["typ-view", "atom", "List"]) }; - let cls = with_cls ? cls : []; div( ~attr=clss(cls), [ text(start_text), - view_of_pts(~font_metrics, false, with_cls, potential_typ_set), + view_of_potential_typ_set( + ~font_metrics, + ~with_cls, + false, + potential_typ_set, + ), text(end_text), ], ); - } -and view_of_btyp = (btyp: PotentialTypeSet.base_typ, with_cls: bool): Node.t => { - with_cls - ? btyp |> PotentialTypeSet.string_of_btyp |> text - : btyp |> PotentialTypeSet.base_typ_to_ityp |> ITyp.ityp_to_typ |> view; + }; +} +and view_of_base_typ = + (~font_metrics, ~with_cls, btyp: PotentialTypeSet.base_typ): Node.t => { + btyp + |> PotentialTypeSet.base_typ_to_ityp + |> ITyp.ityp_to_typ + |> view(~font_metrics=Some(font_metrics), ~with_cls); }; From 866be932696556551ecb9a41cc7941b26913b045 Mon Sep 17 00:00:00 2001 From: RaefM Date: Wed, 14 Jun 2023 15:53:24 -0400 Subject: [PATCH 046/129] fix weird positioning issues --- src/haz3lcore/Measured.re | 3 ++- src/haz3lweb/view/dec/DecUtil.re | 9 ++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index 1398dd7bca..faa6dd2b30 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -386,7 +386,8 @@ let of_segment = ) ) { | Solvable(suggestion_string) - | NestedInconsistency(suggestion_string) => String.length(suggestion_string); + | NestedInconsistency(suggestion_string) => + String.length(suggestion_string) | NoSuggestion(_) => 1 }; diff --git a/src/haz3lweb/view/dec/DecUtil.re b/src/haz3lweb/view/dec/DecUtil.re index b30cf4d753..70887d9885 100644 --- a/src/haz3lweb/view/dec/DecUtil.re +++ b/src/haz3lweb/view/dec/DecUtil.re @@ -63,8 +63,8 @@ let pos_str_relative = (~width, ~height, ~fudge: fdims=fzero, font_metrics: FontMetrics.t) => Printf.sprintf( "position: relative; width: %fpx; height: %fpx;", - Float.of_int(width) *. (font_metrics.col_width +. fudge.width), - Float.of_int(height) *. (font_metrics.row_height +. fudge.height), + width *. (font_metrics.col_width +. fudge.width), + height *. (font_metrics.row_height +. fudge.height), ); let code_svg_sized = @@ -100,8 +100,7 @@ let code_svg_sized_relative = ~fudge: fdims=fzero, paths: list(SvgUtil.Path.cmd), ) => { - // let (left, top) = (origin.col, origin.row); - let (width, height) = (1, 1); + let (width, height) = (1., 0.75); let style = pos_str_relative(~width, ~height, ~fudge, font_metrics); create_svg( "svg", @@ -109,7 +108,7 @@ let code_svg_sized_relative = Attr.many([ Attr.classes(base_cls), Attr.create("style", style), - Attr.create("viewBox", Printf.sprintf("0 0 %d %d", width, height)), + Attr.create("viewBox", Printf.sprintf("0 0 %f %f", width, height)), Attr.create("preserveAspectRatio", "none"), ]), [SvgUtil.Path.view(~attrs=[Attr.classes(path_cls)], paths)], From 7e4d53d29637c0fe8be2bbf7b0970427908cd2f5 Mon Sep 17 00:00:00 2001 From: RaefM Date: Wed, 14 Jun 2023 18:54:01 -0400 Subject: [PATCH 047/129] makes parenthesization less/un ambiguous (always parenthesizes left child in a type if it is arr/sum). fixes some other stylistic issues. It may be better to decrease spacing as the current formatting makes the cursor inspector overflow when the suggestions are long-ish --- src/haz3lcore/inference/InferenceResult.re | 2 +- src/haz3lcore/inference/PotentialTypeSet.re | 15 +++--- src/haz3lcore/statics/Typ.re | 19 +++++-- src/haz3lweb/view/InferenceView.re | 2 +- src/haz3lweb/view/Type.re | 59 ++++++++++++--------- src/haz3lweb/view/dec/EmptyHoleDec.re | 4 +- src/haz3lweb/www/style.css | 10 +--- 7 files changed, 64 insertions(+), 47 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index d97c9e3332..b0e8b97606 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -33,7 +33,7 @@ let get_suggestion_text_for_id = Solvable(ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string) | Some(Unsolved([potential_typ])) => NestedInconsistency( - PotentialTypeSet.string_of_potential_typ(true, potential_typ), + PotentialTypeSet.string_of_potential_typ(false, potential_typ), ) | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) | None => NoSuggestion(NonTypeHoleId) diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index 8235a75456..ceb4132207 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -516,28 +516,29 @@ and potential_typ_to_ityp = (id: Id.t, ptyp: potential_typ): ITyp.t => { }; let rec string_of_potential_typ_set_no_nesting = - (outermost, potential_typ_set: t): string => + (is_left_child, potential_typ_set: t): string => switch (potential_typ_set) { | [] => "" - | [hd] => string_of_potential_typ(outermost, hd) + | [hd] => string_of_potential_typ(is_left_child, hd) | [_hd, ..._tl] => "!" } -and string_of_potential_typ = (outermost: bool, potential_typ: potential_typ) => +and string_of_potential_typ = + (is_left_child: bool, potential_typ: potential_typ) => switch (potential_typ) { | Base(btyp) => string_of_btyp(btyp) | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => let (ctor_start, ctor_string, ctor_end) = switch (ctor) { - | CArrow => outermost ? ("", " -> ", "") : ("(", " -> ", ")") + | CArrow => is_left_child ? ("(", " -> ", ")") : ("", " -> ", "") | CProd => ("(", ", ", ")") - | CSum => outermost ? ("", " + ", "") : ("(", " + ", ")") + | CSum => is_left_child ? ("(", " + ", ")") : ("", " + ", "") }; String.concat( "", [ ctor_start, - string_of_potential_typ_set_no_nesting(false, potential_typ_set_lt), + string_of_potential_typ_set_no_nesting(true, potential_typ_set_lt), ctor_string, string_of_potential_typ_set_no_nesting(false, potential_typ_set_rt), ctor_end, @@ -560,4 +561,4 @@ and string_of_potential_typ = (outermost: bool, potential_typ: potential_typ) => }; let strings_of_potential_typ_set = (potential_typ_set: t): list(string) => - List.map(string_of_potential_typ(true), potential_typ_set); + List.map(string_of_potential_typ(false), potential_typ_set); diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index e3f5b78a4a..9ea6a55196 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -349,8 +349,12 @@ let rec eq = (t1, t2) => | (Var(_), _) => false }; -let rec typ_to_string = (ty: t): string => +let rec typ_to_string = (ty: t): string => { + typ_to_string_with_parens(false, ty); +} +and typ_to_string_with_parens = (is_left_child: bool, ty: t): string => { //TODO: parens on ops when ambiguous + let parenthesize_if_left_child = s => is_left_child ? "(" ++ s ++ ")" : s; switch (ty) { | Unknown(_) => "?" | Int => "Int" @@ -359,7 +363,11 @@ let rec typ_to_string = (ty: t): string => | Bool => "Bool" | Var(name) => name | List(t) => "[" ++ typ_to_string(t) ++ "]" - | Arrow(t1, t2) => typ_to_string(t1) ++ " -> " ++ typ_to_string(t2) + | Arrow(t1, t2) => + typ_to_string_with_parens(true, t1) + ++ " -> " + ++ typ_to_string(t2) + |> parenthesize_if_left_child | Prod([]) => "Unit" | Prod([_]) => "BadProduct" | Prod([t0, ...ts]) => @@ -370,5 +378,10 @@ let rec typ_to_string = (ty: t): string => ts, ) ++ ")" - | Sum(t1, t2) => typ_to_string(t1) ++ " + " ++ typ_to_string(t2) + | Sum(t1, t2) => + typ_to_string_with_parens(true, t1) + ++ " + " + ++ typ_to_string(t2) + |> parenthesize_if_left_child }; +}; diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index 589087e841..ee20c06178 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -26,7 +26,7 @@ let get_suggestion_ui_for_id = Type.view_of_potential_typ( ~font_metrics, ~with_cls=colored_ui, - true, + false, potential_typ, ); NestedInconsistency(ptyp_node); diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index acab87b0af..ee96f0b464 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -7,10 +7,13 @@ let rec view = ( ~font_metrics: option(FontMetrics.t)=None, ~with_cls: bool=true, + ~is_left_child: bool=false, ty: Haz3lcore.Typ.t, ) : Node.t => { //TODO: parens on ops when ambiguous + let parenthesize_if_left_child = (n): Node.t => + (is_left_child ? [Node.text("("), ...n] @ [Node.text(")")] : n) |> span; let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); let ty_view = (cls: string, s: string): Node.t => div(~attr=clss(["typ-view", cls]), [text(s)]); @@ -41,14 +44,17 @@ let rec view = [text("["), view(~font_metrics, ~with_cls, t), text("]")], ) | Arrow(t1, t2) => - div( - ~attr=clss(["typ-view", "Arrow"]), - [ - view(~font_metrics, ~with_cls, t1), - text(" -> "), - view(~font_metrics, ~with_cls, t2), - ], - ) + [ + div( + ~attr=clss(["typ-view", "Arrow"]), + [ + view(~font_metrics, ~with_cls, ~is_left_child=true, t1), + text(" -> "), + view(~font_metrics, ~with_cls, t2), + ], + ), + ] + |> parenthesize_if_left_child | Prod([]) => div(~attr=clss(["typ-view", "Prod"]), [text("()")]) | Prod([_]) => div(~attr=clss(["typ-view", "Prod"]), [text("BadProduct")]) @@ -72,14 +78,17 @@ let rec view = ], ) | Sum(t1, t2) => - div( - ~attr=clss(["typ-view", "Sum"]), - [ - view(~font_metrics, ~with_cls, t1), - text(" + "), - view(~font_metrics, ~with_cls, t2), - ], - ) + [ + div( + ~attr=clss(["typ-view", "Sum"]), + [ + view(~font_metrics, ~with_cls, ~is_left_child=true, t1), + text(" + "), + view(~font_metrics, ~with_cls, t2), + ], + ), + ] + |> parenthesize_if_left_child }; } and view_of_potential_typ_set = @@ -90,7 +99,7 @@ and view_of_potential_typ_set = potential_typ_set: PotentialTypeSet.t, ) : Node.t => { - let div = (~attr, nodes) => div(~attr=with_cls ? attr : clss([]), nodes); + let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); switch (potential_typ_set) { | [] => view( @@ -116,25 +125,25 @@ and view_of_potential_typ = ( ~font_metrics, ~with_cls: bool, - outermost: bool, + is_left_child: bool, potential_typ: PotentialTypeSet.potential_typ, ) : Node.t => { - let div = (~attr, nodes) => div(~attr=with_cls ? attr : clss([]), nodes); + let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); switch (potential_typ) { | Base(btyp) => view_of_base_typ(~font_metrics, ~with_cls, btyp) | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => let (ctor_start, ctor_string, ctor_end, cls) = switch (ctor) { | CArrow => - outermost - ? ("", " -> ", "", ["typ-view", "Arrow"]) - : ("(", " -> ", ")", ["typ-view", "Arrow"]) + is_left_child + ? ("(", " -> ", ")", ["typ-view", "Arrow"]) + : ("", " -> ", "", ["typ-view", "Arrow"]) | CProd => ("(", ", ", ")", ["typ-view", "Sum"]) | CSum => - outermost - ? ("", " + ", "", ["typ-view", "Sum"]) - : ("(", " + ", ")", ["typ-view", "Sum"]) + is_left_child + ? ("(", " + ", ")", ["typ-view", "Sum"]) + : ("", " + ", "", ["typ-view", "Sum"]) }; div( ~attr=clss(cls), diff --git a/src/haz3lweb/view/dec/EmptyHoleDec.re b/src/haz3lweb/view/dec/EmptyHoleDec.re index b566ee17a2..f5d73f5b44 100644 --- a/src/haz3lweb/view/dec/EmptyHoleDec.re +++ b/src/haz3lweb/view/dec/EmptyHoleDec.re @@ -41,7 +41,7 @@ let view = ~measurement, ~base_cls=["empty-hole"], ~path_cls=["unsolved-empty-hole-path", c_cls], - path(tip_l, tip_r, 0., 0.58), + path(tip_l, tip_r, 0., 0.42), ) : DecUtil.code_svg_sized( ~font_metrics, @@ -67,7 +67,7 @@ let relative_view = (~font_metrics, is_unsolved, mold: Mold.t): Node.t => { ~font_metrics, ~base_cls=["empty-hole"], ~path_cls=["unsolved-empty-hole-path", c_cls], - path(tip_l, tip_r, 0., 0.58), + path(tip_l, tip_r, 0., 0.42), ) : DecUtil.code_svg_sized_relative( ~font_metrics, diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index fd97f5f42c..b83e77a350 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -571,17 +571,11 @@ body { } .unsolved-empty-hole-path { - /* fill: #f0d1d1; - stroke: var(--err-color); - stroke-width: 1.2px; - stroke-dasharray: 1, 1; - vector-effect: non-scaling-stroke; */ fill: #d001; - stroke-dasharray: 1, 1; + stroke-dasharray: 2, 3; stroke: var(--err-color); - stroke-width: 1.2px; + stroke-width: 1.15px; vector-effect: non-scaling-stroke; - /* mix-blend-mode: color;*/ } .selection { From c497f61747ce34f69167c1507bd1d18a47658ff3 Mon Sep 17 00:00:00 2001 From: RaefM Date: Tue, 11 Jul 2023 12:31:43 -0400 Subject: [PATCH 048/129] Fix UI bugs --- src/haz3lweb/view/InferenceView.re | 2 +- src/haz3lweb/view/dec/EmptyHoleDec.re | 2 +- src/haz3lweb/www/style.css | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index ee20c06178..97b1df5767 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -49,7 +49,7 @@ let svg_display_settings = | NestedInconsistency(_) => (false, true) | NoSuggestion(SuggestionsDisabled) | NoSuggestion(OnlyHoleSolutions) => (true, false) - | NoSuggestion(NonTypeHoleId) => (false, false) + | NoSuggestion(NonTypeHoleId) => (true, false) | NoSuggestion(InconsistentSet) => (true, true) }; (show_svg, is_unsolved); diff --git a/src/haz3lweb/view/dec/EmptyHoleDec.re b/src/haz3lweb/view/dec/EmptyHoleDec.re index f5d73f5b44..a981fda188 100644 --- a/src/haz3lweb/view/dec/EmptyHoleDec.re +++ b/src/haz3lweb/view/dec/EmptyHoleDec.re @@ -41,7 +41,7 @@ let view = ~measurement, ~base_cls=["empty-hole"], ~path_cls=["unsolved-empty-hole-path", c_cls], - path(tip_l, tip_r, 0., 0.42), + path(tip_l, tip_r, 0., 0.6), ) : DecUtil.code_svg_sized( ~font_metrics, diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index b83e77a350..a39bfc135f 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -572,9 +572,9 @@ body { .unsolved-empty-hole-path { fill: #d001; - stroke-dasharray: 2, 3; stroke: var(--err-color); - stroke-width: 1.15px; + stroke-dasharray: 1, 1; + stroke-width: 0.75px; vector-effect: non-scaling-stroke; } From 8af2bea1c22c4eddfa624cde855861c34ceda533 Mon Sep 17 00:00:00 2001 From: RaefM Date: Tue, 11 Jul 2023 22:31:36 -0400 Subject: [PATCH 049/129] add message to CI on errors --- src/haz3lweb/view/CursorInspector.re | 59 +++++++++++++++------------- 1 file changed, 32 insertions(+), 27 deletions(-) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index a3fb9f5f87..760e04976b 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -175,33 +175,38 @@ let view_of_global_inference_info = | Some((false, conflicting_typs)) => div( ~attr=clss([infoc, "typ"]), - List.map( - typ => - div( - ~attr=clss(["typ-view-conflict"]), - [ - Widgets.hoverable_button( - [Type.view(~font_metrics, typ)], - _mouse_event => { - State.set_considering_suggestion(false); - inject(Update.Mouseup); - }, - _mouse_event => { - State.set_considering_suggestion(true); - inject(Update.Paste(Haz3lcore.Typ.typ_to_string(typ))); - }, - _mouse_event => - if (State.get_considering_suggestion()) { - State.set_considering_suggestion(false); - inject(Update.Undo); - } else { - inject(Update.Mouseup); - }, - ), - ], - ), - conflicting_typs, - ), + [ + text("conflicting constraints"), + ...List.map( + typ => + div( + ~attr=clss(["typ-view-conflict"]), + [ + Widgets.hoverable_button( + [Type.view(~font_metrics, typ)], + _mouse_event => { + State.set_considering_suggestion(false); + inject(Update.Mouseup); + }, + _mouse_event => { + State.set_considering_suggestion(true); + inject( + Update.Paste(Haz3lcore.Typ.typ_to_string(typ)), + ); + }, + _mouse_event => + if (State.get_considering_suggestion()) { + State.set_considering_suggestion(false); + inject(Update.Undo); + } else { + inject(Update.Mouseup); + }, + ), + ], + ), + conflicting_typs, + ), + ], ) | None => div([]) }; From 64d109ed39c5925b8474035a2b4e7942d55483ad Mon Sep 17 00:00:00 2001 From: RaefM Date: Tue, 11 Jul 2023 22:38:00 -0400 Subject: [PATCH 050/129] fix weird hover bug --- src/haz3lweb/view/CursorInspector.re | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 760e04976b..e776650e0c 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -136,11 +136,13 @@ let term_tag = (~inject, ~show_lang_doc, is_err, sort) => { module State = { type t = { considering_suggestion: ref(bool), + suggestion_pasted: ref(bool), last_inspector: ref(Node.t), }; let init = () => { considering_suggestion: ref(false), + suggestion_pasted: ref(false), last_inspector: ref(div([])), }; @@ -149,6 +151,9 @@ module State = { let get_considering_suggestion = () => curr_state.considering_suggestion^; let set_considering_suggestion = v => curr_state.considering_suggestion := v; + let get_suggestion_pasted = () => curr_state.suggestion_pasted^; + let set_suggestion_pasted = v => curr_state.suggestion_pasted := v; + let get_last_inspector = () => curr_state.last_inspector^; let set_last_inspector = v => curr_state.last_inspector := v; }; @@ -190,12 +195,18 @@ let view_of_global_inference_info = }, _mouse_event => { State.set_considering_suggestion(true); - inject( - Update.Paste(Haz3lcore.Typ.typ_to_string(typ)), - ); + if (!State.get_suggestion_pasted()) { + State.set_suggestion_pasted(true); + inject( + Update.Paste(Haz3lcore.Typ.typ_to_string(typ)), + ); + } else { + inject(Update.Mouseup); + }; }, _mouse_event => if (State.get_considering_suggestion()) { + State.set_suggestion_pasted(false); State.set_considering_suggestion(false); inject(Update.Undo); } else { From 7985faf6cdfdbecb4f8c5b1af6cf59dba9787a24 Mon Sep 17 00:00:00 2001 From: RaefM Date: Wed, 12 Jul 2023 01:32:28 -0400 Subject: [PATCH 051/129] add text to consistent suggestions in ci --- src/haz3lweb/view/CursorInspector.re | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index e776650e0c..338a0328fd 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -170,7 +170,10 @@ let view_of_global_inference_info = | Some((true, solution)) => div( ~attr=clss([infoc, "typ"]), - [Type.view(~font_metrics, List.nth(solution, 0))], + [ + text("consistent constraints"), + Type.view(~font_metrics, List.nth(solution, 0)), + ], ) | Some((false, [typ_with_nested_conflict])) => div( From 7607246a766f6887647628708ca7e0cc65d533d1 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Wed, 23 Aug 2023 12:14:51 -0500 Subject: [PATCH 052/129] merged type_provenance cases 'Internal' and 'TypeHole' --- src/haz3lcore/inference/ITyp.re | 2 +- src/haz3lcore/inference/InferenceResult.re | 9 ++++----- src/haz3lcore/inference/PotentialTypeSet.re | 5 ++--- src/haz3lcore/statics/Statics.re | 16 ++++++++-------- src/haz3lcore/statics/Term.re | 4 ++-- src/haz3lcore/statics/Typ.re | 18 ++++++------------ 6 files changed, 23 insertions(+), 31 deletions(-) diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index 6fc9741a89..ce557b89de 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -20,7 +20,7 @@ and constraints = list(equivalence); let rec prov_to_iprov: Typ.type_provenance => Typ.type_provenance = fun - | SynSwitch(u) => Internal(u) + | SynSwitch(u) => AstNode(u) | Inference(mprov, prov) => Inference(mprov, prov_to_iprov(prov)) | _ as prov => prov; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index b0e8b97606..510da5bc88 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -56,14 +56,14 @@ let empty_info = (): global_inference_info => let get_desired_solutions = (inference_results: list(t)): type_hole_to_solution => { - let id_and_status_if_type_hole = (result: t): option((Id.t, status)) => { + let id_and_status_if_ast_node = (result: t): option((Id.t, status)) => { switch (result) { - | (Unknown(TypeHole(id)), status) => Some((id, status)) + | (Unknown(AstNode(id)), status) => Some((id, status)) | _ => None }; }; - let elts = List.filter_map(id_and_status_if_type_hole, inference_results); + let elts = List.filter_map(id_and_status_if_ast_node, inference_results); let new_map = Hashtbl.create(List.length(elts)); List.iter(((id, annot)) => Hashtbl.add(new_map, id, annot), elts); @@ -102,8 +102,7 @@ let rec prov_to_priority = (prov: Typ.type_provenance): int => { switch (prov) { | Anonymous => (-1) | SynSwitch(id) - | TypeHole(id) - | Internal(id) => id + | AstNode(id) => id | Inference(_, prov) => prov_to_priority(prov) }; }; diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index ceb4132207..1e5ed94378 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -426,8 +426,7 @@ let comp_potential_typ = let strip_id_from_prov: Typ.type_provenance => float = fun | SynSwitch(id) - | TypeHole(id) - | Internal(id) => + | AstNode(id) => id == 0 ? (-2.0) : Float.sub(0.0, Float.div(1.0, float_of_int(id))) | _ => 0.0; @@ -480,7 +479,7 @@ let string_of_btyp = (btyp: base_typ): string => { let rec potential_typ_set_to_ityp_unroll = (id: Id.t, pts: t): list(ITyp.t) => { switch (pts) { // TODO: raef and anand: fix this to distinguish between solved and unsolved holes - | [] => [ITyp.Unknown(Internal(id))] + | [] => [ITyp.Unknown(AstNode(id))] | [hd] => [potential_typ_to_ityp(id, hd)] | _ => List.map(potential_typ_to_ityp(id), pts) }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 7e971298f4..d600354969 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -182,7 +182,7 @@ let is_error = (ci: t): bool => { non-empty holes', i.e. assigned Unknown type. */ let typ_after_fix = (mode: Typ.mode, self: Typ.self, termId: Id.t): Typ.t => switch (error_status(mode, self)) { - | InHole(_) => Unknown(Internal(termId)) + | InHole(_) => Unknown(AstNode(termId)) | NotInHole(SynConsistent(t)) => t | NotInHole(AnaConsistent(_, _, ty_join)) => ty_join | NotInHole(AnaExternalInconsistent(ty_ana, _)) => ty_ana @@ -356,7 +356,7 @@ and uexp_to_info_map = ); switch (term) { | Invalid(msg) => - let final_typ: Typ.t = Unknown(Internal(Term.UExp.rep_id(uexp))); + let final_typ: Typ.t = Unknown(AstNode(Term.UExp.rep_id(uexp))); ( final_typ, [], @@ -375,7 +375,7 @@ and uexp_to_info_map = typ_after_fix(mode, Multi, Term.UExp.rep_id(uexp)), ); add(~self=Multi, ~free=Ctx.union(free), union_m(maps), constraints); - | EmptyHole => atomic(Just(Unknown(Internal(Term.UExp.rep_id(uexp))))) + | EmptyHole => atomic(Just(Unknown(AstNode(Term.UExp.rep_id(uexp))))) | Triv => atomic(Just(Prod([]))) | Bool(_) => atomic(Just(Bool)) | Int(_) => atomic(Just(Int)) @@ -594,7 +594,7 @@ and upat_to_info_map = Typ.Unknown( is_synswitch ? SynSwitch(Term.UPat.rep_id(upat)) - : Internal(Term.UPat.rep_id(upat)), + : AstNode(Term.UPat.rep_id(upat)), ); let cls = Term.UPat.cls_of_term(term); let add = (~self: Typ.self, ~ctx, m, constraints) => { @@ -623,7 +623,7 @@ and upat_to_info_map = ); switch (term) { | Invalid(msg) => - let final_typ: Typ.t = Unknown(Internal(Term.UPat.rep_id(upat))); + let final_typ: Typ.t = Unknown(AstNode(Term.UPat.rep_id(upat))); ( final_typ, ctx, @@ -712,7 +712,7 @@ and upat_to_info_map = let typ = typ_after_fix( mode, - Just(Unknown(Internal(upat_rep_id))), + Just(Unknown(AstNode(upat_rep_id))), upat_rep_id, ); let entry = Ctx.VarEntry({name, id: upat_rep_id, typ}); @@ -775,7 +775,7 @@ and utyp_to_info_map = ({ids, term} as utyp: Term.UTyp.t): (Typ.t, map) => { let just = m => (ty, add(Just(ty), m)); switch (term) { | Invalid(msg) => ( - Unknown(Internal(Term.UTyp.rep_id(utyp))), + Unknown(AstNode(Term.UTyp.rep_id(utyp))), add_info(ids, Invalid(msg), Id.Map.empty), ) | EmptyHole @@ -797,7 +797,7 @@ and utyp_to_info_map = ({ids, term} as utyp: Term.UTyp.t): (Typ.t, map) => { | Var(name) => switch (BuiltinADTs.is_typ_var(name)) { | None => ( - Unknown(Internal(Term.UTyp.rep_id(utyp))), + Unknown(AstNode(Term.UTyp.rep_id(utyp))), add(Free(TypeVariable), Id.Map.empty), ) | Some(_) => (Var(name), add(Just(Var(name)), Id.Map.empty)) diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index edecc9faac..5afacc413f 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -501,8 +501,8 @@ let rec utyp_to_ty: UTyp.t => Typ.t = utyp => switch (utyp.term) { | Invalid(_) - | MultiHole(_) => Unknown(Internal(UTyp.rep_id(utyp))) - | EmptyHole => Unknown(TypeHole(UTyp.rep_id(utyp))) + | MultiHole(_) + | EmptyHole => Unknown(AstNode(UTyp.rep_id(utyp))) | Bool => Bool | Int => Int | Float => Float diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index 9ea6a55196..36f12c67b2 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -5,7 +5,7 @@ open Sexplib.Std; Forms associated with a unique Id.t linking them to some UExp/UPat ------------------------------------------------------------ SynSwitch: Generated from an unannotated pattern variable - TypeHole: Generataed from a pattern variable annotated with a type hole + TypeHole: Generataed from a user-created type hole (empty annotation) Internal: Generated by an internal judgement Forms without a unique Id.t of their own @@ -24,8 +24,7 @@ open Sexplib.Std; type type_provenance = | Anonymous | SynSwitch(Id.t) - | TypeHole(Id.t) - | Internal(Id.t) + | AstNode(Id.t) | Inference(matched_provenance, type_provenance) and matched_provenance = | Matched_Arrow_Left @@ -114,13 +113,8 @@ let source_tys = List.map((source: source) => source.ty); let join_type_provenance = (p1: type_provenance, p2: type_provenance): type_provenance => switch (p1, p2) { - | ( - TypeHole(_) as t, - Inference(_) | TypeHole(_) | Internal(_) | SynSwitch(_) | Anonymous, - ) - | (Inference(_) | Internal(_) | SynSwitch(_) | Anonymous, TypeHole(_) as t) => t - | (Internal(_) as i, Inference(_) | Internal(_) | SynSwitch(_) | Anonymous) - | (Inference(_) | SynSwitch(_) | Anonymous, Internal(_) as i) => i + | (AstNode(_) as t, Inference(_) | AstNode(_) | SynSwitch(_) | Anonymous) + | (Inference(_) | SynSwitch(_) | Anonymous, AstNode(_) as t) => t | (SynSwitch(_) as s, Inference(_) | SynSwitch(_) | Anonymous) | (Inference(_) | Anonymous, SynSwitch(_) as s) => s | (Inference(_) as inf, Anonymous | Inference(_)) @@ -227,7 +221,7 @@ let matched_arrow = (ty: t, termId: Id.t): ((t, t), constraints) => { switch (ty) { | Arrow(ty_in, ty_out) => ((ty_in, ty_out), []) | Unknown(prov) => matched_arrow_of_prov(prov) - | _ => matched_arrow_of_prov(Internal(termId)) + | _ => matched_arrow_of_prov(AstNode(termId)) }; }; @@ -251,7 +245,7 @@ let matched_list = (ty: t, termId: Id.t): (t, constraints) => { switch (ty) { | List(ty) => (ty, []) | Unknown(prov) => matched_list_of_prov(prov) - | _ => matched_list_of_prov(Internal(termId)) + | _ => matched_list_of_prov(AstNode(termId)) }; }; From 1afa3ee4cbdc3fe5825f4e34fdd9749dc7c910d7 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Wed, 23 Aug 2023 12:31:21 -0500 Subject: [PATCH 053/129] rename Anonymous to NoProvenance --- src/haz3lcore/dynamics/Evaluator.re | 28 +++++++++--------- src/haz3lcore/dynamics/elaborator.re | 2 +- src/haz3lcore/inference/ITyp.re | 4 +-- src/haz3lcore/inference/InferenceResult.re | 2 +- src/haz3lcore/inference/PotentialTypeSet.re | 4 +-- src/haz3lcore/statics/Statics.re | 17 +++++++---- src/haz3lcore/statics/Typ.re | 32 ++++++++++----------- src/haz3lweb/view/Type.re | 2 +- 8 files changed, 48 insertions(+), 43 deletions(-) diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 80a2e2b5a1..3541b14d15 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -20,14 +20,14 @@ type match_result = | IndetMatch; let grounded_Arrow = - NotGroundOrHole(Arrow(Unknown(Anonymous), Unknown(Anonymous))); + NotGroundOrHole(Arrow(Unknown(NoProvenance), Unknown(NoProvenance))); let grounded_Sum = - NotGroundOrHole(Sum(Unknown(Anonymous), Unknown(Anonymous))); + NotGroundOrHole(Sum(Unknown(NoProvenance), Unknown(NoProvenance))); let grounded_Prod = length => NotGroundOrHole( - Prod(ListUtil.replicate(length, Typ.Unknown(Anonymous))), + Prod(ListUtil.replicate(length, Typ.Unknown(NoProvenance))), ); -let grounded_List = NotGroundOrHole(List(Unknown(Anonymous))); +let grounded_List = NotGroundOrHole(List(Unknown(NoProvenance))); let ground_cases_of = (ty: Typ.t): ground_cases => switch (ty) { @@ -189,7 +189,7 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => p => [p], List.combine( tys, - List.init(List.length(tys), _ => Typ.Unknown(Anonymous)), + List.init(List.length(tys), _ => Typ.Unknown(NoProvenance)), ), ), ) @@ -200,7 +200,7 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => List.map( p => [p], List.combine( - List.init(List.length(tys'), _ => Typ.Unknown(Anonymous)), + List.init(List.length(tys'), _ => Typ.Unknown(NoProvenance)), tys', ), ), @@ -210,9 +210,9 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => | (Cons(_) | ListLit(_), Cast(d, List(ty1), List(ty2))) => matches_cast_Cons(dp, d, [(ty1, ty2)]) | (Cons(_) | ListLit(_), Cast(d, Unknown(_), List(ty2))) => - matches_cast_Cons(dp, d, [(Unknown(Anonymous), ty2)]) + matches_cast_Cons(dp, d, [(Unknown(NoProvenance), ty2)]) | (Cons(_) | ListLit(_), Cast(d, List(ty1), Unknown(_))) => - matches_cast_Cons(dp, d, [(ty1, Unknown(Anonymous))]) + matches_cast_Cons(dp, d, [(ty1, Unknown(NoProvenance))]) | (Cons(_, _), Cons(_, _)) | (ListLit(_, _), Cons(_, _)) | (Cons(_, _), ListLit(_)) @@ -254,14 +254,14 @@ and matches_cast_Inj = side, dp, d', - [(tyL1, tyR1, Unknown(Anonymous), Unknown(Anonymous))], + [(tyL1, tyR1, Unknown(NoProvenance), Unknown(NoProvenance))], ) | Cast(d', Unknown(_), Sum(tyL2, tyR2)) => matches_cast_Inj( side, dp, d', - [(Unknown(Anonymous), Unknown(Anonymous), tyL2, tyR2)], + [(Unknown(NoProvenance), Unknown(NoProvenance), tyL2, tyR2)], ) | Cast(_, _, _) => DoesNotMatch | BoundVar(_) => DoesNotMatch @@ -339,14 +339,14 @@ and matches_cast_Tuple = ); } | Cast(d', Prod(tys), Unknown(_)) => - let tys' = List.init(List.length(tys), _ => Typ.Unknown(Anonymous)); + let tys' = List.init(List.length(tys), _ => Typ.Unknown(NoProvenance)); matches_cast_Tuple( dps, d', List.map2(List.cons, List.combine(tys, tys'), elt_casts), ); | Cast(d', Unknown(_), Prod(tys')) => - let tys = List.init(List.length(tys'), _ => Typ.Unknown(Anonymous)); + let tys = List.init(List.length(tys'), _ => Typ.Unknown(NoProvenance)); matches_cast_Tuple( dps, d', @@ -486,9 +486,9 @@ and matches_cast_Cons = | Cast(d', List(ty1), List(ty2)) => matches_cast_Cons(dp, d', [(ty1, ty2), ...elt_casts]) | Cast(d', List(ty1), Unknown(_)) => - matches_cast_Cons(dp, d', [(ty1, Unknown(Anonymous)), ...elt_casts]) + matches_cast_Cons(dp, d', [(ty1, Unknown(NoProvenance)), ...elt_casts]) | Cast(d', Unknown(_), List(ty2)) => - matches_cast_Cons(dp, d', [(Unknown(Anonymous), ty2), ...elt_casts]) + matches_cast_Cons(dp, d', [(Unknown(NoProvenance), ty2), ...elt_casts]) | Cast(_, _, _) => DoesNotMatch | BoundVar(_) => DoesNotMatch | FreeVar(_) => IndetMatch diff --git a/src/haz3lcore/dynamics/elaborator.re b/src/haz3lcore/dynamics/elaborator.re index a130debab3..f94b679b94 100644 --- a/src/haz3lcore/dynamics/elaborator.re +++ b/src/haz3lcore/dynamics/elaborator.re @@ -382,5 +382,5 @@ let uexp_elab = (m: Statics.map, uexp: Term.UExp.t): ElaborationResult.t => | None => DoesNotElaborate | Some(d) => let d = uexp_elab_wrap_builtins(d); - Elaborates(d, Typ.Unknown(Anonymous), Delta.empty); //TODO: get type from ci + Elaborates(d, Typ.Unknown(NoProvenance), Delta.empty); //TODO: get type from ci }; diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index ce557b89de..4ef0bb690f 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -38,7 +38,7 @@ let rec typ_to_ityp: Typ.t => t = | Prod([hd_ty, ...tl_tys]) => Prod(typ_to_ityp(hd_ty), typ_to_ityp(Prod(tl_tys))) | Prod([]) => Unit - | Var(_) => Unknown(Anonymous); + | Var(_) => Unknown(NoProvenance); let unwrap_if_prod = (typ: Typ.t): list(Typ.t) => { switch (typ) { @@ -64,7 +64,7 @@ let rec ityp_to_typ: t => Typ.t = let to_ityp_constraints = (constraints: Typ.constraints): constraints => { constraints |> List.filter(((t1, t2)) => - t1 != Typ.Unknown(Anonymous) && t2 != Typ.Unknown(Anonymous) + t1 != Typ.Unknown(NoProvenance) && t2 != Typ.Unknown(NoProvenance) ) |> List.map(((t1, t2)) => (typ_to_ityp(t1), typ_to_ityp(t2))); }; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 510da5bc88..5a52187863 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -100,7 +100,7 @@ let condense = let rec prov_to_priority = (prov: Typ.type_provenance): int => { switch (prov) { - | Anonymous => (-1) + | NoProvenance => (-1) | SynSwitch(id) | AstNode(id) => id | Inference(_, prov) => prov_to_priority(prov) diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index 1e5ed94378..7e8af0e34d 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -487,9 +487,9 @@ let rec potential_typ_set_to_ityp_unroll = (id: Id.t, pts: t): list(ITyp.t) => { and potential_typ_set_to_ityp_no_unroll = (id: Id.t, pts: t): ITyp.t => { switch (pts) { // TODO: raef and anand: fix this to distinguish between solved and unsolved holes - | [] => ITyp.Unknown(Anonymous) + | [] => ITyp.Unknown(NoProvenance) | [hd] => potential_typ_to_ityp(id, hd) - | _ => ITyp.Unknown(Anonymous) + | _ => ITyp.Unknown(NoProvenance) }; } and potential_typ_to_ityp = (id: Id.t, ptyp: potential_typ): ITyp.t => { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index d600354969..46a3248dc4 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -109,7 +109,9 @@ type error_status = let error_status = (mode: Typ.mode, self: Typ.self): error_status => switch (mode, self) { | (SynFun, Just(ty)) => - switch (Typ.join(Arrow(Unknown(Anonymous), Unknown(Anonymous)), ty)) { + switch ( + Typ.join(Arrow(Unknown(NoProvenance), Unknown(NoProvenance)), ty) + ) { | None => InHole(NoFun(ty)) | Some(_) => NotInHole(SynConsistent(ty)) } @@ -119,7 +121,10 @@ let error_status = (mode: Typ.mode, self: Typ.self): error_status => | None => InHole(SynInconsistentBranches(tys_syn)) | Some(ty_joined) => switch ( - Typ.join(Arrow(Unknown(Anonymous), Unknown(Anonymous)), ty_joined) + Typ.join( + Arrow(Unknown(NoProvenance), Unknown(NoProvenance)), + ty_joined, + ) ) { | None => InHole(NoFun(ty_joined)) | Some(_) => NotInHole(SynConsistent(ty_joined)) @@ -127,7 +132,7 @@ let error_status = (mode: Typ.mode, self: Typ.self): error_status => }; | (Syn | SynFun | Ana(_), Free(free_error)) => InHole(Free(free_error)) | (Syn | SynFun | Ana(_), Multi) => - NotInHole(SynConsistent(Unknown(Anonymous))) + NotInHole(SynConsistent(Unknown(NoProvenance))) | (Syn, Just(ty)) => NotInHole(SynConsistent(ty)) | (Syn, Joined(wrap, tys_syn)) => let tys_syn = Typ.source_tys(tys_syn); @@ -381,7 +386,7 @@ and uexp_to_info_map = | Int(_) => atomic(Just(Int)) | Float(_) => atomic(Just(Float)) | String(_) => atomic(Just(String)) - | ListLit([]) => atomic(Just(List(Unknown(Anonymous)))) + | ListLit([]) => atomic(Just(List(Unknown(NoProvenance)))) | ListLit(es) => let (modes, list_of_match_constraints) = List.init(List.length(es), _ => @@ -647,7 +652,7 @@ and upat_to_info_map = | Triv => atomic(Just(Prod([]))) | Bool(_) => atomic(Just(Bool)) | String(_) => atomic(Just(String)) - | ListLit([]) => atomic(Just(List(Unknown(Anonymous)))) + | ListLit([]) => atomic(Just(List(Unknown(NoProvenance)))) | ListLit(ps) => let (modes, list_of_match_constraints) = List.init(List.length(ps), _ => @@ -706,7 +711,7 @@ and upat_to_info_map = | None => atomic(Free(Tag)) | Some(typ) => atomic(Just(typ)) } - | Wild => atomic(Just(Unknown(Anonymous))) + | Wild => atomic(Just(Unknown(NoProvenance))) | Var(name) => let upat_rep_id = Term.UPat.rep_id(upat); let typ = diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index 36f12c67b2..31263f944f 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -16,13 +16,13 @@ open Sexplib.Std; Generally, will always link to some form with its own unique Id.t Currently supports matched list, arrow, and prod. - Anonymous: Generated for unknown types not linked to any UExp/UPat, wildcards, - and other generally 'unconstrainable' unknown types - Consequently, Anonymous unknown types do not accumulate constraints + NoProvenance: Generated for unknown types with no provenance. They did not originate from + any expression/pattern/type in the source program, directly or indirectly. + Consequently, NoProvenance unknown types do not accumulate constraints or receive inference results.*/ [@deriving (show({with_path: false}), sexp, yojson)] type type_provenance = - | Anonymous + | NoProvenance | SynSwitch(Id.t) | AstNode(Id.t) | Inference(matched_provenance, type_provenance) @@ -103,23 +103,23 @@ let source_tys = List.map((source: source) => source.ty); joining unknown types. This probably requires more thought, but right now TypeHole strictly predominates over Internal which strictly predominates over SynSwitch, which - strictly predominates over Anonymous. + strictly predominates over NoProvenance. If two provenances have different Ids, either can be taken as a representative of the other in later computations regarding the type as a whole. Similarly, if two Internal provenances have different matched provenance strucutres, either structure can be taken. Precedence: - TypeHole > Internal > SynSwitch > Inference > Anonymous*/ + TypeHole > Internal > SynSwitch > Inference > NoProvenance*/ let join_type_provenance = (p1: type_provenance, p2: type_provenance): type_provenance => switch (p1, p2) { - | (AstNode(_) as t, Inference(_) | AstNode(_) | SynSwitch(_) | Anonymous) - | (Inference(_) | SynSwitch(_) | Anonymous, AstNode(_) as t) => t - | (SynSwitch(_) as s, Inference(_) | SynSwitch(_) | Anonymous) - | (Inference(_) | Anonymous, SynSwitch(_) as s) => s - | (Inference(_) as inf, Anonymous | Inference(_)) - | (Anonymous, Inference(_) as inf) => inf - | (Anonymous, Anonymous) => Anonymous + | (AstNode(_) as t, Inference(_) | AstNode(_) | SynSwitch(_) | NoProvenance) + | (Inference(_) | SynSwitch(_) | NoProvenance, AstNode(_) as t) => t + | (SynSwitch(_) as s, Inference(_) | SynSwitch(_) | NoProvenance) + | (Inference(_) | NoProvenance, SynSwitch(_) as s) => s + | (Inference(_) as inf, NoProvenance | Inference(_)) + | (NoProvenance, Inference(_) as inf) => inf + | (NoProvenance, NoProvenance) => NoProvenance }; /* Lattice join on types. This is a LUB join in the hazel2 @@ -173,7 +173,7 @@ let rec join = (ty1: t, ty2: t): option(t) => let join_all: list(t) => option(t) = List.fold_left( (acc, ty) => Util.OptUtil.and_then(join(ty), acc), - Some(Unknown(Anonymous)), + Some(Unknown(NoProvenance)), ); let join_or_fst = (ty: t, ty': t): t => @@ -196,11 +196,11 @@ let t_of_self = | Just(t) => t | Joined(wrap, ss) => switch (ss |> List.map(s => s.ty) |> join_all) { - | None => Unknown(Anonymous) + | None => Unknown(NoProvenance) | Some(t) => wrap(t) } | Multi - | Free(_) => Unknown(Anonymous); + | Free(_) => Unknown(NoProvenance); /* MATCHED JUDGEMENTS: Note that matched judgements work a bit different than hazel2 here since hole fixing is diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index ee96f0b464..c9395bd45c 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -105,7 +105,7 @@ and view_of_potential_typ_set = view( ~font_metrics=Some(font_metrics), ~with_cls, - Typ.Unknown(Anonymous), + Typ.Unknown(NoProvenance), ) | [hd] => view_of_potential_typ(~font_metrics, ~with_cls, outermost, hd) | _ => From 4119c857197870457f14ea97ab8ee6e748c3b2a3 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Wed, 23 Aug 2023 12:48:58 -0500 Subject: [PATCH 054/129] renamed Inference prov case to Matched --- src/haz3lcore/inference/ITyp.re | 2 +- src/haz3lcore/inference/InferenceResult.re | 2 +- src/haz3lcore/statics/Typ.re | 31 +++++++++++----------- 3 files changed, 17 insertions(+), 18 deletions(-) diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index 4ef0bb690f..dd17e07a59 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -21,7 +21,7 @@ and constraints = list(equivalence); let rec prov_to_iprov: Typ.type_provenance => Typ.type_provenance = fun | SynSwitch(u) => AstNode(u) - | Inference(mprov, prov) => Inference(mprov, prov_to_iprov(prov)) + | Matched(mprov, prov) => Matched(mprov, prov_to_iprov(prov)) | _ as prov => prov; let rec typ_to_ityp: Typ.t => t = diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 5a52187863..f13a3d13fc 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -103,7 +103,7 @@ let rec prov_to_priority = (prov: Typ.type_provenance): int => { | NoProvenance => (-1) | SynSwitch(id) | AstNode(id) => id - | Inference(_, prov) => prov_to_priority(prov) + | Matched(_, prov) => prov_to_priority(prov) }; }; diff --git a/src/haz3lcore/statics/Typ.re b/src/haz3lcore/statics/Typ.re index 31263f944f..b43f952065 100644 --- a/src/haz3lcore/statics/Typ.re +++ b/src/haz3lcore/statics/Typ.re @@ -5,12 +5,11 @@ open Sexplib.Std; Forms associated with a unique Id.t linking them to some UExp/UPat ------------------------------------------------------------ SynSwitch: Generated from an unannotated pattern variable - TypeHole: Generataed from a user-created type hole (empty annotation) - Internal: Generated by an internal judgement + AstNode: Generated from an expression/pattern/type in the source code Forms without a unique Id.t of their own ---------------------------------------- - Inference: Always derived from some other provenance for use in global inference. + Matched: Always derived from some other provenance for use in global inference. Composed of a 'matched_provenenace' indicating how it was derived, and the provenance it was derived from. Generally, will always link to some form with its own unique Id.t @@ -25,7 +24,7 @@ type type_provenance = | NoProvenance | SynSwitch(Id.t) | AstNode(Id.t) - | Inference(matched_provenance, type_provenance) + | Matched(matched_provenance, type_provenance) and matched_provenance = | Matched_Arrow_Left | Matched_Arrow_Right @@ -109,16 +108,16 @@ let source_tys = List.map((source: source) => source.ty); type as a whole. Similarly, if two Internal provenances have different matched provenance strucutres, either structure can be taken. Precedence: - TypeHole > Internal > SynSwitch > Inference > NoProvenance*/ + TypeHole > Internal > SynSwitch > Matched > NoProvenance*/ let join_type_provenance = (p1: type_provenance, p2: type_provenance): type_provenance => switch (p1, p2) { - | (AstNode(_) as t, Inference(_) | AstNode(_) | SynSwitch(_) | NoProvenance) - | (Inference(_) | SynSwitch(_) | NoProvenance, AstNode(_) as t) => t - | (SynSwitch(_) as s, Inference(_) | SynSwitch(_) | NoProvenance) - | (Inference(_) | NoProvenance, SynSwitch(_) as s) => s - | (Inference(_) as inf, NoProvenance | Inference(_)) - | (NoProvenance, Inference(_) as inf) => inf + | (AstNode(_) as t, Matched(_) | AstNode(_) | SynSwitch(_) | NoProvenance) + | (Matched(_) | SynSwitch(_) | NoProvenance, AstNode(_) as t) => t + | (SynSwitch(_) as s, Matched(_) | SynSwitch(_) | NoProvenance) + | (Matched(_) | NoProvenance, SynSwitch(_) as s) => s + | (Matched(_) as inf, NoProvenance | Matched(_)) + | (NoProvenance, Matched(_) as inf) => inf | (NoProvenance, NoProvenance) => NoProvenance }; @@ -210,8 +209,8 @@ let t_of_self = let matched_arrow = (ty: t, termId: Id.t): ((t, t), constraints) => { let matched_arrow_of_prov = prov => { let (arrow_lhs, arrow_rhs) = ( - Unknown(Inference(Matched_Arrow_Left, prov)), - Unknown(Inference(Matched_Arrow_Right, prov)), + Unknown(Matched(Matched_Arrow_Left, prov)), + Unknown(Matched(Matched_Arrow_Right, prov)), ); ( (arrow_lhs, arrow_rhs), @@ -238,7 +237,7 @@ let matched_arrow_mode = let matched_list = (ty: t, termId: Id.t): (t, constraints) => { let matched_list_of_prov = prov => { - let list_elts_typ = Unknown(Inference(Matched_List, prov)); + let list_elts_typ = Unknown(Matched(Matched_List, prov)); (list_elts_typ, [(Unknown(prov), List(list_elts_typ))]); }; @@ -263,8 +262,8 @@ let rec matched_prod_mode = (mode: mode, length): (list(mode), constraints) => { let binary_matched_prod_of_prov = (prov: type_provenance): ((t, t), equivalence) => { let (left_ty, right_ty) = ( - Unknown(Inference(Matched_Prod_Left, prov)), - Unknown(Inference(Matched_Prod_Right, prov)), + Unknown(Matched(Matched_Prod_Left, prov)), + Unknown(Matched(Matched_Prod_Right, prov)), ); ((left_ty, right_ty), (Unknown(prov), Prod([left_ty, right_ty]))); }; From 1db78ad56ec5600ed1aa411ca98e934654beb2a0 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Fri, 25 Aug 2023 16:38:20 -0500 Subject: [PATCH 055/129] rewrite pt. 1 --- src/haz3lcore/inference/Infer.re | 171 +++++++++++++++++++++ src/haz3lcore/inference/InferenceResult.re | 7 +- src/haz3lcore/statics/Statics.re | 15 +- src/haz3lcore/zipper/Editor.re | 3 +- src/haz3lweb/Keyboard.re | 3 +- src/haz3lweb/view/Cell.re | 3 +- src/haz3lweb/view/Page.re | 3 +- src/haz3lweb/view/SchoolMode.re | 1 + src/haz3lweb/view/ScratchMode.re | 3 +- 9 files changed, 199 insertions(+), 10 deletions(-) create mode 100644 src/haz3lcore/inference/Infer.re diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re new file mode 100644 index 0000000000..a987e99590 --- /dev/null +++ b/src/haz3lcore/inference/Infer.re @@ -0,0 +1,171 @@ +type ptyp = + | Int + | Float + | Bool + | String + | Var(string) + | List(pts) + | Arrow(pts, pts) + | Sum(pts, pts) // unused + | Prod(list(pts)) +and pts = UnionFind.elem(list(ptyp)); + +module Ctx = { + type t = Hashtbl.t(Typ.type_provenance, pts); + + let create = (): t => Hashtbl.create(100); + + let lookup_or_create = (ctx: t, p: Typ.type_provenance): pts => { + let lookup = Hashtbl.find_opt(ctx, p); + switch (lookup) { + | Some(pts) => pts + | None => + let pts = UnionFind.make([]); + Hashtbl.add(ctx, p, pts); + pts; + }; + }; +}; + +let rec pts_of_typ = (ctx: Ctx.t, t: Typ.t): pts => { + switch (t) { + | Typ.Unknown(p) => Ctx.lookup_or_create(ctx, p) + | _ => + let ptyp = ptyp_of_typ(ctx, t); + UnionFind.make([ptyp]); + }; +} +and ptyp_of_typ = (ctx: Ctx.t, t: Typ.t): ptyp => { + switch (t) { + | Int => Int + | Float => Float + | Bool => Bool + | String => String + | Var(s) => Var(s) + | List(t) => List(pts_of_typ(ctx, t)) + | Arrow(t1, t2) => Arrow(pts_of_typ(ctx, t1), pts_of_typ(ctx, t2)) + | Sum(t1, t2) => Sum(pts_of_typ(ctx, t1), pts_of_typ(ctx, t2)) + | Prod(ts) => Prod(List.map(pts_of_typ(ctx), ts)) + | Typ.Unknown(_p) => failwith("unreachable") + }; +}; + +// merge two pts +let rec merge = (ctx: Ctx.t, pts1: pts, pts2: pts): pts => { + let representative = UnionFind.union(pts1, pts2); + let tys = merge_helper(ctx, pts1, pts2); + let _ = UnionFind.set(representative, tys); + representative; +} +and merge_helper = (ctx: Ctx.t, pts1: pts, pts2: pts): list(ptyp) => { + let tys1 = UnionFind.get(pts1); + let tys2 = UnionFind.get(pts2); + List.fold_left(extend_helper(ctx), tys1, tys2); +} +// // extend pts with a ptyp +// and extend = (ctx: Ctx.t, pts: pts, ptyp: ptyp): unit => { +// let types = UnionFind.get(pts); +// let types2 = extend_helper(ctx, types, ptyp); +// (); +// } +and extend_helper = (ctx: Ctx.t, tys: list(ptyp), ptyp: ptyp): list(ptyp) => { + switch (tys) { + | [] => [ptyp] + | [hd, ...tl] => + let new_tl = extend_helper(ctx, tl, ptyp); + switch (hd, ptyp) { + // duplicate + | (Int, Int) => [Int, ...new_tl] + | (Float, Float) => [Float, ...new_tl] + | (Bool, Bool) => [Bool, ...new_tl] + | (String, String) => [String, ...new_tl] + | (Var(s1), Var(s2)) when s1 == s2 => [Var(s1), ...new_tl] + // similar, merge children + | (List(pts1), List(pts2)) => + let pts = merge(ctx, pts1, pts2); + [List(pts), ...new_tl]; + | (Arrow(pts1, pts2), Arrow(pts3, pts4)) => + let pts1 = merge(ctx, pts1, pts3); + let pts2 = merge(ctx, pts2, pts4); + [Arrow(pts1, pts2), ...new_tl]; + | (Sum(pts1, pts2), Sum(pts3, pts4)) => + let pts1 = merge(ctx, pts1, pts3); + let pts2 = merge(ctx, pts2, pts4); + [Sum(pts1, pts2), ...new_tl]; + | (Prod(tys1), Prod(tys2)) => + let tys = List.map2(merge(ctx), tys1, tys2); + [Prod(tys), ...new_tl]; + // different, keep both + | _ => [ptyp, hd, ...new_tl] + }; + }; +}; + +// API +let constrain = (ctx: Ctx.t, t1: Typ.t, t2: Typ.t): unit => { + let pts1 = pts_of_typ(ctx, t1); + let pts2 = pts_of_typ(ctx, t2); + if (!UnionFind.eq(pts1, pts2)) { + let _ = merge(ctx, pts1, pts2); + (); + }; +}; + +type status = + | Solved(Typ.t) + | Unsolved(list(ptyp)); + +let rec get_status = (ctx: Ctx.t, id: Id.t): status => { + let pts = Ctx.lookup_or_create(ctx, Typ.AstNode(id)); + get_status_helper(ctx, pts); +} +and get_status_helper = (ctx: Ctx.t, pts: pts): status => { + let tys = UnionFind.get(pts); + switch (tys) { + | [ty] => + switch (ty) { + | Int => Solved(Int) + | Float => Solved(Float) + | Bool => Solved(Bool) + | String => Solved(String) + | Var(s) => Solved(Var(s)) + | List(pts) => + switch (get_status_helper(ctx, pts)) { + | Solved(ty) => Solved(List(ty)) + | Unsolved(_) => Unsolved(tys) + } + | Arrow(pts1, pts2) => + switch (get_status_helper(ctx, pts1), get_status_helper(ctx, pts2)) { + | (Solved(ty1), Solved(ty2)) => Solved(Arrow(ty1, ty2)) + | _ => Unsolved(tys) + } + | Sum(pts1, pts2) => + switch (get_status_helper(ctx, pts1), get_status_helper(ctx, pts2)) { + | (Solved(ty1), Solved(ty2)) => Solved(Sum(ty1, ty2)) + | _ => Unsolved(tys) + } + | Prod(tys_inner) => + let is_solved = (s: status): bool => { + switch (s) { + | Solved(_) => true + | Unsolved(_) => false + }; + }; + let unwrap_solution = (s: status): Typ.t => { + switch (s) { + | Solved(ty) => ty + | Unsolved(_) => failwith("unreachable") + }; + }; + let statuses = List.map(get_status_helper(ctx), tys_inner); + if (List.for_all(is_solved, statuses)) { + let tys3 = List.map(unwrap_solution, statuses); + Solved(Prod(tys3)); + } else { + Unsolved(tys); + }; + } + | [] + | [_, ..._] => Unsolved(tys) + }; +}; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index f13a3d13fc..d33c6e1456 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -9,6 +9,7 @@ type type_hole_to_solution = Hashtbl.t(Id.t, status); type global_inference_info = { enabled: bool, solution_statuses: type_hole_to_solution, + ctx: Infer.Ctx.t, }; type suggestion('a) = @@ -47,12 +48,12 @@ let hole_mold: Mold.t = {out: Any, in_: [], nibs: (hole_nib, hole_nib)}; let empty_solutions = (): type_hole_to_solution => Hashtbl.create(20); -let mk_global_inference_info = (enabled, annotations) => { - {enabled, solution_statuses: annotations}; +let mk_global_inference_info = (enabled, annotations, ctx) => { + {enabled, solution_statuses: annotations, ctx}; }; let empty_info = (): global_inference_info => - mk_global_inference_info(true, empty_solutions()); + mk_global_inference_info(true, empty_solutions(), Infer.Ctx.create()); let get_desired_solutions = (inference_results: list(t)): type_hole_to_solution => { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 46a3248dc4..3dc55463fd 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -826,12 +826,23 @@ let mk_map_and_inference_solutions = let global_inference_solutions = InferenceResult.get_desired_solutions(inference_results); - (info_map, global_inference_solutions); + // rewrite is here + let ctx = Infer.Ctx.create(); + let _ = + List.iter( + c => { + let (typ1, typ2) = c; + Infer.constrain(ctx, typ1, typ2); + }, + constraints, + ); + + (info_map, global_inference_solutions, ctx); }, ); let mk_map = e => { - let (info_map, _) = mk_map_and_inference_solutions(e); + let (info_map, _, _) = mk_map_and_inference_solutions(e); info_map; }; diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 2029a1c94b..150e9af650 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -54,7 +54,7 @@ module Meta = { let unselected = Zipper.unselect_and_zip(z); let (term, _) = MakeTerm.go(unselected); // TODO Raef: add in flow for the enabled flag - let (_, global_inference_solutions) = + let (_, global_inference_solutions, ctx) = Statics.mk_map_and_inference_solutions(term); let measured = Measured.of_segment( @@ -64,6 +64,7 @@ module Meta = { InferenceResult.mk_global_inference_info( inference_enabled, global_inference_solutions, + ctx, ), unselected, ); diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 4b59e0b040..13236b6f60 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -25,12 +25,13 @@ let handle_key_event = (k: Key.t, ~model: Model.t): list(Update.t) => { let zipper = Editors.get_zipper(model.editors); let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, global_inference_solutions) = + let (_, global_inference_solutions, ctx) = Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( model.langDocMessages.annotations, global_inference_solutions, + ctx, ); let restricted = Backpack.restricted(zipper.backpack); let now = a => [Update.PerformAction(a) /*Update.UpdateDoubleTap(None)*/]; diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index b6f6928ead..de75936906 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -289,13 +289,14 @@ let editor_view = let segment = Zipper.zip(zipper); let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, global_inference_solutions) = + let (_, global_inference_solutions, ctx) = Statics.mk_map_and_inference_solutions(term); let measured = editor.state.meta.measured; let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, global_inference_solutions, + ctx, ); let code_base_view = Code.view( diff --git a/src/haz3lweb/view/Page.re b/src/haz3lweb/view/Page.re index f5e4cc620f..e0c6fa08d3 100644 --- a/src/haz3lweb/view/Page.re +++ b/src/haz3lweb/view/Page.re @@ -232,12 +232,13 @@ let main_ui_view = let zipper = Editors.get_editor(editors).state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, global_inference_solutions) = + let (_, global_inference_solutions, ctx) = Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, global_inference_solutions, + ctx, ); [top_bar_view] @ SchoolMode.view( diff --git a/src/haz3lweb/view/SchoolMode.re b/src/haz3lweb/view/SchoolMode.re index 8d431d8191..08a8bf35a8 100644 --- a/src/haz3lweb/view/SchoolMode.re +++ b/src/haz3lweb/view/SchoolMode.re @@ -84,6 +84,7 @@ let view = InferenceResult.mk_global_inference_info( langDocMessages.annotations, global_inference_info.solution_statuses, + global_inference_info.ctx, ); let color_highlighting: option(ColorSteps.colorMap) = diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index e44080cd9b..9411d967b7 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -19,12 +19,13 @@ let view = let zipper = editor.state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (info_map, global_inference_solutions) = + let (info_map, global_inference_solutions, ctx) = Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, global_inference_solutions, + ctx, ); let color_highlighting: option(ColorSteps.colorMap) = From 25f1808b54bd9f71b5e8c2663e726ee5b2c5b87e Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Fri, 25 Aug 2023 22:41:42 -0500 Subject: [PATCH 056/129] rewrite pt. 2 --- src/haz3lcore/inference/Infer.re | 220 ++++++++++++++++----------- src/haz3lweb/view/CursorInspector.re | 158 ++++++++++++------- src/haz3lweb/view/InferenceView.re | 95 ++++++++---- 3 files changed, 296 insertions(+), 177 deletions(-) diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re index a987e99590..e5699f5226 100644 --- a/src/haz3lcore/inference/Infer.re +++ b/src/haz3lcore/inference/Infer.re @@ -16,6 +16,12 @@ module Ctx = { let create = (): t => Hashtbl.create(100); let lookup_or_create = (ctx: t, p: Typ.type_provenance): pts => { + // get rid of SynSwitch + let p = + switch (p) { + | Typ.SynSwitch(id) => Typ.AstNode(id) + | _ => p + }; let lookup = Hashtbl.find_opt(ctx, p); switch (lookup) { | Some(pts) => pts @@ -52,52 +58,60 @@ and ptyp_of_typ = (ctx: Ctx.t, t: Typ.t): ptyp => { // merge two pts let rec merge = (ctx: Ctx.t, pts1: pts, pts2: pts): pts => { + let pts3 = merge_helper(ctx, pts1, pts2); let representative = UnionFind.union(pts1, pts2); - let tys = merge_helper(ctx, pts1, pts2); - let _ = UnionFind.set(representative, tys); + let _ = UnionFind.set(representative, pts3); representative; } and merge_helper = (ctx: Ctx.t, pts1: pts, pts2: pts): list(ptyp) => { let tys1 = UnionFind.get(pts1); let tys2 = UnionFind.get(pts2); - List.fold_left(extend_helper(ctx), tys1, tys2); + List.fold_left(extend(ctx), tys1, tys2); } -// // extend pts with a ptyp -// and extend = (ctx: Ctx.t, pts: pts, ptyp: ptyp): unit => { -// let types = UnionFind.get(pts); -// let types2 = extend_helper(ctx, types, ptyp); -// (); -// } -and extend_helper = (ctx: Ctx.t, tys: list(ptyp), ptyp: ptyp): list(ptyp) => { - switch (tys) { - | [] => [ptyp] - | [hd, ...tl] => - let new_tl = extend_helper(ctx, tl, ptyp); - switch (hd, ptyp) { - // duplicate - | (Int, Int) => [Int, ...new_tl] - | (Float, Float) => [Float, ...new_tl] - | (Bool, Bool) => [Bool, ...new_tl] - | (String, String) => [String, ...new_tl] - | (Var(s1), Var(s2)) when s1 == s2 => [Var(s1), ...new_tl] - // similar, merge children - | (List(pts1), List(pts2)) => - let pts = merge(ctx, pts1, pts2); - [List(pts), ...new_tl]; - | (Arrow(pts1, pts2), Arrow(pts3, pts4)) => - let pts1 = merge(ctx, pts1, pts3); - let pts2 = merge(ctx, pts2, pts4); - [Arrow(pts1, pts2), ...new_tl]; - | (Sum(pts1, pts2), Sum(pts3, pts4)) => - let pts1 = merge(ctx, pts1, pts3); - let pts2 = merge(ctx, pts2, pts4); - [Sum(pts1, pts2), ...new_tl]; - | (Prod(tys1), Prod(tys2)) => - let tys = List.map2(merge(ctx), tys1, tys2); - [Prod(tys), ...new_tl]; - // different, keep both - | _ => [ptyp, hd, ...new_tl] - }; +and extend = (ctx: Ctx.t, tys: list(ptyp), ptyp: ptyp): list(ptyp) => { + let (newlist, combined) = + List.fold_left( + ((newlist, combined), element) => { + switch (combine_if_similar(ctx, ptyp, element)) { + | Some(ptyp_combined) => ([ptyp_combined, ...newlist], true) + | None => ([element, ...newlist], combined) + } + }, + ([], false), + tys, + ); + if (combined) { + newlist; + } else { + [ptyp, ...newlist]; + }; +} +and combine_if_similar = + (ctx: Ctx.t, ptyp1: ptyp, ptyp2: ptyp): Option.t(ptyp) => { + switch (ptyp1, ptyp2) { + // the same + | (Int, Int) => Some(Int) + | (Float, Float) => Some(Float) + | (Bool, Bool) => Some(Bool) + | (String, String) => Some(String) + | (Var(s1), Var(s2)) when s1 == s2 => Some(Var(s1)) + // similar, merge children + | (List(pts1), List(pts2)) => + let pts = merge(ctx, pts1, pts2); + Some(List(pts)); + | (Arrow(pts1, pts2), Arrow(pts3, pts4)) => + let pts1 = merge(ctx, pts1, pts3); + let pts2 = merge(ctx, pts2, pts4); + Some(Arrow(pts1, pts2)); + | (Sum(pts1, pts2), Sum(pts3, pts4)) => + let pts1 = merge(ctx, pts1, pts3); + let pts2 = merge(ctx, pts2, pts4); + Some(Sum(pts1, pts2)); + | (Prod(tys1), Prod(tys2)) => + let tys = List.map2(merge(ctx), tys1, tys2); + Some(Prod(tys)); + // different, doesn't combine + | _ => None }; }; @@ -105,67 +119,89 @@ and extend_helper = (ctx: Ctx.t, tys: list(ptyp), ptyp: ptyp): list(ptyp) => { let constrain = (ctx: Ctx.t, t1: Typ.t, t2: Typ.t): unit => { let pts1 = pts_of_typ(ctx, t1); let pts2 = pts_of_typ(ctx, t2); - if (!UnionFind.eq(pts1, pts2)) { - let _ = merge(ctx, pts1, pts2); - (); - }; + let _ = merge(ctx, pts1, pts2); + (); }; type status = | Solved(Typ.t) - | Unsolved(list(ptyp)); + | Unsolved(list(Typ.t)); -let rec get_status = (ctx: Ctx.t, id: Id.t): status => { - let pts = Ctx.lookup_or_create(ctx, Typ.AstNode(id)); - get_status_helper(ctx, pts); -} -and get_status_helper = (ctx: Ctx.t, pts: pts): status => { +let unwrap_solution = (s: status): Typ.t => { + switch (s) { + | Solved(ty) => ty + | Unsolved(_) => Unknown(NoProvenance) + }; +}; + +let rec get_status_pts = (ctx: Ctx.t, pts: pts): status => { let tys = UnionFind.get(pts); switch (tys) { - | [ty] => - switch (ty) { - | Int => Solved(Int) - | Float => Solved(Float) - | Bool => Solved(Bool) - | String => Solved(String) - | Var(s) => Solved(Var(s)) - | List(pts) => - switch (get_status_helper(ctx, pts)) { - | Solved(ty) => Solved(List(ty)) - | Unsolved(_) => Unsolved(tys) - } - | Arrow(pts1, pts2) => - switch (get_status_helper(ctx, pts1), get_status_helper(ctx, pts2)) { - | (Solved(ty1), Solved(ty2)) => Solved(Arrow(ty1, ty2)) - | _ => Unsolved(tys) - } - | Sum(pts1, pts2) => - switch (get_status_helper(ctx, pts1), get_status_helper(ctx, pts2)) { - | (Solved(ty1), Solved(ty2)) => Solved(Sum(ty1, ty2)) - | _ => Unsolved(tys) - } - | Prod(tys_inner) => - let is_solved = (s: status): bool => { - switch (s) { - | Solved(_) => true - | Unsolved(_) => false - }; - }; - let unwrap_solution = (s: status): Typ.t => { - switch (s) { - | Solved(ty) => ty - | Unsolved(_) => failwith("unreachable") - }; + | [ty] => get_status_ptyp(ctx, ty) + | [] => Unsolved([Typ.String]) // TODO remove this + | [_, ..._] as xs => + Unsolved( + xs |> List.map(get_status_ptyp(ctx)) |> List.map(unwrap_solution), + ) + }; +} +and get_status_ptyp = (ctx: Ctx.t, ptyp: ptyp): status => { + switch (ptyp) { + | Int => Solved(Int) + | Float => Solved(Float) + | Bool => Solved(Bool) + | String => Solved(String) + | Var(s) => Solved(Var(s)) + | List(pts) => + switch (get_status_pts(ctx, pts)) { + | Solved(ty) => Solved(List(ty)) + | Unsolved(_) => Unsolved([List(Unknown(NoProvenance))]) + } + | Arrow(pts1, pts2) => + switch (get_status_pts(ctx, pts1), get_status_pts(ctx, pts2)) { + | (Solved(ty1), Solved(ty2)) => Solved(Arrow(ty1, ty2)) + | (Solved(ty1), Unsolved(_)) => + Unsolved([Arrow(ty1, Unknown(NoProvenance))]) + | (Unsolved(_), Solved(ty2)) => + Unsolved([Arrow(Unknown(NoProvenance), ty2)]) + | (Unsolved(_), Unsolved(_)) => + Unsolved([Arrow(Unknown(NoProvenance), Unknown(NoProvenance))]) + } + | Sum(pts1, pts2) => + switch (get_status_pts(ctx, pts1), get_status_pts(ctx, pts2)) { + | (Solved(ty1), Solved(ty2)) => Solved(Sum(ty1, ty2)) + | (Solved(ty1), Unsolved(_)) => + Unsolved([Sum(ty1, Unknown(NoProvenance))]) + | (Unsolved(_), Solved(ty2)) => + Unsolved([Sum(Unknown(NoProvenance), ty2)]) + | (Unsolved(_), Unsolved(_)) => + Unsolved([Sum(Unknown(NoProvenance), Unknown(NoProvenance))]) + } + | Prod(tys_inner) => + let is_solved = (s: status): bool => { + switch (s) { + | Solved(_) => true + | Unsolved(_) => false }; - let statuses = List.map(get_status_helper(ctx), tys_inner); - if (List.for_all(is_solved, statuses)) { - let tys3 = List.map(unwrap_solution, statuses); - Solved(Prod(tys3)); - } else { - Unsolved(tys); + }; + let force_unwrap_solution = (s: status): Typ.t => { + switch (s) { + | Solved(ty) => ty + | Unsolved(_) => failwith("unreachable") }; - } - | [] - | [_, ..._] => Unsolved(tys) + }; + let statuses = List.map(get_status_pts(ctx), tys_inner); + if (List.for_all(is_solved, statuses)) { + let tys3 = List.map(force_unwrap_solution, statuses); + Solved(Prod(tys3)); + } else { + let tys3 = List.map(unwrap_solution, statuses); + Unsolved([Prod(tys3)]); + }; }; }; + +let get_status = (ctx: Ctx.t, id: Id.t): status => { + let pts = Ctx.lookup_or_create(ctx, Typ.AstNode(id)); + get_status_pts(ctx, pts); +}; diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 338a0328fd..c74a715904 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -166,63 +166,113 @@ let view_of_global_inference_info = id: int, ) => { let font_metrics = Some(font_metrics); - switch (InferenceView.get_cursor_inspect_result(~global_inference_info, id)) { - | Some((true, solution)) => - div( - ~attr=clss([infoc, "typ"]), - [ - text("consistent constraints"), - Type.view(~font_metrics, List.nth(solution, 0)), - ], - ) - | Some((false, [typ_with_nested_conflict])) => - div( - ~attr=clss([infoc, "typ"]), - [Type.view(~font_metrics, typ_with_nested_conflict)], - ) - | Some((false, conflicting_typs)) => - div( - ~attr=clss([infoc, "typ"]), - [ - text("conflicting constraints"), - ...List.map( - typ => - div( - ~attr=clss(["typ-view-conflict"]), - [ - Widgets.hoverable_button( - [Type.view(~font_metrics, typ)], - _mouse_event => { - State.set_considering_suggestion(false); - inject(Update.Mouseup); - }, - _mouse_event => { - State.set_considering_suggestion(true); - if (!State.get_suggestion_pasted()) { - State.set_suggestion_pasted(true); - inject( - Update.Paste(Haz3lcore.Typ.typ_to_string(typ)), - ); - } else { - inject(Update.Mouseup); - }; - }, - _mouse_event => - if (State.get_considering_suggestion()) { - State.set_suggestion_pasted(false); + // switch (InferenceView.get_cursor_inspect_result(~global_inference_info, id)) { + // | Some((true, solution)) => + // div( + // ~attr=clss([infoc, "typ"]), + // [ + // text("consistent constraints"), + // Type.view(~font_metrics, List.nth(solution, 0)), + // ], + // ) + // | Some((false, [typ_with_nested_conflict])) => + // div( + // ~attr=clss([infoc, "typ"]), + // [Type.view(~font_metrics, typ_with_nested_conflict)], + // ) + // | Some((false, conflicting_typs)) => + // div( + // ~attr=clss([infoc, "typ"]), + // [ + // text("conflicting constraints"), + // ...List.map( + // typ => + // div( + // ~attr=clss(["typ-view-conflict"]), + // [ + // Widgets.hoverable_button( + // [Type.view(~font_metrics, typ)], + // _mouse_event => { + // State.set_considering_suggestion(false); + // inject(Update.Mouseup); + // }, + // _mouse_event => { + // State.set_considering_suggestion(true); + // if (!State.get_suggestion_pasted()) { + // State.set_suggestion_pasted(true); + // inject( + // Update.Paste(Haz3lcore.Typ.typ_to_string(typ)), + // ); + // } else { + // inject(Update.Mouseup); + // }; + // }, + // _mouse_event => + // if (State.get_considering_suggestion()) { + // State.set_suggestion_pasted(false); + // State.set_considering_suggestion(false); + // inject(Update.Undo); + // } else { + // inject(Update.Mouseup); + // }, + // ), + // ], + // ), + // conflicting_typs, + // ), + // ], + // ) + // | None => div([]) + // }; + if (global_inference_info.enabled) { + let status = Haz3lcore.Infer.get_status(global_inference_info.ctx, id); + switch (status) { + | Solved(ty) => div([Type.view(~font_metrics, ty)]) + | Unsolved(conflicting_typs) => + div( + ~attr=clss([infoc, "typ"]), + [ + text("conflicting constraints"), + ...List.map( + typ => + div( + ~attr=clss(["typ-view-conflict"]), + [ + Widgets.hoverable_button( + [Type.view(~font_metrics, typ)], + _mouse_event => { State.set_considering_suggestion(false); - inject(Update.Undo); - } else { inject(Update.Mouseup); }, - ), - ], - ), - conflicting_typs, - ), - ], - ) - | None => div([]) + _mouse_event => { + State.set_considering_suggestion(true); + if (!State.get_suggestion_pasted()) { + State.set_suggestion_pasted(true); + inject( + Update.Paste(Haz3lcore.Typ.typ_to_string(typ)), + ); + } else { + inject(Update.Mouseup); + }; + }, + _mouse_event => + if (State.get_considering_suggestion()) { + State.set_suggestion_pasted(false); + State.set_considering_suggestion(false); + inject(Update.Undo); + } else { + inject(Update.Mouseup); + }, + ), + ], + ), + conflicting_typs, + ), + ], + ) + }; + } else { + div([]); }; }; diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index 97b1df5767..d576f7f7ae 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -1,37 +1,57 @@ -open Util.OptUtil.Syntax; open Virtual_dom.Vdom; open Haz3lcore; +// let get_suggestion_ui_for_id = +// ( +// ~font_metrics, +// id: Id.t, +// global_inference_info: InferenceResult.global_inference_info, +// colored_ui: bool, +// ) +// : InferenceResult.suggestion(Node.t) => +// if (global_inference_info.enabled) { +// let status_opt = +// Hashtbl.find_opt(global_inference_info.solution_statuses, id); +// switch (status_opt) { +// | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) +// | Some(Solved(ityp)) => +// Solvable( +// ityp +// |> ITyp.ityp_to_typ +// |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), +// ) +// | Some(Unsolved([potential_typ])) => +// let ptyp_node = +// Type.view_of_potential_typ( +// ~font_metrics, +// ~with_cls=colored_ui, +// false, +// potential_typ, +// ); +// NestedInconsistency(ptyp_node); +// | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) +// | None => NoSuggestion(NonTypeHoleId) +// }; +// } else { +// NoSuggestion(SuggestionsDisabled); +// }; + let get_suggestion_ui_for_id = ( ~font_metrics, id: Id.t, global_inference_info: InferenceResult.global_inference_info, - colored_ui: bool, + _colored_ui: bool, ) : InferenceResult.suggestion(Node.t) => if (global_inference_info.enabled) { - let status_opt = - Hashtbl.find_opt(global_inference_info.solution_statuses, id); - switch (status_opt) { - | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) - | Some(Solved(ityp)) => + let status = Infer.get_status(global_inference_info.ctx, id); + switch (status) { + | Solved(typ) => Solvable( - ityp - |> ITyp.ityp_to_typ - |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), + typ |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), ) - | Some(Unsolved([potential_typ])) => - let ptyp_node = - Type.view_of_potential_typ( - ~font_metrics, - ~with_cls=colored_ui, - false, - potential_typ, - ); - NestedInconsistency(ptyp_node); - | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) - | None => NoSuggestion(NonTypeHoleId) + | Unsolved(_tys) => NoSuggestion(InconsistentSet) // TODO anand: use tys }; } else { NoSuggestion(SuggestionsDisabled); @@ -55,21 +75,34 @@ let svg_display_settings = (show_svg, is_unsolved); }; +// let get_cursor_inspect_result = +// (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) +// : option((bool, list(Typ.t))) => +// if (global_inference_info.enabled) { +// let* status = +// Hashtbl.find_opt(global_inference_info.solution_statuses, id); +// switch (status) { +// | Unsolved(potential_typ_set) => +// Some(( +// false, +// potential_typ_set +// |> PotentialTypeSet.potential_typ_set_to_ityp_unroll(id) +// |> List.map(ITyp.ityp_to_typ), +// )) +// | Solved(ityp) => Some((true, [ityp |> ITyp.ityp_to_typ])) +// }; +// } else { +// None; +// }; + let get_cursor_inspect_result = (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) : option((bool, list(Typ.t))) => if (global_inference_info.enabled) { - let* status = - Hashtbl.find_opt(global_inference_info.solution_statuses, id); + let status = Infer.get_status(global_inference_info.ctx, id); switch (status) { - | Unsolved(potential_typ_set) => - Some(( - false, - potential_typ_set - |> PotentialTypeSet.potential_typ_set_to_ityp_unroll(id) - |> List.map(ITyp.ityp_to_typ), - )) - | Solved(ityp) => Some((true, [ityp |> ITyp.ityp_to_typ])) + | Unsolved(_tys) => Some((false, [])) // TODO anand use tys + | Solved(typ) => Some((true, [typ])) }; } else { None; From 7c431e900165f3fd363e1c7604ff4e877089a565 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Fri, 25 Aug 2023 23:09:36 -0500 Subject: [PATCH 057/129] functional again --- src/haz3lcore/inference/Infer.re | 2 +- src/haz3lcore/inference/InferenceResult.re | 40 +++++++++++++++------- src/haz3lweb/view/InferenceView.re | 5 +++ 3 files changed, 34 insertions(+), 13 deletions(-) diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re index e5699f5226..2e8c7e8b55 100644 --- a/src/haz3lcore/inference/Infer.re +++ b/src/haz3lcore/inference/Infer.re @@ -138,7 +138,7 @@ let rec get_status_pts = (ctx: Ctx.t, pts: pts): status => { let tys = UnionFind.get(pts); switch (tys) { | [ty] => get_status_ptyp(ctx, ty) - | [] => Unsolved([Typ.String]) // TODO remove this + | [] => Unsolved([]) | [_, ..._] as xs => Unsolved( xs |> List.map(get_status_ptyp(ctx)) |> List.map(unwrap_solution), diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index d33c6e1456..8ca0419091 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -22,22 +22,38 @@ and reason_for_silence = | OnlyHoleSolutions | InconsistentSet; +// let get_suggestion_text_for_id = +// (id: Id.t, global_inference_info: global_inference_info) +// : suggestion(string) => +// if (global_inference_info.enabled) { +// let status_opt = +// Hashtbl.find_opt(global_inference_info.solution_statuses, id); +// switch (status_opt) { +// | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) +// | Some(Solved(ityp)) => +// Solvable(ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string) +// | Some(Unsolved([potential_typ])) => +// NestedInconsistency( +// PotentialTypeSet.string_of_potential_typ(false, potential_typ), +// ) +// | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) +// | None => NoSuggestion(NonTypeHoleId) +// }; +// } else { +// NoSuggestion(SuggestionsDisabled); +// }; + let get_suggestion_text_for_id = (id: Id.t, global_inference_info: global_inference_info) : suggestion(string) => if (global_inference_info.enabled) { - let status_opt = - Hashtbl.find_opt(global_inference_info.solution_statuses, id); - switch (status_opt) { - | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) - | Some(Solved(ityp)) => - Solvable(ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string) - | Some(Unsolved([potential_typ])) => - NestedInconsistency( - PotentialTypeSet.string_of_potential_typ(false, potential_typ), - ) - | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) - | None => NoSuggestion(NonTypeHoleId) + let status = Infer.get_status(global_inference_info.ctx, id); + switch (status) { + | Solved(Unknown(_)) => NoSuggestion(OnlyHoleSolutions) + | Solved(typ) => Solvable(typ |> Typ.typ_to_string) + | Unsolved([]) => NoSuggestion(NonTypeHoleId) + | Unsolved([typ]) => NestedInconsistency(typ |> Typ.typ_to_string) + | Unsolved(_) => NoSuggestion(InconsistentSet) }; } else { NoSuggestion(SuggestionsDisabled); diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index d576f7f7ae..f71514db25 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -51,6 +51,11 @@ let get_suggestion_ui_for_id = Solvable( typ |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), ) + | Unsolved([]) => NoSuggestion(NonTypeHoleId) + | Unsolved([typ]) => + NestedInconsistency( + Type.view(~font_metrics=Some(font_metrics), ~with_cls=false, typ), + ) | Unsolved(_tys) => NoSuggestion(InconsistentSet) // TODO anand: use tys }; } else { From 887574b221edd78f2a432832fd7c7d81cb0e54ac Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Fri, 25 Aug 2023 23:20:08 -0500 Subject: [PATCH 058/129] cleanup --- src/haz3lcore/inference/ITyp.re | 80 --- src/haz3lcore/inference/Infer.re | 11 +- src/haz3lcore/inference/Inference.re | 64 -- src/haz3lcore/inference/InferenceResult.re | 119 +--- .../inference/MutablePotentialTypeSet.re | 265 --------- .../inference/MutablePotentialTypeSet.rei | 35 -- src/haz3lcore/inference/PTSGraph.re | 103 ---- src/haz3lcore/inference/PTSGraph.rei | 23 - src/haz3lcore/inference/PotentialTypeSet.re | 563 ------------------ src/haz3lcore/inference/SuggestionTyp.re | 1 - src/haz3lcore/statics/Statics.re | 8 +- src/haz3lcore/zipper/Editor.re | 9 +- src/haz3lweb/Keyboard.re | 4 +- src/haz3lweb/view/Cell.re | 4 +- src/haz3lweb/view/Page.re | 4 +- src/haz3lweb/view/SchoolMode.re | 1 - src/haz3lweb/view/ScratchMode.re | 4 +- src/haz3lweb/view/Type.re | 204 +++---- 18 files changed, 119 insertions(+), 1383 deletions(-) delete mode 100644 src/haz3lcore/inference/ITyp.re delete mode 100644 src/haz3lcore/inference/Inference.re delete mode 100644 src/haz3lcore/inference/MutablePotentialTypeSet.re delete mode 100644 src/haz3lcore/inference/MutablePotentialTypeSet.rei delete mode 100644 src/haz3lcore/inference/PTSGraph.re delete mode 100644 src/haz3lcore/inference/PTSGraph.rei delete mode 100644 src/haz3lcore/inference/PotentialTypeSet.re delete mode 100644 src/haz3lcore/inference/SuggestionTyp.re diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re deleted file mode 100644 index dd17e07a59..0000000000 --- a/src/haz3lcore/inference/ITyp.re +++ /dev/null @@ -1,80 +0,0 @@ -open Sexplib.Std; -exception TypeVarUnsupported; - -[@deriving (show({with_path: false}), sexp, yojson)] -type t = - | Unknown(Typ.type_provenance) - | Unit - | Int - | Float - | Bool - | String - | List(t) - | Arrow(t, t) - | Sum(t, t) - | Prod(t, t); - -[@deriving (show({with_path: false}), sexp, yojson)] -type equivalence = (t, t) -and constraints = list(equivalence); - -let rec prov_to_iprov: Typ.type_provenance => Typ.type_provenance = - fun - | SynSwitch(u) => AstNode(u) - | Matched(mprov, prov) => Matched(mprov, prov_to_iprov(prov)) - | _ as prov => prov; - -let rec typ_to_ityp: Typ.t => t = - fun - | Unknown(prov) => Unknown(prov_to_iprov(prov)) - | Int => Int - | Float => Float - | Bool => Bool - | String => String - | List(tys) => List(typ_to_ityp(tys)) - | Arrow(t1, t2) => Arrow(typ_to_ityp(t1), typ_to_ityp(t2)) - | Sum(t1, t2) => Sum(typ_to_ityp(t1), typ_to_ityp(t2)) - | Prod([single]) => typ_to_ityp(single) - | Prod([hd_ty, ...tl_tys]) => - Prod(typ_to_ityp(hd_ty), typ_to_ityp(Prod(tl_tys))) - | Prod([]) => Unit - | Var(_) => Unknown(NoProvenance); - -let unwrap_if_prod = (typ: Typ.t): list(Typ.t) => { - switch (typ) { - | Prod([hd, ...tl]) => [hd, ...tl] - | _ => [typ] - }; -}; - -let rec ityp_to_typ: t => Typ.t = - fun - | Unknown(prov) => Unknown(prov) - | Int => Int - | Float => Float - | Bool => Bool - | String => String - | List(ity) => List(ityp_to_typ(ity)) - | Arrow(t1, t2) => Arrow(ityp_to_typ(t1), ityp_to_typ(t2)) - | Sum(t1, t2) => Sum(ityp_to_typ(t1), ityp_to_typ(t2)) - | Unit => Prod([]) - | Prod(t1, t2) => - Prod([ityp_to_typ(t1)] @ (t2 |> ityp_to_typ |> unwrap_if_prod)); - -let to_ityp_constraints = (constraints: Typ.constraints): constraints => { - constraints - |> List.filter(((t1, t2)) => - t1 != Typ.Unknown(NoProvenance) && t2 != Typ.Unknown(NoProvenance) - ) - |> List.map(((t1, t2)) => (typ_to_ityp(t1), typ_to_ityp(t2))); -}; - -let rec contains_hole = (ty: t): bool => - switch (ty) { - | Unknown(_) => true - | Arrow(ty1, ty2) - | Sum(ty1, ty2) - | Prod(ty1, ty2) => contains_hole(ty1) || contains_hole(ty2) - | List(l_ty) => contains_hole(l_ty) - | _ => false - }; diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re index 2e8c7e8b55..f9680154a9 100644 --- a/src/haz3lcore/inference/Infer.re +++ b/src/haz3lcore/inference/Infer.re @@ -17,11 +17,12 @@ module Ctx = { let lookup_or_create = (ctx: t, p: Typ.type_provenance): pts => { // get rid of SynSwitch - let p = - switch (p) { - | Typ.SynSwitch(id) => Typ.AstNode(id) - | _ => p - }; + let rec prov_to_iprov: Typ.type_provenance => Typ.type_provenance = + fun + | SynSwitch(u) => AstNode(u) + | Matched(mprov, prov) => Matched(mprov, prov_to_iprov(prov)) + | _ as prov => prov; + let p = prov_to_iprov(p); let lookup = Hashtbl.find_opt(ctx, p); switch (lookup) { | Some(pts) => pts diff --git a/src/haz3lcore/inference/Inference.re b/src/haz3lcore/inference/Inference.re deleted file mode 100644 index 271cb775f9..0000000000 --- a/src/haz3lcore/inference/Inference.re +++ /dev/null @@ -1,64 +0,0 @@ -/** - * NOTE: - * Current formulation does not unify constraints comparing inconsistent constructors. - * Unifying these would cause PotentialTypeSets to be potentially considered invalid without any - * inconsistencies within them, which is a confusing result to represent to a user and may - * pollute other equivalence classes with unhelpful error statuses that static inference can - * already give better results on. - * We decide here that we will only draw inference results on holes and the things these holes - * are compared to through their neighborhood of implied consistencies as governed by attempted - * consistency checks in synthesis and analysis. - */ -// A unification algorithm based on Huet's unification, adjusted so it does not fail -let rec unify = (pts_graph: PTSGraph.t, constraints: ITyp.constraints): unit => { - List.iter(unify_one(pts_graph), constraints); -} -and unify_one = (pts_graph: PTSGraph.t, typs: (ITyp.t, ITyp.t)): unit => { - switch (typs) { - | (List(ty1), List(ty2)) => unify_one(pts_graph, (ty1, ty2)) - | (Arrow(ty1_lhs, ty1_rhs), Arrow(ty2_lhs, ty2_rhs)) - | (Prod(ty1_lhs, ty1_rhs), Prod(ty2_lhs, ty2_rhs)) - | (Sum(ty1_lhs, ty1_rhs), Sum(ty2_lhs, ty2_rhs)) => - unify(pts_graph, [(ty1_lhs, ty2_lhs), (ty1_rhs, ty2_rhs)]) - | (Unknown(_) as hole, t) - | (t, Unknown(_) as hole) => - PTSGraph.add_typ_as_node(pts_graph, hole); - - if (ITyp.contains_hole(t)) { - // if the type it is being constrained to is a potential node, add it then connect the two nodes - PTSGraph.add_typ_as_node(pts_graph, t); - PTSGraph.make_occurs_check(pts_graph, t, hole); - PTSGraph.create_traversable_edge(pts_graph, t, hole); - } else { - // otherwise, simply add t to hole's PotentialTypeSet without making a new node - PTSGraph.create_solution_edge( - pts_graph, - hole, - t, - ); - }; - | _ => () - }; -}; - -let unify_and_report_status = - (constraints: Typ.constraints): list(InferenceResult.t) => { - let inference_pts_graph = PTSGraph.create(); - let constraints = ITyp.to_ityp_constraints(constraints); - - unify(inference_pts_graph, constraints); - - let acc_results = - ( - key: ITyp.t, - mut_potential_typ_set: MutablePotentialTypeSet.t, - acc: list(InferenceResult.t), - ) - : list(InferenceResult.t) => { - [(key, InferenceResult.condense(mut_potential_typ_set, key)), ...acc]; - }; - - let unsorted_results = Hashtbl.fold(acc_results, inference_pts_graph, []); - - List.fast_sort(InferenceResult.comp_results, unsorted_results); -}; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 8ca0419091..21b361d4c0 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -1,14 +1,5 @@ -type status = - | Solved(ITyp.t) - | Unsolved(PotentialTypeSet.t); - -type t = (ITyp.t, status); - -type type_hole_to_solution = Hashtbl.t(Id.t, status); - type global_inference_info = { enabled: bool, - solution_statuses: type_hole_to_solution, ctx: Infer.Ctx.t, }; @@ -22,27 +13,6 @@ and reason_for_silence = | OnlyHoleSolutions | InconsistentSet; -// let get_suggestion_text_for_id = -// (id: Id.t, global_inference_info: global_inference_info) -// : suggestion(string) => -// if (global_inference_info.enabled) { -// let status_opt = -// Hashtbl.find_opt(global_inference_info.solution_statuses, id); -// switch (status_opt) { -// | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) -// | Some(Solved(ityp)) => -// Solvable(ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string) -// | Some(Unsolved([potential_typ])) => -// NestedInconsistency( -// PotentialTypeSet.string_of_potential_typ(false, potential_typ), -// ) -// | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) -// | None => NoSuggestion(NonTypeHoleId) -// }; -// } else { -// NoSuggestion(SuggestionsDisabled); -// }; - let get_suggestion_text_for_id = (id: Id.t, global_inference_info: global_inference_info) : suggestion(string) => @@ -62,92 +32,9 @@ let get_suggestion_text_for_id = let hole_nib: Nib.t = {shape: Convex, sort: Any}; let hole_mold: Mold.t = {out: Any, in_: [], nibs: (hole_nib, hole_nib)}; -let empty_solutions = (): type_hole_to_solution => Hashtbl.create(20); - -let mk_global_inference_info = (enabled, annotations, ctx) => { - {enabled, solution_statuses: annotations, ctx}; +let mk_global_inference_info = (enabled, ctx) => { + {enabled, ctx}; }; let empty_info = (): global_inference_info => - mk_global_inference_info(true, empty_solutions(), Infer.Ctx.create()); - -let get_desired_solutions = - (inference_results: list(t)): type_hole_to_solution => { - let id_and_status_if_ast_node = (result: t): option((Id.t, status)) => { - switch (result) { - | (Unknown(AstNode(id)), status) => Some((id, status)) - | _ => None - }; - }; - - let elts = List.filter_map(id_and_status_if_ast_node, inference_results); - let new_map = Hashtbl.create(List.length(elts)); - - List.iter(((id, annot)) => Hashtbl.add(new_map, id, annot), elts); - - new_map; -}; - -let condense = - (potential_typ_set: MutablePotentialTypeSet.t, key: ITyp.t): status => { - let (potential_typ_set, err) = - MutablePotentialTypeSet.snapshot_class(potential_typ_set, key); - let sorted_potential_typ_set = - PotentialTypeSet.sort_potential_typ_set(potential_typ_set); - - let filtered_potential_typ_set = - PotentialTypeSet.filter_unneeded_holes( - PotentialTypeSet.is_known, - sorted_potential_typ_set, - ); - - switch (err) { - | Some(_) => Unsolved(filtered_potential_typ_set) - | None => - let solved_opt = - PotentialTypeSet.filtered_potential_typ_set_to_typ( - filtered_potential_typ_set, - ); - switch (solved_opt) { - | Some(typ) => Solved(typ) - | None => Unsolved(filtered_potential_typ_set) - }; - }; -}; - -let rec prov_to_priority = (prov: Typ.type_provenance): int => { - switch (prov) { - | NoProvenance => (-1) - | SynSwitch(id) - | AstNode(id) => id - | Matched(_, prov) => prov_to_priority(prov) - }; -}; - -let rec convert_leftmost_to_priority = (typ: ITyp.t): int => { - switch (typ) { - | Int - | Unit - | Float - | String - | Bool => (-1) - | Unknown(prov) => prov_to_priority(prov) - | List(elt_typ) => convert_leftmost_to_priority(elt_typ) - | Arrow(typ_lhs, typ_rhs) - | Prod(typ_lhs, typ_rhs) - | Sum(typ_lhs, typ_rhs) => - let lhs = convert_leftmost_to_priority(typ_lhs); - let rhs = convert_leftmost_to_priority(typ_rhs); - switch (lhs, rhs) { - | ((-1), (-1)) => (-1) - | ((-1), _) => rhs - | _ => lhs - }; - }; -}; - -let comp_results = ((ty1, _): t, (ty2, _): t): int => { - let priority1 = convert_leftmost_to_priority(ty1); - let priority2 = convert_leftmost_to_priority(ty2); - Stdlib.compare(priority1, priority2); -}; + mk_global_inference_info(true, Infer.Ctx.create()); diff --git a/src/haz3lcore/inference/MutablePotentialTypeSet.re b/src/haz3lcore/inference/MutablePotentialTypeSet.re deleted file mode 100644 index 322a7131b4..0000000000 --- a/src/haz3lcore/inference/MutablePotentialTypeSet.re +++ /dev/null @@ -1,265 +0,0 @@ -type error_status = - | Occurs; - -type t = UnionFind.elem((mut_pot_typs, option(error_status))) -and mut_pot_typs = list(mut_pot_typ) -and mut_pot_typ = - | Base(PotentialTypeSet.base_typ) - | Unary(PotentialTypeSet.unary_ctor, t) - | Binary(PotentialTypeSet.binary_ctor, t, t); - -let wrap_without_error = (typs: mut_pot_typs): t => { - (typs, None) |> UnionFind.make; -}; - -let unwrap_and_remove_error = (t: t): mut_pot_typs => { - let (typs, _) = UnionFind.get(t); - typs; -}; - -let combine_error_status = - (err1: option(error_status), err2: option(error_status)) => { - switch (err1, err2) { - | (None, None) => None - | (Some(Occurs), Some(Occurs)) - | (Some(Occurs), None) - | (None, Some(Occurs)) => Some(Occurs) - }; -}; - -let get_combined_error_status_of_classes = - (t1: t, t2: t): option(error_status) => { - let (_, err1) = UnionFind.get(t1); - let (_, err2) = UnionFind.get(t2); - - combine_error_status(err1, err2); -}; - -let rec snapshot_class = - (mut_potential_typ_set: t, occurs_rep: ITyp.t) - : (PotentialTypeSet.t, option(error_status)) => { - let (typs, err1) = UnionFind.get(mut_potential_typ_set); - let (potential_typ_set, err2) = - snapshot_typs(typs, mut_potential_typ_set, occurs_rep); - (potential_typ_set, combine_error_status(err1, err2)); -} -and snapshot_class_from_child = - (mut_potential_typ_set: t, parent: t, occurs_rep: ITyp.t) - : (PotentialTypeSet.t, option(error_status)) => { - UnionFind.eq(mut_potential_typ_set, parent) - ? ( - [occurs_rep |> PotentialTypeSet.ityp_to_potential_typ], - Some(Occurs), - ) - : snapshot_class(mut_potential_typ_set, occurs_rep); -} -and snapshot_typs = - (mut_pot_typs: mut_pot_typs, parent: t, occurs_rep: ITyp.t) - : (PotentialTypeSet.t, option(error_status)) => { - switch (mut_pot_typs) { - | [] => ([], None) - | [hd, ...tl] => - let (pot_typ_hd, err_hd) = snapshot_typ(hd, parent, occurs_rep); - let (potential_typ_set_tl, err_tl) = - snapshot_typs(tl, parent, occurs_rep); - ( - [pot_typ_hd, ...potential_typ_set_tl], - combine_error_status(err_hd, err_tl), - ); - }; -} -and snapshot_typ = - (mut_pot_typ: mut_pot_typ, parent: t, occurs_rep: ITyp.t) - : (PotentialTypeSet.potential_typ, option(error_status)) => { - switch (mut_pot_typ) { - | Base(b) => (PotentialTypeSet.Base(b), None) - | Binary(ctor, mut_potential_typ_set_lhs, mut_potential_typ_set_rhs) => - let (potential_typ_set_lhs, err_lhs) = - snapshot_class_from_child( - mut_potential_typ_set_lhs, - parent, - occurs_rep, - ); - let (potential_typ_set_rhs, err_rhs) = - snapshot_class_from_child( - mut_potential_typ_set_rhs, - parent, - occurs_rep, - ); - ( - PotentialTypeSet.Binary( - ctor, - potential_typ_set_lhs, - potential_typ_set_rhs, - ), - combine_error_status(err_lhs, err_rhs), - ); - | Unary(ctor, mut_potential_typ_set) => - let (potential_typ_set, err) = - snapshot_class_from_child(mut_potential_typ_set, parent, occurs_rep); - (PotentialTypeSet.Unary(ctor, potential_typ_set), err); - }; -}; - -let rec pot_typ_set_to_mut_pot_typ_set = - (potential_typ_set: PotentialTypeSet.t): t => { - List.map(pot_typ_to_mut_pot_typ, potential_typ_set) |> wrap_without_error; -} -and pot_typ_to_mut_pot_typ = - (pot_typ: PotentialTypeSet.potential_typ): mut_pot_typ => { - switch (pot_typ) { - | Base(base_typ) => Base(base_typ) - | Unary(ctor, potential_typ_set) => - Unary(ctor, pot_typ_set_to_mut_pot_typ_set(potential_typ_set)) - | Binary(ctor, potential_typ_set_lhs, potential_typ_set_rhs) => - Binary( - ctor, - pot_typ_set_to_mut_pot_typ_set(potential_typ_set_lhs), - pot_typ_set_to_mut_pot_typ_set(potential_typ_set_rhs), - ) - }; -}; - -let rec preorder_elem_traversal_mut_potential_typ_set = - (mut_potential_typ_set: t): list(t) => { - [ - mut_potential_typ_set, - ...mut_potential_typ_set - |> unwrap_and_remove_error - |> List.map(preorder_traversal_mut_pot_typ) - |> List.flatten, - ]; -} -and preorder_traversal_mut_pot_typ = (mut_pot_typ: mut_pot_typ): list(t) => { - switch (mut_pot_typ) { - | Base(_) => [] - | Unary(_, potential_typ_set) => - preorder_elem_traversal_mut_potential_typ_set(potential_typ_set) - | Binary(_, lhs, rhs) => - preorder_elem_traversal_mut_potential_typ_set(lhs) - @ preorder_elem_traversal_mut_potential_typ_set(rhs) - }; -}; - -let rec preorder_key_traversal_typ = (ty: ITyp.t): list(ITyp.t) => { - switch (ty) { - | Int - | Unit - | Float - | String - | Bool - | Unknown(_) => [ty] - | Arrow(ty_lhs, ty_rhs) - | Prod(ty_lhs, ty_rhs) - | Sum(ty_lhs, ty_rhs) => [ - ty, - ...preorder_key_traversal_typ(ty_lhs) - @ preorder_key_traversal_typ(ty_rhs), - ] - | List(list_ty) => [ty, ...preorder_key_traversal_typ(list_ty)] - }; -}; - -let derive_nested_keys_and_potential_typ_sets = - (key: ITyp.t): (list(ITyp.t), list(t)) => { - let mut_potential_typ_set = - [key |> PotentialTypeSet.ityp_to_potential_typ] - |> pot_typ_set_to_mut_pot_typ_set; - - let preorder_typs = preorder_key_traversal_typ(key); - let preorder_elems = - preorder_elem_traversal_mut_potential_typ_set(mut_potential_typ_set); - - List.combine(preorder_typs, preorder_elems) - |> List.filter(((k, _)) => ITyp.contains_hole(k)) - |> List.split; -}; - -let rec extend_class_with_class = (target: t, extension: t): t => { - let merged_typs = - extend_typs_with_typs( - unwrap_and_remove_error(target), - unwrap_and_remove_error(extension), - ); - let final_rep = UnionFind.union(target, extension); - UnionFind.set( - final_rep, - (merged_typs, get_combined_error_status_of_classes(target, extension)), - ); - final_rep; -} -and extend_typs_with_typs = - (target: mut_pot_typs, extension: mut_pot_typs): mut_pot_typs => { - switch (extension) { - | [] => target - | [pot_typ_extension, ...extension_tl] => - let target = extend_typs_with_typ(target, pot_typ_extension); - extend_typs_with_typs(target, extension_tl); - }; -} -and extend_typs_with_typ = - (target: mut_pot_typs, pot_typ_extension: mut_pot_typ): mut_pot_typs => { - switch (target) { - | [] => [pot_typ_extension] - | [target_hd, ...target_tl] => - let extend_target_tl: unit => mut_pot_typs = ( - () => { - [target_hd, ...extend_typs_with_typ(target_tl, pot_typ_extension)]; - } - ); - switch (target_hd, pot_typ_extension) { - | (_, Base(_)) => - target_hd == pot_typ_extension ? target : extend_target_tl() - | ( - Unary(hd_ctor, hd_potential_typ_set), - Unary(pot_typ_ctor, potential_typ_set), - ) => - hd_ctor == pot_typ_ctor - ? [ - Unary( - hd_ctor, - extend_class_with_class(hd_potential_typ_set, potential_typ_set), - ), - ...target_tl, - ] - : extend_target_tl() - | ( - Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), - Binary(pot_typ_ctor, potential_typ_set_lt, potential_typ_set_rt), - ) => - if (hd_ctor == pot_typ_ctor) { - let hd_potential_typ_set_lt = - extend_class_with_class( - hd_potential_typ_set_lt, - potential_typ_set_lt, - ); - let hd_potential_typ_set_rt = - extend_class_with_class( - hd_potential_typ_set_rt, - potential_typ_set_rt, - ); - [ - Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), - ...target_tl, - ]; - } else { - extend_target_tl(); - } - | (Base(_) | Unary(_), Binary(_)) - | (Base(_) | Binary(_), Unary(_)) => extend_target_tl() - }; - }; -}; - -let union = (t1: t, t2: t): unit => - if (UnionFind.eq(t1, t2)) { - (); - } else { - let _ = extend_class_with_class(t1, t2); - (); - }; - -let mark_failed_occurs = (mut_potential_typ_set: t): unit => { - let (curr_typs, _) = UnionFind.get(mut_potential_typ_set); - UnionFind.set(mut_potential_typ_set, (curr_typs, Some(Occurs))); -}; diff --git a/src/haz3lcore/inference/MutablePotentialTypeSet.rei b/src/haz3lcore/inference/MutablePotentialTypeSet.rei deleted file mode 100644 index 1a25bc24d7..0000000000 --- a/src/haz3lcore/inference/MutablePotentialTypeSet.rei +++ /dev/null @@ -1,35 +0,0 @@ -/** - * A mutable version of the PotentialTypeSet.t type that allows extension via UnionFind - * such that if one foo: MutablePotentialTypeSet.t is extended (or unioned) with - * bar: MutablePotentialTypeSet.t, both PotentialTypeSetes and all sub-PotentialTypeSetes contained - * within them are union-found with each other. - * Consequently, if either foo or bar are extended with another MutablePotentialTypeSet, - * both will have access to the fully updated PotentialTypeSet without need to dfs - * (as will their children). - * - * NOTE: Preferred usage when not extending/unioning is to call MutablePotentialTypeSet.snapshot_class - * to get an immutable PotentialTypeSet and perform computation on that instead to avoid bugs. - */ - -type error_status = - | Occurs; - -type t = UnionFind.elem((mut_pot_typs, option(error_status))) -and mut_pot_typs = list(mut_pot_typ) -and mut_pot_typ = - | Base(PotentialTypeSet.base_typ) - | Unary(PotentialTypeSet.unary_ctor, t) - | Binary(PotentialTypeSet.binary_ctor, t, t); - -let snapshot_class: - (t, ITyp.t) => (PotentialTypeSet.t, option(error_status)); - -let pot_typ_set_to_mut_pot_typ_set: PotentialTypeSet.t => t; -let pot_typ_to_mut_pot_typ: PotentialTypeSet.potential_typ => mut_pot_typ; - -let derive_nested_keys_and_potential_typ_sets: - ITyp.t => (list(ITyp.t), list(t)); - -let union: (t, t) => unit; - -let mark_failed_occurs: t => unit; diff --git a/src/haz3lcore/inference/PTSGraph.re b/src/haz3lcore/inference/PTSGraph.re deleted file mode 100644 index c66ccfe281..0000000000 --- a/src/haz3lcore/inference/PTSGraph.re +++ /dev/null @@ -1,103 +0,0 @@ -type t = Hashtbl.t(ITyp.t, MutablePotentialTypeSet.t); - -let expected_size: int = 50; - -let create = (): t => { - Hashtbl.create(expected_size); -}; - -let add = - ( - pts_graph: t, - key: ITyp.t, - mut_potential_type_set: MutablePotentialTypeSet.t, - ) - : unit => { - switch (Hashtbl.find_opt(pts_graph, key)) { - | Some(curr_mut_potential_type_set) => - MutablePotentialTypeSet.union( - curr_mut_potential_type_set, - mut_potential_type_set, - ) - | None => Hashtbl.add(pts_graph, key, mut_potential_type_set) - }; -}; - -let add_typ_as_node = (pts_graph: t, typ: ITyp.t): unit => { - let (keys, values) = - MutablePotentialTypeSet.derive_nested_keys_and_potential_typ_sets(typ); - List.iter2(add(pts_graph), keys, values); -}; - -let create_traversable_edge = (pts_graph: t, typ1: ITyp.t, typ2: ITyp.t): unit => { - let elem1 = Hashtbl.find(pts_graph, typ1); - let elem2 = Hashtbl.find(pts_graph, typ2); - - MutablePotentialTypeSet.union(elem1, elem2); -}; - -let create_solution_edge = - (pts_graph: t, node_key: ITyp.t, equated_typ: ITyp.t): unit => { - let curr_potential_type_set = Hashtbl.find(pts_graph, node_key); - let mut_potential_typs_extension = - [equated_typ |> PotentialTypeSet.ityp_to_potential_typ] - |> MutablePotentialTypeSet.pot_typ_set_to_mut_pot_typ_set; - - MutablePotentialTypeSet.union( - curr_potential_type_set, - mut_potential_typs_extension, - ); -}; - -let get_keys_in_potential_type_set = - (pts_graph: t, potential_type_set: PotentialTypeSet.t): list(ITyp.t) => { - let add_key_to_acc = - (key: ITyp.t, _: MutablePotentialTypeSet.t, acc: list(ITyp.t)) => { - [key, ...acc]; - }; - let keys = Hashtbl.fold(add_key_to_acc, pts_graph, []); - let is_in_potential_type_set = (key: ITyp.t) => { - let key_potential_typ = PotentialTypeSet.ityp_to_potential_typ(key); - PotentialTypeSet.target_typ_is_in_potential_typ_set( - key_potential_typ, - potential_type_set, - ); - }; - List.filter(is_in_potential_type_set, keys); -}; - -let fail_occurs_check = (pts_graph: t, t1: ITyp.t, t2: ITyp.t): bool => { - let c1 = Hashtbl.find(pts_graph, t1); - let c2 = Hashtbl.find(pts_graph, t2); - - let (snapshot1, err1) = MutablePotentialTypeSet.snapshot_class(c1, t1); - let (snapshot2, err2) = MutablePotentialTypeSet.snapshot_class(c2, t2); - - switch (err1, err2) { - | (Some(MutablePotentialTypeSet.Occurs), _) - | (_, Some(MutablePotentialTypeSet.Occurs)) => true - | _ => - let keys_in_snapshot1 = - get_keys_in_potential_type_set(pts_graph, snapshot1); - let keys_in_snapshot2 = - get_keys_in_potential_type_set(pts_graph, snapshot2); - - List.exists( - PotentialTypeSet.target_typ_in_domain_but_not_equal(snapshot1), - List.map(PotentialTypeSet.ityp_to_potential_typ, keys_in_snapshot2), - ) - || List.exists( - PotentialTypeSet.target_typ_in_domain_but_not_equal(snapshot2), - List.map(PotentialTypeSet.ityp_to_potential_typ, keys_in_snapshot1), - ); - }; -}; - -let make_occurs_check = (pts_graph: t, t1: ITyp.t, t2: ITyp.t): unit => - if (fail_occurs_check(pts_graph, t1, t2)) { - let elem1 = Hashtbl.find(pts_graph, t1); - let elem2 = Hashtbl.find(pts_graph, t2); - - MutablePotentialTypeSet.mark_failed_occurs(elem1); - MutablePotentialTypeSet.mark_failed_occurs(elem2); - }; diff --git a/src/haz3lcore/inference/PTSGraph.rei b/src/haz3lcore/inference/PTSGraph.rei deleted file mode 100644 index c711d48529..0000000000 --- a/src/haz3lcore/inference/PTSGraph.rei +++ /dev/null @@ -1,23 +0,0 @@ -/** - * An EqGraph is effectively a map from different types (which for inference, must always contain holes) - * to their current equivalence classes. In some senses, the EqGraph is a condensed representation - * of an undirected graph where all nodes are types and edges constitute equivalences. - * - * For more context: - * The set of all constraints accumulated in static type inference constitutes a series of edges between - * types that can be used to create a graph. - * Consider the connected component a type is a member of. The solution associated with any - * type in a connected component is the least upper bound of all types within it (if it exists). - */ - -type t = Hashtbl.t(ITyp.t, MutablePotentialTypeSet.t); - -let create: unit => t; - -let add_typ_as_node: (t, ITyp.t) => unit; - -let create_traversable_edge: (t, ITyp.t, ITyp.t) => unit; - -let create_solution_edge: (t, ITyp.t, ITyp.t) => unit; - -let make_occurs_check: (t, ITyp.t, ITyp.t) => unit; diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re deleted file mode 100644 index 7e8af0e34d..0000000000 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ /dev/null @@ -1,563 +0,0 @@ -open Util; -open OptUtil.Syntax; -open Sexplib.Std; - -/** - * An PotentialTypeSet.t is a condensed representation of a list of types. - * It can be a single type, or a composition of other PotentialTypeSet.t - * - * We use PotentialTypeSet to maintain all possible combinations of solutions during unification - * and properly report errors/solutions without combinatorial explosion. - * Inconsistent types and types failing an occurs check can be added to the same PotentialTypeSet without issue, - * preventing unification from ever having to crash. - */ - -[@deriving (show({with_path: false}), sexp)] -type base_typ = - | BUnit - | BInt - | BFloat - | BBool - | BString - | BUnknown(Typ.type_provenance); - -[@deriving (show({with_path: false}), sexp)] -type unary_ctor = - | CList; - -[@deriving (show({with_path: false}), sexp)] -type binary_ctor = - | CArrow - | CProd - | CSum; - -[@deriving (show({with_path: false}), sexp)] -type t = list(potential_typ) -and potential_typ = - | Base(base_typ) - | Unary(unary_ctor, t) - | Binary(binary_ctor, t, t); - -let mk_as_binary_ctor = (ctor: binary_ctor, ty1: ITyp.t, ty2: ITyp.t): ITyp.t => { - switch (ctor) { - | CArrow => Arrow(ty1, ty2) - | CProd => Prod(ty1, ty2) - | CSum => Sum(ty1, ty2) - }; -}; - -let mk_as_unary_ctor = (ctor: unary_ctor, ty: ITyp.t): ITyp.t => { - switch (ctor) { - | CList => List(ty) - }; -}; - -let rec ityp_to_potential_typ: ITyp.t => potential_typ = - fun - | Unknown(prov) => Base(BUnknown(prov)) - | Int => Base(BInt) - | Unit => Base(BUnit) - | Float => Base(BFloat) - | Bool => Base(BBool) - | String => Base(BString) - | Arrow(ty1, ty2) => - Binary( - CArrow, - [ityp_to_potential_typ(ty1)], - [ityp_to_potential_typ(ty2)], - ) - | Prod(ty1, ty2) => - Binary( - CProd, - [ityp_to_potential_typ(ty1)], - [ityp_to_potential_typ(ty2)], - ) - | Sum(ty1, ty2) => - Binary( - CProd, - [ityp_to_potential_typ(ty1)], - [ityp_to_potential_typ(ty2)], - ) - | List(ty) => Unary(CList, [ityp_to_potential_typ(ty)]); - -let typ_to_potential_typ: Typ.t => potential_typ = - typ => { - typ |> ITyp.typ_to_ityp |> ityp_to_potential_typ; - }; - -let base_typ_to_ityp: base_typ => ITyp.t = - fun - | BInt => Int - | BFloat => Float - | BBool => Bool - | BString => String - | BUnit => Unit - | BUnknown(prov) => Unknown(prov); - -let rec extend_with_potential_typ_set = - (target: t, potential_typ_set_extension: t) => { - switch (potential_typ_set_extension) { - | [] => target - | [potential_typ_extension, ...extension_tl] => - let target = extend_with_potential_typ(target, potential_typ_extension); - extend_with_potential_typ_set(target, extension_tl); - }; -} -and extend_with_potential_typ = - (target: t, potential_typ_extension: potential_typ) => { - switch (target) { - | [] => [potential_typ_extension] - | [target_hd, ...target_tl] => - let extend_target_tl: unit => t = ( - () => { - [ - target_hd, - ...extend_with_potential_typ(target_tl, potential_typ_extension), - ]; - } - ); - switch (target_hd, potential_typ_extension) { - | (_, Base(_)) => - target_hd == potential_typ_extension ? target : extend_target_tl() - | ( - Unary(hd_ctor, hd_potential_typ_set), - Unary(potential_typ_ctor, potential_typ_set), - ) => - hd_ctor == potential_typ_ctor - ? [ - Unary( - hd_ctor, - extend_with_potential_typ_set( - hd_potential_typ_set, - potential_typ_set, - ), - ), - ...target_tl, - ] - : extend_target_tl() - | ( - Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), - Binary( - potential_typ_ctor, - potential_typ_set_lt, - potential_typ_set_rt, - ), - ) => - if (hd_ctor == potential_typ_ctor) { - let hd_potential_typ_set_lt = - extend_with_potential_typ_set( - hd_potential_typ_set_lt, - potential_typ_set_lt, - ); - let hd_potential_typ_set_rt = - extend_with_potential_typ_set( - hd_potential_typ_set_rt, - potential_typ_set_rt, - ); - [ - Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), - ...target_tl, - ]; - } else { - extend_target_tl(); - } - | (Base(_) | Unary(_), Binary(_)) - | (Base(_) | Binary(_), Unary(_)) => extend_target_tl() - }; - }; -}; - -type split_result = - | Success - | Error(split_error_status) -and split_error_status = - | Unsplittable - | WrongCtor; - -let split_potential_typ: potential_typ => option((t, t)) = - fun - | Unary(_) - | Base(_) => None - | Binary(_, potential_typ_set1, potential_typ_set2) => - Some((potential_typ_set1, potential_typ_set2)); - -// not currently in use but kept for utility -let split_potential_typ_set = (ctor_used: binary_ctor, potential_typ_set: t) => { - let split_result_of: potential_typ => split_result = - fun - | Base(ty) => - switch (ty) { - | BUnknown(_) => Success - | _ => Error(Unsplittable) - } - | Unary(_) => Error(Unsplittable) - | Binary(ctor, _, _) => ctor_used == ctor ? Success : Error(WrongCtor); - - let accumulate_splits = - ((acc_class_lt, acc_class_rt): (t, t), potential_typ: potential_typ) => { - switch (split_potential_typ(potential_typ)) { - | None => (acc_class_lt, acc_class_rt) - | Some((potential_typ_set_lt, potential_typ_set_rt)) => - let acc_class_lt = - extend_with_potential_typ_set(acc_class_lt, potential_typ_set_lt); - let acc_class_rt = - extend_with_potential_typ_set(acc_class_rt, potential_typ_set_rt); - (acc_class_lt, acc_class_rt); - }; - }; - - let (potential_typ_set_lt, potential_typ_set_rt) = - List.fold_left(accumulate_splits, ([], []), potential_typ_set); - - // Unsplittable errors take precedence over WrongCtor due to strictly more severe error handling - let rec check_ctor = - (potential_typ_set: t, wrong_ctor_error_found: bool): split_result => { - switch (potential_typ_set) { - | [] => wrong_ctor_error_found ? Error(WrongCtor) : Success - | [hd, ...tl] => - switch (split_result_of(hd)) { - | Error(Unsplittable) as e => e - | Error(WrongCtor) => check_ctor(tl, true) - | _ => check_ctor(tl, wrong_ctor_error_found) - } - }; - }; - - ( - check_ctor(potential_typ_set, false), - potential_typ_set_lt, - potential_typ_set_rt, - ); -}; - -let fuse = - (ctor_used: binary_ctor, potential_typ_set_lt: t, potential_typ_set_rt: t) => { - Binary(ctor_used, potential_typ_set_lt, potential_typ_set_rt); -}; - -let rec target_typ_is_in_potential_typ_set = - (target_typ: potential_typ, potential_typ_set: t): bool => { - // is target_typ ∈ potential_typ_set? this would make them equal (via transitivity) - switch (potential_typ_set) { - | [] => false - | [hd, ...tl] => - target_typ_is_in_potential_typ(target_typ, hd) - || target_typ_is_in_potential_typ_set(target_typ, tl) - }; -} -and target_typ_is_in_potential_typ = - (target_typ: potential_typ, potential_typ: potential_typ): bool => { - switch (target_typ, potential_typ) { - | (_, Base(_)) => target_typ == potential_typ - | ( - Unary(target_ctor, target_potential_typ_set), - Unary(ctor, potential_typ_set), - ) => - target_ctor == ctor - && target_class_is_in_potential_typ_set( - target_potential_typ_set, - potential_typ_set, - ) - | ( - Binary(target_ctor, target_class_lt, target_class_rt), - Binary(ctor, potential_typ_set_lt, potential_typ_set_rt), - ) => - target_ctor == ctor - && target_class_is_in_potential_typ_set( - target_class_lt, - potential_typ_set_lt, - ) - && target_class_is_in_potential_typ_set( - target_class_rt, - potential_typ_set_rt, - ) - | (Base(_) | Binary(_), Unary(_)) - | (Base(_) | Unary(_), Binary(_)) => false - }; -} -and target_class_is_in_potential_typ_set = - (target_class: t, potential_typ_set: t): bool => { - // is target_class ∈ potential_typ_set? this would make them equal (via transitivity) - let target_typ_contained = (target_typ: potential_typ): bool => { - target_typ_is_in_potential_typ_set(target_typ, potential_typ_set); - }; - List.for_all(target_typ_contained, target_class); -}; - -let rec target_typ_used_in_potential_typ_set = - (target_typ: potential_typ, potential_typ_set: t): bool => { - // is [target_typ] ⊆ potential_typ_set? - switch (potential_typ_set) { - | [] => false - | [hd, ...tl] => - target_typ_used_in_potential_typ(target_typ, hd) - || target_typ_used_in_potential_typ_set(target_typ, tl) - }; -} -and target_typ_used_in_potential_typ = - (target_typ: potential_typ, potential_typ: potential_typ): bool => { - // target used inside, or is represented by the potential_typ itself - switch (target_typ, potential_typ) { - | (_, Base(_)) => target_typ == potential_typ - | (Unary(_), Unary(_, potential_typ_set)) => - target_typ_used_in_potential_typ_set(target_typ, potential_typ_set) - || target_typ_is_in_potential_typ(target_typ, potential_typ) - | (Binary(_), Binary(_, potential_typ_set_lt, potential_typ_set_rt)) => - target_typ_used_in_potential_typ_set(target_typ, potential_typ_set_lt) - || target_typ_used_in_potential_typ_set(target_typ, potential_typ_set_rt) - || target_typ_is_in_potential_typ(target_typ, potential_typ) - | (Base(_) | Binary(_), Unary(_, potential_typ_set)) => - target_typ_used_in_potential_typ_set(target_typ, potential_typ_set) - | ( - Base(_) | Unary(_), - Binary(_, potential_typ_set_lt, potential_typ_set_rt), - ) => - target_typ_is_in_potential_typ_set(target_typ, potential_typ_set_lt) - || target_typ_is_in_potential_typ_set(target_typ, potential_typ_set_rt) - }; -} -and target_class_used_in_potential_typ_set = - (target_class: t, potential_typ_set: t): bool => { - // is target_class ⊆ potential_typ_set? - let target_typ_used = (target_typ: potential_typ): bool => { - target_typ_used_in_potential_typ_set(target_typ, potential_typ_set); - }; - // every target typ must be used in the eq class for the whole target class to have been used - List.for_all(target_typ_used, target_class); -}; - -let rec target_typ_in_domain_but_not_equal = - (potential_typ_set: t, target_typ: potential_typ): bool => { - List.exists( - target_typ_in_domain_but_not_equal_typ(target_typ), - potential_typ_set, - ); -} -and target_typ_in_domain_but_not_equal_typ = - (target_typ: potential_typ, potential_typ: potential_typ): bool => { - // is target_typ ⊂ potential_typ? - // NOTE: - // target_typ != potential_typ ^ target_typ ⊆ potential_typ - // => target_typ ⊂ potential_typ - !target_typ_is_in_potential_typ(target_typ, potential_typ) - && target_typ_used_in_potential_typ(target_typ, potential_typ); -}; - -let is_known: potential_typ => bool = - fun - | Base(BUnknown(_)) => false - | _ => true; - -let rec filter_unneeded_holes_class = - (comp: potential_typ => bool, remove: bool, potential_typ_set: t): t => { - switch (potential_typ_set) { - | [] => [] - | [hd, ...tl] => - let (had_hole, filtered_hd_opt) = - filter_unneeded_holes_typ(comp, remove, hd); - let remove = had_hole || remove; - switch (filtered_hd_opt) { - | None => filter_unneeded_holes_class(comp, remove, tl) - | Some(filtered_hd) => [ - filtered_hd, - ...filter_unneeded_holes_class(comp, remove, tl), - ] - }; - }; -} -and filter_unneeded_holes_typ = - (comp: potential_typ => bool, remove: bool, potential_typ: potential_typ) - : (bool, option(potential_typ)) => { - switch (potential_typ) { - | Base(btyp) => - switch (btyp) { - | BUnknown(_) => - let eq_tp_opt = remove ? None : Some(potential_typ); - (true, eq_tp_opt); - | _ => (false, Some(potential_typ)) - } - | Unary(ctor, potential_typ_set) => - let delete_holes = List.exists(comp, potential_typ_set); - let potential_typ_set = - filter_unneeded_holes_class(comp, delete_holes, potential_typ_set); - (false, Some(Unary(ctor, potential_typ_set))); - | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => - let delete_holes_lt = List.exists(comp, potential_typ_set_lt); - let delete_holes_rt = List.exists(comp, potential_typ_set_rt); - let potential_typ_set_lt = - filter_unneeded_holes_class( - comp, - delete_holes_lt, - potential_typ_set_lt, - ); - let potential_typ_set_rt = - filter_unneeded_holes_class( - comp, - delete_holes_rt, - potential_typ_set_rt, - ); - (false, Some(Binary(ctor, potential_typ_set_lt, potential_typ_set_rt))); - }; -}; - -let filter_unneeded_holes = - (comp: potential_typ => bool, potential_typ_set: t): t => { - let delete_holes = List.exists(comp, potential_typ_set); - filter_unneeded_holes_class(comp, delete_holes, potential_typ_set); -}; - -let rec filtered_potential_typ_set_to_typ: t => option(ITyp.t) = - fun - | [] => None - | [Base(btyp)] => Some(btyp |> base_typ_to_ityp) - | [Binary(ctor, potential_typ_set_lt, potential_typ_set_rt)] => { - let* typ1 = filtered_potential_typ_set_to_typ(potential_typ_set_lt); - let+ typ2 = filtered_potential_typ_set_to_typ(potential_typ_set_rt); - mk_as_binary_ctor(ctor, typ1, typ2); - } - | [Unary(ctor, potential_typ_set)] => { - let+ elt_typ = filtered_potential_typ_set_to_typ(potential_typ_set); - mk_as_unary_ctor(ctor, elt_typ); - } - | _ => None; - -let comp_potential_typ = - (potential_typ1: potential_typ, potential_typ2: potential_typ): int => { - let strip_id_from_prov: Typ.type_provenance => float = - fun - | SynSwitch(id) - | AstNode(id) => - id == 0 ? (-2.0) : Float.sub(0.0, Float.div(1.0, float_of_int(id))) - | _ => 0.0; - - let potential_typ_to_float: potential_typ => float = - fun - | Base(BInt) - | Base(BUnit) - | Base(BFloat) - | Base(BString) - | Base(BBool) => 1.0 - | Base(BUnknown(prov)) => strip_id_from_prov(prov) - | Binary(_) => 2.0 - | Unary(_) => 3.0; - - Stdlib.compare( - potential_typ_to_float(potential_typ1), - potential_typ_to_float(potential_typ2), - ); -}; - -let rec sort_potential_typ_set = (potential_typ_set: t): t => { - let potential_typ_set = - List.fast_sort(comp_potential_typ, potential_typ_set); - sort_potential_typ_set_explore(potential_typ_set); -} -and sort_potential_typ_set_explore = (potential_typ_set: t): t => { - switch (potential_typ_set) { - | [] => [] - | [hd, ...tl] => - switch (hd) { - | Base(_) => [hd, ...sort_potential_typ_set_explore(tl)] - | Unary(ctor, potential_typ_set_arg) => - let sorted_class = sort_potential_typ_set(potential_typ_set_arg); - [Unary(ctor, sorted_class), ...sort_potential_typ_set(tl)]; - | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => - let sorted_class_lt = sort_potential_typ_set(potential_typ_set_lt); - let sorted_class_rt = sort_potential_typ_set(potential_typ_set_rt); - [ - Binary(ctor, sorted_class_lt, sorted_class_rt), - ...sort_potential_typ_set_explore(tl), - ]; - } - }; -}; - -let string_of_btyp = (btyp: base_typ): string => { - btyp |> base_typ_to_ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string; -}; - -let rec potential_typ_set_to_ityp_unroll = (id: Id.t, pts: t): list(ITyp.t) => { - switch (pts) { - // TODO: raef and anand: fix this to distinguish between solved and unsolved holes - | [] => [ITyp.Unknown(AstNode(id))] - | [hd] => [potential_typ_to_ityp(id, hd)] - | _ => List.map(potential_typ_to_ityp(id), pts) - }; -} -and potential_typ_set_to_ityp_no_unroll = (id: Id.t, pts: t): ITyp.t => { - switch (pts) { - // TODO: raef and anand: fix this to distinguish between solved and unsolved holes - | [] => ITyp.Unknown(NoProvenance) - | [hd] => potential_typ_to_ityp(id, hd) - | _ => ITyp.Unknown(NoProvenance) - }; -} -and potential_typ_to_ityp = (id: Id.t, ptyp: potential_typ): ITyp.t => { - switch (ptyp) { - | Base(btyp) => base_typ_to_ityp(btyp) - | Unary(CList, t) => ITyp.List(potential_typ_set_to_ityp_no_unroll(id, t)) - | Binary(CArrow, t1, t2) => - ITyp.Arrow( - potential_typ_set_to_ityp_no_unroll(id, t1), - potential_typ_set_to_ityp_no_unroll(id, t2), - ) - | Binary(CProd, t1, t2) => - ITyp.Prod( - potential_typ_set_to_ityp_no_unroll(id, t1), - potential_typ_set_to_ityp_no_unroll(id, t2), - ) - | Binary(CSum, t1, t2) => - ITyp.Sum( - potential_typ_set_to_ityp_no_unroll(id, t1), - potential_typ_set_to_ityp_no_unroll(id, t2), - ) - }; -}; - -let rec string_of_potential_typ_set_no_nesting = - (is_left_child, potential_typ_set: t): string => - switch (potential_typ_set) { - | [] => "" - | [hd] => string_of_potential_typ(is_left_child, hd) - | [_hd, ..._tl] => "!" - } -and string_of_potential_typ = - (is_left_child: bool, potential_typ: potential_typ) => - switch (potential_typ) { - | Base(btyp) => string_of_btyp(btyp) - | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => - let (ctor_start, ctor_string, ctor_end) = - switch (ctor) { - | CArrow => is_left_child ? ("(", " -> ", ")") : ("", " -> ", "") - | CProd => ("(", ", ", ")") - | CSum => is_left_child ? ("(", " + ", ")") : ("", " + ", "") - }; - - String.concat( - "", - [ - ctor_start, - string_of_potential_typ_set_no_nesting(true, potential_typ_set_lt), - ctor_string, - string_of_potential_typ_set_no_nesting(false, potential_typ_set_rt), - ctor_end, - ], - ); - | Unary(ctor, potential_typ_set) => - let (start_text, end_text) = - switch (ctor) { - | CList => ("[", "]") - }; - - String.concat( - "", - [ - start_text, - string_of_potential_typ_set_no_nesting(false, potential_typ_set), - end_text, - ], - ); - }; - -let strings_of_potential_typ_set = (potential_typ_set: t): list(string) => - List.map(string_of_potential_typ(false), potential_typ_set); diff --git a/src/haz3lcore/inference/SuggestionTyp.re b/src/haz3lcore/inference/SuggestionTyp.re deleted file mode 100644 index 8b13789179..0000000000 --- a/src/haz3lcore/inference/SuggestionTyp.re +++ /dev/null @@ -1 +0,0 @@ - diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 3dc55463fd..5d964c640d 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -822,10 +822,6 @@ let mk_map_and_inference_solutions = let (_, _, info_map, constraints) = uexp_to_info_map(~ctx=Builtins.ctx(Builtins.Pervasives.builtins), e); - let inference_results = Inference.unify_and_report_status(constraints); - let global_inference_solutions = - InferenceResult.get_desired_solutions(inference_results); - // rewrite is here let ctx = Infer.Ctx.create(); let _ = @@ -837,12 +833,12 @@ let mk_map_and_inference_solutions = constraints, ); - (info_map, global_inference_solutions, ctx); + (info_map, ctx); }, ); let mk_map = e => { - let (info_map, _, _) = mk_map_and_inference_solutions(e); + let (info_map, _) = mk_map_and_inference_solutions(e); info_map; }; diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 150e9af650..5cd52eb43d 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -54,18 +54,13 @@ module Meta = { let unselected = Zipper.unselect_and_zip(z); let (term, _) = MakeTerm.go(unselected); // TODO Raef: add in flow for the enabled flag - let (_, global_inference_solutions, ctx) = - Statics.mk_map_and_inference_solutions(term); + let (_, ctx) = Statics.mk_map_and_inference_solutions(term); let measured = Measured.of_segment( ~touched, ~old=measured, ~global_inference_info= - InferenceResult.mk_global_inference_info( - inference_enabled, - global_inference_solutions, - ctx, - ), + InferenceResult.mk_global_inference_info(inference_enabled, ctx), unselected, ); let term_ranges = TermRanges.mk(unselected); diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 13236b6f60..9c46c93b9d 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -25,12 +25,10 @@ let handle_key_event = (k: Key.t, ~model: Model.t): list(Update.t) => { let zipper = Editors.get_zipper(model.editors); let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, global_inference_solutions, ctx) = - Statics.mk_map_and_inference_solutions(term); + let (_, ctx) = Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( model.langDocMessages.annotations, - global_inference_solutions, ctx, ); let restricted = Backpack.restricted(zipper.backpack); diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index de75936906..f7ceb18e86 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -289,13 +289,11 @@ let editor_view = let segment = Zipper.zip(zipper); let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, global_inference_solutions, ctx) = - Statics.mk_map_and_inference_solutions(term); + let (_, ctx) = Statics.mk_map_and_inference_solutions(term); let measured = editor.state.meta.measured; let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, - global_inference_solutions, ctx, ); let code_base_view = diff --git a/src/haz3lweb/view/Page.re b/src/haz3lweb/view/Page.re index e0c6fa08d3..3268e86089 100644 --- a/src/haz3lweb/view/Page.re +++ b/src/haz3lweb/view/Page.re @@ -232,12 +232,10 @@ let main_ui_view = let zipper = Editors.get_editor(editors).state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, global_inference_solutions, ctx) = - Statics.mk_map_and_inference_solutions(term); + let (_, ctx) = Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, - global_inference_solutions, ctx, ); [top_bar_view] diff --git a/src/haz3lweb/view/SchoolMode.re b/src/haz3lweb/view/SchoolMode.re index 08a8bf35a8..b0ff9bd6b3 100644 --- a/src/haz3lweb/view/SchoolMode.re +++ b/src/haz3lweb/view/SchoolMode.re @@ -83,7 +83,6 @@ let view = let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, - global_inference_info.solution_statuses, global_inference_info.ctx, ); diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 9411d967b7..839d16d088 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -19,12 +19,10 @@ let view = let zipper = editor.state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (info_map, global_inference_solutions, ctx) = - Statics.mk_map_and_inference_solutions(term); + let (info_map, ctx) = Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, - global_inference_solutions, ctx, ); diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index c9395bd45c..4e405fa33a 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -1,7 +1,6 @@ open Virtual_dom.Vdom; open Node; open Util.Web; -open Haz3lcore; let rec view = ( @@ -90,105 +89,106 @@ let rec view = ] |> parenthesize_if_left_child }; -} -and view_of_potential_typ_set = - ( - ~font_metrics, - ~with_cls, - outermost, - potential_typ_set: PotentialTypeSet.t, - ) - : Node.t => { - let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); - switch (potential_typ_set) { - | [] => - view( - ~font_metrics=Some(font_metrics), - ~with_cls, - Typ.Unknown(NoProvenance), - ) - | [hd] => view_of_potential_typ(~font_metrics, ~with_cls, outermost, hd) - | _ => - div( - ~attr=clss(["typ-view", "atom", "unknown"]), - [ - EmptyHoleDec.relative_view( - ~font_metrics, - true, - Haz3lcore.InferenceResult.hole_mold, - ), - ], - ) - }; -} -and view_of_potential_typ = - ( - ~font_metrics, - ~with_cls: bool, - is_left_child: bool, - potential_typ: PotentialTypeSet.potential_typ, - ) - : Node.t => { - let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); - switch (potential_typ) { - | Base(btyp) => view_of_base_typ(~font_metrics, ~with_cls, btyp) - | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => - let (ctor_start, ctor_string, ctor_end, cls) = - switch (ctor) { - | CArrow => - is_left_child - ? ("(", " -> ", ")", ["typ-view", "Arrow"]) - : ("", " -> ", "", ["typ-view", "Arrow"]) - | CProd => ("(", ", ", ")", ["typ-view", "Sum"]) - | CSum => - is_left_child - ? ("(", " + ", ")", ["typ-view", "Sum"]) - : ("", " + ", "", ["typ-view", "Sum"]) - }; - div( - ~attr=clss(cls), - [ - text(ctor_start), - view_of_potential_typ_set( - ~font_metrics, - ~with_cls, - false, - potential_typ_set_lt, - ), - text(ctor_string), - view_of_potential_typ_set( - ~font_metrics, - ~with_cls, - false, - potential_typ_set_rt, - ), - text(ctor_end), - ], - ); - | Unary(ctor, potential_typ_set) => - let (start_text, end_text, cls) = - switch (ctor) { - | CList => ("[", "]", ["typ-view", "atom", "List"]) - }; - div( - ~attr=clss(cls), - [ - text(start_text), - view_of_potential_typ_set( - ~font_metrics, - ~with_cls, - false, - potential_typ_set, - ), - text(end_text), - ], - ); - }; -} -and view_of_base_typ = - (~font_metrics, ~with_cls, btyp: PotentialTypeSet.base_typ): Node.t => { - btyp - |> PotentialTypeSet.base_typ_to_ityp - |> ITyp.ityp_to_typ - |> view(~font_metrics=Some(font_metrics), ~with_cls); }; +// } +// and view_of_potential_typ_set = +// ( +// ~font_metrics, +// ~with_cls, +// outermost, +// potential_typ_set: PotentialTypeSet.t, +// ) +// : Node.t => { +// let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); +// switch (potential_typ_set) { +// | [] => +// view( +// ~font_metrics=Some(font_metrics), +// ~with_cls, +// Typ.Unknown(NoProvenance), +// ) +// | [hd] => view_of_potential_typ(~font_metrics, ~with_cls, outermost, hd) +// | _ => +// div( +// ~attr=clss(["typ-view", "atom", "unknown"]), +// [ +// EmptyHoleDec.relative_view( +// ~font_metrics, +// true, +// Haz3lcore.InferenceResult.hole_mold, +// ), +// ], +// ) +// }; +// } +// and view_of_potential_typ = +// ( +// ~font_metrics, +// ~with_cls: bool, +// is_left_child: bool, +// potential_typ: PotentialTypeSet.potential_typ, +// ) +// : Node.t => { +// let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); +// switch (potential_typ) { +// | Base(btyp) => view_of_base_typ(~font_metrics, ~with_cls, btyp) +// | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => +// let (ctor_start, ctor_string, ctor_end, cls) = +// switch (ctor) { +// | CArrow => +// is_left_child +// ? ("(", " -> ", ")", ["typ-view", "Arrow"]) +// : ("", " -> ", "", ["typ-view", "Arrow"]) +// | CProd => ("(", ", ", ")", ["typ-view", "Sum"]) +// | CSum => +// is_left_child +// ? ("(", " + ", ")", ["typ-view", "Sum"]) +// : ("", " + ", "", ["typ-view", "Sum"]) +// }; +// div( +// ~attr=clss(cls), +// [ +// text(ctor_start), +// view_of_potential_typ_set( +// ~font_metrics, +// ~with_cls, +// false, +// potential_typ_set_lt, +// ), +// text(ctor_string), +// view_of_potential_typ_set( +// ~font_metrics, +// ~with_cls, +// false, +// potential_typ_set_rt, +// ), +// text(ctor_end), +// ], +// ); +// | Unary(ctor, potential_typ_set) => +// let (start_text, end_text, cls) = +// switch (ctor) { +// | CList => ("[", "]", ["typ-view", "atom", "List"]) +// }; +// div( +// ~attr=clss(cls), +// [ +// text(start_text), +// view_of_potential_typ_set( +// ~font_metrics, +// ~with_cls, +// false, +// potential_typ_set, +// ), +// text(end_text), +// ], +// ); +// }; +// } +// and view_of_base_typ = +// (~font_metrics, ~with_cls, btyp: PotentialTypeSet.base_typ): Node.t => { +// btyp +// |> PotentialTypeSet.base_typ_to_ityp +// |> ITyp.ityp_to_typ +// |> view(~font_metrics=Some(font_metrics), ~with_cls); +// }; From 788fd55ee6223486bce5d983075957b5c56faf4b Mon Sep 17 00:00:00 2001 From: disconcision Date: Sun, 8 Oct 2023 16:14:42 -0400 Subject: [PATCH 059/129] attempt to resolve cursorinspector merge errors --- src/haz3lweb/view/CursorInspector.re | 238 +++++---------------------- 1 file changed, 45 insertions(+), 193 deletions(-) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index e7d1687f9e..51f074b9ac 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -55,7 +55,6 @@ let term_view = (~inject, ~settings: ModelSettings.t, ~show_lang_doc, ci) => { ); }; -<<<<<<< HEAD module State = { type t = { considering_suggestion: ref(bool), @@ -141,89 +140,6 @@ let view_of_global_inference_info = }; }; -let view_of_info = - ( - ~inject, - ~font_metrics, - ~show_lang_doc: bool, - ~global_inference_info, - id: int, - ci: Haz3lcore.Statics.t, - ) - : Node.t => { - let is_err = Haz3lcore.Statics.is_error(ci); - switch (ci) { - | Invalid(msg) => - div( - ~attr=clss([infoc, "unknown"]), - [text("🚫 " ++ Haz3lcore.TermBase.show_parse_flag(msg))], - ) - | InfoExp({mode, self, _}) => - let error_status = Haz3lcore.Statics.error_status(mode, self); - div( - ~attr=clss([infoc, "exp"]), - [ - term_tag(~inject, ~show_lang_doc, is_err, "exp"), - status_view(error_status), - ], - ); - | InfoPat({mode, self, _}) => - let error_status = Haz3lcore.Statics.error_status(mode, self); - div( - ~attr=clss([infoc, "pat"]), - [ - term_tag(~inject, ~show_lang_doc, is_err, "pat"), - status_view(error_status), - ], - ); - | InfoTyp({self: Free(free_error), _}) => - div( - ~attr=clss([infoc, "typ"]), - [ - term_tag(~inject, ~show_lang_doc, is_err, "typ"), - error_view(Free(free_error)), - ], - ) - | InfoTyp({self: Just(ty), _}) => - switch ( - Haz3lcore.InferenceResult.get_suggestion_text_for_id( - id, - global_inference_info, - ) - ) { - | NoSuggestion(SuggestionsDisabled) - | NoSuggestion(NonTypeHoleId) - | NoSuggestion(OnlyHoleSolutions) => - div( - ~attr=clss([infoc, "typ"]), - [ - term_tag(~inject, ~show_lang_doc, is_err, "typ"), - text("is"), - Type.view(ty), - ], - ) - | _ => - div( - ~attr=clss([infoc, "typ"]), - [ - term_tag(~inject, ~show_lang_doc, is_err, "typ"), - view_of_global_inference_info( - ~inject, - ~font_metrics, - ~global_inference_info, - id, - ), - ], - ) - } - | InfoTyp({self: _, _}) => - failwith("CursorInspector: Impossible type error") - | InfoRul(_) => - div( - ~attr=clss([infoc, "rul"]), - [term_tag(~inject, ~show_lang_doc, is_err, "rul"), text("Rule")], - ) -======= let elements_noun: Term.Cls.t => string = fun | Exp(Match | If) => "Branches" @@ -299,8 +215,42 @@ let common_ok_view = (cls: Term.Cls.t, ok: Info.ok_pat) => { let typ_ok_view = (cls: Term.Cls.t, ok: Info.ok_typ) => switch (ok) { - | Type(_) when cls == Typ(EmptyHole) => [text("Fillable by any type")] - | Type(ty) => [Type.view(ty)] + | Type(ty) => + switch ( + Haz3lcore.InferenceResult.get_suggestion_text_for_id( + id, + global_inference_info, + ) + ) { + | NoSuggestion(SuggestionsDisabled) + | NoSuggestion(NonTypeHoleId) + | NoSuggestion(OnlyHoleSolutions) => + div( + ~attr=clss([infoc, "typ"]), + [ + term_tag(~inject, ~show_lang_doc, is_err, "typ"), + text("is"), + Type.view(ty), + ], + ) + | _ => + div( + ~attr=clss([infoc, "typ"]), + [ + term_tag(~inject, ~show_lang_doc, is_err, "typ"), + view_of_global_inference_info( + ~inject, + ~font_metrics, + ~global_inference_info, + id, + ), + ], + ) + } + //TODO(andrew): restore this message? + //| Type(_) when cls == Typ(EmptyHole) => [text("Fillable by any type")] + //| Type(ty) => [Type.view(ty)] + //TODO(andrew): how do these interact with THI? | TypeAlias(name, ty_lookup) => [ Type.view(Var(name)), text("is an alias for"), @@ -361,7 +311,7 @@ let tpat_view = (_: Term.Cls.t, status: Info.status_tpat) => }; let view_of_info = - (~inject, ~settings, ~show_lang_doc: bool, ci: Statics.Info.t): Node.t => { + (~inject,~font_metrics, ~global_inference_info,~settings, ~show_lang_doc: bool, ci: Statics.Info.t): Node.t => { let wrapper = status_view => div( ~attr=clss(["info"]), @@ -372,124 +322,26 @@ let view_of_info = | InfoPat({cls, status, _}) => wrapper(pat_view(cls, status)) | InfoTyp({cls, status, _}) => wrapper(typ_view(cls, status)) | InfoTPat({cls, status, _}) => wrapper(tpat_view(cls, status)) ->>>>>>> dev - }; -}; - -let inspector_view = (~inject, ~settings, ~show_lang_doc, ci): Node.t => - div( -<<<<<<< HEAD - ~attr=Attr.many([clss(["extra"] @ (visible ? ["visible"] : []))]), - [id_view(id), cls_view(ci)], - ); - -let toggle_context_and_print_ci = (~inject: Update.t => 'a, ci, _) => { - print_endline(Haz3lcore.Statics.show(ci)); - switch (ci) { - | InfoPat({mode, self, _}) - | InfoExp({mode, self, _}) => - Haz3lcore.Statics.error_status(mode, self) - |> Haz3lcore.Statics.show_error_status - |> print_endline - | _ => () }; - inject(Set(ContextInspector)); }; -let inspector_view = - ( - ~inject, - ~font_metrics, - ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, - ~settings: ModelSettings.t, - ~show_lang_doc: bool, - id: int, - ci: Haz3lcore.Statics.t, - ) - : Node.t => +let inspector_view = (~inject, ~font_metrics, + ~global_inference_info,~settings, ~show_lang_doc, ci): Node.t => div( - ~attr= - Attr.many([ - clss( - ["cursor-inspector"] - @ [Haz3lcore.Statics.is_error(ci) ? errorc : happyc], - ), - Attr.on_click(toggle_context_and_print_ci(~inject, ci)), - ]), - [ - extra_view(settings.context_inspector, id, ci), - view_of_info( - ~inject, - ~font_metrics, - ~show_lang_doc, - ~global_inference_info, - id, - ci, - ), - CtxInspector.inspector_view(~inject, ~settings, id, ci), - ], -======= ~attr=clss(["cursor-inspector"] @ [Info.is_error(ci) ? errc : okc]), - [view_of_info(~inject, ~settings, ~show_lang_doc, ci)], ->>>>>>> dev + [view_of_info(~inject, ~font_metrics, + ~global_inference_info, ~settings, ~show_lang_doc, ci)], ); let view = ( ~inject, -<<<<<<< HEAD - ~settings, - ~font_metrics, - ~show_lang_doc: bool, - zipper: Haz3lcore.Zipper.t, - info_map: Haz3lcore.Statics.map, - global_inference_info: Haz3lcore.InferenceResult.global_inference_info, - ) => { - let backpack = zipper.backpack; - let curr_view = - if (State.get_considering_suggestion()) { - State.get_last_inspector(); - } else if (List.length(backpack) > 0) { - div([]); - } else { - let index = Haz3lcore.Indicated.index(zipper); - - switch (index) { - | Some(index) => - switch (Haz3lcore.Id.Map.find_opt(index, info_map)) { - | Some(ci) => - inspector_view( - ~inject, - ~font_metrics, - ~global_inference_info, - ~settings, - ~show_lang_doc, - index, - ci, - ) - | None => - div( - ~attr=clss(["cursor-inspector"]), - [div(~attr=clss(["icon"]), [Icons.magnify]), text("")], - ) - } - | None => - div( - ~attr=clss(["cursor-inspector"]), - [ - div(~attr=clss(["icon"]), [Icons.magnify]), - text("No Indicated Index"), - ], - ) - }; - }; - State.set_last_inspector(curr_view); - curr_view; -======= ~settings: ModelSettings.t, + ~font_metrics, ~show_lang_doc: bool, zipper: Zipper.t, info_map: Statics.Map.t, + global_inference_info: Haz3lcore.InferenceResult.global_inference_info,, ) => { let bar_view = div(~attr=Attr.id("bottom-bar")); let err_view = err => @@ -507,7 +359,8 @@ let view = | None => err_view("Whitespace or Comment") | Some(ci) => bar_view([ - inspector_view(~inject, ~settings, ~show_lang_doc, ci), + inspector_view(~inject,~font_metrics, + ~global_inference_info, ~settings, ~show_lang_doc, ci), div( ~attr=clss(["id"]), [text(String.sub(Id.to_string(id), 0, 4))], @@ -515,5 +368,4 @@ let view = ]) } }; ->>>>>>> dev }; From 44a649ff80e2ad4bd31ddcc4a848f63b5c8f3221 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Sun, 8 Oct 2023 17:51:50 -0500 Subject: [PATCH 060/129] statics still WIP, does not compile --- src/haz3lcore/dynamics/Evaluator.re | 10 +- src/haz3lcore/inference/Infer.re | 35 +- src/haz3lcore/statics/Info.re | 47 +- src/haz3lcore/statics/Mode.re | 76 ++- src/haz3lcore/statics/Self.re | 4 +- src/haz3lcore/statics/Statics.re | 950 +++++---------------------- src/haz3lcore/statics/Term.re | 24 +- src/haz3lcore/statics/TypBase.re | 83 ++- src/haz3lweb/view/CursorInspector.re | 52 +- src/haz3lweb/view/LangDoc.re | 3 - src/haz3lweb/view/ScratchMode.re | 8 +- 11 files changed, 360 insertions(+), 932 deletions(-) diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 117943a5cf..e5d26340e8 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -24,7 +24,9 @@ let const_unknown: 'a => Typ.t = _ => Unknown(NoProvenance); let grounded_Arrow = NotGroundOrHole(Arrow(Unknown(NoProvenance), Unknown(NoProvenance))); let grounded_Prod = length => - NotGroundOrHole(Prod(ListUtil.replicate(length, Typ.Unknown(NoProvenance)))); + NotGroundOrHole( + Prod(ListUtil.replicate(length, Typ.Unknown(NoProvenance))), + ); let grounded_Sum = (sm: Typ.sum_map): ground_cases => { let sm' = sm |> ConstructorMap.map(Option.map(const_unknown)); NotGroundOrHole(Sum(sm')); @@ -375,11 +377,11 @@ and matches_cast_Tuple = List.map2(List.cons, List.combine(tys, tys'), elt_casts), ); | Cast(d', Unknown(_), Prod(tys')) => -<<<<<<< HEAD - let tys = List.init(List.length(tys'), _ => Typ.Unknown(NoProvenance)); -======= let tys = List.init(List.length(tys'), const_unknown); + matches_cast_Tuple( + dps, d', + List.map2(List.cons, List.combine(tys, tys'), elt_casts), ); | Cast(_, _, _) => DoesNotMatch | BoundVar(_) => DoesNotMatch diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re index f9680154a9..a12c411d85 100644 --- a/src/haz3lcore/inference/Infer.re +++ b/src/haz3lcore/inference/Infer.re @@ -6,7 +6,7 @@ type ptyp = | Var(string) | List(pts) | Arrow(pts, pts) - | Sum(pts, pts) // unused + | Sum(list(pts)) // TODO anand and raef: fill this in | Prod(list(pts)) and pts = UnionFind.elem(list(ptyp)); @@ -51,7 +51,8 @@ and ptyp_of_typ = (ctx: Ctx.t, t: Typ.t): ptyp => { | Var(s) => Var(s) | List(t) => List(pts_of_typ(ctx, t)) | Arrow(t1, t2) => Arrow(pts_of_typ(ctx, t1), pts_of_typ(ctx, t2)) - | Sum(t1, t2) => Sum(pts_of_typ(ctx, t1), pts_of_typ(ctx, t2)) + | Sum(_) => Sum([]) // TODO anand and raef: unimplemented + | Rec(_) => Sum([]) // TODO anand and raef: unimplemented | Prod(ts) => Prod(List.map(pts_of_typ(ctx), ts)) | Typ.Unknown(_p) => failwith("unreachable") }; @@ -104,10 +105,11 @@ and combine_if_similar = let pts1 = merge(ctx, pts1, pts3); let pts2 = merge(ctx, pts2, pts4); Some(Arrow(pts1, pts2)); - | (Sum(pts1, pts2), Sum(pts3, pts4)) => - let pts1 = merge(ctx, pts1, pts3); - let pts2 = merge(ctx, pts2, pts4); - Some(Sum(pts1, pts2)); + | (Sum(_), Sum(_)) => + // let pts1 = merge(ctx, pts1, pts3); + // let pts2 = merge(ctx, pts2, pts4); + // Some(Sum(pts1, pts2)) + None // TODO anand and raef: unimplemented | (Prod(tys1), Prod(tys2)) => let tys = List.map2(merge(ctx), tys1, tys2); Some(Prod(tys)); @@ -168,16 +170,17 @@ and get_status_ptyp = (ctx: Ctx.t, ptyp: ptyp): status => { | (Unsolved(_), Unsolved(_)) => Unsolved([Arrow(Unknown(NoProvenance), Unknown(NoProvenance))]) } - | Sum(pts1, pts2) => - switch (get_status_pts(ctx, pts1), get_status_pts(ctx, pts2)) { - | (Solved(ty1), Solved(ty2)) => Solved(Sum(ty1, ty2)) - | (Solved(ty1), Unsolved(_)) => - Unsolved([Sum(ty1, Unknown(NoProvenance))]) - | (Unsolved(_), Solved(ty2)) => - Unsolved([Sum(Unknown(NoProvenance), ty2)]) - | (Unsolved(_), Unsolved(_)) => - Unsolved([Sum(Unknown(NoProvenance), Unknown(NoProvenance))]) - } + | Sum(_) => + // switch (get_status_pts(ctx, pts1), get_status_pts(ctx, pts2)) { + // | (Solved(ty1), Solved(ty2)) => Solved(Sum(ty1, ty2)) + // | (Solved(ty1), Unsolved(_)) => + // Unsolved([Sum(ty1, Unknown(NoProvenance))]) + // | (Unsolved(_), Solved(ty2)) => + // Unsolved([Sum(Unknown(NoProvenance), ty2)]) + // | (Unsolved(_), Unsolved(_)) => + // Unsolved([Sum(Unknown(NoProvenance), Unknown(NoProvenance))]) + // } + Unsolved([]) // TODO anand and raef: unimplemented | Prod(tys_inner) => let is_solved = (s: status): bool => { switch (s) { diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 69d3871db6..157b0d7070 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -187,7 +187,8 @@ type exp = { co_ctx: CoCtx.t, /* Locally free variables */ cls: Term.Cls.t, /* DERIVED: Syntax class (i.e. form name) */ status: status_exp, /* DERIVED: Ok/Error statuses for display */ - ty: Typ.t /* DERIVED: Type after nonempty hole fixing */ + ty: Typ.t, /* DERIVED: Type after nonempty hole fixing */ + constraints: Typ.constraints, }; [@deriving (show({with_path: false}), sexp, yojson)] @@ -200,6 +201,7 @@ type pat = { cls: Term.Cls.t, status: status_pat, ty: Typ.t, + constraints: Typ.constraints, }; [@deriving (show({with_path: false}), sexp, yojson)] @@ -267,7 +269,11 @@ let rec status_common = } | (Just(syn), SynFun) => switch ( - Typ.join_fix(ctx, Arrow(Unknown(Internal), Unknown(Internal)), syn) + Typ.join_fix( + ctx, + Arrow(Unknown(NoProvenance), Unknown(NoProvenance)), + syn, + ) ) { | None => InHole(Inconsistent(WithArrow(syn))) | Some(_) => NotInHole(Syn(syn)) @@ -283,9 +289,9 @@ let rec status_common = | _ => InHole(NoType(FreeConstructor(name))) } | (BadToken(name), _) => InHole(NoType(BadToken(name))) - | (IsMulti, _) => NotInHole(Syn(Unknown(Internal))) + | (IsMulti, _) => NotInHole(Syn(Unknown(NoProvenance))) | (NoJoin(wrap, tys), Ana(ana)) => - let syn: Typ.t = wrap(Unknown(Internal)); + let syn: Typ.t = wrap(Unknown(NoProvenance)); switch (Typ.join_fix(ctx, ana, syn)) { | None => InHole(Inconsistent(Expectation({ana, syn}))) | Some(_) => @@ -422,33 +428,46 @@ let fixed_typ_ok: ok_pat => Typ.t = | Ana(Consistent({join, _})) => join | Ana(InternallyInconsistent({ana, _})) => ana; -let fixed_typ_pat = (ctx, mode: Mode.t, self: Self.pat): Typ.t => +let fixed_typ_pat = (ctx, mode: Mode.t, self: Self.pat, termId: Id.t): Typ.t => switch (status_pat(ctx, mode, self)) { - | InHole(_) => Unknown(Internal) + | InHole(_) => Unknown(AstNode(termId)) | NotInHole(ok) => fixed_typ_ok(ok) }; -let fixed_typ_exp = (ctx, mode: Mode.t, self: Self.exp): Typ.t => +let fixed_typ_exp = (ctx, mode: Mode.t, self: Self.exp, termId: Id.t): Typ.t => switch (status_exp(ctx, mode, self)) { - | InHole(_) => Unknown(Internal) + | InHole(_) => Unknown(AstNode(termId)) | NotInHole(ok) => fixed_typ_ok(ok) }; /* Add derivable attributes for expression terms */ let derived_exp = - (~uexp: UExp.t, ~ctx, ~mode, ~ancestors, ~self, ~co_ctx): exp => { + (~uexp: UExp.t, ~ctx, ~mode, ~ancestors, ~self, ~co_ctx, ~constraints) + : exp => { let cls = Cls.Exp(UExp.cls_of_term(uexp.term)); let status = status_exp(ctx, mode, self); - let ty = fixed_typ_exp(ctx, mode, self); - {cls, self, ty, mode, status, ctx, co_ctx, ancestors, term: uexp}; + let ty = fixed_typ_exp(ctx, mode, self, UExp.rep_id(uexp)); + { + cls, + self, + ty, + mode, + status, + ctx, + co_ctx, + ancestors, + constraints, + term: uexp, + }; }; /* Add derivable attributes for pattern terms */ -let derived_pat = (~upat: UPat.t, ~ctx, ~mode, ~ancestors, ~self): pat => { +let derived_pat = + (~upat: UPat.t, ~ctx, ~mode, ~ancestors, ~self, ~constraints): pat => { let cls = Cls.Pat(UPat.cls_of_term(upat.term)); let status = status_pat(ctx, mode, self); - let ty = fixed_typ_pat(ctx, mode, self); - {cls, self, mode, ty, status, ctx, ancestors, term: upat}; + let ty = fixed_typ_pat(ctx, mode, self, UPat.rep_id(upat)); + {cls, self, mode, ty, status, ctx, ancestors, constraints, term: upat}; }; /* Add derivable attributes for types */ diff --git a/src/haz3lcore/statics/Mode.re b/src/haz3lcore/statics/Mode.re index f8dc127b9f..d0a27aa519 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -26,56 +26,80 @@ type t = let ana: Typ.t => t = ty => Ana(ty); /* The expected type imposed by a mode */ -let ty_of: t => Typ.t = - fun - | Ana(ty) => ty - | Syn => Unknown(SynSwitch) - | SynFun => Arrow(Unknown(SynSwitch), Unknown(SynSwitch)); +let ty_of = (ctx: Ctx.t, t: t, id: Id.t): (Typ.t, Typ.constraints) => + switch (t) { + | Ana(ty) => (ty, []) + | Syn => (Unknown(SynSwitch(id)), []) + | SynFun => + let ((ty_l, ty_r), constraints) = + Typ.matched_arrow(ctx, id, Unknown(SynSwitch(id))); + (Arrow(ty_l, ty_r), constraints); + }; -let of_arrow = (ctx: Ctx.t, mode: t): (t, t) => +let of_arrow = + (ctx: Ctx.t, mode: t, termId: Id.t): ((t, t), Typ.constraints) => switch (mode) { | Syn - | SynFun => (Syn, Syn) - | Ana(ty) => ty |> Typ.matched_arrow(ctx) |> TupleUtil.map2(ana) + | SynFun => ((Syn, Syn), []) + | Ana(ty) => + let (matched_typs, constraints) = Typ.matched_arrow(ctx, termId, ty); + (TupleUtil.map2(ana, matched_typs), constraints); }; -let of_prod = (ctx: Ctx.t, mode: t, length): list(t) => +let of_prod = + (ctx: Ctx.t, mode: t, termId: Id.t, length): (list(t), Typ.constraints) => switch (mode) { | Syn - | SynFun => List.init(length, _ => Syn) - | Ana(ty) => ty |> Typ.matched_prod(ctx, length) |> List.map(ana) + | SynFun => (List.init(length, _ => Syn), []) + | Ana(ty) => + let (tys, constraints) = Typ.matched_prod(ctx, length, termId, ty); + (List.map(ana, tys), constraints); }; -let of_cons_hd = (ctx: Ctx.t, mode: t): t => +let of_cons_hd = (ctx: Ctx.t, mode: t, termId: Id.t): (t, Typ.constraints) => switch (mode) { | Syn - | SynFun => Syn - | Ana(ty) => Ana(Typ.matched_list(ctx, ty)) + | SynFun => (Syn, []) + | Ana(ty) => + let (matched_ty, constraints) = Typ.matched_list(ctx, termId, ty); + (Ana(matched_ty), constraints); }; -let of_cons_tl = (ctx: Ctx.t, mode: t, hd_ty: Typ.t): t => +let of_cons_tl = + (ctx: Ctx.t, mode: t, hd_ty: Typ.t, termId: Id.t): (t, Typ.constraints) => switch (mode) { | Syn - | SynFun => Ana(List(hd_ty)) - | Ana(ty) => Ana(List(Typ.matched_list(ctx, ty))) + | SynFun => (Ana(List(hd_ty)), []) + | Ana(ty) => + let (matched_ty, constraints) = Typ.matched_list(ctx, termId, ty); + (Ana(List(matched_ty)), constraints); }; -let of_list = (ctx: Ctx.t, mode: t): t => +let of_list = (ctx: Ctx.t, mode: t, termId: Id.t): (t, Typ.constraints) => switch (mode) { | Syn - | SynFun => Syn - | Ana(ty) => Ana(Typ.matched_list(ctx, ty)) + | SynFun => (Syn, []) + | Ana(ty) => + let (matched_typ, constraints) = Typ.matched_list(ctx, termId, ty); + (Ana(matched_typ), constraints); }; -let of_list_concat = (ctx: Ctx.t, mode: t): t => +let of_list_concat = (ctx: Ctx.t, id, mode: t): (t, Typ.constraints) => switch (mode) { | Syn - | SynFun => Ana(List(Unknown(SynSwitch))) - | Ana(ty) => Ana(List(Typ.matched_list(ctx, ty))) + | SynFun => (Ana(List(Unknown(SynSwitch(id)))), []) + | Ana(ty) => + let (matched_typ, constraints) = Typ.matched_list(ctx, id, ty); + (Ana(List(matched_typ)), constraints); }; -let of_list_lit = (ctx: Ctx.t, length, mode: t): list(t) => - List.init(length, _ => of_list(ctx, mode)); +let of_list_lit = + (ctx: Ctx.t, length, termId: Id.t, mode: t): (list(t), Typ.constraints) => { + let (typs, constraint_lists) = + List.init(length, _ => of_list(ctx, mode, termId)) |> List.split; + let constraints = List.flatten(constraint_lists); + (typs, constraints); +}; let ctr_ana_typ = (ctx: Ctx.t, mode: t, ctr: Constructor.t): option(Typ.t) => { /* If a ctr is being analyzed against (an arrow type returning) @@ -103,7 +127,7 @@ let of_ctr_in_ap = (ctx: Ctx.t, mode: t, ctr: Constructor.t): option(t) => is nullary but used as unary; we reflect this by analyzing against an arrow type. Since we can't guess at what the parameter type might have be, we use Unknown. */ - Some(Ana(Arrow(Unknown(Internal), ty_ana))) + Some(Ana(Arrow(Unknown(NoProvenance), ty_ana))) | None => None }; diff --git a/src/haz3lcore/statics/Self.re b/src/haz3lcore/statics/Self.re index f30c1e2e13..6eb1049628 100644 --- a/src/haz3lcore/statics/Self.re +++ b/src/haz3lcore/statics/Self.re @@ -88,7 +88,7 @@ let of_ctr = (ctx: Ctx.t, name: Constructor.t): t => let add_source = List.map2((id, ty) => Typ.{id, ty}); let match = (ctx: Ctx.t, tys: list(Typ.t), ids: list(Id.t)): t => - switch (Typ.join_all(~empty=Unknown(Internal), ctx, tys)) { + switch (Typ.join_all(~empty=Unknown(NoProvenance), ctx, tys)) { | None => NoJoin(ty => ty, add_source(ids, tys)) | Some(ty) => Just(ty) }; @@ -100,7 +100,7 @@ let listlit = (~empty, ctx: Ctx.t, tys: list(Typ.t), ids: list(Id.t)): t => }; let list_concat = (ctx: Ctx.t, tys: list(Typ.t), ids: list(Id.t)): t => - switch (Typ.join_all(~empty=Unknown(Internal), ctx, tys)) { + switch (Typ.join_all(~empty=Unknown(NoProvenance), ctx, tys)) { | None => NoJoin(ty => List(ty), add_source(ids, tys)) | Some(ty) => Just(ty) }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 5217fcaba7..8209c16a18 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -37,219 +37,7 @@ module Map = { type t = Id.Map.t(Info.t); }; -<<<<<<< HEAD -/* Patterns are assigned a mode (reflecting the static expectations - if any of their syntactic parent) and a self (reflecting what their - statics would be in isolation), a context (variables in scope) */ -[@deriving (show({with_path: false}), sexp, yojson)] -type info_pat = { - cls: Term.UPat.cls, - term: Term.UPat.t, - mode: Typ.mode, - self: Typ.self, - ctx: Ctx.t // TODO: detect in-pattern shadowing -}; - -/* (Syntactic) Types are assigned their corresponding semantic type. */ -[@deriving (show({with_path: false}), sexp, yojson)] -type info_typ = { - cls: Term.UTyp.cls, - term: Term.UTyp.t, - self: Typ.self, -}; - -[@deriving (show({with_path: false}), sexp, yojson)] -type info_rul = { - cls: Term.URul.cls, - term: Term.UExp.t, -}; - -/* The Info aka Cursorinfo assigned to each subterm. */ -[@deriving (show({with_path: false}), sexp, yojson)] -type t = - | Invalid(TermBase.parse_flag) - | InfoExp(info_exp) - | InfoPat(info_pat) - | InfoTyp(info_typ) - | InfoRul(info_rul); - -/* The InfoMap collating all info for a composite term */ -type map = Id.Map.t(t); - -let terms = (map: map): Id.Map.t(Term.any) => - map - |> Id.Map.filter_map(_ => - fun - | Invalid(_) => None - | InfoExp({term, _}) => Some(Term.Exp(term)) - | InfoPat({term, _}) => Some(Term.Pat(term)) - | InfoTyp({term, _}) => Some(Term.Typ(term)) - | InfoRul({term, _}) => Some(Term.Exp(term)) - ); - -/* Static error classes */ -[@deriving (show({with_path: false}), sexp, yojson)] -type error = - | Free(Typ.free_errors) - | Multi - | NoFun(Typ.t) - | SynInconsistentBranches(list(Typ.t)) - | TypeInconsistent(Typ.t, Typ.t); - -/* Statics non-error classes */ -[@deriving (show({with_path: false}), sexp, yojson)] -type happy = - | SynConsistent(Typ.t) - | AnaConsistent(Typ.t, Typ.t, Typ.t) //ana, syn, join - | AnaInternalInconsistent(Typ.t, list(Typ.t)) // ana, branches - | AnaExternalInconsistent(Typ.t, Typ.t); // ana, syn - -/* The error status which 'wraps' each term. */ -[@deriving (show({with_path: false}), sexp, yojson)] -type error_status = - | InHole(error) - | NotInHole(happy); - -/* Determines whether an expression or pattern is in an error hole, - depending on the mode, which represents the expectations of the - surrounding syntactic context, and the self which represents the - makeup of the expression / pattern itself. */ -let error_status = (mode: Typ.mode, self: Typ.self): error_status => - switch (mode, self) { - | (SynFun, Just(ty)) => - switch ( - Typ.join(Arrow(Unknown(NoProvenance), Unknown(NoProvenance)), ty) - ) { - | None => InHole(NoFun(ty)) - | Some(_) => NotInHole(SynConsistent(ty)) - } - | (SynFun, Joined(_wrap, tys_syn)) => - let tys_syn = Typ.source_tys(tys_syn); - switch (Typ.join_all(tys_syn)) { - | None => InHole(SynInconsistentBranches(tys_syn)) - | Some(ty_joined) => - switch ( - Typ.join( - Arrow(Unknown(NoProvenance), Unknown(NoProvenance)), - ty_joined, - ) - ) { - | None => InHole(NoFun(ty_joined)) - | Some(_) => NotInHole(SynConsistent(ty_joined)) - } - }; - | (Syn | SynFun | Ana(_), Free(free_error)) => InHole(Free(free_error)) - | (Syn | SynFun | Ana(_), Multi) => - NotInHole(SynConsistent(Unknown(NoProvenance))) - | (Syn, Just(ty)) => NotInHole(SynConsistent(ty)) - | (Syn, Joined(wrap, tys_syn)) => - let tys_syn = Typ.source_tys(tys_syn); - switch (Typ.join_all(tys_syn)) { - | None => InHole(SynInconsistentBranches(tys_syn)) - | Some(ty_joined) => NotInHole(SynConsistent(wrap(ty_joined))) - }; - | (Ana(ty_ana), Just(ty_syn)) => - switch (Typ.join(ty_ana, ty_syn)) { - | None => InHole(TypeInconsistent(ty_syn, ty_ana)) - | Some(ty_join) => NotInHole(AnaConsistent(ty_ana, ty_syn, ty_join)) - } - | (Ana(ty_ana), Joined(wrap, tys_syn)) => - // TODO: review logic of these cases - switch (Typ.join_all(Typ.source_tys(tys_syn))) { - | Some(ty_syn) => - let ty_syn = wrap(ty_syn); - switch (Typ.join(ty_syn, ty_ana)) { - | None => NotInHole(AnaExternalInconsistent(ty_ana, ty_syn)) - | Some(ty_join) => NotInHole(AnaConsistent(ty_syn, ty_ana, ty_join)) - }; - | None => - NotInHole(AnaInternalInconsistent(ty_ana, Typ.source_tys(tys_syn))) - } - }; - -/* Determines whether any term is in an error hole. Currently types cannot - be in error, and Invalids (things to which Term was unable to assign a - parse) are always in error. The error status of expressions and patterns - are determined by error_status above. */ -let is_error = (ci: t): bool => { - switch (ci) { - | Invalid(Secondary) => false - | Invalid(_) => true - | InfoExp({mode, self, _}) - | InfoPat({mode, self, _}) => - switch (error_status(mode, self)) { - | InHole(_) => true - | NotInHole(_) => false - } - | InfoTyp({self, _}) => - switch (self) { - | Free(TypeVariable) => true - | _ => false - } - | InfoRul(_) => false //TODO - }; -}; - -/* 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. */ -let typ_after_fix = (mode: Typ.mode, self: Typ.self, termId: Id.t): Typ.t => - switch (error_status(mode, self)) { - | InHole(_) => Unknown(AstNode(termId)) - | NotInHole(SynConsistent(t)) => t - | NotInHole(AnaConsistent(_, _, ty_join)) => ty_join - | NotInHole(AnaExternalInconsistent(ty_ana, _)) => ty_ana - | NotInHole(AnaInternalInconsistent(ty_ana, _)) => ty_ana - }; - -/* The type of an expression after hole wrapping */ -let exp_typ = (m: map, e: Term.UExp.t): Typ.t => - switch (Id.Map.find_opt(Term.UExp.rep_id(e), m)) { - | Some(InfoExp({mode, self, _})) => - typ_after_fix(mode, self, Term.UExp.rep_id(e)) - | Some(InfoPat(_) | InfoTyp(_) | InfoRul(_) | Invalid(_)) - | None => failwith(__LOC__ ++ ": XXX") - }; - -let exp_self_typ_id = (m: map, id): Typ.t => - switch (Id.Map.find_opt(id, m)) { - | Some(InfoExp({self, _})) => Typ.t_of_self(self) - | Some(InfoPat(_) | InfoTyp(_) | InfoRul(_) | Invalid(_)) - | None => failwith(__LOC__ ++ ": XXX") - }; - -let exp_self_typ = (m: map, e: Term.UExp.t): Typ.t => - exp_self_typ_id(m, Term.UExp.rep_id(e)); - -let exp_mode_id = (m: map, id): Typ.mode => - switch (Id.Map.find_opt(id, m)) { - | Some(InfoExp({mode, _})) => mode - | Some(InfoPat(_) | InfoTyp(_) | InfoRul(_) | Invalid(_)) - | None => failwith(__LOC__ ++ ": XXX") - }; - -let exp_mode = (m: map, e: Term.UExp.t): Typ.mode => - exp_mode_id(m, Term.UExp.rep_id(e)); - -/* The type of a pattern after hole wrapping */ -let pat_typ = (m: map, p: Term.UPat.t): Typ.t => - switch (Id.Map.find_opt(Term.UPat.rep_id(p), m)) { - | Some(InfoPat({mode, self, _})) => - typ_after_fix(mode, self, Term.UPat.rep_id(p)) - | Some(InfoExp(_) | InfoTyp(_) | InfoRul(_) | Invalid(_)) - | None => failwith(__LOC__ ++ ": XXX") - }; -let pat_self_typ = (m: map, p: Term.UPat.t): Typ.t => - switch (Id.Map.find_opt(Term.UPat.rep_id(p), m)) { - | Some(InfoPat({self, _})) => Typ.t_of_self(self) - | Some(InfoExp(_) | InfoTyp(_) | InfoRul(_) | Invalid(_)) - | None => failwith(__LOC__ ++ ": XXX") - }; - -let union_m = -======= let map_m = (f, xs, m: Map.t) => ->>>>>>> dev List.fold_left( ((xs, m), x) => f(x, m) |> (((x, m)) => (xs @ [x], m)), ([], m), @@ -302,7 +90,6 @@ let typ_exp_unop: UExp.op_un => (Typ.t, Typ.t) = | Bool(Not) => (Bool, Bool) | Int(Minus) => (Int, Int); -<<<<<<< HEAD let join_constraints = (tys: list(Typ.t)): Typ.constraints => { // find first elt containing hole and constrain it to every other elt let elts_with_hole = List.filter(Typ.contains_hole, tys); @@ -317,7 +104,7 @@ let join_constraints = (tys: list(Typ.t)): Typ.constraints => { }; }; -let subsumption_constraints = (mode: Typ.mode, final_typ: Typ.t) => { +let subsumption_constraints = (mode: Mode.t, final_typ: Typ.t) => { switch (mode) { | Ana(expected_typ) => [(final_typ, expected_typ)] | _ => [] @@ -325,114 +112,42 @@ let subsumption_constraints = (mode: Typ.mode, final_typ: Typ.t) => { }; let rec any_to_info_map = - (~ctx: Ctx.t, any: Term.any): (Ctx.co, map, Typ.constraints) => + (~ctx: Ctx.t, ~ancestors, any: any, m: Map.t) + : (CoCtx.t, Map.t, Typ.constraints) => switch (any) { | Exp(e) => - let (_, co, map, constraints) = uexp_to_info_map(~ctx, e); - (co, map, constraints); + let (Info.{co_ctx, constraints, _}, m) = + uexp_to_info_map(~ctx, ~ancestors, e, m); + (co_ctx, m, constraints); | Pat(p) => - let (_, _, map, constraints) = - upat_to_info_map(~is_synswitch=false, ~ctx, p); - (VarMap.empty, map, constraints); - | Typ(ty) => - let (_, map) = utyp_to_info_map(ty); - (VarMap.empty, map, []); - // TODO(d) consider Rul case - | Rul(_) - | Nul () - | Any () => (VarMap.empty, Id.Map.empty, []) -======= -let rec any_to_info_map = - (~ctx: Ctx.t, ~ancestors, any: any, m: Map.t): (CoCtx.t, Map.t) => - switch (any) { - | Exp(e) => - let (Info.{co_ctx, _}, m) = uexp_to_info_map(~ctx, ~ancestors, e, m); - (co_ctx, m); - | Pat(p) => - let m = - upat_to_info_map(~is_synswitch=false, ~ancestors, ~ctx, p, m) |> snd; - (VarMap.empty, m); + let (Info.{constraints, _}, m) = + upat_to_info_map(~is_synswitch=false, ~ancestors, ~ctx, p, m); + (VarMap.empty, m, constraints); | TPat(tp) => ( VarMap.empty, utpat_to_info_map(~ctx, ~ancestors, tp, m) |> snd, + [], ) - | Typ(ty) => ( - VarMap.empty, - utyp_to_info_map(~ctx, ~ancestors, ty, m) |> snd, - ) + | Typ(ty) => + let (_typ, m) = utyp_to_info_map(~ctx, ~ancestors, ty, m); + (VarMap.empty, m, []); | Rul(_) | Nul () - | Any () => (VarMap.empty, m) ->>>>>>> dev + | Any () => (VarMap.empty, m, []) } -and multi = (~ctx, ~ancestors, m, tms) => +and multi = + (~ctx, ~ancestors, m, tms): (list(CoCtx.t), Typ.constraints, Map.t) => List.fold_left( - ((co_ctxs, m), any) => { - let (co_ctx, m) = any_to_info_map(~ctx, ~ancestors, any, m); - (co_ctxs @ [co_ctx], m); + ((co_ctxs, acc_constraints, m), any) => { + let (co_ctx, m, constraints) = + //TODO: anand and raef is this underscore reasonable (might go away) + any_to_info_map(~ctx, ~ancestors, any, m); + (co_ctxs @ [co_ctx], acc_constraints @ constraints, m); }, - ([], m), + ([], [], m), tms, ) and uexp_to_info_map = -<<<<<<< HEAD - (~ctx: Ctx.t, ~mode=Typ.Syn, {ids, term} as uexp: Term.UExp.t) - : (Typ.t, Ctx.co, map, Typ.constraints) => { - /* Maybe switch mode to syn */ - let mode = - switch (mode) { - | Ana(Unknown(SynSwitch(_))) => Typ.Syn - | _ => mode - }; - let cls = Term.UExp.cls_of_term(term); - let go = uexp_to_info_map(~ctx); - let add = (~self: Typ.self, ~free, m, constraints) => { - let joined_constraints = - switch (self) { - | Joined(wrap, sources) => - sources |> Typ.source_tys |> List.map(wrap) |> join_constraints - | _ => [] - }; - ( - typ_after_fix(mode, self, Term.UExp.rep_id(uexp)), - free, - add_info(ids, InfoExp({cls, self, mode, ctx, free, term: uexp}), m), - joined_constraints @ constraints, - ); - }; - let atomic = self => - add( - ~self, - ~free=[], - Id.Map.empty, - subsumption_constraints( - mode, - typ_after_fix(mode, self, Term.UExp.rep_id(uexp)), - ), - ); - switch (term) { - | Invalid(msg) => - let final_typ: Typ.t = Unknown(AstNode(Term.UExp.rep_id(uexp))); - ( - final_typ, - [], - add_info(ids, Invalid(msg), Id.Map.empty), - subsumption_constraints(mode, final_typ), - ); - | MultiHole(tms) => - let info = tms |> List.map(any_to_info_map(~ctx)); - let free = List.map(((f, _, _)) => f, info); - let maps = List.map(((_, m, _)) => m, info); - let constraints = List.map(((_, _, c)) => c, info) |> List.flatten; - let constraints = - constraints - @ subsumption_constraints( - mode, - typ_after_fix(mode, Multi, Term.UExp.rep_id(uexp)), - ); - add(~self=Multi, ~free=Ctx.union(free), union_m(maps), constraints); - | EmptyHole => atomic(Just(Unknown(AstNode(Term.UExp.rep_id(uexp))))) -======= ( ~ctx: Ctx.t, ~mode=Mode.Syn, @@ -444,15 +159,24 @@ and uexp_to_info_map = /* Maybe switch mode to syn */ let mode = switch (mode) { - | Ana(Unknown(SynSwitch)) => Mode.Syn + | Ana(Unknown(SynSwitch(_))) => Mode.Syn | _ => mode }; - let add' = (~self, ~co_ctx, m) => { + let add' = (~self, ~co_ctx, ~constraints, m) => { let info = - Info.derived_exp(~uexp, ~ctx, ~mode, ~ancestors, ~self, ~co_ctx); + Info.derived_exp( + ~uexp, + ~ctx, + ~mode, + ~ancestors, + ~self, + ~co_ctx, + ~constraints, + ); (info, add_info(ids, InfoExp(info), m)); }; - let add = (~self, ~co_ctx, m) => add'(~self=Common(self), ~co_ctx, m); + let add = (~self, ~constraints, ~co_ctx, m) => + add'(~self=Common(self), ~constraints, ~co_ctx, m); let ancestors = [UExp.rep_id(uexp)] @ ancestors; let go' = uexp_to_info_map(~ancestors); let go = go'(~ctx); @@ -463,299 +187,147 @@ and uexp_to_info_map = ([], m), ); let go_pat = upat_to_info_map(~ctx, ~ancestors); - let atomic = self => add(~self, ~co_ctx=CoCtx.empty, m); + // TODO: add subsumption constraints + let atomic = self => { + let final_typ = + switch (Self.typ_of(ctx, self)) { + | Some(typ) => typ + | None => Unknown(AstNode(UExp.rep_id(uexp))) + }; + add( + ~self, + ~co_ctx=CoCtx.empty, + m, + ~constraints=subsumption_constraints(mode, final_typ), + ); + }; switch (term) { | MultiHole(tms) => - let (co_ctxs, m) = multi(~ctx, ~ancestors, m, tms); - add(~self=IsMulti, ~co_ctx=CoCtx.union(co_ctxs), m); + let (co_ctxs, constraints, m) = multi(~ctx, ~ancestors, m, tms); + add(~self=IsMulti, ~co_ctx=CoCtx.union(co_ctxs), m, ~constraints); | Invalid(token) => atomic(BadToken(token)) - | EmptyHole => atomic(Just(Unknown(Internal))) ->>>>>>> dev + | EmptyHole => atomic(Just(Unknown(AstNode(UExp.rep_id(uexp))))) | Triv => atomic(Just(Prod([]))) | Bool(_) => atomic(Just(Bool)) | Int(_) => atomic(Just(Int)) | Float(_) => atomic(Just(Float)) | String(_) => atomic(Just(String)) -<<<<<<< HEAD - | ListLit([]) => atomic(Just(List(Unknown(NoProvenance)))) - | ListLit(es) => - let (modes, list_of_match_constraints) = - List.init(List.length(es), _ => - Typ.matched_list_mode(mode, Term.UExp.rep_id(uexp)) - ) - |> List.split; - let match_constraints = List.flatten(list_of_match_constraints); - let e_ids = List.map(Term.UExp.rep_id, es); - let infos = List.map2((e, mode) => go(~mode, e), es, modes); - let tys = List.map(((ty, _, _, _)) => ty, infos); - let constraints = List.map(((_, _, _, c)) => c, infos) |> List.flatten; - let self: Typ.self = - switch (Typ.join_all(tys)) { - | None => - Joined( - ty => List(ty), - List.map2((id, ty) => Typ.{id, ty}, e_ids, tys), - ) - | Some(ty) => Just(List(ty)) - }; - let free = Ctx.union(List.map(((_, f, _, _)) => f, infos)); - let m = union_m(List.map(((_, _, m, _)) => m, infos)); - add(~self, ~free, m, match_constraints @ constraints); - | Cons(e1, e2) => - let (mode_e, match_constraints) = - Typ.matched_list_mode(mode, Term.UExp.rep_id(uexp)); - let (ty1, free1, m1, constraints1) = go(~mode=mode_e, e1); - let (_, free2, m2, constraints2) = go(~mode=Ana(List(ty1)), e2); - add( - ~self=Just(List(ty1)), - ~free=Ctx.union([free1, free2]), - union_m([m1, m2]), - match_constraints @ constraints1 @ constraints2, - ); - | Var(name) => - switch (Ctx.lookup_var(ctx, name)) { - | None => atomic(Free(Variable)) - | Some(var) => - add( - ~self=Just(var.typ), - ~free=[(name, [{id: Term.UExp.rep_id(uexp), mode}])], - Id.Map.empty, - subsumption_constraints(mode, var.typ), - ) - } - | Parens(e) => - let (ty, free, m, constraints) = go(~mode, e); - add(~self=Just(ty), ~free, m, constraints); - | UnOp(op, e) => - let (ty_in, ty_out) = typ_exp_unop(op); - let (_, free, m, constraints) = go(~mode=Ana(ty_in), e); - add( - ~self=Just(ty_out), - ~free, - m, - subsumption_constraints(mode, ty_out) @ constraints, - ); - | BinOp(op, e1, e2) => - let (ty1, ty2, ty_out) = typ_exp_binop(op); - let (_, free1, m1, constraints1) = go(~mode=Ana(ty1), e1); - let (_, free2, m2, constraints2) = go(~mode=Ana(ty2), e2); - add( - ~self=Just(ty_out), - ~free=Ctx.union([free1, free2]), - union_m([m1, m2]), - subsumption_constraints(mode, ty_out) @ constraints1 @ constraints2, - ); - | Tuple(es) => - let (modes, match_constraints) = - Typ.matched_prod_mode(mode, List.length(es)); - let infos = List.map2((e, mode) => go(~mode, e), es, modes); - let free = Ctx.union(List.map(((_, f, _, _)) => f, infos)); - let final_typ = Typ.Prod(List.map(((ty, _, _, _)) => ty, infos)); - let self = Typ.Just(final_typ); - let m = union_m(List.map(((_, _, m, _)) => m, infos)); - let constraints = List.map(((_, _, _, c)) => c, infos) |> List.flatten; - add(~self, ~free, m, match_constraints @ constraints); - | Tag(name) => - switch (BuiltinADTs.get_tag_typ(name)) { - | None => atomic(Free(Tag)) - | Some(typ) => atomic(Just(typ)) - } - | Test(test) => - let (_, free_test, m1, constraints) = go(~mode=Ana(Bool), test); - add(~self=Just(Prod([])), ~free=free_test, m1, constraints); - | If(cond, e1, e2) => - let (_, free_e0, m1, constraints1) = go(~mode=Ana(Bool), cond); - let (ty_e1, free_e1, m2, constraints2) = go(~mode, e1); - let (ty_e2, free_e2, m3, constraints3) = go(~mode, e2); - add( - ~self= - Joined( - Fun.id, - [ - {id: Term.UExp.rep_id(e1), ty: ty_e1}, - {id: Term.UExp.rep_id(e2), ty: ty_e2}, - ], - ), - ~free=Ctx.union([free_e0, free_e1, free_e2]), - union_m([m1, m2, m3]), - constraints1 @ constraints2 @ constraints3, -======= | ListLit(es) => let ids = List.map(UExp.rep_id, es); - let modes = Mode.of_list_lit(ctx, List.length(es), mode); + let (modes, constraints) = + Mode.of_list_lit(ctx, List.length(es), UExp.rep_id(uexp), mode); let (es, m) = map_m_go(m, modes, es); let tys = List.map(Info.exp_ty, es); add( - ~self=Self.listlit(~empty=Unknown(Internal), ctx, tys, ids), + ~self=Self.listlit(~empty=Unknown(NoProvenance), ctx, tys, ids), ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es)), + ~constraints, m, ); | Cons(hd, tl) => - let (hd, m) = go(~mode=Mode.of_cons_hd(ctx, mode), hd, m); - let (tl, m) = go(~mode=Mode.of_cons_tl(ctx, mode, hd.ty), tl, m); + let (hd_mode, hd_constraints) = + Mode.of_cons_hd(ctx, mode, UExp.rep_id(uexp)); + let (hd, m) = go(~mode=hd_mode, hd, m); + let (tl_mode, tl_constraints) = + Mode.of_cons_tl(ctx, mode, hd.ty, UExp.rep_id(uexp)); + let (tl, m) = go(~mode=tl_mode, tl, m); add( ~self=Just(List(hd.ty)), ~co_ctx=CoCtx.union([hd.co_ctx, tl.co_ctx]), m, + ~constraints=hd_constraints @ tl_constraints, ); | ListConcat(e1, e2) => let ids = List.map(Term.UExp.rep_id, [e1, e2]); - let mode = Mode.of_list_concat(ctx, mode); + let (mode, constraints) = + Mode.of_list_concat(ctx, UExp.rep_id(uexp), mode); let (e1, m) = go(~mode, e1, m); let (e2, m) = go(~mode, e2, m); add( ~self=Self.list_concat(ctx, [e1.ty, e2.ty], ids), ~co_ctx=CoCtx.union([e1.co_ctx, e2.co_ctx]), + ~constraints, m, ); | Var(name) => + let (self: Self.exp, final_typ: Typ.t) = + switch (Ctx.lookup_var(ctx, name)) { + | None => (Free(name), Unknown(AstNode(UExp.rep_id(uexp)))) + | Some(var) => (Common(Just(var.typ)), var.typ) + }; + let (mode_ty, constraints) = Mode.ty_of(ctx, mode, UExp.rep_id(uexp)); add'( - ~self=Self.of_exp_var(ctx, name), - ~co_ctx=CoCtx.singleton(name, UExp.rep_id(uexp), Mode.ty_of(mode)), + ~self, + ~co_ctx=CoCtx.singleton(name, UExp.rep_id(uexp), mode_ty), m, - ) + ~constraints=subsumption_constraints(mode, final_typ) @ constraints, + ); | Parens(e) => let (e, m) = go(~mode, e, m); - add(~self=Just(e.ty), ~co_ctx=e.co_ctx, m); + add(~self=Just(e.ty), ~co_ctx=e.co_ctx, ~constraints=e.constraints, m); | UnOp(op, e) => let (ty_in, ty_out) = typ_exp_unop(op); let (e, m) = go(~mode=Ana(ty_in), e, m); - add(~self=Just(ty_out), ~co_ctx=e.co_ctx, m); + add(~self=Just(ty_out), ~co_ctx=e.co_ctx, ~constraints=e.constraints, m); | BinOp(op, e1, e2) => let (ty1, ty2, ty_out) = typ_exp_binop(op); let (e1, m) = go(~mode=Ana(ty1), e1, m); let (e2, m) = go(~mode=Ana(ty2), e2, m); - add(~self=Just(ty_out), ~co_ctx=CoCtx.union([e1.co_ctx, e2.co_ctx]), m); + add( + ~self=Just(ty_out), + ~co_ctx=CoCtx.union([e1.co_ctx, e2.co_ctx]), + ~constraints=e1.constraints @ e2.constraints, + m, + ); | Tuple(es) => - let modes = Mode.of_prod(ctx, mode, List.length(es)); + let (modes, constraints) = + Mode.of_prod(ctx, mode, UExp.rep_id(uexp), List.length(es)); let (es, m) = map_m_go(m, modes, es); add( ~self=Just(Prod(List.map(Info.exp_ty, es))), ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es)), + ~constraints, m, ->>>>>>> dev ); | Test(e) => let (e, m) = go(~mode=Ana(Bool), e, m); - add(~self=Just(Prod([])), ~co_ctx=e.co_ctx, m); - | Seq(e1, e2) => -<<<<<<< HEAD - let (_, free1, m1, constraints1) = go(~mode=Syn, e1); - let (ty2, free2, m2, constraints2) = go(~mode, e2); - add( - ~self=Just(ty2), - ~free=Ctx.union([free1, free2]), - union_m([m1, m2]), - constraints1 @ constraints2, - ); - | Ap(fn, arg) => - /* Function position mode Ana(Hole->Hole) instead of Syn */ - let (ty_fn, free_fn, m_fn, constraints1) = - uexp_to_info_map(~ctx, ~mode=Typ.ap_mode, fn); - let ((ty_in, ty_out), match_constraints) = - Typ.matched_arrow(ty_fn, Term.UExp.rep_id(uexp)); - let (_, free_arg, m_arg, constraints2) = - uexp_to_info_map(~ctx, ~mode=Ana(ty_in), arg); - add( - ~self=Just(ty_out), - ~free=Ctx.union([free_fn, free_arg]), - union_m([m_fn, m_arg]), - match_constraints - @ constraints1 - @ constraints2 - @ subsumption_constraints(mode, ty_out), - ); - | Fun(pat, body) => - let ((mode_pat, mode_body), match_constraints) = - Typ.matched_arrow_mode(mode, Term.UExp.rep_id(uexp)); - let (ty_pat, ctx_pat, m_pat, constraints1) = - upat_to_info_map(~is_synswitch=false, ~mode=mode_pat, pat); - let ctx_body = VarMap.concat(ctx, ctx_pat); - let (ty_body, free_body, m_body, constraints2) = - uexp_to_info_map(~ctx=ctx_body, ~mode=mode_body, body); - add( - ~self=Just(Arrow(ty_pat, ty_body)), - ~free=Ctx.subtract_typ(ctx_pat, free_body), - union_m([m_pat, m_body]), - match_constraints @ constraints1 @ constraints2, - ); - | Let(pat, def, body) => - let (ty_pat, ctx_pat, _m_pat, constraints1) = - upat_to_info_map(~is_synswitch=true, ~mode=Syn, pat); - let def_ctx = extend_let_def_ctx(ctx, pat, ctx_pat, def); - let (ty_def, free_def, m_def, constraints2) = - 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, constraints3) = - upat_to_info_map(~is_synswitch=false, ~mode=Ana(ty_def), pat); - let ctx_body = VarMap.concat(ctx, ctx_pat_ana); - let (ty_body, free_body, m_body, constraints4) = - 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)]), - union_m([m_pat, m_def, m_body]), - constraints1 @ constraints2 @ constraints3 @ constraints4, - ); - | Match(scrut, rules) => - let (ty_scrut, free_scrut, m_scrut, constraints1) = go(~mode=Syn, scrut); - let (pats, branches) = List.split(rules); - let pat_infos = - List.map( - upat_to_info_map(~is_synswitch=false, ~mode=Typ.Ana(ty_scrut)), - pats, - ); - let branch_infos = - List.map2( - (branch, (_, ctx_pat, _, _)) => - uexp_to_info_map(~ctx=VarMap.concat(ctx, ctx_pat), ~mode, branch), - branches, - pat_infos, - ); - let branch_sources = - List.map2( - (e: Term.UExp.t, (ty, _, _, _)) => - Typ.{id: Term.UExp.rep_id(e), ty}, - branches, - branch_infos, - ); - let pat_ms = List.map(((_, _, m, _)) => m, pat_infos); - let pat_constraints = - List.map(((_, _, _, c)) => c, pat_infos) |> List.flatten; - let branch_ms = List.map(((_, _, m, _)) => m, branch_infos); - let branch_frees = List.map(((_, free, _, _)) => free, branch_infos); - let branch_constraints = - List.map(((_, _, _, c)) => c, branch_infos) |> List.flatten; - let self = Typ.Joined(Fun.id, branch_sources); - let free = Ctx.union([free_scrut] @ branch_frees); - add( - ~self, - ~free, - union_m([m_scrut] @ pat_ms @ branch_ms), - constraints1 @ pat_constraints @ branch_constraints, + ~self=Just(Prod([])), + ~co_ctx=e.co_ctx, + ~constraints=e.constraints, + m, ); -======= + | Seq(e1, e2) => let (e1, m) = go(~mode=Syn, e1, m); let (e2, m) = go(~mode, e2, m); - add(~self=Just(e2.ty), ~co_ctx=CoCtx.union([e1.co_ctx, e2.co_ctx]), m); + add( + ~self=Just(e2.ty), + ~co_ctx=CoCtx.union([e1.co_ctx, e2.co_ctx]), + ~constraints=e1.constraints @ e2.constraints, + m, + ); | Constructor(ctr) => atomic(Self.of_ctr(ctx, ctr)) | Ap(fn, arg) => let fn_mode = Mode.of_ap(ctx, mode, UExp.ctr_name(fn)); let (fn, m) = go(~mode=fn_mode, fn, m); - let (ty_in, ty_out) = Typ.matched_arrow(ctx, fn.ty); + let ((ty_in, ty_out), constraints) = + Typ.matched_arrow(ctx, UExp.rep_id(uexp), fn.ty); let (arg, m) = go(~mode=Ana(ty_in), arg, m); add( ~self=Just(ty_out), ~co_ctx=CoCtx.union([fn.co_ctx, arg.co_ctx]), + ~constraints, m, ); | Fun(p, e) => - let (mode_pat, mode_body) = Mode.of_arrow(ctx, mode); + let ((mode_pat, mode_body), constraints) = + Mode.of_arrow(ctx, mode, UExp.rep_id(uexp)); let (p, m) = go_pat(~is_synswitch=false, ~mode=mode_pat, p, m); let (e, m) = go'(~ctx=p.ctx, ~mode=mode_body, e, m); add( ~self=Just(Arrow(p.ty, e.ty)), ~co_ctx=CoCtx.mk(ctx, p.ctx, e.co_ctx), + ~constraints, m, ); | Let(p, def, body) => @@ -777,6 +349,7 @@ and uexp_to_info_map = let (cons, m) = go(~mode, e1, m); let (alt, m) = go(~mode, e2, m); add( + ~constraints, ~self=Self.match(ctx, [cons.ty, alt.ty], branch_ids), ~co_ctx=CoCtx.union([cond.co_ctx, cons.co_ctx, alt.co_ctx]), m, @@ -800,6 +373,7 @@ and uexp_to_info_map = let e_co_ctxs = List.map2(CoCtx.mk(ctx), p_ctxs, List.map(Info.exp_co_ctx, es)); add( + ~constraints, ~self=Self.match(ctx, e_tys, branch_ids), ~co_ctx=CoCtx.union([scrut.co_ctx] @ e_co_ctxs), m, @@ -841,7 +415,7 @@ and uexp_to_info_map = /* Make sure types don't escape their scope */ let ty_escape = Typ.subst(ty_def, name, ty_body); let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; - add(~self=Just(ty_escape), ~co_ctx, m); + add(~self=Just(ty_escape), ~constraints, ~co_ctx, m); | Var(_) | Invalid(_) | EmptyHole @@ -849,9 +423,8 @@ and uexp_to_info_map = let ({co_ctx, ty: ty_body, _}: Info.exp, m) = go'(~ctx, ~mode, body, m); let m = utyp_to_info_map(~ctx, ~ancestors, utyp, m) |> snd; - add(~self=Just(ty_body), ~co_ctx, m); + add(~self=Just(ty_body), ~constraints=[], ~co_ctx, m); }; ->>>>>>> dev }; } and upat_to_info_map = @@ -863,68 +436,39 @@ and upat_to_info_map = {ids, term} as upat: UPat.t, m: Map.t, ) -<<<<<<< HEAD - : (Typ.t, Ctx.t, map, Typ.constraints) => { - let upat_to_info_map = upat_to_info_map(~is_synswitch); - let unknown = - Typ.Unknown( - is_synswitch - ? SynSwitch(Term.UPat.rep_id(upat)) - : AstNode(Term.UPat.rep_id(upat)), - ); - let cls = Term.UPat.cls_of_term(term); - let add = (~self: Typ.self, ~ctx, m, constraints) => { + : (Info.pat, Map.t) => { + let id = UPat.rep_id(upat); + let add = (~self, ~ctx, ~constraints, m) => { let joined_constraints = switch (self) { | Joined(wrap, sources) => sources |> Typ.source_tys |> List.map(wrap) |> join_constraints | _ => [] }; - ( - typ_after_fix(mode, self, Term.UPat.rep_id(upat)), - ctx, - add_info(ids, InfoPat({cls, self, mode, ctx, term: upat}), m), - joined_constraints @ constraints, - ); + let info = + Info.derived_pat( + ~upat, + ~ctx, + ~mode, + ~ancestors, + ~constraints, + ~self=Common(self), + ); + (info, add_info(ids, InfoPat(info), m)); }; - let atomic = self => + let atomic = self => { + let final_typ = + switch (Self.typ_of(ctx, self)) { + | Some(typ) => typ + | None => Unknown(AstNode(UPat.rep_id(upat))) + }; add( ~self, ~ctx, - Id.Map.empty, - subsumption_constraints( - mode, - typ_after_fix(mode, self, Term.UPat.rep_id(upat)), - ), - ); - switch (term) { - | Invalid(msg) => - let final_typ: Typ.t = Unknown(AstNode(Term.UPat.rep_id(upat))); - ( - final_typ, - ctx, - add_info(ids, Invalid(msg), Id.Map.empty), - subsumption_constraints(mode, final_typ), + m, + ~constraints=subsumption_constraints(mode, final_typ), ); - | MultiHole(tms) => - let info = tms |> List.map(any_to_info_map(~ctx)); - let maps = List.map(((_, m, _)) => m, info); - let constraints = List.map(((_, _, c)) => c, info) |> List.flatten; - let constraints = - subsumption_constraints( - mode, - typ_after_fix(mode, Multi, Term.UPat.rep_id(upat)), - ) - @ constraints; - add(~self=Multi, ~ctx, union_m(maps), constraints); -======= - : (Info.pat, Map.t) => { - let add = (~self, ~ctx, m) => { - let info = - Info.derived_pat(~upat, ~ctx, ~mode, ~ancestors, ~self=Common(self)); - (info, add_info(ids, InfoPat(info), m)); }; - let atomic = self => add(~self, ~ctx, m); let ancestors = [UPat.rep_id(upat)] @ ancestors; let go = upat_to_info_map(~is_synswitch, ~ancestors); let unknown = Typ.Unknown(is_synswitch ? SynSwitch : Internal); @@ -937,153 +481,28 @@ and upat_to_info_map = ); switch (term) { | MultiHole(tms) => - let (_, m) = multi(~ctx, ~ancestors, m, tms); - add(~self=IsMulti, ~ctx, m); - | Invalid(token) => atomic(BadToken(token)) ->>>>>>> dev + let (_, constraints, m) = multi(~ctx, ~ancestors, m, tms); + add(~self=IsMulti, ~ctx, ~constraints, m); + | Invalid(token) => + let final_typ: Typ.t = Unknown(AstNode(Term.UPat.rep_id(upat))); + atomic(BadToken(token)); | EmptyHole => atomic(Just(unknown)) | Int(_) => atomic(Just(Int)) | Float(_) => atomic(Just(Float)) | Triv => atomic(Just(Prod([]))) | Bool(_) => atomic(Just(Bool)) | String(_) => atomic(Just(String)) -<<<<<<< HEAD - | ListLit([]) => atomic(Just(List(Unknown(NoProvenance)))) | ListLit(ps) => - let (modes, list_of_match_constraints) = - List.init(List.length(ps), _ => - Typ.matched_list_mode(mode, Term.UPat.rep_id(upat)) - ) - |> List.split; - let match_constraints = List.flatten(list_of_match_constraints); - let p_ids = List.map(Term.UPat.rep_id, ps); - let (ctx, infos) = - List.fold_left2( - ((ctx, infos), e, mode) => { - let (_, ctx, _, _) as info = upat_to_info_map(~ctx, ~mode, e); - (ctx, infos @ [info]); - }, - (ctx, []), - ps, - modes, - ); - let tys = List.map(((ty, _, _, _)) => ty, infos); - let ps_constraints = - List.map(((_, _, _, c)) => c, infos) |> List.flatten; - let self: Typ.self = - switch (Typ.join_all(tys)) { - | None => - Joined( - ty => List(ty), - List.map2((id, ty) => Typ.{id, ty}, p_ids, tys), - ) - | Some(ty) => Just(List(ty)) - }; - let info: t = InfoPat({cls, self, mode, 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, Term.UPat.rep_id(upat)), - ctx, - m, - match_constraints @ ps_constraints, - ); - | Cons(hd, tl) => - let (mode_e, match_constraints) = - Typ.matched_list_mode(mode, Term.UPat.rep_id(upat)); - let (ty1, ctx, m_hd, constraints1) = - upat_to_info_map(~ctx, ~mode=mode_e, hd); - let (_, ctx, m_tl, constraints2) = - upat_to_info_map(~ctx, ~mode=Ana(List(ty1)), tl); - add( - ~self=Just(List(ty1)), - ~ctx, - union_m([m_hd, m_tl]), - match_constraints @ constraints1 @ constraints2, - ); - | Tag(name) => - switch (BuiltinADTs.get_tag_typ(name)) { - | None => atomic(Free(Tag)) - | Some(typ) => atomic(Just(typ)) - } - | Wild => atomic(Just(Unknown(NoProvenance))) - | Var(name) => - let upat_rep_id = Term.UPat.rep_id(upat); - let typ = - typ_after_fix( - mode, - Just(Unknown(AstNode(upat_rep_id))), - upat_rep_id, - ); - let entry = Ctx.VarEntry({name, id: upat_rep_id, typ}); - add( - ~self=Just(unknown), - ~ctx=Ctx.extend(entry, ctx), - Id.Map.empty, - subsumption_constraints(mode, typ), - ); - | Tuple(ps) => - let (modes, match_constraints) = - Typ.matched_prod_mode(mode, List.length(ps)); - let (ctx, infos) = - List.fold_left2( - ((ctx, infos), e, mode) => { - let (_, ctx, _, _) as info = upat_to_info_map(~mode, ~ctx, e); - (ctx, infos @ [info]); - }, - (ctx, []), - ps, - modes, - ); - let self = Typ.Just(Prod(List.map(((ty, _, _, _)) => ty, infos))); - let m = union_m(List.map(((_, _, m, _)) => m, infos)); - let ps_constraints = - List.map(((_, _, _, c)) => c, infos) |> List.flatten; - add(~self, ~ctx, m, match_constraints @ ps_constraints); - | Parens(p) => - let (ty, ctx, m, constraints) = upat_to_info_map(~ctx, ~mode, p); - add(~self=Just(ty), ~ctx, m, constraints); - | Ap(fn, arg) => - /* Contructor application */ - /* Function position mode Ana(Hole->Hole) instead of Syn */ - let (ty_fn, ctx, m_fn, constraints1) = - upat_to_info_map(~ctx, ~mode=Typ.ap_mode, fn); - let ((ty_in, ty_out), match_constraints) = - Typ.matched_arrow(ty_fn, Term.UPat.rep_id(upat)); - let (_, ctx, m_arg, constraints2) = - upat_to_info_map(~ctx, ~mode=Ana(ty_in), arg); + let ids = List.map(UPat.rep_id, ps); + let (modes, constraints) = + Mode.of_list_lit(ctx, List.length(ps), UExp.rep_id(uexp), mode); + let (ctx, tys, m) = ctx_fold(ctx, m, ps, modes); add( - ~self=Just(ty_out), + ~self=Self.listlit(~empty=unknown, ctx, tys, ids), ~ctx, - union_m([m_fn, m_arg]), - match_constraints - @ constraints1 - @ constraints2 - @ subsumption_constraints(mode, ty_out), + ~constraints, + m, ); - | TypeAnn(p, ty) => - let (ty_ann, m_typ) = utyp_to_info_map(ty); - let (_ty, ctx, m, constraints) = - upat_to_info_map(~ctx, ~mode=Ana(ty_ann), p); - add(~self=Just(ty_ann), ~ctx, union_m([m, m_typ]), constraints); - }; -} -and utyp_to_info_map = ({ids, term} as utyp: Term.UTyp.t): (Typ.t, map) => { - let cls = Term.UTyp.cls_of_term(term); - let ty = Term.utyp_to_ty(utyp); - let add = self => add_info(ids, InfoTyp({cls, self, term: utyp})); - let just = m => (ty, add(Just(ty), m)); - switch (term) { - | Invalid(msg) => ( - Unknown(AstNode(Term.UTyp.rep_id(utyp))), - add_info(ids, Invalid(msg), Id.Map.empty), -======= - | ListLit(ps) => - let ids = List.map(UPat.rep_id, ps); - let modes = Mode.of_list_lit(ctx, List.length(ps), mode); - let (ctx, tys, m) = ctx_fold(ctx, m, ps, modes); - add(~self=Self.listlit(~empty=unknown, ctx, tys, ids), ~ctx, m); | Cons(hd, tl) => let (hd, m) = go(~ctx, ~mode=Mode.of_cons_hd(ctx, mode), hd, m); let (tl, m) = @@ -1095,27 +514,33 @@ and utyp_to_info_map = ({ids, term} as utyp: Term.UTyp.t): (Typ.t, map) => { may be SynSwitch, but SynSwitch is never added to the context; Unknown(Internal) is used in this case */ let ctx_typ = - Info.fixed_typ_pat(ctx, mode, Common(Just(Unknown(Internal)))); + Info.fixed_typ_pat( + ctx, + mode, + Common(Just(Unknown(Internal))), + rep_id(term), + ); let entry = Ctx.VarEntry({name, id: UPat.rep_id(upat), typ: ctx_typ}); add(~self=Just(unknown), ~ctx=Ctx.extend(ctx, entry), m); | Tuple(ps) => - let modes = Mode.of_prod(ctx, mode, List.length(ps)); + let (modes, constraints) = + Mode.of_prod(ctx, mode, UPat.rep_id(upat), List.length(ps)); let (ctx, tys, m) = ctx_fold(ctx, m, ps, modes); - add(~self=Just(Prod(tys)), ~ctx, m); + add(~self=Just(Prod(tys)), ~ctx, ~constraints, m); | Parens(p) => let (p, m) = go(~ctx, ~mode, p, m); - add(~self=Just(p.ty), ~ctx=p.ctx, m); + add(~self=Just(p.ty), ~ctx=p.ctx, ~constraints=[], m); | Constructor(ctr) => atomic(Self.of_ctr(ctx, ctr)) | Ap(fn, arg) => let fn_mode = Mode.of_ap(ctx, mode, UPat.ctr_name(fn)); let (fn, m) = go(~ctx, ~mode=fn_mode, fn, m); - let (ty_in, ty_out) = Typ.matched_arrow(ctx, fn.ty); + let ((ty_in, ty_out), constraints) = Typ.matched_arrow(ctx, id, fn.ty); let (arg, m) = go(~ctx, ~mode=Ana(ty_in), arg, m); - add(~self=Just(ty_out), ~ctx=arg.ctx, m); + add(~self=Just(ty_out), ~ctx=arg.ctx, ~constraints, m); | TypeAnn(p, ann) => let (ann, m) = utyp_to_info_map(~ctx, ~ancestors, ann, m); let (p, m) = go(~ctx, ~mode=Ana(ann.ty), p, m); - add(~self=Just(ann.ty), ~ctx=p.ctx, m); + add(~self=Just(ann.ty), ~ctx=p.ctx, ~constraints=[], m); }; } and utyp_to_info_map = @@ -1125,7 +550,6 @@ and utyp_to_info_map = ~ancestors, {ids, term} as utyp: UTyp.t, m: Map.t, ->>>>>>> dev ) : (Info.typ, Map.t) => { let add = m => { @@ -1157,69 +581,6 @@ and utyp_to_info_map = let m = go(t2, m) |> snd; add(m); | Tuple(ts) => -<<<<<<< HEAD - let m = ts |> List.map(utyp_to_info_map) |> List.map(snd) |> union_m; - just(m); - | Var(name) => - switch (BuiltinADTs.is_typ_var(name)) { - | None => ( - Unknown(AstNode(Term.UTyp.rep_id(utyp))), - add(Free(TypeVariable), Id.Map.empty), - ) - | Some(_) => (Var(name), add(Just(Var(name)), Id.Map.empty)) - } - | MultiHole(tms) => - // TODO thread ctx through to multihole terms once ctx is available - let info = tms |> List.map(any_to_info_map(~ctx=Ctx.empty)); - let maps = List.map(((_, m, _)) => m, info); - just(union_m(maps)); - }; -}; - -let mk_map_and_inference_solutions = - Core.Memo.general( - ~cache_size_bound=1000, - e => { - let (_, _, info_map, constraints) = - uexp_to_info_map(~ctx=Builtins.ctx(Builtins.Pervasives.builtins), e); - - // rewrite is here - let ctx = Infer.Ctx.create(); - let _ = - List.iter( - c => { - let (typ1, typ2) = c; - Infer.constrain(ctx, typ1, typ2); - }, - constraints, - ); - - (info_map, ctx); - }, - ); - -let mk_map = e => { - let (info_map, _) = mk_map_and_inference_solutions(e); - info_map; -}; - -let get_binding_site = (id: Id.t, statics_map: map): option(Id.t) => { - open OptUtil.Syntax; - let* opt = Id.Map.find_opt(id, statics_map); - let* info_exp = - switch (opt) { - | InfoExp(info_exp) => Some(info_exp) - | _ => None - }; - - let+ entry = - switch (info_exp.term.term) { - | TermBase.UExp.Var(name) => Ctx.lookup_var(info_exp.ctx, name) - | _ => None - }; - entry.id; -}; -======= let m = map_m(go, ts, m) |> snd; add(m); | Ap(t1, t2) => @@ -1254,7 +615,7 @@ and utpat_to_info_map = let ancestors = [UTPat.rep_id(utpat)] @ ancestors; switch (term) { | MultiHole(tms) => - let (_, m) = multi(~ctx, ~ancestors, m, tms); + let (_, _, m) = multi(~ctx, ~ancestors, m, tms); add(m); | Invalid(_) | EmptyHole @@ -1293,4 +654,3 @@ let mk_map = uexp_to_info_map(~ctx=Builtins.ctx_init, ~ancestors=[], e, Id.Map.empty) |> snd }); ->>>>>>> dev diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index fad060071a..96b097022b 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -112,8 +112,8 @@ module UTyp = { (ctx, utyp) => switch (utyp.term) { | Invalid(_) - | MultiHole(_) => Unknown(Internal) - | EmptyHole => Unknown(TypeHole) + | MultiHole(_) + | EmptyHole => Unknown(AstNode(rep_id(utyp))) | Bool => Bool | Int => Int | Float => Float @@ -130,7 +130,7 @@ module UTyp = { | Parens(u) => to_typ(ctx, u) /* The below cases should occur only inside sums */ | Constructor(_) - | Ap(_) => Unknown(Internal) + | Ap(_) => Unknown(AstNode(rep_id(utyp))) } and to_variant: (Ctx.t, variant) => option(ConstructorMap.binding(option(Typ.t))) = @@ -633,24 +633,6 @@ module UExp = { } ); - /* Converts a syntactic type into a semantic type */ - let rec utyp_to_ty: UTyp.t => Typ.t = - // TODO anand: figure out where this lives now. Make sure "Unknown(AstNode(UTyp.rep_id(utyp)))" still happens - utyp => - switch (utyp.term) { - | Invalid(_) - | MultiHole(_) - | EmptyHole => Unknown(AstNode(UTyp.rep_id(utyp))) - | Bool => Bool - | Int => Int - | Float => Float - | String => String - | Var(name) => Var(name) - | Arrow(u1, u2) => Arrow(utyp_to_ty(u1), utyp_to_ty(u2)) - | Tuple(us) => Prod(List.map(utyp_to_ty, us)) - | List(u) => List(utyp_to_ty(u)) - | Parens(u) => utyp_to_ty(u) - }; let ctr_name = (e: t): option(Constructor.t) => switch (e.term) { | Constructor(name) => Some(name) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index d99d02330a..fbd0edada7 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -74,12 +74,13 @@ module rec Typ: { ty: t, }; + // TODO: anand and raef; change t, Id.t sigs to source (see above) let of_source: list(source) => list(t); let join_type_provenance: (type_provenance, type_provenance) => type_provenance; - let matched_arrow: (Ctx.t, t) => (t, t); - let matched_prod: (Ctx.t, int, t) => list(t); - let matched_list: (Ctx.t, t) => t; + let matched_arrow: (Ctx.t, Id.t, t) => ((t, t), constraints); + let matched_prod: (Ctx.t, int, Id.t, t) => (list(t), constraints); + let matched_list: (Ctx.t, Id.t, t) => (t, constraints); let precedence: t => int; let subst: (t, TypVar.t, t) => t; let unroll: t => t; @@ -94,13 +95,24 @@ module rec Typ: { let sum_entry: (Constructor.t, sum_map) => option(sum_entry); let get_sum_constructors: (Ctx.t, t) => option(sum_map); let is_unknown: t => bool; + let typ_to_string: t => string; + let typ_to_string_with_parens: (bool, t) => string; + let contains_hole: t => bool; } = { [@deriving (show({with_path: false}), sexp, yojson)] type type_provenance = - | SynSwitch - | TypeHole + | NoProvenance + | SynSwitch(Id.t) + | AstNode(Id.t) | Free(TypVar.t) - | Internal; + | Matched(matched_provenance, type_provenance) + and matched_provenance = + | Matched_Arrow_Left + | Matched_Arrow_Right + // TODO: anand and raef make this be of index and not LR + | Matched_Prod_Left + | Matched_Prod_Right + | Matched_List; /* TYP.T: Hazel types */ [@deriving (show({with_path: false}), sexp, yojson)] @@ -127,6 +139,10 @@ module rec Typ: { ty: t, }; + [@deriving (show({with_path: false}), sexp, yojson)] + type equivalence = (t, t) + and constraints = list(equivalence); + /* Strip location information from a list of sources */ let of_source = List.map((source: source) => source.ty); @@ -174,6 +190,9 @@ module rec Typ: { | (Matched(_) as inf, NoProvenance | Matched(_)) | (NoProvenance, Matched(_) as inf) => inf | (NoProvenance, NoProvenance) => NoProvenance + | _ => + print_endline("TODO anand: get rid of fallthrough"); + NoProvenance; }; let precedence = (ty: t): int => @@ -273,11 +292,8 @@ module rec Typ: { ts, ) ++ ")" - | Sum(t1, t2) => - typ_to_string_with_parens(true, t1) - ++ " + " - ++ typ_to_string(t2) - |> parenthesize_if_left_child + | Sum(_) + | _ => "DISPLAYING SUM and REC NOT IMPLEMEMNTED TODO anand. Ask Andrew where the code that already does this..." }; }; @@ -311,7 +327,7 @@ module rec Typ: { (~resolve=false, ~fix, ctx: Ctx.t, ty1: t, ty2: t): option(t) => { let join' = join(~resolve, ~fix, ctx); switch (ty1, ty2) { - | (_, Unknown(TypeHole | Free(_)) as ty) when fix => + | (_, Unknown(AstNode(_) | Free(_)) as ty) when fix => /* NOTE(andrew): This is load bearing for ensuring that function literals get appropriate casts. Examples/Dynamics has regression tests */ @@ -319,7 +335,7 @@ module rec Typ: { | (Unknown(p1), Unknown(p2)) => Some(Unknown(join_type_provenance(p1, p2))) | (Unknown(_), ty) - | (ty, Unknown(Internal | SynSwitch)) => Some(ty) + | (ty, Unknown(NoProvenance | SynSwitch(_))) => Some(ty) | (Var(n1), Var(n2)) => if (n1 == n2) { Some(Var(n1)); @@ -416,8 +432,9 @@ module rec Typ: { let rec contains_hole = (ty: t): bool => switch (ty) { | Unknown(_) => true - | Arrow(ty1, ty2) - | Sum(ty1, ty2) => contains_hole(ty1) || contains_hole(ty2) + | Arrow(ty1, ty2) => contains_hole(ty1) || contains_hole(ty2) + | Sum(tys) => + tys |> List.filter_map(((_, b)) => b) |> List.exists(contains_hole) | Prod(tys) => List.exists(contains_hole, tys) | _ => false }; @@ -460,7 +477,7 @@ module rec Typ: { }; let matched_arrow = - (ctx: Ctx.t, ty: t, termId: Id.t): ((t, t), constraints) => { + (ctx: Ctx.t, termId: Id.t, ty: t): ((t, t), Typ.constraints) => { let matched_arrow_of_prov = prov => { let (arrow_lhs, arrow_rhs) = ( Unknown(Matched(Matched_Arrow_Left, prov)), @@ -473,38 +490,38 @@ module rec Typ: { }; switch (weak_head_normalize(ctx, ty)) { | Arrow(ty_in, ty_out) => ((ty_in, ty_out), []) - | Unknown(SynSwitch) => (Unknown(SynSwitch), Unknown(SynSwitch)) + | Unknown(SynSwitch(_) as p) => matched_arrow_of_prov(p) | Unknown(prov) => matched_arrow_of_prov(prov) | _ => matched_arrow_of_prov(AstNode(termId)) }; }; - let matched_prod = (ctx: Ctx.t, length, ty: t) => { - let matched_prod_of_prov = prov => { - let (prod_lhs, prod_rhs) = ( - Unknown(Matched(Matched_Prod_Left, prov)), - Unknown(Matched(Matched_Prod_Right, prov)), - ); - ( - (prod_lhs, prod_rhs), - [(Unknown(prov), Prod(prod_lhs, prod_rhs))], - ); - }; + let matched_prod = (ctx: Ctx.t, length, _termId: Id.t, ty: t) => { + // let matched_prod_of_prov = prov => { + // let (prod_lhs, prod_rhs) = ( + // Unknown(Matched(Matched_Prod_Left, prov)), + // Unknown(Matched(Matched_Prod_Right, prov)), + // ); + // ( + // (prod_lhs, prod_rhs), + // [(Unknown(prov), Prod([prod_lhs, prod_rhs]))] // TODO anand: this is not right. + // ); + // }; switch (weak_head_normalize(ctx, ty)) { - | Prod(tys) when List.length(tys) == length => tys - | Unknown(SynSwitch) => List.init(length, _ => Unknown(SynSwitch)) - | _ => List.init(length, _ => Unknown(Internal)) + | Prod(tys) when List.length(tys) == length => (tys, []) + | Unknown(SynSwitch(_) as p) => (List.init(length, _ => Unknown(p)), []) + | _ => (List.init(length, _ => Unknown(NoProvenance)), []) }; }; - let matched_list = (ctx: Ctx.t, ty: t, termId: Id.ty) => { + let matched_list = (_ctx: Ctx.t, termId: Id.t, ty: t) => { let matched_list_of_prov = prov => { let list_elts_typ = Unknown(Matched(Matched_List, prov)); (list_elts_typ, [(Unknown(prov), List(list_elts_typ))]); }; switch (ty) { | List(ty) => (ty, []) - | Unknown(SynSwitch) => Unknown(SynSwitch) + | Unknown(SynSwitch(_) as p) => (Unknown(p), []) // TODO anand: return constraints here | Unknown(prov) => matched_list_of_prov(prov) | _ => matched_list_of_prov(AstNode(termId)) }; diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 51f074b9ac..7ddedc7245 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -215,7 +215,7 @@ let common_ok_view = (cls: Term.Cls.t, ok: Info.ok_pat) => { let typ_ok_view = (cls: Term.Cls.t, ok: Info.ok_typ) => switch (ok) { - | Type(ty) => + | Type(ty) => switch ( Haz3lcore.InferenceResult.get_suggestion_text_for_id( id, @@ -247,7 +247,7 @@ let typ_ok_view = (cls: Term.Cls.t, ok: Info.ok_typ) => ], ) } - //TODO(andrew): restore this message? + //TODO(andrew): restore this message? //| Type(_) when cls == Typ(EmptyHole) => [text("Fillable by any type")] //| Type(ty) => [Type.view(ty)] //TODO(andrew): how do these interact with THI? @@ -311,7 +311,15 @@ let tpat_view = (_: Term.Cls.t, status: Info.status_tpat) => }; let view_of_info = - (~inject,~font_metrics, ~global_inference_info,~settings, ~show_lang_doc: bool, ci: Statics.Info.t): Node.t => { + ( + ~inject, + ~font_metrics, + ~global_inference_info, + ~settings, + ~show_lang_doc: bool, + ci: Statics.Info.t, + ) + : Node.t => { let wrapper = status_view => div( ~attr=clss(["info"]), @@ -325,23 +333,39 @@ let view_of_info = }; }; -let inspector_view = (~inject, ~font_metrics, - ~global_inference_info,~settings, ~show_lang_doc, ci): Node.t => +let inspector_view = + ( + ~inject, + ~font_metrics, + ~global_inference_info, + ~settings, + ~show_lang_doc, + ci, + ) + : Node.t => div( ~attr=clss(["cursor-inspector"] @ [Info.is_error(ci) ? errc : okc]), - [view_of_info(~inject, ~font_metrics, - ~global_inference_info, ~settings, ~show_lang_doc, ci)], + [ + view_of_info( + ~inject, + ~font_metrics, + ~global_inference_info, + ~settings, + ~show_lang_doc, + ci, + ), + ], ); let view = ( ~inject, ~settings: ModelSettings.t, - ~font_metrics, + ~font_metrics, ~show_lang_doc: bool, zipper: Zipper.t, info_map: Statics.Map.t, - global_inference_info: Haz3lcore.InferenceResult.global_inference_info,, + global_inference_info: Haz3lcore.InferenceResult.global_inference_info, ) => { let bar_view = div(~attr=Attr.id("bottom-bar")); let err_view = err => @@ -359,8 +383,14 @@ let view = | None => err_view("Whitespace or Comment") | Some(ci) => bar_view([ - inspector_view(~inject,~font_metrics, - ~global_inference_info, ~settings, ~show_lang_doc, ci), + inspector_view( + ~inject, + ~font_metrics, + ~global_inference_info, + ~settings, + ~show_lang_doc, + ci, + ), div( ~attr=clss(["id"]), [text(String.sub(Id.to_string(id), 0, 4))], diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index bd657a1eb8..f744991b78 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -2861,8 +2861,6 @@ let section = (~section_clss: string, ~title: string, contents: list(Node.t)) => ); let get_color_map = -<<<<<<< HEAD -======= (~doc: LangDocMessages.t, index': option(Id.t), info_map: Statics.Map.t) => { let info: option(Statics.Info.t) = switch (index') { @@ -2878,7 +2876,6 @@ let get_color_map = }; let view = ->>>>>>> dev ( ~global_inference_info: InferenceResult.global_inference_info, ~doc: LangDocMessages.t, diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index efd70d6718..6b0f1e7c47 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -90,15 +90,9 @@ let view = ~doc=langDocMessages, Indicated.index(zipper), info_map, -<<<<<<< HEAD global_inference_info, - ), - ] - : []; -======= ) - : div([]); ->>>>>>> dev + : []; [ div( From 1c2f44025e1809d15edc142c255bf3b459b58ef4 Mon Sep 17 00:00:00 2001 From: disconcision Date: Tue, 10 Oct 2023 17:34:57 -0400 Subject: [PATCH 061/129] resolving remaining merge type errors. starts up fine but UI is utterly borked, suspect CI+css issues --- src/haz3lcore/dynamics/elaborator.re | 39 +++---- src/haz3lcore/statics/Info.re | 4 + src/haz3lcore/statics/Statics.re | 146 ++++++++++++++++++--------- src/haz3lweb/Keyboard.re | 4 +- src/haz3lweb/Update.re | 8 +- src/haz3lweb/view/BackpackView.re | 3 +- src/haz3lweb/view/Code.re | 88 +++++++++++----- src/haz3lweb/view/CursorInspector.re | 83 ++++++++++----- src/haz3lweb/view/ExerciseMode.re | 1 + src/haz3lweb/view/InferenceView.re | 8 +- src/haz3lweb/view/LangDoc.re | 18 ++-- src/haz3lweb/view/ScratchMode.re | 2 +- src/haz3lweb/view/Type.re | 71 +++++++------ 13 files changed, 301 insertions(+), 174 deletions(-) diff --git a/src/haz3lcore/dynamics/elaborator.re b/src/haz3lcore/dynamics/elaborator.re index 47e2d484c2..185d100d86 100644 --- a/src/haz3lcore/dynamics/elaborator.re +++ b/src/haz3lcore/dynamics/elaborator.re @@ -27,7 +27,7 @@ let fixed_pat_typ = (m: Statics.Map.t, p: Term.UPat.t): option(Typ.t) => | _ => None }; -let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => +let cast = (ctx: Ctx.t, id: Id.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => switch (mode) { | Syn => d | SynFun => @@ -50,8 +50,8 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => } | Fun(_) => /* See regression tests in Examples/Dynamics */ - let (_, ana_out) = Typ.matched_arrow(ctx, ana_ty); - let (self_in, _) = Typ.matched_arrow(ctx, self_ty); + let ((_, ana_out), _) = Typ.matched_arrow(ctx, id, ana_ty); + let ((self_in, _), _) = Typ.matched_arrow(ctx, id, self_ty); DHExp.cast(d, Arrow(self_in, ana_out), ana_ty); | Tuple(ds) => switch (ana_ty) { @@ -103,24 +103,24 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => /* Handles cast insertion and non-empty-hole wrapping for elaborated expressions */ -let wrap = (ctx: Ctx.t, u: Id.t, mode: Mode.t, self, d: DHExp.t): DHExp.t => +let wrap = (ctx: Ctx.t, id: Id.t, mode: Mode.t, self, d: DHExp.t): DHExp.t => switch (Info.status_exp(ctx, mode, self)) { | NotInHole(_) => let self_ty = switch (Self.typ_of_exp(ctx, self)) { | Some(self_ty) => Typ.normalize(ctx, self_ty) - | None => Unknown(Internal) + | None => Unknown(NoProvenance) }; - cast(ctx, mode, self_ty, d); - | InHole(_) => NonEmptyHole(TypeInconsistent, u, 0, d) + cast(ctx, id, mode, self_ty, d); + | InHole(_) => NonEmptyHole(TypeInconsistent, id, 0, d) }; let rec dhexp_of_uexp = (m: Statics.Map.t, uexp: Term.UExp.t): option(DHExp.t) => { - switch (Id.Map.find_opt(Term.UExp.rep_id(uexp), m)) { + let id = Term.UExp.rep_id(uexp); /* NOTE: using term uids for hole ids */ + switch (Id.Map.find_opt(id, m)) { | Some(InfoExp({mode, self, ctx, _})) => let err_status = Info.status_exp(ctx, mode, self); - let id = Term.UExp.rep_id(uexp); /* NOTE: using term uids for hole ids */ let+ d: DHExp.t = switch (uexp.term) { | Invalid(t) => Some(DHExp.InvalidText(id, 0, t)) @@ -138,7 +138,7 @@ let rec dhexp_of_uexp = | ListLit(es) => let* ds = es |> List.map(dhexp_of_uexp(m)) |> OptUtil.sequence; let+ ty = fixed_exp_typ(m, uexp); - let ty = Typ.matched_list(ctx, ty); + let (ty, _) = Typ.matched_list(ctx, id, ty); DHExp.ListLit(id, 0, ty, ds); | Fun(p, body) => let* dp = dhpat_of_upat(m, p); @@ -279,7 +279,8 @@ let rec dhexp_of_uexp = }; } and dhpat_of_upat = (m: Statics.Map.t, upat: Term.UPat.t): option(DHPat.t) => { - switch (Id.Map.find_opt(Term.UPat.rep_id(upat), m)) { + let id = Term.UPat.rep_id(upat); /* NOTE: using term uids for hole ids */ + switch (Id.Map.find_opt(id, m)) { | Some(InfoPat({mode, self, ctx, _})) => let err_status = Info.status_pat(ctx, mode, self); let maybe_reason: option(ErrStatus.HoleReason.t) = @@ -287,18 +288,17 @@ and dhpat_of_upat = (m: Statics.Map.t, upat: Term.UPat.t): option(DHPat.t) => { | NotInHole(_) => None | InHole(_) => Some(TypeInconsistent) }; - let u = Term.UPat.rep_id(upat); /* NOTE: using term uids for hole ids */ let wrap = (d: DHPat.t): option(DHPat.t) => switch (maybe_reason) { | None => Some(d) - | Some(reason) => Some(NonEmptyHole(reason, u, 0, d)) + | Some(reason) => Some(NonEmptyHole(reason, id, 0, d)) }; switch (upat.term) { - | Invalid(t) => Some(DHPat.InvalidText(u, 0, t)) - | EmptyHole => Some(EmptyHole(u, 0)) + | Invalid(t) => Some(DHPat.InvalidText(id, 0, t)) + | EmptyHole => Some(EmptyHole(id, 0)) | MultiHole(_) => // TODO: dhexp, eval for multiholes - Some(EmptyHole(u, 0)) + Some(EmptyHole(id, 0)) | Wild => wrap(Wild) | Bool(b) => wrap(BoolLit(b)) | Int(n) => wrap(IntLit(n)) @@ -308,11 +308,12 @@ and dhpat_of_upat = (m: Statics.Map.t, upat: Term.UPat.t): option(DHPat.t) => { | ListLit(ps) => let* ds = ps |> List.map(dhpat_of_upat(m)) |> OptUtil.sequence; let* ty = fixed_pat_typ(m, upat); - wrap(ListLit(Typ.matched_list(ctx, ty), ds)); + let (ty', _) = Typ.matched_list(ctx, id, ty); + wrap(ListLit(ty', ds)); | Constructor(name) => switch (err_status) { | InHole(Common(NoType(FreeConstructor(_)))) => - Some(BadConstructor(u, 0, name)) + Some(BadConstructor(id, 0, name)) | _ => wrap(Constructor(name)) } | Cons(hd, tl) => @@ -347,7 +348,7 @@ let uexp_elab = (m: Statics.Map.t, uexp: Term.UExp.t): ElaborationResult.t => let ty = switch (fixed_exp_typ(m, uexp)) { | Some(ty) => ty - | None => Typ.Unknown(Internal) + | None => Typ.Unknown(NoProvenance) }; Elaborates(d, ty, Delta.empty); }; diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 157b0d7070..7f7aa22367 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -257,6 +257,10 @@ let exp_co_ctx: exp => CoCtx.t = ({co_ctx, _}) => co_ctx; let exp_ty: exp => Typ.t = ({ty, _}) => ty; let pat_ctx: pat => Ctx.t = ({ctx, _}) => ctx; let pat_ty: pat => Typ.t = ({ty, _}) => ty; +let exp_constraints: exp => Typ.constraints = + ({constraints, _}) => constraints; +let pat_constraints: pat => Typ.constraints = + ({constraints, _}) => constraints; let rec status_common = (ctx: Ctx.t, mode: Mode.t, self: Self.t): status_common => diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 8209c16a18..fbd0cceb75 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -1,4 +1,5 @@ open Term; +open Util; /* STATICS.re @@ -214,39 +215,38 @@ and uexp_to_info_map = | String(_) => atomic(Just(String)) | ListLit(es) => let ids = List.map(UExp.rep_id, es); - let (modes, constraints) = + let (modes, mode_cs) = Mode.of_list_lit(ctx, List.length(es), UExp.rep_id(uexp), mode); let (es, m) = map_m_go(m, modes, es); let tys = List.map(Info.exp_ty, es); add( ~self=Self.listlit(~empty=Unknown(NoProvenance), ctx, tys, ids), ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es)), - ~constraints, + ~constraints=mode_cs @ ListUtil.flat_map(Info.exp_constraints, es), m, ); | Cons(hd, tl) => - let (hd_mode, hd_constraints) = + let (hd_mode, hd_mode_cs) = Mode.of_cons_hd(ctx, mode, UExp.rep_id(uexp)); let (hd, m) = go(~mode=hd_mode, hd, m); - let (tl_mode, tl_constraints) = + let (tl_mode, tl_mode_cs) = Mode.of_cons_tl(ctx, mode, hd.ty, UExp.rep_id(uexp)); let (tl, m) = go(~mode=tl_mode, tl, m); add( ~self=Just(List(hd.ty)), ~co_ctx=CoCtx.union([hd.co_ctx, tl.co_ctx]), m, - ~constraints=hd_constraints @ tl_constraints, + ~constraints=hd.constraints @ tl.constraints @ hd_mode_cs @ tl_mode_cs, ); | ListConcat(e1, e2) => let ids = List.map(Term.UExp.rep_id, [e1, e2]); - let (mode, constraints) = - Mode.of_list_concat(ctx, UExp.rep_id(uexp), mode); + let (mode, mode_cs) = Mode.of_list_concat(ctx, UExp.rep_id(uexp), mode); let (e1, m) = go(~mode, e1, m); let (e2, m) = go(~mode, e2, m); add( ~self=Self.list_concat(ctx, [e1.ty, e2.ty], ids), ~co_ctx=CoCtx.union([e1.co_ctx, e2.co_ctx]), - ~constraints, + ~constraints=mode_cs @ e1.constraints @ e2.constraints, m, ); | Var(name) => @@ -255,12 +255,12 @@ and uexp_to_info_map = | None => (Free(name), Unknown(AstNode(UExp.rep_id(uexp)))) | Some(var) => (Common(Just(var.typ)), var.typ) }; - let (mode_ty, constraints) = Mode.ty_of(ctx, mode, UExp.rep_id(uexp)); + let (mode_ty, mode_cs) = Mode.ty_of(ctx, mode, UExp.rep_id(uexp)); add'( ~self, ~co_ctx=CoCtx.singleton(name, UExp.rep_id(uexp), mode_ty), m, - ~constraints=subsumption_constraints(mode, final_typ) @ constraints, + ~constraints=subsumption_constraints(mode, final_typ) @ mode_cs, ); | Parens(e) => let (e, m) = go(~mode, e, m); @@ -286,7 +286,7 @@ and uexp_to_info_map = add( ~self=Just(Prod(List.map(Info.exp_ty, es))), ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es)), - ~constraints, + ~constraints=constraints @ ListUtil.flat_map(Info.exp_constraints, es), m, ); | Test(e) => @@ -341,6 +341,7 @@ and uexp_to_info_map = ~self=Just(body.ty), ~co_ctx= CoCtx.union([def.co_ctx, CoCtx.mk(ctx, p_ana.ctx, body.co_ctx)]), + ~constraints=p_ana.constraints @ def.constraints @ body.constraints, m, ); | If(e0, e1, e2) => @@ -349,9 +350,9 @@ and uexp_to_info_map = let (cons, m) = go(~mode, e1, m); let (alt, m) = go(~mode, e2, m); add( - ~constraints, ~self=Self.match(ctx, [cons.ty, alt.ty], branch_ids), ~co_ctx=CoCtx.union([cond.co_ctx, cons.co_ctx, alt.co_ctx]), + ~constraints=cond.constraints @ cons.constraints @ alt.constraints, m, ); | Match(scrut, rules) => @@ -361,6 +362,7 @@ and uexp_to_info_map = let (ps, m) = map_m(go_pat(~is_synswitch=false, ~mode=Mode.Ana(scrut.ty)), ps, m); let p_ctxs = List.map(Info.pat_ctx, ps); + let p_constraints = ListUtil.flat_map(Info.pat_constraints, ps); let (es, m) = List.fold_left2( ((es, m), e, ctx) => @@ -370,10 +372,11 @@ and uexp_to_info_map = p_ctxs, ); let e_tys = List.map(Info.exp_ty, es); + let e_constraints = ListUtil.flat_map(Info.exp_constraints, es); let e_co_ctxs = List.map2(CoCtx.mk(ctx), p_ctxs, List.map(Info.exp_co_ctx, es)); add( - ~constraints, + ~constraints=scrut.constraints @ e_constraints @ p_constraints, ~self=Self.match(ctx, e_tys, branch_ids), ~co_ctx=CoCtx.union([scrut.co_ctx] @ e_co_ctxs), m, @@ -415,7 +418,8 @@ and uexp_to_info_map = /* Make sure types don't escape their scope */ let ty_escape = Typ.subst(ty_def, name, ty_body); let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; - add(~self=Just(ty_escape), ~constraints, ~co_ctx, m); + //TODO anand: constraints? + add(~self=Just(ty_escape), ~constraints=[], ~co_ctx, m); | Var(_) | Invalid(_) | EmptyHole @@ -423,6 +427,7 @@ and uexp_to_info_map = let ({co_ctx, ty: ty_body, _}: Info.exp, m) = go'(~ctx, ~mode, body, m); let m = utyp_to_info_map(~ctx, ~ancestors, utyp, m) |> snd; + //TODO anand: constraints? add(~self=Just(ty_body), ~constraints=[], ~co_ctx, m); }; }; @@ -440,9 +445,9 @@ and upat_to_info_map = let id = UPat.rep_id(upat); let add = (~self, ~ctx, ~constraints, m) => { let joined_constraints = - switch (self) { - | Joined(wrap, sources) => - sources |> Typ.source_tys |> List.map(wrap) |> join_constraints + switch ((self: Self.t)) { + | NoJoin(wrap, sources) => + sources |> Typ.of_source |> List.map(wrap) |> join_constraints | _ => [] }; let info = @@ -451,7 +456,7 @@ and upat_to_info_map = ~ctx, ~mode, ~ancestors, - ~constraints, + ~constraints=constraints @ joined_constraints, ~self=Common(self), ); (info, add_info(ids, InfoPat(info), m)); @@ -469,23 +474,27 @@ and upat_to_info_map = ~constraints=subsumption_constraints(mode, final_typ), ); }; - let ancestors = [UPat.rep_id(upat)] @ ancestors; + let ancestors = [id] @ ancestors; let go = upat_to_info_map(~is_synswitch, ~ancestors); - let unknown = Typ.Unknown(is_synswitch ? SynSwitch : Internal); + let unknown = Typ.Unknown(is_synswitch ? SynSwitch(id) : NoProvenance); let ctx_fold = (ctx: Ctx.t, m) => List.fold_left2( - ((ctx, tys, m), e, mode) => + (((ctx, cs), tys, m), e, mode) => go(~ctx, ~mode, e, m) - |> (((info, m)) => (info.ctx, tys @ [info.ty], m)), - (ctx, [], m), + |> ( + ((info, m)) => ( + (info.ctx, info.constraints @ cs), + tys @ [info.ty], + m, + ) + ), + ((ctx, []), [], m), ); switch (term) { | MultiHole(tms) => let (_, constraints, m) = multi(~ctx, ~ancestors, m, tms); add(~self=IsMulti, ~ctx, ~constraints, m); - | Invalid(token) => - let final_typ: Typ.t = Unknown(AstNode(Term.UPat.rep_id(upat))); - atomic(BadToken(token)); + | Invalid(token) => atomic(BadToken(token)) | EmptyHole => atomic(Just(unknown)) | Int(_) => atomic(Just(Int)) | Float(_) => atomic(Just(Float)) @@ -494,20 +503,25 @@ and upat_to_info_map = | String(_) => atomic(Just(String)) | ListLit(ps) => let ids = List.map(UPat.rep_id, ps); - let (modes, constraints) = - Mode.of_list_lit(ctx, List.length(ps), UExp.rep_id(uexp), mode); - let (ctx, tys, m) = ctx_fold(ctx, m, ps, modes); + let (modes, mode_cs) = Mode.of_list_lit(ctx, List.length(ps), id, mode); + let ((ctx, constraints), tys, m) = ctx_fold(ctx, m, ps, modes); add( ~self=Self.listlit(~empty=unknown, ctx, tys, ids), ~ctx, - ~constraints, + ~constraints=mode_cs @ constraints, m, ); | Cons(hd, tl) => - let (hd, m) = go(~ctx, ~mode=Mode.of_cons_hd(ctx, mode), hd, m); - let (tl, m) = - go(~ctx=hd.ctx, ~mode=Mode.of_cons_tl(ctx, mode, hd.ty), tl, m); - add(~self=Just(List(hd.ty)), ~ctx=tl.ctx, m); + let (mode_hd, mode_cs_hd) = Mode.of_cons_hd(ctx, mode, id); + let (hd, m) = go(~ctx, ~mode=mode_hd, hd, m); + let (mode_tl, mode_cs_tl) = Mode.of_cons_tl(ctx, mode_hd, hd.ty, id); + let (tl, m) = go(~ctx=hd.ctx, ~mode=mode_tl, tl, m); + add( + ~self=Just(List(hd.ty)), + ~ctx=tl.ctx, + ~constraints=hd.constraints @ tl.constraints @ mode_cs_hd @ mode_cs_tl, + m, + ); | Wild => atomic(Just(unknown)) | Var(name) => /* NOTE: The self type assigned to pattern variables (Unknown) @@ -517,29 +531,41 @@ and upat_to_info_map = Info.fixed_typ_pat( ctx, mode, - Common(Just(Unknown(Internal))), - rep_id(term), + Common(Just(Unknown(AstNode(id)))), + id, ); - let entry = Ctx.VarEntry({name, id: UPat.rep_id(upat), typ: ctx_typ}); - add(~self=Just(unknown), ~ctx=Ctx.extend(ctx, entry), m); + let entry = Ctx.VarEntry({name, id, typ: ctx_typ}); + add( + ~self=Just(unknown), + ~ctx=Ctx.extend(ctx, entry), + ~constraints=subsumption_constraints(mode, ctx_typ), + m, + ); | Tuple(ps) => - let (modes, constraints) = + let (modes, mode_cs) = Mode.of_prod(ctx, mode, UPat.rep_id(upat), List.length(ps)); - let (ctx, tys, m) = ctx_fold(ctx, m, ps, modes); - add(~self=Just(Prod(tys)), ~ctx, ~constraints, m); + let ((ctx, constraints), tys, m) = ctx_fold(ctx, m, ps, modes); + add(~self=Just(Prod(tys)), ~ctx, ~constraints=mode_cs @ constraints, m); | Parens(p) => let (p, m) = go(~ctx, ~mode, p, m); - add(~self=Just(p.ty), ~ctx=p.ctx, ~constraints=[], m); + add(~self=Just(p.ty), ~ctx=p.ctx, ~constraints=p.constraints, m); | Constructor(ctr) => atomic(Self.of_ctr(ctx, ctr)) | Ap(fn, arg) => let fn_mode = Mode.of_ap(ctx, mode, UPat.ctr_name(fn)); let (fn, m) = go(~ctx, ~mode=fn_mode, fn, m); - let ((ty_in, ty_out), constraints) = Typ.matched_arrow(ctx, id, fn.ty); + let ((ty_in, ty_out), matched_constraints) = + Typ.matched_arrow(ctx, id, fn.ty); let (arg, m) = go(~ctx, ~mode=Ana(ty_in), arg, m); - add(~self=Just(ty_out), ~ctx=arg.ctx, ~constraints, m); + add( + ~self=Just(ty_out), + ~ctx=arg.ctx, + ~constraints=fn.constraints @ arg.constraints @ matched_constraints, + m, + ); | TypeAnn(p, ann) => let (ann, m) = utyp_to_info_map(~ctx, ~ancestors, ann, m); let (p, m) = go(~ctx, ~mode=Ana(ann.ty), p, m); + //TODO anand: constraints? add(~self=Just(ann.ty), ~ctx=p.ctx, ~constraints=[], m); }; } @@ -562,7 +588,7 @@ and utyp_to_info_map = //TODO(andrew): make this return free, replacing Typ.free_vars switch (term) { | MultiHole(tms) => - let (_, m) = multi(~ctx, ~ancestors, m, tms); + let (_, _, m) = multi(~ctx, ~ancestors, m, tms); add(m); | Invalid(_) | EmptyHole @@ -589,7 +615,8 @@ and utyp_to_info_map = switch (expects) { | VariantExpected(m, sum_ty) => ConstructorExpected(m, Arrow(ty_in, sum_ty)) - | _ => ConstructorExpected(Unique, Arrow(ty_in, Unknown(Internal))) + | _ => + ConstructorExpected(Unique, Arrow(ty_in, Unknown(NoProvenance))) }; let m = go'(~expects=t1_mode, t1, m) |> snd; let m = go'(~expects=TypeExpected, t2, m) |> snd; @@ -654,3 +681,30 @@ let mk_map = uexp_to_info_map(~ctx=Builtins.ctx_init, ~ancestors=[], e, Id.Map.empty) |> snd }); + +let mk_map_and_inference_solutions = + Core.Memo.general( + ~cache_size_bound=1000, + e => { + let (info, map) = + uexp_to_info_map( + ~ctx=Builtins.ctx_init, + ~ancestors=[], + e, + Id.Map.empty, + ); + + // rewrite is here + let ctx = Infer.Ctx.create(); + let _ = + List.iter( + c => { + let (typ1, typ2) = c; + Infer.constrain(ctx, typ1, typ2); + }, + info.constraints, + ); + + (map, ctx); + }, + ); diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index e65659de1c..90208fc65f 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -95,8 +95,8 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { |> StringUtil.to_list |> List.filter(s => s != "?" && s != "!") |> join; - [UpdateAction.Paste(no_hole_marks)]; - | _ => now_save(Insert(Form.linebreak)) + Some(UpdateAction.Paste(no_hole_marks)); + | _ => now(Insert(Form.linebreak)) }; | _ when Form.is_valid_char(key) && String.length(key) == 1 => /* TODO(andrew): length==1 is hack to prevent things diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index 9ac8d2b30c..97e4d95c0c 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -168,9 +168,11 @@ let evaluate_and_schedule = // ======= let perform_action = (model: Model.t, a: Action.t): Result.t(Model.t) => switch ( - model.editors - |> Editors.get_editor - |> Haz3lcore.Perform.go(a, model.langDocMessages.annotations) + Haz3lcore.Perform.go( + a, + Editors.get_editor(model.editors), + model.langDocMessages.annotations, + ) ) { | Error(err) => Error(FailedToPerform(err)) | Ok(ed) => diff --git a/src/haz3lweb/view/BackpackView.re b/src/haz3lweb/view/BackpackView.re index d208e5630d..f4c2b89e18 100644 --- a/src/haz3lweb/view/BackpackView.re +++ b/src/haz3lweb/view/BackpackView.re @@ -15,7 +15,6 @@ let backpack_sel_view = module Text = Code.Text({ let map = Measured.of_segment(content); - let global_inference_info = global_inference_info; let settings = Init.startup.settings; }); // TODO(andrew): Maybe use init sort at caret to prime this @@ -35,7 +34,7 @@ let backpack_sel_view = ), ]), // zwsp necessary for containing box to stretch to contain trailing newline - Text.of_segment(~global_inference_info, true, Any, content) + Text.of_segment(true, Any, font_metrics, global_inference_info, content) @ [text(Unicode.zwsp)], ); }; diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index d91eca0e4d..4a55695c2b 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -31,13 +31,13 @@ let of_delim = let of_grout = ( - ~font_metrics, - ~global_inference_info: InferenceResult.global_inference_info, + font_metrics: FontMetrics.t, + global_inference_info: InferenceResult.global_inference_info, id: Id.t, ) => { let suggestion: InferenceResult.suggestion(Node.t) = InferenceView.get_suggestion_ui_for_id( - ~font_metrics, + ~font_metrics=Some(font_metrics), id, global_inference_info, false, @@ -85,22 +85,30 @@ let of_secondary = values, they will need to be explictly encoded in the key. TODO: Consider setting a limit for the hashtbl size */ -let piece_hash: Hashtbl.t((Sort.t, Piece.t, int, ModelSettings.t), list(t)) = +let piece_hash: + Hashtbl.t( + ( + Sort.t, + Piece.t, + int, + ModelSettings.t, + FontMetrics.t, + InferenceResult.global_inference_info, + ), + list(t), + ) = Hashtbl.create(10000); -module Text = - ( - M: { - let map: Measured.t; - let global_inference_info: InferenceResult.global_inference_info; - let settings: ModelSettings.t; - }, - ) => { +module Text = (M: { + let map: Measured.t; + let settings: ModelSettings.t; + }) => { let m = p => Measured.find_p(p, M.map); let rec of_segment = ( no_sorts, sort, + font_metrics: FontMetrics.t, global_inference_info: InferenceResult.global_inference_info, seg: Segment.t, ) @@ -119,37 +127,55 @@ module Text = seg |> List.mapi((i, p) => (i, p)) |> List.concat_map(((i, p)) => - of_piece(~font_metrics, ~global_inference_info, sort_of_p_idx(i), p) + of_piece(font_metrics, global_inference_info, sort_of_p_idx(i), p) ); } and of_piece' = ( - expected_sort: Sort.t, + font_metrics: FontMetrics.t, global_inference_info: InferenceResult.global_inference_info, + expected_sort: Sort.t, p: Piece.t, ) : list(Node.t) => { switch (p) { | Tile(t) => - of_tile(~font_metrics, ~global_inference_info, expected_sort, t) - | Grout(g) => of_grout(~font_metrics, ~global_inference_info, g.id) + of_tile(font_metrics, global_inference_info, expected_sort, t) + | Grout(g) => of_grout(font_metrics, global_inference_info, g.id) | Secondary({content, _}) => of_secondary((M.settings.secondary_icons, m(p).last.col, content)) }; } - and of_piece = (expected_sort: Sort.t, p: Piece.t): list(Node.t) => { + and of_piece = + ( + font_metrics: FontMetrics.t, + global_inference_info: InferenceResult.global_inference_info, + expected_sort: Sort.t, + p: Piece.t, + ) + : list(Node.t) => { /* Last two elements of arg track the functorial args which can effect the code layout; without these the first, indentation can get out of sync */ - let arg = (expected_sort, p, m(p).last.col, M.settings); + let arg = ( + expected_sort, + p, + m(p).last.col, + M.settings, + font_metrics, + global_inference_info, + ); try(Hashtbl.find(piece_hash, arg)) { | _ => - let res = of_piece'(expected_sort, p); + let res = + of_piece'(font_metrics, global_inference_info, expected_sort, p); Hashtbl.add(piece_hash, arg, res); res; }; } - and of_tile = (expected_sort: Sort.t, t: Tile.t): list(Node.t) => { + and of_tile = + (font_metrics, global_inference_info, expected_sort: Sort.t, t: Tile.t) + : list(Node.t) => { let children_and_sorts = List.mapi( (i, (l, child, r)) => @@ -160,7 +186,7 @@ module Text = let is_consistent = Sort.consistent(t.mold.out, expected_sort); Aba.mk(t.shards, children_and_sorts) |> Aba.join(of_delim(t.mold.out, is_consistent, t), ((seg, sort)) => - of_segment(false, sort, seg, global_inference_info) + of_segment(false, sort, font_metrics, global_inference_info, seg) ) |> List.concat; }; @@ -213,7 +239,6 @@ let simple_view = module Text = Text({ let map = map; - let global_inference_info = global_inference_info; let settings = settings; }); div( @@ -221,7 +246,13 @@ let simple_view = [ span_c( "code-text", - Text.of_segment(false, Sort.Any, unselected, global_inference_info), + Text.of_segment( + false, + Sort.Any, + font_metrics, + global_inference_info, + unselected, + ), ), ], ); @@ -230,7 +261,7 @@ let simple_view = let view = ( ~sort: Sort.t, - ~font_metrics, + ~font_metrics: FontMetrics.t, ~segment, ~unselected, ~measured, @@ -241,12 +272,17 @@ let view = module Text = Text({ let map = measured; - let global_inference_info = global_inference_info; let settings = settings; }); let unselected = TimeUtil.measure_time("Code.view/unselected", settings.benchmark, () => - Text.of_segment(false, sort, unselected, global_inference_info) + Text.of_segment( + false, + sort, + font_metrics, + global_inference_info, + unselected, + ) ); let holes = TimeUtil.measure_time("Code.view/holes", settings.benchmark, () => diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 7ddedc7245..d8f873fbeb 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -9,6 +9,8 @@ let okc = "ok"; let div_err = div(~attr=clss([errc])); let div_ok = div(~attr=clss([okc])); +let infoc = "info"; //TODO: ???? + let code_err = (code: string): Node.t => div(~attr=clss(["code"]), [text(code)]); @@ -85,7 +87,7 @@ let view_of_global_inference_info = ~inject, ~font_metrics: FontMetrics.t, ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, - id: int, + id: Id.t, ) => { let font_metrics = Some(font_metrics); if (global_inference_info.enabled) { @@ -213,7 +215,15 @@ let common_ok_view = (cls: Term.Cls.t, ok: Info.ok_pat) => { }; }; -let typ_ok_view = (cls: Term.Cls.t, ok: Info.ok_typ) => +let typ_ok_view = + ( + ~inject, + ~font_metrics, + ~global_inference_info, + ~id, + _cls: Term.Cls.t, + ok: Info.ok_typ, + ) => switch (ok) { | Type(ty) => switch ( @@ -224,28 +234,15 @@ let typ_ok_view = (cls: Term.Cls.t, ok: Info.ok_typ) => ) { | NoSuggestion(SuggestionsDisabled) | NoSuggestion(NonTypeHoleId) - | NoSuggestion(OnlyHoleSolutions) => - div( - ~attr=clss([infoc, "typ"]), - [ - term_tag(~inject, ~show_lang_doc, is_err, "typ"), - text("is"), - Type.view(ty), - ], - ) - | _ => - div( - ~attr=clss([infoc, "typ"]), - [ - term_tag(~inject, ~show_lang_doc, is_err, "typ"), - view_of_global_inference_info( - ~inject, - ~font_metrics, - ~global_inference_info, - id, - ), - ], - ) + | NoSuggestion(OnlyHoleSolutions) => [Type.view(ty)] + | _ => [ + view_of_global_inference_info( + ~inject, + ~font_metrics, + ~global_inference_info, + id, + ), + ] } //TODO(andrew): restore this message? //| Type(_) when cls == Typ(EmptyHole) => [text("Fillable by any type")] @@ -291,9 +288,27 @@ let pat_view = (cls: Term.Cls.t, status: Info.status_pat) => | NotInHole(ok) => div_ok(common_ok_view(cls, ok)) }; -let typ_view = (cls: Term.Cls.t, status: Info.status_typ) => +let typ_view = + ( + ~inject, + ~font_metrics, + ~global_inference_info, + ~id, + cls: Term.Cls.t, + status: Info.status_typ, + ) => switch (status) { - | NotInHole(ok) => div_ok(typ_ok_view(cls, ok)) + | NotInHole(ok) => + div_ok( + typ_ok_view( + ~inject, + ~font_metrics, + ~global_inference_info, + ~id, + cls, + ok, + ), + ) | InHole(err) => div_err(typ_err_view(err)) }; @@ -317,6 +332,7 @@ let view_of_info = ~global_inference_info, ~settings, ~show_lang_doc: bool, + ~id, ci: Statics.Info.t, ) : Node.t => { @@ -328,7 +344,17 @@ let view_of_info = switch (ci) { | InfoExp({cls, status, _}) => wrapper(exp_view(cls, status)) | InfoPat({cls, status, _}) => wrapper(pat_view(cls, status)) - | InfoTyp({cls, status, _}) => wrapper(typ_view(cls, status)) + | InfoTyp({cls, status, _}) => + wrapper( + typ_view( + ~inject, + ~font_metrics, + ~global_inference_info, + ~id, + cls, + status, + ), + ) | InfoTPat({cls, status, _}) => wrapper(tpat_view(cls, status)) }; }; @@ -340,6 +366,7 @@ let inspector_view = ~global_inference_info, ~settings, ~show_lang_doc, + ~id, ci, ) : Node.t => @@ -352,6 +379,7 @@ let inspector_view = ~global_inference_info, ~settings, ~show_lang_doc, + ~id, ci, ), ], @@ -389,6 +417,7 @@ let view = ~global_inference_info, ~settings, ~show_lang_doc, + ~id, ci, ), div( diff --git a/src/haz3lweb/view/ExerciseMode.re b/src/haz3lweb/view/ExerciseMode.re index 831d7ff725..cf2425cc01 100644 --- a/src/haz3lweb/view/ExerciseMode.re +++ b/src/haz3lweb/view/ExerciseMode.re @@ -368,6 +368,7 @@ let view = ~doc=langDocMessages, Indicated.index(focal_zipper), focal_info_map, + global_inference_info, ) : div([]); [ diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index f71514db25..b9aafb61fd 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -48,14 +48,10 @@ let get_suggestion_ui_for_id = let status = Infer.get_status(global_inference_info.ctx, id); switch (status) { | Solved(typ) => - Solvable( - typ |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), - ) + Solvable(typ |> Type.view(~font_metrics, ~with_cls=false)) | Unsolved([]) => NoSuggestion(NonTypeHoleId) | Unsolved([typ]) => - NestedInconsistency( - Type.view(~font_metrics=Some(font_metrics), ~with_cls=false, typ), - ) + NestedInconsistency(Type.view(~font_metrics, ~with_cls=false, typ)) | Unsolved(_tys) => NoSuggestion(InconsistentSet) // TODO anand: use tys }; } else { diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index f744991b78..d9347d97aa 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -2861,7 +2861,12 @@ let section = (~section_clss: string, ~title: string, contents: list(Node.t)) => ); let get_color_map = - (~doc: LangDocMessages.t, index': option(Id.t), info_map: Statics.Map.t) => { + ( + ~global_inference_info, + ~doc: LangDocMessages.t, + index': option(Id.t), + info_map: Statics.Map.t, + ) => { let info: option(Statics.Info.t) = switch (index') { | Some(index) => @@ -2871,11 +2876,12 @@ let get_color_map = } | None => None }; - let (_, (_, (color_map, _)), _) = get_doc(~docs=doc, info, Colorings); + let (_, (_, (color_map, _)), _) = + get_doc(~global_inference_info, ~docs=doc, info, Colorings); color_map; }; -let view = +let _view = ( ~global_inference_info: InferenceResult.global_inference_info, ~doc: LangDocMessages.t, @@ -2902,11 +2908,11 @@ let view = ~font_metrics: FontMetrics.t, ~settings: ModelSettings.t, ~doc: LangDocMessages.t, - index': option(int), - info_map: Statics.map, + index': option(Id.t), + info_map: Statics.Map.t, global_inference_info: InferenceResult.global_inference_info, ) => { - let info: option(Statics.t) = + let info: option(Info.t) = switch (index') { | Some(index) => switch (Id.Map.find_opt(index, info_map)) { diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 6b0f1e7c47..f9605e3d6f 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -92,7 +92,7 @@ let view = info_map, global_inference_info, ) - : []; + : div([]); [ div( diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 4a3a33cb9a..f5d13e6b2a 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -9,22 +9,20 @@ let ty_view = (cls: string, s: string): Node.t => let alias_view = (s: string): Node.t => div(~attr=clss(["typ-alias-view"]), [text(s)]); -let prov_view: Typ.type_provenance => Node.t = +//TODO: restore or delete +/*let prov_view: Typ.type_provenance => Node.t = fun - | Internal => div([]) + | NoProvenance => div([]) | Free(name) => div(~attr=clss(["typ-mod", "free-type-var"]), [text(name)]) - | TypeHole => div(~attr=clss(["typ-mod", "type-hole"]), [text("𝜏")]) - | SynSwitch => div(~attr=clss(["typ-mod", "syn-switch"]), [text("⇒")]); + | AstNode(_) => div(~attr=clss(["typ-mod", "ast-node"]), [text("𝜏")]) + | Matched(_) => div(~attr=clss(["typ-mod", "matched"]), [text("m")]) + | SynSwitch(_) => div(~attr=clss(["typ-mod", "syn-switch"]), [text("⇒")]);*/ let rec view_ty = - ( - ~font_metrics: option(FontMetrics.t)=None, - ~with_cls: bool=true, - ~is_left_child: bool=false, - ty: Haz3lcore.Typ.t, - ) + (~font_metrics, ~with_cls, ~is_left_child: bool=false, ty: Typ.t) : Node.t => { + let view_ty' = view_ty(~font_metrics, ~with_cls); //TODO: parens on ops when ambiguous let parenthesize_if_left_child = (n): Node.t => (is_left_child ? [Node.text("("), ...n] @ [Node.text(")")] : n) |> span; @@ -39,13 +37,14 @@ let rec view_ty = ~attr= Attr.many([ clss(["typ-view", "atom", "unknown"]), - Attr.title(Typ.show_type_provenance(prov)), + //TODO: restore provenance view on hover? + //Attr.title(Typ.show_type_provenance(prov)), ]), [ EmptyHoleDec.relative_view( ~font_metrics, false, - Haz3lcore.InferenceResult.hole_mold, + InferenceResult.hole_mold, ), ], ) @@ -59,22 +58,18 @@ let rec view_ty = | Rec(x, t) => div( ~attr=clss(["typ-view", "Rec"]), - [text("Rec " ++ x ++ ". "), view_ty(t)], + [text("Rec " ++ x ++ ". "), view_ty'(t)], ) | List(t) => div( ~attr=clss(["typ-view", "atom", "List"]), - [text("["), view_ty(~font_metrics, ~with_cls, t), text("]")], + [text("["), view_ty'(t), text("]")], ) | Arrow(t1, t2) => [ div( ~attr=clss(["typ-view", "Arrow"]), - [ - view_ty(~font_metrics, ~with_cls, ~is_left_child=true, t1), - text(" -> "), - view_ty(~font_metrics, ~with_cls, t2), - ], + [view_ty'(~is_left_child=true, t1), text(" -> "), view_ty'(t2)], ), ] |> parenthesize_if_left_child @@ -88,38 +83,42 @@ let rec view_ty = text("("), div( ~attr=clss(["typ-view", "Prod"]), - [view_ty(~font_metrics, ~with_cls, t0)] - @ ( - List.map( - t => [text(", "), view_ty(~font_metrics, ~with_cls, t)], - ts, - ) - |> List.flatten - ), + [view_ty'(t0)] + @ (List.map(t => [text(", "), view_ty'(t)], ts) |> List.flatten), ), text(")"), ], ) | Sum(ts) => + let ctr_view' = ctr_view(~font_metrics, ~with_cls); div( ~attr=clss(["typ-view", "Sum"]), switch (ts) { | [] => [text("Nullary Sum")] - | [t0] => [text("+")] @ ctr_view(t0) + | [t0] => [text("+")] @ ctr_view'(t0) | [t0, ...ts] => let ts_views = - List.map(t => [text(" + ")] @ ctr_view(~font_metrics, t), ts) - |> List.flatten; - ctr_view(t0) @ ts_views; + List.map(t => [text(" + ")] @ ctr_view'(t), ts) |> List.flatten; + ctr_view'(t0) @ ts_views; }, - ) + ); }; } -and ctr_view = (~font_metrics, (ctr, typ)) => +and ctr_view = (~font_metrics, ~with_cls, (ctr, typ)) => switch (typ) { | None => [text(ctr)] - | Some(typ) => [text(ctr ++ "("), view_ty(~font_metrics, typ), text(")")] + | Some(typ) => [ + text(ctr ++ "("), + view_ty(~font_metrics, ~with_cls, typ), + text(")"), + ] }; -let view = (ty: Haz3lcore.Typ.t): Node.t => - div_c("typ-wrapper", [view_ty(ty)]); +let view = + ( + ~font_metrics: option(FontMetrics.t)=None, + ~with_cls: bool=true, + ty: Typ.t, + ) + : Node.t => + div_c("typ-wrapper", [view_ty(~font_metrics, ~with_cls, ty)]); From 3251d22876bab6d5b92575e134481ee092d84739 Mon Sep 17 00:00:00 2001 From: disconcision Date: Tue, 10 Oct 2023 17:36:44 -0400 Subject: [PATCH 062/129] resolve some css issues; UI now renders okay, but still some issues --- src/haz3lweb/www/style.css | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index 43775dedd9..6212f5326d 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -726,7 +726,6 @@ select { font-weight: bold; } -<<<<<<< HEAD .code .text-Exp { color: var(--exp-text-color); } @@ -768,9 +767,6 @@ select { .code .token.mono {} .code .token.mono-string-lit { -======= -.code .token.mono.string-lit { ->>>>>>> dev color: var(--string-lit-color); } From 8afd3818ef5f21fa300f2448ee28700b465424fe Mon Sep 17 00:00:00 2001 From: andrew blinn Date: Tue, 10 Oct 2023 17:47:33 -0400 Subject: [PATCH 063/129] Update Elaborator.re --- src/haz3lcore/dynamics/Elaborator.re | 39 ++++++++++++++-------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/src/haz3lcore/dynamics/Elaborator.re b/src/haz3lcore/dynamics/Elaborator.re index 47e2d484c2..185d100d86 100644 --- a/src/haz3lcore/dynamics/Elaborator.re +++ b/src/haz3lcore/dynamics/Elaborator.re @@ -27,7 +27,7 @@ let fixed_pat_typ = (m: Statics.Map.t, p: Term.UPat.t): option(Typ.t) => | _ => None }; -let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => +let cast = (ctx: Ctx.t, id: Id.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => switch (mode) { | Syn => d | SynFun => @@ -50,8 +50,8 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => } | Fun(_) => /* See regression tests in Examples/Dynamics */ - let (_, ana_out) = Typ.matched_arrow(ctx, ana_ty); - let (self_in, _) = Typ.matched_arrow(ctx, self_ty); + let ((_, ana_out), _) = Typ.matched_arrow(ctx, id, ana_ty); + let ((self_in, _), _) = Typ.matched_arrow(ctx, id, self_ty); DHExp.cast(d, Arrow(self_in, ana_out), ana_ty); | Tuple(ds) => switch (ana_ty) { @@ -103,24 +103,24 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => /* Handles cast insertion and non-empty-hole wrapping for elaborated expressions */ -let wrap = (ctx: Ctx.t, u: Id.t, mode: Mode.t, self, d: DHExp.t): DHExp.t => +let wrap = (ctx: Ctx.t, id: Id.t, mode: Mode.t, self, d: DHExp.t): DHExp.t => switch (Info.status_exp(ctx, mode, self)) { | NotInHole(_) => let self_ty = switch (Self.typ_of_exp(ctx, self)) { | Some(self_ty) => Typ.normalize(ctx, self_ty) - | None => Unknown(Internal) + | None => Unknown(NoProvenance) }; - cast(ctx, mode, self_ty, d); - | InHole(_) => NonEmptyHole(TypeInconsistent, u, 0, d) + cast(ctx, id, mode, self_ty, d); + | InHole(_) => NonEmptyHole(TypeInconsistent, id, 0, d) }; let rec dhexp_of_uexp = (m: Statics.Map.t, uexp: Term.UExp.t): option(DHExp.t) => { - switch (Id.Map.find_opt(Term.UExp.rep_id(uexp), m)) { + let id = Term.UExp.rep_id(uexp); /* NOTE: using term uids for hole ids */ + switch (Id.Map.find_opt(id, m)) { | Some(InfoExp({mode, self, ctx, _})) => let err_status = Info.status_exp(ctx, mode, self); - let id = Term.UExp.rep_id(uexp); /* NOTE: using term uids for hole ids */ let+ d: DHExp.t = switch (uexp.term) { | Invalid(t) => Some(DHExp.InvalidText(id, 0, t)) @@ -138,7 +138,7 @@ let rec dhexp_of_uexp = | ListLit(es) => let* ds = es |> List.map(dhexp_of_uexp(m)) |> OptUtil.sequence; let+ ty = fixed_exp_typ(m, uexp); - let ty = Typ.matched_list(ctx, ty); + let (ty, _) = Typ.matched_list(ctx, id, ty); DHExp.ListLit(id, 0, ty, ds); | Fun(p, body) => let* dp = dhpat_of_upat(m, p); @@ -279,7 +279,8 @@ let rec dhexp_of_uexp = }; } and dhpat_of_upat = (m: Statics.Map.t, upat: Term.UPat.t): option(DHPat.t) => { - switch (Id.Map.find_opt(Term.UPat.rep_id(upat), m)) { + let id = Term.UPat.rep_id(upat); /* NOTE: using term uids for hole ids */ + switch (Id.Map.find_opt(id, m)) { | Some(InfoPat({mode, self, ctx, _})) => let err_status = Info.status_pat(ctx, mode, self); let maybe_reason: option(ErrStatus.HoleReason.t) = @@ -287,18 +288,17 @@ and dhpat_of_upat = (m: Statics.Map.t, upat: Term.UPat.t): option(DHPat.t) => { | NotInHole(_) => None | InHole(_) => Some(TypeInconsistent) }; - let u = Term.UPat.rep_id(upat); /* NOTE: using term uids for hole ids */ let wrap = (d: DHPat.t): option(DHPat.t) => switch (maybe_reason) { | None => Some(d) - | Some(reason) => Some(NonEmptyHole(reason, u, 0, d)) + | Some(reason) => Some(NonEmptyHole(reason, id, 0, d)) }; switch (upat.term) { - | Invalid(t) => Some(DHPat.InvalidText(u, 0, t)) - | EmptyHole => Some(EmptyHole(u, 0)) + | Invalid(t) => Some(DHPat.InvalidText(id, 0, t)) + | EmptyHole => Some(EmptyHole(id, 0)) | MultiHole(_) => // TODO: dhexp, eval for multiholes - Some(EmptyHole(u, 0)) + Some(EmptyHole(id, 0)) | Wild => wrap(Wild) | Bool(b) => wrap(BoolLit(b)) | Int(n) => wrap(IntLit(n)) @@ -308,11 +308,12 @@ and dhpat_of_upat = (m: Statics.Map.t, upat: Term.UPat.t): option(DHPat.t) => { | ListLit(ps) => let* ds = ps |> List.map(dhpat_of_upat(m)) |> OptUtil.sequence; let* ty = fixed_pat_typ(m, upat); - wrap(ListLit(Typ.matched_list(ctx, ty), ds)); + let (ty', _) = Typ.matched_list(ctx, id, ty); + wrap(ListLit(ty', ds)); | Constructor(name) => switch (err_status) { | InHole(Common(NoType(FreeConstructor(_)))) => - Some(BadConstructor(u, 0, name)) + Some(BadConstructor(id, 0, name)) | _ => wrap(Constructor(name)) } | Cons(hd, tl) => @@ -347,7 +348,7 @@ let uexp_elab = (m: Statics.Map.t, uexp: Term.UExp.t): ElaborationResult.t => let ty = switch (fixed_exp_typ(m, uexp)) { | Some(ty) => ty - | None => Typ.Unknown(Internal) + | None => Typ.Unknown(NoProvenance) }; Elaborates(d, ty, Delta.empty); }; From c07e305c1056928ed66f1b3ef4161eee2f28d809 Mon Sep 17 00:00:00 2001 From: RaefM Date: Tue, 14 Nov 2023 20:35:44 -0500 Subject: [PATCH 064/129] add logging --- src/haz3lcore/dynamics/elaborator.re | 354 --------------------------- src/haz3lcore/statics/Statics.re | 9 +- src/haz3lcore/statics/TypBase.re | 13 + 3 files changed, 20 insertions(+), 356 deletions(-) delete mode 100644 src/haz3lcore/dynamics/elaborator.re diff --git a/src/haz3lcore/dynamics/elaborator.re b/src/haz3lcore/dynamics/elaborator.re deleted file mode 100644 index 185d100d86..0000000000 --- a/src/haz3lcore/dynamics/elaborator.re +++ /dev/null @@ -1,354 +0,0 @@ -open Util; -open OptUtil.Syntax; - -module ElaborationResult = { - [@deriving sexp] - type t = - | Elaborates(DHExp.t, Typ.t, Delta.t) - | DoesNotElaborate; -}; - -let exp_binop_of: Term.UExp.op_bin => (Typ.t, (_, _) => DHExp.t) = - fun - | Int(op) => (Int, ((e1, e2) => BinIntOp(op, e1, e2))) - | Float(op) => (Float, ((e1, e2) => BinFloatOp(op, e1, e2))) - | Bool(op) => (Bool, ((e1, e2) => BinBoolOp(op, e1, e2))) - | String(op) => (String, ((e1, e2) => BinStringOp(op, e1, e2))); - -let fixed_exp_typ = (m: Statics.Map.t, e: Term.UExp.t): option(Typ.t) => - switch (Id.Map.find_opt(Term.UExp.rep_id(e), m)) { - | Some(InfoExp({ty, _})) => Some(ty) - | _ => None - }; - -let fixed_pat_typ = (m: Statics.Map.t, p: Term.UPat.t): option(Typ.t) => - switch (Id.Map.find_opt(Term.UPat.rep_id(p), m)) { - | Some(InfoPat({ty, _})) => Some(ty) - | _ => None - }; - -let cast = (ctx: Ctx.t, id: Id.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => - switch (mode) { - | Syn => d - | SynFun => - switch (self_ty) { - | Unknown(prov) => - DHExp.cast(d, Unknown(prov), Arrow(Unknown(prov), Unknown(prov))) - | Arrow(_) => d - | _ => failwith("Elaborator.wrap: SynFun non-arrow-type") - } - | Ana(ana_ty) => - let ana_ty = Typ.normalize(ctx, ana_ty); - /* Forms with special ana rules get cast from their appropriate Matched types */ - switch (d) { - | ListLit(_) - | ListConcat(_) - | Cons(_) => - switch (ana_ty) { - | Unknown(prov) => DHExp.cast(d, List(Unknown(prov)), Unknown(prov)) - | _ => d - } - | Fun(_) => - /* See regression tests in Examples/Dynamics */ - let ((_, ana_out), _) = Typ.matched_arrow(ctx, id, ana_ty); - let ((self_in, _), _) = Typ.matched_arrow(ctx, id, self_ty); - DHExp.cast(d, Arrow(self_in, ana_out), ana_ty); - | Tuple(ds) => - switch (ana_ty) { - | Unknown(prov) => - let us = List.init(List.length(ds), _ => Typ.Unknown(prov)); - DHExp.cast(d, Prod(us), Unknown(prov)); - | _ => d - } - | Ap(Constructor(_), _) - | Constructor(_) => - switch (ana_ty, self_ty) { - | (Unknown(prov), Rec(_, Sum(_))) - | (Unknown(prov), Sum(_)) => DHExp.cast(d, self_ty, Unknown(prov)) - | _ => d - } - /* Forms with special ana rules but no particular typing requirements */ - | ConsistentCase(_) - | InconsistentBranches(_) - | Sequence(_) - | Let(_) - | FixF(_) => d - /* Hole-like forms: Don't cast */ - | InvalidText(_) - | FreeVar(_) - | ExpandingKeyword(_) - | EmptyHole(_) - | NonEmptyHole(_) => d - /* DHExp-specific forms: Don't cast */ - | Cast(_) - | Closure(_) - | FailedCast(_) - | InvalidOperation(_) => d - /* Normal cases: wrap */ - | BoundVar(_) - | Ap(_) - | ApBuiltin(_) - | Prj(_) - | BoolLit(_) - | IntLit(_) - | FloatLit(_) - | StringLit(_) - | BinBoolOp(_) - | BinIntOp(_) - | BinFloatOp(_) - | BinStringOp(_) - | TestLit(_) => DHExp.cast(d, self_ty, ana_ty) - }; - }; - -/* Handles cast insertion and non-empty-hole wrapping - for elaborated expressions */ -let wrap = (ctx: Ctx.t, id: Id.t, mode: Mode.t, self, d: DHExp.t): DHExp.t => - switch (Info.status_exp(ctx, mode, self)) { - | NotInHole(_) => - let self_ty = - switch (Self.typ_of_exp(ctx, self)) { - | Some(self_ty) => Typ.normalize(ctx, self_ty) - | None => Unknown(NoProvenance) - }; - cast(ctx, id, mode, self_ty, d); - | InHole(_) => NonEmptyHole(TypeInconsistent, id, 0, d) - }; - -let rec dhexp_of_uexp = - (m: Statics.Map.t, uexp: Term.UExp.t): option(DHExp.t) => { - let id = Term.UExp.rep_id(uexp); /* NOTE: using term uids for hole ids */ - switch (Id.Map.find_opt(id, m)) { - | Some(InfoExp({mode, self, ctx, _})) => - let err_status = Info.status_exp(ctx, mode, self); - let+ d: DHExp.t = - switch (uexp.term) { - | Invalid(t) => Some(DHExp.InvalidText(id, 0, t)) - | EmptyHole => Some(DHExp.EmptyHole(id, 0)) - | MultiHole(_tms) => - /* TODO: add a dhexp case and eval logic for multiholes. - Make sure new dhexp form is properly considered Indet - to avoid casting issues. */ - Some(EmptyHole(id, 0)) - | Triv => Some(Tuple([])) - | Bool(b) => Some(BoolLit(b)) - | Int(n) => Some(IntLit(n)) - | Float(n) => Some(FloatLit(n)) - | String(s) => Some(StringLit(s)) - | ListLit(es) => - let* ds = es |> List.map(dhexp_of_uexp(m)) |> OptUtil.sequence; - let+ ty = fixed_exp_typ(m, uexp); - let (ty, _) = Typ.matched_list(ctx, id, ty); - DHExp.ListLit(id, 0, ty, ds); - | Fun(p, body) => - let* dp = dhpat_of_upat(m, p); - let* d1 = dhexp_of_uexp(m, body); - let+ ty = fixed_pat_typ(m, p); - DHExp.Fun(dp, ty, d1, None); - | Tuple(es) => - let+ ds = es |> List.map(dhexp_of_uexp(m)) |> OptUtil.sequence; - DHExp.Tuple(ds); - | Cons(e1, e2) => - let* dc1 = dhexp_of_uexp(m, e1); - let+ dc2 = dhexp_of_uexp(m, e2); - DHExp.Cons(dc1, dc2); - | ListConcat(e1, e2) => - let* dc1 = dhexp_of_uexp(m, e1); - let+ dc2 = dhexp_of_uexp(m, e2); - DHExp.ListConcat(dc1, dc2); - | UnOp(Int(Minus), e) => - let+ dc = dhexp_of_uexp(m, e); - DHExp.BinIntOp(Minus, IntLit(0), dc); - | UnOp(Bool(Not), e) => - let+ d_scrut = dhexp_of_uexp(m, e); - let d_rules = - DHExp.[ - Rule(BoolLit(true), BoolLit(false)), - Rule(BoolLit(false), BoolLit(true)), - ]; - let d = DHExp.ConsistentCase(DHExp.Case(d_scrut, d_rules, 0)); - /* Manually construct cast (case is not otherwise cast) */ - switch (mode) { - | Ana(ana_ty) => DHExp.cast(d, Bool, ana_ty) - | _ => d - }; - | BinOp(op, e1, e2) => - let (_, cons) = exp_binop_of(op); - let* dc1 = dhexp_of_uexp(m, e1); - let+ dc2 = dhexp_of_uexp(m, e2); - cons(dc1, dc2); - | Parens(e) => dhexp_of_uexp(m, e) - | Seq(e1, e2) => - let* d1 = dhexp_of_uexp(m, e1); - let+ d2 = dhexp_of_uexp(m, e2); - DHExp.Sequence(d1, d2); - | Test(test) => - let+ dtest = dhexp_of_uexp(m, test); - DHExp.Ap(TestLit(id), dtest); - | Var(name) => - switch (err_status) { - | InHole(FreeVariable(_)) => Some(FreeVar(id, 0, name)) - | _ => Some(BoundVar(name)) - } - | Constructor(name) => - switch (err_status) { - | InHole(Common(NoType(FreeConstructor(_)))) => - Some(FreeVar(id, 0, name)) - | _ => Some(Constructor(name)) - } - | Let(p, def, body) => - let add_name: (option(string), DHExp.t) => DHExp.t = ( - name => - fun - | Fun(p, ty, e, _) => DHExp.Fun(p, ty, e, name) - | d => d - ); - let* dp = dhpat_of_upat(m, p); - let* ddef = dhexp_of_uexp(m, def); - let* dbody = dhexp_of_uexp(m, body); - let+ ty_body = fixed_exp_typ(m, body); - switch (Term.UPat.get_recursive_bindings(p)) { - | None => - /* not recursive */ - DHExp.Let(dp, add_name(Term.UPat.get_var(p), ddef), dbody) - | Some([f]) => - /* simple recursion */ - Let(dp, FixF(f, ty_body, add_name(Some(f), ddef)), dbody) - | Some(fs) => - /* mutual recursion */ - let ddef = - switch (ddef) { - | Tuple(a) => - DHExp.Tuple(List.map2(s => add_name(Some(s)), fs, a)) - | _ => ddef - }; - let uniq_id = List.nth(def.ids, 0); - let self_id = "__mutual__" ++ Id.to_string(uniq_id); - let self_var = DHExp.BoundVar(self_id); - let (_, substituted_def) = - fs - |> List.fold_left( - ((i, ddef), f) => { - let ddef = - Substitution.subst_var(DHExp.Prj(self_var, i), f, ddef); - (i + 1, ddef); - }, - (0, ddef), - ); - Let(dp, FixF(self_id, ty_body, substituted_def), dbody); - }; - | Ap(fn, arg) => - let* c_fn = dhexp_of_uexp(m, fn); - let+ c_arg = dhexp_of_uexp(m, arg); - DHExp.Ap(c_fn, c_arg); - | If(scrut, e1, e2) => - let* d_scrut = dhexp_of_uexp(m, scrut); - let* d1 = dhexp_of_uexp(m, e1); - let+ d2 = dhexp_of_uexp(m, e2); - let d_rules = - DHExp.[Rule(BoolLit(true), d1), Rule(BoolLit(false), d2)]; - let d = DHExp.Case(d_scrut, d_rules, 0); - switch (err_status) { - | InHole(Common(Inconsistent(Internal(_)))) => - DHExp.InconsistentBranches(id, 0, d) - | _ => ConsistentCase(d) - }; - | Match(scrut, rules) => - let* d_scrut = dhexp_of_uexp(m, scrut); - let+ d_rules = - List.map( - ((p, e)) => { - let* d_p = dhpat_of_upat(m, p); - let+ d_e = dhexp_of_uexp(m, e); - DHExp.Rule(d_p, d_e); - }, - rules, - ) - |> OptUtil.sequence; - let d = DHExp.Case(d_scrut, d_rules, 0); - switch (err_status) { - | InHole(Common(Inconsistent(Internal(_)))) => - DHExp.InconsistentBranches(id, 0, d) - | _ => ConsistentCase(d) - }; - | TyAlias(_, _, e) => dhexp_of_uexp(m, e) - }; - wrap(ctx, id, mode, self, d); - | Some(InfoPat(_) | InfoTyp(_) | InfoTPat(_)) - | None => None - }; -} -and dhpat_of_upat = (m: Statics.Map.t, upat: Term.UPat.t): option(DHPat.t) => { - let id = Term.UPat.rep_id(upat); /* NOTE: using term uids for hole ids */ - switch (Id.Map.find_opt(id, m)) { - | Some(InfoPat({mode, self, ctx, _})) => - let err_status = Info.status_pat(ctx, mode, self); - let maybe_reason: option(ErrStatus.HoleReason.t) = - switch (err_status) { - | NotInHole(_) => None - | InHole(_) => Some(TypeInconsistent) - }; - let wrap = (d: DHPat.t): option(DHPat.t) => - switch (maybe_reason) { - | None => Some(d) - | Some(reason) => Some(NonEmptyHole(reason, id, 0, d)) - }; - switch (upat.term) { - | Invalid(t) => Some(DHPat.InvalidText(id, 0, t)) - | EmptyHole => Some(EmptyHole(id, 0)) - | MultiHole(_) => - // TODO: dhexp, eval for multiholes - Some(EmptyHole(id, 0)) - | Wild => wrap(Wild) - | Bool(b) => wrap(BoolLit(b)) - | Int(n) => wrap(IntLit(n)) - | Float(n) => wrap(FloatLit(n)) - | String(s) => wrap(StringLit(s)) - | Triv => wrap(Tuple([])) - | ListLit(ps) => - let* ds = ps |> List.map(dhpat_of_upat(m)) |> OptUtil.sequence; - let* ty = fixed_pat_typ(m, upat); - let (ty', _) = Typ.matched_list(ctx, id, ty); - wrap(ListLit(ty', ds)); - | Constructor(name) => - switch (err_status) { - | InHole(Common(NoType(FreeConstructor(_)))) => - Some(BadConstructor(id, 0, name)) - | _ => wrap(Constructor(name)) - } - | Cons(hd, tl) => - let* d_hd = dhpat_of_upat(m, hd); - let* d_tl = dhpat_of_upat(m, tl); - wrap(Cons(d_hd, d_tl)); - | Tuple(ps) => - let* ds = ps |> List.map(dhpat_of_upat(m)) |> OptUtil.sequence; - wrap(DHPat.Tuple(ds)); - | Var(name) => Some(Var(name)) - | Parens(p) => dhpat_of_upat(m, p) - | Ap(p1, p2) => - let* d_p1 = dhpat_of_upat(m, p1); - let* d_p2 = dhpat_of_upat(m, p2); - wrap(Ap(d_p1, d_p2)); - | TypeAnn(p, _ty) => - let* dp = dhpat_of_upat(m, p); - wrap(dp); - }; - | Some(InfoExp(_) | InfoTyp(_) | InfoTPat(_)) - | None => None - }; -}; - -//let dhexp_of_uexp = Core.Memo.general(~cache_size_bound=1000, dhexp_of_uexp); - -let uexp_elab = (m: Statics.Map.t, uexp: Term.UExp.t): ElaborationResult.t => - switch (dhexp_of_uexp(m, uexp)) { - | None => DoesNotElaborate - | Some(d) => - //let d = uexp_elab_wrap_builtins(d); - let ty = - switch (fixed_exp_typ(m, uexp)) { - | Some(ty) => ty - | None => Typ.Unknown(NoProvenance) - }; - Elaborates(d, ty, Delta.empty); - }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index fbd0cceb75..e381e099a2 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -114,7 +114,8 @@ let subsumption_constraints = (mode: Mode.t, final_typ: Typ.t) => { let rec any_to_info_map = (~ctx: Ctx.t, ~ancestors, any: any, m: Map.t) - : (CoCtx.t, Map.t, Typ.constraints) => + : (CoCtx.t, Map.t, Typ.constraints) => { + print_endline("ECHOOOOO"); switch (any) { | Exp(e) => let (Info.{co_ctx, constraints, _}, m) = @@ -135,7 +136,8 @@ let rec any_to_info_map = | Rul(_) | Nul () | Any () => (VarMap.empty, m, []) - } + }; +} and multi = (~ctx, ~ancestors, m, tms): (list(CoCtx.t), Typ.constraints, Map.t) => List.fold_left( @@ -694,6 +696,9 @@ let mk_map_and_inference_solutions = Id.Map.empty, ); + print_endline("~~~Printing constraints:"); + info.constraints |> Typ.constraints_to_string |> print_endline; + // rewrite is here let ctx = Infer.Ctx.create(); let _ = diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index fbd0edada7..9d1f69266c 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -98,6 +98,8 @@ module rec Typ: { let typ_to_string: t => string; let typ_to_string_with_parens: (bool, t) => string; let contains_hole: t => bool; + let constraints_to_string: constraints => string; + let equivalence_to_string: equivalence => string; } = { [@deriving (show({with_path: false}), sexp, yojson)] type type_provenance = @@ -297,6 +299,17 @@ module rec Typ: { }; }; + let rec constraints_to_string = (constraints: constraints) => { + String.concat("\n", List.map(equivalence_to_string, constraints)); + } + and equivalence_to_string = (equivalence: equivalence) => { + let (a, b) = equivalence; + String.concat( + "", + ["(", Typ.typ_to_string(a), ", ", Typ.typ_to_string(b), ")"], + ); + }; + let rec free_vars = (~bound=[], ty: t): list(Var.t) => switch (ty) { | Unknown(_) From 6b60d728d44e754526821d0d61e55a4e77f49c25 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Tue, 14 Nov 2023 20:32:30 -0600 Subject: [PATCH 065/129] setup logging --- src/haz3lcore/inference/InferenceResult.re | 4 +- src/haz3lcore/statics/TypBase.re | 52 +++++++++++++++++----- src/haz3lweb/view/CursorInspector.re | 4 +- 3 files changed, 45 insertions(+), 15 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 21b361d4c0..b38a84761f 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -20,9 +20,9 @@ let get_suggestion_text_for_id = let status = Infer.get_status(global_inference_info.ctx, id); switch (status) { | Solved(Unknown(_)) => NoSuggestion(OnlyHoleSolutions) - | Solved(typ) => Solvable(typ |> Typ.typ_to_string) + | Solved(typ) => Solvable(Typ.typ_to_string(typ, false)) | Unsolved([]) => NoSuggestion(NonTypeHoleId) - | Unsolved([typ]) => NestedInconsistency(typ |> Typ.typ_to_string) + | Unsolved([typ]) => NestedInconsistency(Typ.typ_to_string(typ, false)) | Unsolved(_) => NoSuggestion(InconsistentSet) }; } else { diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 9d1f69266c..b42040911d 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -95,11 +95,13 @@ module rec Typ: { let sum_entry: (Constructor.t, sum_map) => option(sum_entry); let get_sum_constructors: (Ctx.t, t) => option(sum_map); let is_unknown: t => bool; - let typ_to_string: t => string; - let typ_to_string_with_parens: (bool, t) => string; + let typ_to_string: (t, bool) => string; + let typ_to_string_with_parens: (bool, t, bool) => string; let contains_hole: t => bool; let constraints_to_string: constraints => string; let equivalence_to_string: equivalence => string; + let prov_to_string: type_provenance => string; + let matched_prov_to_string: matched_provenance => string; } = { [@deriving (show({with_path: false}), sexp, yojson)] type type_provenance = @@ -265,32 +267,52 @@ module rec Typ: { }; }; - let rec typ_to_string = (ty: t): string => { - typ_to_string_with_parens(false, ty); + let rec prov_to_string = (prov: type_provenance): string => { + switch (prov) { + | NoProvenance => "" + | SynSwitch(id) => Id.to_string(id) + | AstNode(id) => Id.to_string(id) + | Free(var) => var + | Matched(mprov, type_provenance) => + matched_prov_to_string(mprov) ++ prov_to_string(type_provenance) + }; + } + and matched_prov_to_string = (mprov: matched_provenance): string => { + switch (mprov) { + | Matched_Arrow_Left => "M->L @" + | Matched_Arrow_Right => "M->R @" + | Matched_Prod_Left => "M*L @" + | Matched_Prod_Right => "M*R @" + | Matched_List => "M[] @" + }; + }; + + let rec typ_to_string = (ty: t, debug): string => { + typ_to_string_with_parens(false, ty, debug); } - and typ_to_string_with_parens = (is_left_child: bool, ty: t): string => { + and typ_to_string_with_parens = (is_left_child: bool, ty: t, debug): string => { //TODO: parens on ops when ambiguous let parenthesize_if_left_child = s => is_left_child ? "(" ++ s ++ ")" : s; switch (ty) { - | Unknown(_) => "?" + | Unknown(prov) => "?" ++ (debug ? prov_to_string(prov) : "") | Int => "Int" | Float => "Float" | String => "String" | Bool => "Bool" | Var(name) => name - | List(t) => "[" ++ typ_to_string(t) ++ "]" + | List(t) => "[" ++ typ_to_string(t, debug) ++ "]" | Arrow(t1, t2) => - typ_to_string_with_parens(true, t1) + typ_to_string_with_parens(true, t1, debug) ++ " -> " - ++ typ_to_string(t2) + ++ typ_to_string(t2, debug) |> parenthesize_if_left_child | Prod([]) => "Unit" | Prod([_]) => "BadProduct" | Prod([t0, ...ts]) => "(" ++ List.fold_left( - (acc, t) => acc ++ ", " ++ typ_to_string(t), - typ_to_string(t0), + (acc, t) => acc ++ ", " ++ typ_to_string(t, debug), + typ_to_string(t0, debug), ts, ) ++ ")" @@ -306,7 +328,13 @@ module rec Typ: { let (a, b) = equivalence; String.concat( "", - ["(", Typ.typ_to_string(a), ", ", Typ.typ_to_string(b), ")"], + [ + "(", + Typ.typ_to_string(a, true), + ", ", + Typ.typ_to_string(b, true), + ")", + ], ); }; diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index d8f873fbeb..772983ea53 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -115,7 +115,9 @@ let view_of_global_inference_info = if (!State.get_suggestion_pasted()) { State.set_suggestion_pasted(true); inject( - Update.Paste(Haz3lcore.Typ.typ_to_string(typ)), + Update.Paste( + Haz3lcore.Typ.typ_to_string(typ, false), + ), ); } else { inject(Update.Mouseup); From adf926ee8b9a6c954b067c903aaa96d5898305d5 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Tue, 14 Nov 2023 19:07:37 -0600 Subject: [PATCH 066/129] consider tuples conflicting if they have different arity --- src/haz3lcore/inference/Infer.re | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re index a12c411d85..70bd1b183a 100644 --- a/src/haz3lcore/inference/Infer.re +++ b/src/haz3lcore/inference/Infer.re @@ -111,8 +111,12 @@ and combine_if_similar = // Some(Sum(pts1, pts2)) None // TODO anand and raef: unimplemented | (Prod(tys1), Prod(tys2)) => - let tys = List.map2(merge(ctx), tys1, tys2); - Some(Prod(tys)); + if (List.length(tys1) != List.length(tys2)) { + None; + } else { + let tys = List.map2(merge(ctx), tys1, tys2); + Some(Prod(tys)); + } // different, doesn't combine | _ => None }; From 30442f051516d88eef1f57737d0a778adb517b4c Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Tue, 14 Nov 2023 19:27:51 -0600 Subject: [PATCH 067/129] fixed how unknown types are displayed --- src/haz3lcore/inference/Infer.re | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re index 70bd1b183a..54276919bc 100644 --- a/src/haz3lcore/inference/Infer.re +++ b/src/haz3lcore/inference/Infer.re @@ -137,7 +137,9 @@ type status = let unwrap_solution = (s: status): Typ.t => { switch (s) { | Solved(ty) => ty - | Unsolved(_) => Unknown(NoProvenance) + | Unsolved([]) => Unknown(NoProvenance) + | Unsolved([ty]) => ty + | Unsolved([_, ..._]) => Unknown(NoProvenance) }; }; From 7484d1724e489fa440cd72c9694b6cbcafb30d39 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Tue, 14 Nov 2023 19:30:34 -0600 Subject: [PATCH 068/129] added comments to clarify last change --- src/haz3lcore/inference/Infer.re | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re index 54276919bc..e28d123808 100644 --- a/src/haz3lcore/inference/Infer.re +++ b/src/haz3lcore/inference/Infer.re @@ -137,9 +137,9 @@ type status = let unwrap_solution = (s: status): Typ.t => { switch (s) { | Solved(ty) => ty - | Unsolved([]) => Unknown(NoProvenance) - | Unsolved([ty]) => ty - | Unsolved([_, ..._]) => Unknown(NoProvenance) + | Unsolved([]) => Unknown(NoProvenance) // underdetermined + | Unsolved([ty]) => ty // children are unsolved + | Unsolved([_, ..._]) => Unknown(NoProvenance) // overdetermined }; }; From a8bf67f7ded8ad6ed08389279ec8d238930a1ee4 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Tue, 14 Nov 2023 20:27:57 -0600 Subject: [PATCH 069/129] occurs check --- src/haz3lcore/inference/Infer.re | 39 +++++++++++++++++++++++++++----- 1 file changed, 33 insertions(+), 6 deletions(-) diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re index e28d123808..93de7bf368 100644 --- a/src/haz3lcore/inference/Infer.re +++ b/src/haz3lcore/inference/Infer.re @@ -58,13 +58,40 @@ and ptyp_of_typ = (ctx: Ctx.t, t: Typ.t): ptyp => { }; }; +// return true if pts1 contains pts2 +let rec contains = (pts1: pts, pts2: pts): bool => + if (UnionFind.eq(pts1, pts2)) { + true; + } else { + let pts1_tys = UnionFind.get(pts1); + List.exists(contains_helper(pts2), pts1_tys); + } +// return true if ptyp contains pts2 +and contains_helper = (pts2: pts, ptyp: ptyp): bool => { + switch (ptyp) { + | Int + | Float + | Bool + | String + | Var(_) => false + | List(pts1) => contains(pts1, pts2) + | Arrow(pts1, pts2) => contains(pts1, pts2) || contains(pts2, pts2) + | Sum(pts1, pts2) => contains(pts1, pts2) || contains(pts2, pts2) + | Prod(tys) => List.exists(contains(pts2), tys) + }; +}; + // merge two pts -let rec merge = (ctx: Ctx.t, pts1: pts, pts2: pts): pts => { - let pts3 = merge_helper(ctx, pts1, pts2); - let representative = UnionFind.union(pts1, pts2); - let _ = UnionFind.set(representative, pts3); - representative; -} +let rec merge = (ctx: Ctx.t, pts1: pts, pts2: pts): pts => + // TODO: if pts1 contains pts2 or vice versa, pick one arbitrarily and return it + if (contains(pts1, pts2) || contains(pts2, pts1)) { + pts1; + } else { + let pts3 = merge_helper(ctx, pts1, pts2); + let representative = UnionFind.union(pts1, pts2); + let _ = UnionFind.set(representative, pts3); + representative; + } and merge_helper = (ctx: Ctx.t, pts1: pts, pts2: pts): list(ptyp) => { let tys1 = UnionFind.get(pts1); let tys2 = UnionFind.get(pts2); From 3179e5ae976429a1c3281c367bd15f18145e920f Mon Sep 17 00:00:00 2001 From: RaefM Date: Tue, 5 Dec 2023 21:15:16 -0500 Subject: [PATCH 070/129] Fix a bunch of todos and missing constraints --- src/haz3lcore/inference/Infer.re | 60 +++++++++++++++++++++++--------- src/haz3lcore/statics/Statics.re | 21 ++++++----- src/haz3lcore/statics/TypBase.re | 27 +++++++------- 3 files changed, 70 insertions(+), 38 deletions(-) diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re index 93de7bf368..2dee5805ae 100644 --- a/src/haz3lcore/inference/Infer.re +++ b/src/haz3lcore/inference/Infer.re @@ -76,7 +76,7 @@ and contains_helper = (pts2: pts, ptyp: ptyp): bool => { | Var(_) => false | List(pts1) => contains(pts1, pts2) | Arrow(pts1, pts2) => contains(pts1, pts2) || contains(pts2, pts2) - | Sum(pts1, pts2) => contains(pts1, pts2) || contains(pts2, pts2) + | Sum(tys) => List.exists(contains(pts2), tys) | Prod(tys) => List.exists(contains(pts2), tys) }; }; @@ -132,11 +132,21 @@ and combine_if_similar = let pts1 = merge(ctx, pts1, pts3); let pts2 = merge(ctx, pts2, pts4); Some(Arrow(pts1, pts2)); - | (Sum(_), Sum(_)) => - // let pts1 = merge(ctx, pts1, pts3); - // let pts2 = merge(ctx, pts2, pts4); - // Some(Sum(pts1, pts2)) - None // TODO anand and raef: unimplemented + // for nary types, we're taking the approach of 'if the arity doesn't match, they are inconsistent + // this isn't true (eg ? * ? ~ ? * ? * ?) but proceeding as it they are consistent may just expose + // the programmer to more linked unknowns that they never really intended to be the same, leading to confusing suggestions. + // If they truly intend for them to be consistent, eventually they may change the program so that the arities match + // which would lead to further suggestions. + // A notable exception to this would be in currying- for arrow types, we DEFINITELY dont want this behavior + // but for products and sums, where the associativity is already often vague, it doesn't necessarily make sense to enforce one + // and derive constraints accordingly (not that it would be incorrect, but simply that it may not be the frame of reference the user is taking either) + | (Sum(tys1), Sum(tys2)) => + if (List.length(tys1) != List.length(tys2)) { + None; + } else { + let tys = List.map2(merge(ctx), tys1, tys2); + Some(Sum(tys)); + } | (Prod(tys1), Prod(tys2)) => if (List.length(tys1) != List.length(tys2)) { None; @@ -203,17 +213,33 @@ and get_status_ptyp = (ctx: Ctx.t, ptyp: ptyp): status => { | (Unsolved(_), Unsolved(_)) => Unsolved([Arrow(Unknown(NoProvenance), Unknown(NoProvenance))]) } - | Sum(_) => - // switch (get_status_pts(ctx, pts1), get_status_pts(ctx, pts2)) { - // | (Solved(ty1), Solved(ty2)) => Solved(Sum(ty1, ty2)) - // | (Solved(ty1), Unsolved(_)) => - // Unsolved([Sum(ty1, Unknown(NoProvenance))]) - // | (Unsolved(_), Solved(ty2)) => - // Unsolved([Sum(Unknown(NoProvenance), ty2)]) - // | (Unsolved(_), Unsolved(_)) => - // Unsolved([Sum(Unknown(NoProvenance), Unknown(NoProvenance))]) - // } - Unsolved([]) // TODO anand and raef: unimplemented + | Sum(tys_inner) => + let is_solved = (s: status): bool => { + switch (s) { + | Solved(_) => true + | Unsolved(_) => false + }; + }; + let force_unwrap_solution = (s: status): Typ.t => { + switch (s) { + | Solved(ty) => ty + | Unsolved(_) => failwith("unreachable") + }; + }; + let statuses = List.map(get_status_pts(ctx), tys_inner); + if (List.for_all(is_solved, statuses)) { + let tys3 = + statuses + |> List.map(force_unwrap_solution) + |> List.map(typ => ("", Some(typ))); // Makes all constructors the empty string! Prob a bad idea!! + Solved(Sum(tys3)); + } else { + let tys3 = + statuses + |> List.map(unwrap_solution) + |> List.map(typ => ("", Some(typ))); + Unsolved([Sum(tys3)]); + }; | Prod(tys_inner) => let is_solved = (s: status): bool => { switch (s) { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index e381e099a2..0ce46c1eeb 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -190,7 +190,6 @@ and uexp_to_info_map = ([], m), ); let go_pat = upat_to_info_map(~ctx, ~ancestors); - // TODO: add subsumption constraints let atomic = self => { let final_typ = switch (Self.typ_of(ctx, self)) { @@ -415,22 +414,27 @@ and uexp_to_info_map = | Some(sm) => Ctx.add_ctrs(ctx_body, name, UTyp.rep_id(utyp), sm) | None => ctx_body }; - let ({co_ctx, ty: ty_body, _}: Info.exp, m) = + let ( + {co_ctx, ty: ty_body, constraints: constraints_body, _}: Info.exp, + m, + ) = go'(~ctx=ctx_body, ~mode, body, m); /* Make sure types don't escape their scope */ let ty_escape = Typ.subst(ty_def, name, ty_body); let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; - //TODO anand: constraints? - add(~self=Just(ty_escape), ~constraints=[], ~co_ctx, m); + //TODO anand: typ aliases- should they generate new constraints too? + add(~self=Just(ty_escape), ~constraints=constraints_body, ~co_ctx, m); | Var(_) | Invalid(_) | EmptyHole | MultiHole(_) => - let ({co_ctx, ty: ty_body, _}: Info.exp, m) = + let ( + {co_ctx, ty: ty_body, constraints: constraints_body, _}: Info.exp, + m, + ) = go'(~ctx, ~mode, body, m); let m = utyp_to_info_map(~ctx, ~ancestors, utyp, m) |> snd; - //TODO anand: constraints? - add(~self=Just(ty_body), ~constraints=[], ~co_ctx, m); + add(~self=Just(ty_body), ~constraints=constraints_body, ~co_ctx, m); }; }; } @@ -567,8 +571,7 @@ and upat_to_info_map = | TypeAnn(p, ann) => let (ann, m) = utyp_to_info_map(~ctx, ~ancestors, ann, m); let (p, m) = go(~ctx, ~mode=Ana(ann.ty), p, m); - //TODO anand: constraints? - add(~self=Just(ann.ty), ~ctx=p.ctx, ~constraints=[], m); + add(~self=Just(ann.ty), ~ctx=p.ctx, ~constraints=p.constraints, m); }; } and utyp_to_info_map = diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index b42040911d..77252187ba 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -37,8 +37,7 @@ module rec Typ: { and matched_provenance = | Matched_Arrow_Left | Matched_Arrow_Right - | Matched_Prod_Left - | Matched_Prod_Right + | Matched_Prod_N(int) | Matched_List; /* TYP.T: Hazel types */ @@ -75,6 +74,7 @@ module rec Typ: { }; // TODO: anand and raef; change t, Id.t sigs to source (see above) + // TODO: anand and raef; figure out where the equivalent of matched sum is called and add constraints to it let of_source: list(source) => list(t); let join_type_provenance: (type_provenance, type_provenance) => type_provenance; @@ -113,9 +113,7 @@ module rec Typ: { and matched_provenance = | Matched_Arrow_Left | Matched_Arrow_Right - // TODO: anand and raef make this be of index and not LR - | Matched_Prod_Left - | Matched_Prod_Right + | Matched_Prod_N(int) | Matched_List; /* TYP.T: Hazel types */ @@ -281,8 +279,7 @@ module rec Typ: { switch (mprov) { | Matched_Arrow_Left => "M->L @" | Matched_Arrow_Right => "M->R @" - | Matched_Prod_Left => "M*L @" - | Matched_Prod_Right => "M*R @" + | Matched_Prod_N(n) => "M* " ++ string_of_int(n) | Matched_List => "M[] @" }; }; @@ -517,6 +514,9 @@ module rec Typ: { }; }; + // Todo: anand and raef: everywhere behavior is conditioned meaningfully on synswitch instead needs to make + // a recursive check in the case of match to see if it is rooted at synswitch + let matched_arrow = (ctx: Ctx.t, termId: Id.t, ty: t): ((t, t), Typ.constraints) => { let matched_arrow_of_prov = prov => { @@ -531,13 +531,12 @@ module rec Typ: { }; switch (weak_head_normalize(ctx, ty)) { | Arrow(ty_in, ty_out) => ((ty_in, ty_out), []) - | Unknown(SynSwitch(_) as p) => matched_arrow_of_prov(p) | Unknown(prov) => matched_arrow_of_prov(prov) | _ => matched_arrow_of_prov(AstNode(termId)) }; }; - let matched_prod = (ctx: Ctx.t, length, _termId: Id.t, ty: t) => { + let matched_prod = (ctx: Ctx.t, length, termId: Id.t, ty: t) => { // let matched_prod_of_prov = prov => { // let (prod_lhs, prod_rhs) = ( // Unknown(Matched(Matched_Prod_Left, prov)), @@ -548,10 +547,15 @@ module rec Typ: { // [(Unknown(prov), Prod([prod_lhs, prod_rhs]))] // TODO anand: this is not right. // ); // }; + let matched_prod_of_prov = prov => { + let matched_prod_typs = + List.init(length, n => Unknown(Matched(Matched_Prod_N(n), prov))); + (matched_prod_typs, [(Unknown(prov), Prod(matched_prod_typs))]); + }; switch (weak_head_normalize(ctx, ty)) { | Prod(tys) when List.length(tys) == length => (tys, []) - | Unknown(SynSwitch(_) as p) => (List.init(length, _ => Unknown(p)), []) - | _ => (List.init(length, _ => Unknown(NoProvenance)), []) + | Unknown(prov) => matched_prod_of_prov(prov) + | _ => matched_prod_of_prov(AstNode(termId)) }; }; @@ -562,7 +566,6 @@ module rec Typ: { }; switch (ty) { | List(ty) => (ty, []) - | Unknown(SynSwitch(_) as p) => (Unknown(p), []) // TODO anand: return constraints here | Unknown(prov) => matched_list_of_prov(prov) | _ => matched_list_of_prov(AstNode(termId)) }; From 9a78e945777fbea5f592ed5643fe559150296eba Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Sun, 10 Dec 2023 20:13:41 -0600 Subject: [PATCH 071/129] changed grout width back to 1 for inference suggestions --- src/haz3lcore/Measured.re | 16 +- src/haz3lcore/zipper/Editor.re | 2 +- src/haz3lweb/view/Code.re | 6 +- src/haz3lweb/www/style.css | 322 +++++++++++++++++++++++++-------- 4 files changed, 255 insertions(+), 91 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index ec028fa1d0..ea5341af7d 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -271,7 +271,7 @@ let of_segment = ( ~old: t=empty, ~touched=Touched.empty, - ~global_inference_info=InferenceResult.empty_info(), + ~_global_inference_info=InferenceResult.empty_info(), seg: Segment.t, ) : t => { @@ -363,19 +363,7 @@ let of_segment = let map = map |> add_w(w, {origin, last}); (contained_indent, last, map); | Grout(g) => - let annotation_offset = - switch ( - InferenceResult.get_suggestion_text_for_id( - g.id, - global_inference_info, - ) - ) { - | Solvable(suggestion_string) - | NestedInconsistency(suggestion_string) => - String.length(suggestion_string) - | NoSuggestion(_) => 1 - }; - + let annotation_offset = 1; let last = {...origin, col: origin.col + annotation_offset}; let map = map |> add_g(g, {origin, last}); (contained_indent, last, map); diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index f416379896..6ff270f0a8 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -59,7 +59,7 @@ module Meta = { Measured.of_segment( ~touched, ~old=measured, - ~global_inference_info= + ~_global_inference_info= InferenceResult.mk_global_inference_info(inference_enabled, ctx), unselected, ); diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 4a55695c2b..793bae8efe 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -46,9 +46,9 @@ let of_grout = | NoSuggestion(SuggestionsDisabled) | NoSuggestion(NonTypeHoleId) | NoSuggestion(OnlyHoleSolutions) => [Node.text(Unicode.nbsp)] - | Solvable(suggestion_node) - | NestedInconsistency(suggestion_node) => [ - [suggestion_node] |> span_c("solved-annotation"), + | Solvable(_suggestion_node) + | NestedInconsistency(_suggestion_node) => [ + [Node.text("@")] |> span_c("solved-annotation"), ] | NoSuggestion(InconsistentSet) => [ [Node.text("!")] |> span_c("unsolved-annotation"), diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index 6212f5326d..d668eff776 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -150,7 +150,7 @@ --caret-position-z: 13; --current-caret-pos-z: 15; --caret-z: 14; - --docs-highlight-z:8; + --docs-highlight-z: 8; --type-inspector-z: 14; --top-bar-z: 15; @@ -384,7 +384,8 @@ select { #top-bar .menu-icon { width: 2.75em; - min-width: 2.75em; /* Seems to be necessary at high zooms? */ + min-width: 2.75em; + /* Seems to be necessary at high zooms? */ height: 2.75em; display: flex; justify-content: center; @@ -475,7 +476,7 @@ select { background-color: #99854a; } -#top-bar #editor-mode .mode-name{ +#top-bar #editor-mode .mode-name { border-radius: 0.4em 1em 1em 0.4em; padding: 0 0.5em 0 0.5em; background-color: #a69460; @@ -751,7 +752,7 @@ select { /* INFERENCE ANNOTATIONS */ .solved-annotation { - color: rgb(178, 178, 178); + color: rgb(23, 208, 23); } .unsolved-annotation { @@ -824,69 +825,229 @@ svg.tile-selected { /* TOKEN COLORS */ -.code .token.Nul { color: var(--nul-text-color); } -.code .token.Any { color: var(--any-text-color); } -.code .token.Exp { color: var(--exp-text-color); } -.code .token.Pat { color: var(--pat-text-color); } -.code .token.Typ { color: var(--typ-text-color); } -.code .token.Rul { color: var(--rul-text-color); } -.code .token.TPat { color: var(--tpat-text-color); } - -.tile-path.Nul { filter: url(#drop-shadow-Nul); } -.tile-path.Any { filter: url(#drop-shadow-Any); } -.tile-path.Exp { filter: url(#drop-shadow-Exp); } -.tile-path.Pat { filter: url(#drop-shadow-Pat); } -.tile-path.Typ { filter: url(#drop-shadow-Typ); } -.tile-path.Rul { filter: url(#drop-shadow-Rul); } -.tile-path.TPat { filter: url(#drop-shadow-TPat); } - -.tile-path.Nul.indicated { fill: var(--nul-bg-color); } -.tile-path.Any.indicated { fill: var(--any-bg-color); } -.tile-path.Exp.indicated { fill: var(--exp-bg-color); } -.tile-path.Pat.indicated { fill: var(--pat-bg-off-color); } -.tile-path.Typ.indicated { fill: var(--typ-bg-off-color); } -.tile-path.Rul.indicated { fill: var(--rul-bg-color); } -.tile-path.TPat.indicated { fill: var(--tpat-bg-off-color); } - -.tile-path.Nul.indicated-caret { fill: var(--nul-bg-color); } -.tile-path.Any.indicated-caret { fill: var(--any-bg-color); } -.tile-path.Exp.indicated-caret { fill: var(--exp-bg-off-color); } -.tile-path.Pat.indicated-caret { fill: var(--pat-bg-color); } -.tile-path.Typ.indicated-caret { fill: var(--typ-bg-color); } -.tile-path.Rul.indicated-caret { fill: var(--rul-bg-color); } -.tile-path.TPat.indicated-caret { fill: var(--tpat-bg-color); } - -.tile-path.Nul.raised { filter: url(#raised-drop-shadow-Nul); } -.tile-path.Any.raised { filter: url(#raised-drop-shadow-Any); } -.tile-path.Exp.raised { filter: url(#raised-drop-shadow-Exp); } -.tile-path.Pat.raised { filter: url(#raised-drop-shadow-Pat); } -.tile-path.Typ.raised { filter: url(#raised-drop-shadow-Typ); } -.tile-path.Rul.raised { filter: url(#raised-drop-shadow-Rul); } -.tile-path.TPat.raised { filter: url(#raised-drop-shadow-TPat); } - -.child-line.Nul { stroke: var(--nul-shadow-color); } -.child-line.Any { stroke: var(--any-shadow-color); } -.child-line.Exp { stroke: var(--exp-shadow-color); } -.child-line.Pat { stroke: var(--pat-shadow-color); } -.child-line.Typ { stroke: var(--typ-shadow-color); } -.child-line.Rul { stroke: var(--rul-shadow-color); } -.child-line.TPat { stroke: var(--tpat-shadow-color); } - -#drop-shadow-Nul .tile-drop-shadow { flood-color: var(--nul-shadow-color); } -#drop-shadow-Any .tile-drop-shadow { flood-color: var(--any-shadow-color); } -#drop-shadow-Exp .tile-drop-shadow { flood-color: var(--exp-shadow-color); } -#drop-shadow-Pat .tile-drop-shadow { flood-color: var(--pat-shadow-color); } -#drop-shadow-Typ .tile-drop-shadow { flood-color: var(--typ-shadow-color); } -#drop-shadow-Rul .tile-drop-shadow { flood-color: var(--rul-shadow-color); } -#drop-shadow-TPat .tile-drop-shadow { flood-color: var(--tpat-shadow-color); } - -#raised-drop-shadow-Nul .tile-drop-shadow { flood-color: var(--nul-shadow-color); } -#raised-drop-shadow-Any .tile-drop-shadow { flood-color: var(--any-shadow-color); } -#raised-drop-shadow-Exp .tile-drop-shadow { flood-color: var(--exp-shadow-color); } -#raised-drop-shadow-Pat .tile-drop-shadow { flood-color: var(--pat-shadow-color); } -#raised-drop-shadow-Typ .tile-drop-shadow { flood-color: var(--typ-shadow-color); } -#raised-drop-shadow-Rul .tile-drop-shadow { flood-color: var(--rul-shadow-color); } -#raised-drop-shadow-TPat .tile-drop-shadow { flood-color: var(--tpat-shadow-color); } +.code .token.Nul { + color: var(--nul-text-color); +} + +.code .token.Any { + color: var(--any-text-color); +} + +.code .token.Exp { + color: var(--exp-text-color); +} + +.code .token.Pat { + color: var(--pat-text-color); +} + +.code .token.Typ { + color: var(--typ-text-color); +} + +.code .token.Rul { + color: var(--rul-text-color); +} + +.code .token.TPat { + color: var(--tpat-text-color); +} + +.tile-path.Nul { + filter: url(#drop-shadow-Nul); +} + +.tile-path.Any { + filter: url(#drop-shadow-Any); +} + +.tile-path.Exp { + filter: url(#drop-shadow-Exp); +} + +.tile-path.Pat { + filter: url(#drop-shadow-Pat); +} + +.tile-path.Typ { + filter: url(#drop-shadow-Typ); +} + +.tile-path.Rul { + filter: url(#drop-shadow-Rul); +} + +.tile-path.TPat { + filter: url(#drop-shadow-TPat); +} + +.tile-path.Nul.indicated { + fill: var(--nul-bg-color); +} + +.tile-path.Any.indicated { + fill: var(--any-bg-color); +} + +.tile-path.Exp.indicated { + fill: var(--exp-bg-color); +} + +.tile-path.Pat.indicated { + fill: var(--pat-bg-off-color); +} + +.tile-path.Typ.indicated { + fill: var(--typ-bg-off-color); +} + +.tile-path.Rul.indicated { + fill: var(--rul-bg-color); +} + +.tile-path.TPat.indicated { + fill: var(--tpat-bg-off-color); +} + +.tile-path.Nul.indicated-caret { + fill: var(--nul-bg-color); +} + +.tile-path.Any.indicated-caret { + fill: var(--any-bg-color); +} + +.tile-path.Exp.indicated-caret { + fill: var(--exp-bg-off-color); +} + +.tile-path.Pat.indicated-caret { + fill: var(--pat-bg-color); +} + +.tile-path.Typ.indicated-caret { + fill: var(--typ-bg-color); +} + +.tile-path.Rul.indicated-caret { + fill: var(--rul-bg-color); +} + +.tile-path.TPat.indicated-caret { + fill: var(--tpat-bg-color); +} + +.tile-path.Nul.raised { + filter: url(#raised-drop-shadow-Nul); +} + +.tile-path.Any.raised { + filter: url(#raised-drop-shadow-Any); +} + +.tile-path.Exp.raised { + filter: url(#raised-drop-shadow-Exp); +} + +.tile-path.Pat.raised { + filter: url(#raised-drop-shadow-Pat); +} + +.tile-path.Typ.raised { + filter: url(#raised-drop-shadow-Typ); +} + +.tile-path.Rul.raised { + filter: url(#raised-drop-shadow-Rul); +} + +.tile-path.TPat.raised { + filter: url(#raised-drop-shadow-TPat); +} + +.child-line.Nul { + stroke: var(--nul-shadow-color); +} + +.child-line.Any { + stroke: var(--any-shadow-color); +} + +.child-line.Exp { + stroke: var(--exp-shadow-color); +} + +.child-line.Pat { + stroke: var(--pat-shadow-color); +} + +.child-line.Typ { + stroke: var(--typ-shadow-color); +} + +.child-line.Rul { + stroke: var(--rul-shadow-color); +} + +.child-line.TPat { + stroke: var(--tpat-shadow-color); +} + +#drop-shadow-Nul .tile-drop-shadow { + flood-color: var(--nul-shadow-color); +} + +#drop-shadow-Any .tile-drop-shadow { + flood-color: var(--any-shadow-color); +} + +#drop-shadow-Exp .tile-drop-shadow { + flood-color: var(--exp-shadow-color); +} + +#drop-shadow-Pat .tile-drop-shadow { + flood-color: var(--pat-shadow-color); +} + +#drop-shadow-Typ .tile-drop-shadow { + flood-color: var(--typ-shadow-color); +} + +#drop-shadow-Rul .tile-drop-shadow { + flood-color: var(--rul-shadow-color); +} + +#drop-shadow-TPat .tile-drop-shadow { + flood-color: var(--tpat-shadow-color); +} + +#raised-drop-shadow-Nul .tile-drop-shadow { + flood-color: var(--nul-shadow-color); +} + +#raised-drop-shadow-Any .tile-drop-shadow { + flood-color: var(--any-shadow-color); +} + +#raised-drop-shadow-Exp .tile-drop-shadow { + flood-color: var(--exp-shadow-color); +} + +#raised-drop-shadow-Pat .tile-drop-shadow { + flood-color: var(--pat-shadow-color); +} + +#raised-drop-shadow-Typ .tile-drop-shadow { + flood-color: var(--typ-shadow-color); +} + +#raised-drop-shadow-Rul .tile-drop-shadow { + flood-color: var(--rul-shadow-color); +} + +#raised-drop-shadow-TPat .tile-drop-shadow { + flood-color: var(--tpat-shadow-color); +} /* OTHER SORT COLORS */ @@ -894,26 +1055,32 @@ svg.tile-selected { background-color: var(--nul-bg-color); color: var(--nul-off-color); } + .ci-header.Any { background-color: var(--any-bg-color); color: var(--any-off-color); } + .ci-header.Exp { background-color: var(--exp-bg-color); color: var(--exp-off-color); } + .ci-header.Pat { background-color: var(--pat-bg-color); color: var(--pat-off-color); } + .ci-header.Typ { background-color: var(--typ-bg-color); color: var(--typ-off-color); } + .ci-header.Rul { background-color: var(--rul-bg-color); color: var(--rul-off-color); } + .ci-header.TPat { background-color: var(--tpat-bg-color); color: var(--tpat-off-color); @@ -925,11 +1092,13 @@ svg.tile-selected { stroke: var(--exp-text-color); fill: var(--exp-text-color); } + .caret-position-path.Pat.sibling, .caret-position-path.Pat.inner-cousin { stroke: var(--pat-text-color); fill: var(--pat-text-color); } + .caret-position-path.Typ.sibling, .caret-position-path.Typ.inner-cousin { stroke: var(--typ-text-color); @@ -942,11 +1111,13 @@ svg.tile-selected { stroke: var(--exp-shadow-color); fill: var(--exp-shadow-color); } + .caret-position-path.Pat.anchor, .caret-position-path.Pat.current-caret-pos { stroke: var(--pat-text-color); fill: var(--pat-text-color); } + .caret-position-path.Typ.anchor, .caret-position-path.Typ.current-caret-pos { stroke: var(--typ-text-color); @@ -1103,6 +1274,7 @@ svg.tile-selected { /* to advertise provenance display on-hover */ cursor: help; } + .typ-alias-view { color: var(--tpat-text-color); display: flex; @@ -1153,7 +1325,7 @@ svg.tile-selected { border-color: var(--err-color); } -.cursor-inspector .gamma:hover + .context-inspector, +.cursor-inspector .gamma:hover+.context-inspector, .context-inspector.visible { display: flex; } @@ -1211,8 +1383,11 @@ svg.tile-selected { scrollbar-color: #c7b480 #e4d6a6; scrollbar-width: thin; } + @supports (-moz-appearance:none) { - .context-inspector { scroll-snap-type: y mandatory; } + .context-inspector { + scroll-snap-type: y mandatory; + } } .context-inspector::-webkit-scrollbar { @@ -1247,7 +1422,7 @@ svg.tile-selected { border-bottom: 0.5px solid rgb(51 36 11); } -.context-entry .name{ +.context-entry .name { cursor: pointer; } @@ -1294,7 +1469,8 @@ svg.tile-selected { .bottom-bar .id-and-class .syntax-class { color: var(--top_bar_icon_fill); - color: #392f10; /*#fdf6e3;*/ + color: #392f10; + /*#fdf6e3;*/ } .bottom-bar .id-and-class .id { @@ -1355,7 +1531,7 @@ svg.tile-selected { flex-direction: column; } -.lang-doc .example + .example { +.lang-doc .example+.example { border-top: 1px dotted #c7b480; padding-top: 0.6em; } @@ -1986,4 +2162,4 @@ svg.expandable path { height: 1em; top: -1em; left: -1em; -} +} \ No newline at end of file From bdacad67276669b9f5788ffd6f5fbe0cef744c20 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Sun, 10 Dec 2023 20:18:38 -0600 Subject: [PATCH 072/129] added labels for more clarity --- src/haz3lweb/view/CursorInspector.re | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 772983ea53..6442cef3b9 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -106,11 +106,11 @@ let view_of_global_inference_info = [ Widgets.hoverable_button( [Type.view(~font_metrics, typ)], - _mouse_event => { + _off_hover => { State.set_considering_suggestion(false); inject(Update.Mouseup); }, - _mouse_event => { + _on_hover => { State.set_considering_suggestion(true); if (!State.get_suggestion_pasted()) { State.set_suggestion_pasted(true); @@ -123,7 +123,7 @@ let view_of_global_inference_info = inject(Update.Mouseup); }; }, - _mouse_event => + _on_click => if (State.get_considering_suggestion()) { State.set_suggestion_pasted(false); State.set_considering_suggestion(false); From 9d17cf22e1d113f09ef930c3faa2f77eb7f09aa6 Mon Sep 17 00:00:00 2001 From: Anand Dukkipati Date: Sun, 10 Dec 2023 21:59:22 -0600 Subject: [PATCH 073/129] fixed some compiler errors, more to go... --- src/haz3lcore/assistant/AssistantCtx.re | 34 ++++++++++++++----- src/haz3lcore/assistant/AssistantForms.re | 6 ++-- src/haz3lcore/statics/CoCtx.re | 4 +-- src/haz3lcore/statics/Mode.re | 6 ++++ src/haz3lcore/statics/Statics.re | 15 +++++--- src/haz3lweb/Keyboard.re | 2 +- src/haz3lweb/Update.re | 2 +- src/haz3lweb/view/Code.re | 6 ++-- src/haz3lweb/view/CursorInspector.re | 6 ++-- .../view/assistant/UpdateAssistant.re | 8 +++-- 10 files changed, 60 insertions(+), 29 deletions(-) diff --git a/src/haz3lcore/assistant/AssistantCtx.re b/src/haz3lcore/assistant/AssistantCtx.re index 1697229700..93e37db432 100644 --- a/src/haz3lcore/assistant/AssistantCtx.re +++ b/src/haz3lcore/assistant/AssistantCtx.re @@ -92,14 +92,30 @@ let suggest_variable = (ci: Info.t): list(Suggestion.t) => { let ctx = Info.ctx_of(ci); switch (ci) { | InfoExp({mode, _}) => - bound_variables(Mode.ty_of(mode), ctx) - @ bound_aps(Mode.ty_of(mode), ctx) - @ bound_constructors(x => Exp(Common(x)), Mode.ty_of(mode), ctx) - @ bound_constructor_aps(x => Exp(Common(x)), Mode.ty_of(mode), ctx) + bound_variables(Mode.assistant_ty_of(mode), ctx) + @ bound_aps(Mode.assistant_ty_of(mode), ctx) + @ bound_constructors( + x => Exp(Common(x)), + Mode.assistant_ty_of(mode), + ctx, + ) + @ bound_constructor_aps( + x => Exp(Common(x)), + Mode.assistant_ty_of(mode), + ctx, + ) | InfoPat({mode, co_ctx, _}) => - free_variables(Mode.ty_of(mode), ctx, co_ctx) - @ bound_constructors(x => Pat(Common(x)), Mode.ty_of(mode), ctx) - @ bound_constructor_aps(x => Pat(Common(x)), Mode.ty_of(mode), ctx) + free_variables(Mode.assistant_ty_of(mode), ctx, co_ctx) + @ bound_constructors( + x => Pat(Common(x)), + Mode.assistant_ty_of(mode), + ctx, + ) + @ bound_constructor_aps( + x => Pat(Common(x)), + Mode.assistant_ty_of(mode), + ctx, + ) | InfoTyp(_) => typ_context_entries(ctx) | _ => [] }; @@ -141,7 +157,7 @@ let suggest_lookahead_variable = (ci: Info.t): list(Suggestion.t) => { let exp_aps = ty => bound_aps(ty, ctx) @ bound_constructor_aps(x => Exp(Common(x)), ty, ctx); - switch (Mode.ty_of(mode)) { + switch (Mode.assistant_ty_of(mode)) { | List(ty) => List.map(restrategize(" )::"), exp_aps(ty)) @ List.map(restrategize("::"), exp_refs(ty)) @@ -165,7 +181,7 @@ let suggest_lookahead_variable = (ci: Info.t): list(Suggestion.t) => { free_variables(ty, ctx, co_ctx) @ bound_constructors(x => Pat(Common(x)), ty, ctx); let pat_aps = ty => bound_constructor_aps(x => Pat(Common(x)), ty, ctx); - switch (Mode.ty_of(mode)) { + switch (Mode.assistant_ty_of(mode)) { | List(ty) => List.map(restrategize(" )::"), pat_aps(ty)) @ List.map(restrategize("::"), pat_refs(ty)) diff --git a/src/haz3lcore/assistant/AssistantForms.re b/src/haz3lcore/assistant/AssistantForms.re index b9fb8bffa8..0aa68c0c74 100644 --- a/src/haz3lcore/assistant/AssistantForms.re +++ b/src/haz3lcore/assistant/AssistantForms.re @@ -11,7 +11,7 @@ let leading_expander = " " ++ AssistantExpander.c; * running Statics, but for now, new forms e.g. operators must be added * below manually. */ module Typ = { - let unk: Typ.t = Unknown(Internal); + let unk: Typ.t = Unknown(NoProvenance); let of_const_mono_delim: list((Token.t, Typ.t)) = [ ("true", Bool), @@ -70,8 +70,8 @@ module Typ = { let expected: Info.t => Typ.t = fun | InfoExp({mode, _}) - | InfoPat({mode, _}) => Mode.ty_of(mode) - | _ => Unknown(Internal); + | InfoPat({mode, _}) => Mode.assistant_ty_of(mode) + | _ => Unknown(NoProvenance); let filter_by = ( diff --git a/src/haz3lcore/statics/CoCtx.re b/src/haz3lcore/statics/CoCtx.re index f25981c622..92c6c37d5b 100644 --- a/src/haz3lcore/statics/CoCtx.re +++ b/src/haz3lcore/statics/CoCtx.re @@ -63,8 +63,8 @@ let singleton = (name, id, expected_ty): t => [ let join: (Ctx.t, list(entry)) => Typ.t = (ctx, entries) => { let expected_tys = List.map(entry => entry.expected_ty, entries); - switch (Typ.join_all(~empty=Unknown(Internal), ctx, expected_tys)) { - | None => Unknown(Internal) + switch (Typ.join_all(~empty=Unknown(NoProvenance), ctx, expected_tys)) { + | None => Unknown(NoProvenance) | Some(ty) => ty }; }; diff --git a/src/haz3lcore/statics/Mode.re b/src/haz3lcore/statics/Mode.re index d0a27aa519..486dbf89fe 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -36,6 +36,12 @@ let ty_of = (ctx: Ctx.t, t: t, id: Id.t): (Typ.t, Typ.constraints) => (Arrow(ty_l, ty_r), constraints); }; +let assistant_ty_of: t => Typ.t = + fun + | Ana(ty) => ty + | Syn => Unknown(NoProvenance) + | SynFun => Arrow(Unknown(NoProvenance), Unknown(NoProvenance)); + let of_arrow = (ctx: Ctx.t, mode: t, termId: Id.t): ((t, t), Typ.constraints) => switch (mode) { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 534b76d582..b492e1c900 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -130,8 +130,7 @@ let rec any_to_info_map = ~ctx, p, m, - ) - |> snd; + ); (CoCtx.empty, m, constraints); | TPat(tp) => ( CoCtx.empty, @@ -502,10 +501,18 @@ and upat_to_info_map = : (Info.pat, Map.t) => { let id = UPat.rep_id(upat); let add = (~self, ~ctx, ~constraints, m) => { + let wrap_fn = (wrap: Self.join_type) => + switch (wrap) { + | Id => (x => x) + | List => (x => Typ.List(x)) + }; let joined_constraints = switch ((self: Self.t)) { - | NoJoin(wrap, sources) => - sources |> Typ.of_source |> List.map(wrap) |> join_constraints + | NoJoin(wrap_ty, sources) => + sources + |> Typ.of_source + |> List.map(wrap_fn(wrap_ty)) + |> join_constraints | _ => [] }; let info = diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 536d96a192..9560b03f49 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -5,7 +5,7 @@ let is_digit = s => Re.Str.(string_match(regexp("^[0-9]$"), s, 0)); let is_f_key = s => Re.Str.(string_match(regexp("^F[0-9][0-9]*$"), s, 0)); let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { - let zipper = Editors.get_zipper(model.editors); + let zipper = Editors.active_zipper(model.editors); let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); let (_, ctx) = Statics.mk_map_and_inference_solutions(term); diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index 821ba9a91e..3b7fd43d80 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -480,7 +480,7 @@ let rec apply = | None => Error(CantPaste) | Some(z) => //HACK(andrew): below is not strictly a insert action... - let ed = Haz3lcore.Editor.new_state(Insert(clipboard), z, ed); + let ed = Haz3lcore.Editor.new_state(Insert(clipboard), z, ed, false); let editors = Editors.put_editor(ed, model.editors); Ok({...model, editors}); }; diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 5d2e52eb9b..d049e64a8e 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -101,7 +101,7 @@ let piece_hash: Sort.t, Piece.t, int, - ModelSettings.t, + Settings.t, FontMetrics.t, InferenceResult.global_inference_info, ), @@ -278,7 +278,7 @@ let simple_view = ~map, ~font_metrics, ~global_inference_info, - ~settings: ModelSettings.t, + ~settings: Settings.t, ) : Node.t => { module Text = @@ -331,7 +331,7 @@ let view = unselected, ); let holes = - holes(~font_metrics, ~global_inference_info, map = measured, segment); + holes(~font_metrics, ~global_inference_info, ~map=measured, segment); div( ~attr=Attr.class_("code"), [span_c("code-text", unselected), ...holes], diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 6a729340e5..86a1071996 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -108,7 +108,7 @@ let view_of_global_inference_info = [Type.view(~font_metrics, typ)], _off_hover => { State.set_considering_suggestion(false); - inject(Update.Mouseup); + inject(Update.SetMeta(Mouseup)); }, _on_hover => { State.set_considering_suggestion(true); @@ -120,7 +120,7 @@ let view_of_global_inference_info = ), ); } else { - inject(Update.Mouseup); + inject(Update.SetMeta(Mouseup)); }; }, _on_click => @@ -129,7 +129,7 @@ let view_of_global_inference_info = State.set_considering_suggestion(false); inject(Update.Undo); } else { - inject(Update.Mouseup); + inject(Update.SetMeta(Mouseup)); }, ), ], diff --git a/src/haz3lweb/view/assistant/UpdateAssistant.re b/src/haz3lweb/view/assistant/UpdateAssistant.re index 3370ab03f6..2b25043d9f 100644 --- a/src/haz3lweb/view/assistant/UpdateAssistant.re +++ b/src/haz3lweb/view/assistant/UpdateAssistant.re @@ -4,7 +4,9 @@ include UpdateAction; /* NOTE: this is duplicated from Update */ let perform_action = (model: Model.t, a: Action.t): Result.t(Model.t) => { let ed_init = Editors.get_editor(model.editors); - switch (Haz3lcore.Perform.go(~settings=model.settings.core, a, ed_init)) { + switch ( + Haz3lcore.Perform.go(~settings=model.settings.core, a, ed_init, false) + ) { | Error(err) => Error(FailedToPerform(err)) | Ok(ed) => Ok({...model, editors: Editors.put_editor(ed, model.editors)}) }; @@ -18,7 +20,7 @@ let reset_buffer = (model: Model.t) => { switch (Perform.go_z(~settings=model.settings.core, Destruct(Left), z)) { | Error(_) => model | Ok(z) => - let ed = Editor.new_state(Destruct(Left), z, ed); + let ed = Editor.new_state(Destruct(Left), z, ed, false); //TODO(andrew): fix double action {...model, editors: Editors.put_editor(ed, model.editors)}; } @@ -43,7 +45,7 @@ let apply = switch (TyDi.set_buffer(~settings=settings.core, ~ctx=ctx_init, z)) { | None => Ok(model) | Some(z) => - let ed = Editor.new_state(Pick_up, z, editor); + let ed = Editor.new_state(Pick_up, z, editor, false); //TODO: add correct action to history (Pick_up is wrong) let editors = Editors.put_editor(ed, model.editors); Ok({...model, editors}); From 6a4bdc9dfb51e99b8ceb098a4b0d418100c8513a Mon Sep 17 00:00:00 2001 From: RaefM Date: Mon, 18 Dec 2023 19:33:24 -0500 Subject: [PATCH 074/129] fix build failures after latest merge --- src/haz3lcore/dynamics/PatternMatch.re | 10 +++--- src/haz3lcore/dynamics/Transition.re | 8 ++--- src/haz3lweb/Keyboard.re | 8 ++--- src/haz3lweb/Main.re | 11 ++++--- src/haz3lweb/view/LangDoc.re | 45 +------------------------- src/haz3lweb/view/ScratchMode.re | 4 +-- 6 files changed, 22 insertions(+), 64 deletions(-) diff --git a/src/haz3lcore/dynamics/PatternMatch.re b/src/haz3lcore/dynamics/PatternMatch.re index da4cc067e3..cb408902ca 100644 --- a/src/haz3lcore/dynamics/PatternMatch.re +++ b/src/haz3lcore/dynamics/PatternMatch.re @@ -5,7 +5,7 @@ type match_result = | DoesNotMatch | IndetMatch; -let const_unknown: 'a => Typ.t = _ => Unknown(Internal); +let const_unknown: 'a => Typ.t = _ => Unknown(NoProvenance); let cast_sum_maps = (sm1: Typ.sum_map, sm2: Typ.sum_map) @@ -191,9 +191,9 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => | (Cons(_) | ListLit(_), Cast(d, List(ty1), List(ty2))) => matches_cast_Cons(dp, d, [(ty1, ty2)]) | (Cons(_) | ListLit(_), Cast(d, Unknown(_), List(ty2))) => - matches_cast_Cons(dp, d, [(Unknown(Internal), ty2)]) + matches_cast_Cons(dp, d, [(Unknown(NoProvenance), ty2)]) | (Cons(_) | ListLit(_), Cast(d, List(ty1), Unknown(_))) => - matches_cast_Cons(dp, d, [(ty1, Unknown(Internal))]) + matches_cast_Cons(dp, d, [(ty1, Unknown(NoProvenance))]) | (Cons(_, _), Cons(_, _)) | (ListLit(_, _), Cons(_, _)) | (Cons(_, _), ListLit(_)) @@ -457,9 +457,9 @@ and matches_cast_Cons = | Cast(d', List(ty1), List(ty2)) => matches_cast_Cons(dp, d', [(ty1, ty2), ...elt_casts]) | Cast(d', List(ty1), Unknown(_)) => - matches_cast_Cons(dp, d', [(ty1, Unknown(Internal)), ...elt_casts]) + matches_cast_Cons(dp, d', [(ty1, Unknown(NoProvenance)), ...elt_casts]) | Cast(d', Unknown(_), List(ty2)) => - matches_cast_Cons(dp, d', [(Unknown(Internal), ty2), ...elt_casts]) + matches_cast_Cons(dp, d', [(Unknown(NoProvenance), ty2), ...elt_casts]) | Cast(_, _, _) => DoesNotMatch | BoundVar(_) => DoesNotMatch | FreeVar(_) => IndetMatch diff --git a/src/haz3lcore/dynamics/Transition.re b/src/haz3lcore/dynamics/Transition.re index b460b0bda3..bbc616618f 100644 --- a/src/haz3lcore/dynamics/Transition.re +++ b/src/haz3lcore/dynamics/Transition.re @@ -73,19 +73,19 @@ module CastHelpers = { | Ground | NotGroundOrHole(Typ.t) /* the argument is the corresponding ground type */; - let const_unknown: 'a => Typ.t = _ => Unknown(Internal); + let const_unknown: 'a => Typ.t = _ => Unknown(NoProvenance); let grounded_Arrow = - NotGroundOrHole(Arrow(Unknown(Internal), Unknown(Internal))); + NotGroundOrHole(Arrow(Unknown(NoProvenance), Unknown(NoProvenance))); let grounded_Prod = length => NotGroundOrHole( - Prod(ListUtil.replicate(length, Typ.Unknown(Internal))), + Prod(ListUtil.replicate(length, Typ.Unknown(NoProvenance))), ); let grounded_Sum = (sm: Typ.sum_map): ground_cases => { let sm' = sm |> ConstructorMap.map(Option.map(const_unknown)); NotGroundOrHole(Sum(sm')); }; - let grounded_List = NotGroundOrHole(List(Unknown(Internal))); + let grounded_List = NotGroundOrHole(List(Unknown(NoProvenance))); let rec ground_cases_of = (ty: Typ.t): ground_cases => { let is_ground_arg: option(Typ.t) => bool = diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 9560b03f49..2c946c12c2 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -14,7 +14,6 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { model.langDocMessages.annotations, ctx, ); - let restricted = Backpack.restricted(zipper.backpack); let now = (a: Action.t): option(UpdateAction.t) => Some(PerformAction(a)); switch (k) { @@ -75,10 +74,9 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { Some(UpdateAction.Paste(no_hole_marks)); | _ => now(Insert(Form.linebreak)) }; - | _ when Form.is_valid_char(key) && String.length(key) == 1 => - /* TODO(andrew): length==1 is hack to prevent things - like F5 which are now valid tokens and also weird - unicode shit which is multichar i guess */ + | _ when String.length(key) == 1 => + /* Note: length==1 prevent specials like + * SHIFT from being captured here */ now(Insert(key)) | _ => None } diff --git a/src/haz3lweb/Main.re b/src/haz3lweb/Main.re index 251ee68cab..ebb0106a63 100644 --- a/src/haz3lweb/Main.re +++ b/src/haz3lweb/Main.re @@ -76,21 +76,23 @@ let update_handler = ( ~inject: UpdateAction.t => Ui_effect.t(unit), ~dir: Key.dir, + ~model: Model.t, evt: Js.t(Dom_html.keyboardEvent), ) : Effect.t(unit) => Effect.( - switch (Keyboard.handle_key_event(Key.mk(dir, evt))) { + switch (Keyboard.handle_key_event(Key.mk(dir, evt), ~model)) { | None => Ignore | Some(action) => Many([Prevent_default, Stop_propagation, inject(action)]) } ); -let handlers = (~inject: UpdateAction.t => Ui_effect.t(unit)) => [ +let handlers = + (~model: Model.t, ~inject: UpdateAction.t => Ui_effect.t(unit)) => [ Attr.on_keypress(_ => Effect.Prevent_default), - Attr.on_keyup(update_handler(~inject, ~dir=KeyUp)), - Attr.on_keydown(update_handler(~inject, ~dir=KeyDown)), + Attr.on_keyup(update_handler(~inject, ~dir=KeyUp, ~model)), + Attr.on_keydown(update_handler(~inject, ~dir=KeyDown, ~model)), ]; module App = { @@ -142,6 +144,7 @@ module App = { ) => { open Incr.Let_syntax; let%map model = model; + let handlers = handlers(~model); /* Note: mapping over the old_model here may trigger an additional redraw */ Component.create( diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index b89068a969..081d3f9836 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -2910,49 +2910,6 @@ let get_color_map = Id.Map.find_opt(index, info_map); | None => None }; - let (_, (_, (color_map, _)), _) = get_doc(~docs=doc, info, Colorings); - color_map; -}; - -let view = - ( - ~inject, - ~font_metrics: FontMetrics.t, - ~settings: Settings.t, - ~doc: LangDocMessages.t, - index': option(Id.t), - info_map: Statics.Map.t, - ) => { - let info: option(Statics.Info.t) = - switch (index') { - | Some(index) => - switch (Id.Map.find_opt(index, info_map)) { - | Some(ci) => Some(ci) - | None => None - } - | None => None - }; - let (_, (_, (color_map, _)), _) = - get_doc(~global_inference_info, ~docs=doc, info, Colorings); - color_map; -}; - -let _view = - ( - ~global_inference_info: InferenceResult.global_inference_info, - ~doc: LangDocMessages.t, - index': option(Id.t), - info_map: Statics.Map.t, - ) => { - let info: option(Statics.Info.t) = - switch (index') { - | Some(index) => - switch (Id.Map.find_opt(index, info_map)) { - | Some(ci) => Some(ci) - | None => None - } - | None => None - }; let (_, (_, (color_map, _)), _) = get_doc(~global_inference_info, ~docs=doc, info, Colorings); color_map; @@ -2962,7 +2919,7 @@ let view = ( ~inject, ~font_metrics: FontMetrics.t, - ~settings: ModelSettings.t, + ~settings: Settings.t, ~doc: LangDocMessages.t, index': option(Id.t), info_map: Statics.Map.t, diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 77269ba735..314c912c8f 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -23,10 +23,10 @@ let view = ) => { let editor = Editors.get_editor(editors); let zipper = editor.state.zipper; - let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.from_zip_for_sem(zipper); let (info_map, ctx) = Statics.mk_map_and_inference_solutions(term); - //let info_map = Interface.Statics.mk_map_ctx(settings.core, ctx_init, term); // TODO anand and raef: do we need to use this instead? + let _ctx_init = ctx_init; + //let info_map = Interface.Statics.mk_map_ctx(settings.core, ctx_init, term); // TODO anand and raef: we need to use this instead; figure out how let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, From 3571c9264cef1b09a79118c8b7f2f3a1e44ad04e Mon Sep 17 00:00:00 2001 From: RaefM Date: Mon, 18 Dec 2023 20:32:11 -0500 Subject: [PATCH 075/129] Fix join constraint threading --- src/haz3lcore/statics/Statics.re | 58 ++++++++++++++++---------------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index b492e1c900..e4864cd6c0 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -91,17 +91,27 @@ let typ_exp_unop: UExp.op_un => (Typ.t, Typ.t) = | Bool(Not) => (Bool, Bool) | Int(Minus) => (Int, Int); -let join_constraints = (tys: list(Typ.t)): Typ.constraints => { - // find first elt containing hole and constrain it to every other elt - let elts_with_hole = List.filter(Typ.contains_hole, tys); - switch (elts_with_hole) { - | [] => [] - | [hd, ..._] => - let constrain_rep_to_elt = - (acc: Typ.constraints, curr: Typ.t): Typ.constraints => { - [(hd, curr), ...acc]; +let join_constraints = (self: Self.t): Typ.constraints => { + let thread_constraints = (tys: list(Typ.t)): Typ.constraints => { + // find first element containing hole and constrain it to every other elt + let elts_with_hole = List.filter(Typ.contains_hole, tys); + switch (elts_with_hole) { + | [] => [] + | [hd, ..._] => + let constrain_rep_to_elt = + (acc: Typ.constraints, curr: Typ.t): Typ.constraints => { + [(hd, curr), ...acc]; + }; + List.fold_left(constrain_rep_to_elt, [], tys); }; - List.fold_left(constrain_rep_to_elt, [], tys); + }; + switch ((self: Self.t)) { + | NoJoin(wrap_ty, sources) => + sources + |> Typ.of_source + |> List.map(Self.join_of(wrap_ty)) + |> thread_constraints + | _ => [] }; }; @@ -115,7 +125,6 @@ let subsumption_constraints = (mode: Mode.t, final_typ: Typ.t) => { let rec any_to_info_map = (~ctx: Ctx.t, ~ancestors, any: any, m: Map.t) : (CoCtx.t, Map.t, Typ.constraints) => { - print_endline("ECHOOOOO"); switch (any) { | Exp(e) => let ({co_ctx, constraints, _}: Info.exp, m) = @@ -173,7 +182,12 @@ and uexp_to_info_map = | Ana(Unknown(SynSwitch(_))) => Mode.Syn | _ => mode }; - let add' = (~self, ~co_ctx, ~constraints, m) => { + let add' = (~self: Self.exp, ~co_ctx, ~constraints, m) => { + let joined_constraints = + switch (self) { + | Common(t) => join_constraints(t) + | _ => [] + }; let info = Info.derived_exp( ~uexp, @@ -182,11 +196,11 @@ and uexp_to_info_map = ~ancestors, ~self, ~co_ctx, - ~constraints, + ~constraints=constraints @ joined_constraints, ); (info, add_info(ids, InfoExp(info), m)); }; - let add = (~self, ~constraints, ~co_ctx, m) => + let add = (~self: Self.t, ~constraints, ~co_ctx, m) => add'(~self=Common(self), ~constraints, ~co_ctx, m); let ancestors = [UExp.rep_id(uexp)] @ ancestors; let go' = uexp_to_info_map(~ancestors); @@ -501,20 +515,6 @@ and upat_to_info_map = : (Info.pat, Map.t) => { let id = UPat.rep_id(upat); let add = (~self, ~ctx, ~constraints, m) => { - let wrap_fn = (wrap: Self.join_type) => - switch (wrap) { - | Id => (x => x) - | List => (x => Typ.List(x)) - }; - let joined_constraints = - switch ((self: Self.t)) { - | NoJoin(wrap_ty, sources) => - sources - |> Typ.of_source - |> List.map(wrap_fn(wrap_ty)) - |> join_constraints - | _ => [] - }; let info = Info.derived_pat( ~upat, @@ -522,7 +522,7 @@ and upat_to_info_map = ~co_ctx, ~mode, ~ancestors, - ~constraints=constraints @ joined_constraints, + ~constraints=constraints @ join_constraints(self), ~self=Common(self), ); (info, add_info(ids, InfoPat(info), m)); From 03facf9beec5095ed954d145cd31ba70810fb97e Mon Sep 17 00:00:00 2001 From: RaefM Date: Mon, 18 Dec 2023 22:33:04 -0500 Subject: [PATCH 076/129] Fix some issues with join_constraints and missing constraints for uexp_to_info_map --- src/haz3lcore/statics/Mode.re | 2 + src/haz3lcore/statics/Statics.re | 76 ++++++++++++++++++++------------ 2 files changed, 51 insertions(+), 27 deletions(-) diff --git a/src/haz3lcore/statics/Mode.re b/src/haz3lcore/statics/Mode.re index 486dbf89fe..0170f69dc4 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -107,6 +107,8 @@ let of_list_lit = (typs, constraints); }; +// TODO: anand and raef; discuss if the mode ctr fns below need constraints + let ctr_ana_typ = (ctx: Ctx.t, mode: t, ctr: Constructor.t): option(Typ.t) => { /* If a ctr is being analyzed against (an arrow type returning) a sum type having that ctr as a variant, we consider the diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index e4864cd6c0..6db090c7b5 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -115,13 +115,29 @@ let join_constraints = (self: Self.t): Typ.constraints => { }; }; -let subsumption_constraints = (mode: Mode.t, final_typ: Typ.t) => { +let subsumption_constraints = + (any: any, ctx: Ctx.t, mode: Mode.t, self: Self.t) => { + let rep_id = Term.rep_id(any); + let final_typ = + switch (Self.typ_of(ctx, self)) { + | Some(typ) => typ + | None => Unknown(AstNode(rep_id)) + }; switch (mode) { | Ana(expected_typ) => [(final_typ, expected_typ)] | _ => [] }; }; +let rec is_synswitch_rooted = (prov: Typ.type_provenance) => + switch (prov) { + | NoProvenance + | AstNode(_) + | Free(_) => false + | SynSwitch(_) => true + | Matched(_, prov) => is_synswitch_rooted(prov) + }; + let rec any_to_info_map = (~ctx: Ctx.t, ~ancestors, any: any, m: Map.t) : (CoCtx.t, Map.t, Typ.constraints) => { @@ -160,7 +176,6 @@ and multi = (~ctx, ~ancestors, m, tms) => List.fold_left( ((co_ctxs, acc_constraints, m), any) => { let (co_ctx, m, constraints) = - //TODO: anand and raef is this underscore reasonable (might go away) any_to_info_map(~ctx, ~ancestors, any, m); (co_ctxs @ [co_ctx], acc_constraints @ constraints, m); }, @@ -179,7 +194,7 @@ and uexp_to_info_map = /* Maybe switch mode to syn */ let mode = switch (mode) { - | Ana(Unknown(SynSwitch(_))) => Mode.Syn + | Ana(Unknown(prov)) when is_synswitch_rooted(prov) => Mode.Syn | _ => mode }; let add' = (~self: Self.exp, ~co_ctx, ~constraints, m) => { @@ -205,6 +220,8 @@ and uexp_to_info_map = let ancestors = [UExp.rep_id(uexp)] @ ancestors; let go' = uexp_to_info_map(~ancestors); let go = go'(~ctx); + let subsumption_constraints = self => + subsumption_constraints(Exp(uexp), ctx, mode, self); let map_m_go = m => List.fold_left2( ((es, m), mode, e) => @@ -213,24 +230,24 @@ and uexp_to_info_map = ); let go_pat = upat_to_info_map(~ctx, ~ancestors); let atomic = self => { - let final_typ = - switch (Self.typ_of(ctx, self)) { - | Some(typ) => typ - | None => Unknown(AstNode(UExp.rep_id(uexp))) - }; add( ~self, ~co_ctx=CoCtx.empty, m, - ~constraints=subsumption_constraints(mode, final_typ), + ~constraints=subsumption_constraints(self), ); }; switch (term) { | MultiHole(tms) => let (co_ctxs, constraints, m) = multi(~ctx, ~ancestors, m, tms); - add(~self=IsMulti, ~co_ctx=CoCtx.union(co_ctxs), m, ~constraints); + add( + ~self=IsMulti, + ~co_ctx=CoCtx.union(co_ctxs), + m, + ~constraints=constraints @ subsumption_constraints(IsMulti), + ); | Invalid(token) => atomic(BadToken(token)) - | EmptyHole => atomic(Just(Unknown(AstNode(UExp.rep_id(uexp))))) + | EmptyHole => atomic(Just(Unknown(AstNode(UExp.rep_id(uexp))))) // TODO: replace with ExpHole prov | Triv => atomic(Just(Prod([]))) | Bool(_) => atomic(Just(Bool)) | Int(_) => atomic(Just(Int)) @@ -242,10 +259,11 @@ and uexp_to_info_map = Mode.of_list_lit(ctx, List.length(es), UExp.rep_id(uexp), mode); let (es, m) = map_m_go(m, modes, es); let tys = List.map(Info.exp_ty, es); + let self = Self.listlit(~empty=Unknown(NoProvenance), ctx, tys, ids); add( - ~self=Self.listlit(~empty=Unknown(NoProvenance), ctx, tys, ids), + ~self, ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es)), - ~constraints=mode_cs @ ListUtil.flat_map(Info.exp_constraints, es), + ~constraints=mode_cs @ ListUtil.flat_map(Info.exp_constraints, es) @ subsumption_constraints(self), m, ); | Cons(hd, tl) => @@ -273,17 +291,21 @@ and uexp_to_info_map = m, ); | Var(name) => - let (self: Self.exp, final_typ: Typ.t) = + let (self: Self.exp, subsumption_constraints) = switch (Ctx.lookup_var(ctx, name)) { - | None => (Free(name), Unknown(AstNode(UExp.rep_id(uexp)))) - | Some(var) => (Common(Just(var.typ)), var.typ) + | None => + let boundary_hole: Self.t = Just(Unknown(AstNode(UExp.rep_id(uexp)))); + (Free(name), subsumption_constraints(boundary_hole)) + | Some(var) => + let self: Self.t = Just(var.typ); + (Common(self), subsumption_constraints(self)) }; let (mode_ty, mode_cs) = Mode.ty_of(ctx, mode, UExp.rep_id(uexp)); add'( ~self, ~co_ctx=CoCtx.singleton(name, UExp.rep_id(uexp), mode_ty), m, - ~constraints=subsumption_constraints(mode, final_typ) @ mode_cs, + ~constraints=subsumption_constraints @ mode_cs, ); | Parens(e) => let (e, m) = go(~mode, e, m); @@ -291,7 +313,7 @@ and uexp_to_info_map = | UnOp(op, e) => let (ty_in, ty_out) = typ_exp_unop(op); let (e, m) = go(~mode=Ana(ty_in), e, m); - add(~self=Just(ty_out), ~co_ctx=e.co_ctx, ~constraints=e.constraints, m); + add(~self=Just(ty_out), ~co_ctx=e.co_ctx, ~constraints=e.constraints @ subsumption_constraints(Just(ty_out)), m); | BinOp(op, e1, e2) => let (ty1, ty2, ty_out) = typ_exp_binop(op); let (e1, m) = go(~mode=Ana(ty1), e1, m); @@ -299,7 +321,7 @@ and uexp_to_info_map = add( ~self=Just(ty_out), ~co_ctx=CoCtx.union([e1.co_ctx, e2.co_ctx]), - ~constraints=e1.constraints @ e2.constraints, + ~constraints=e1.constraints @ e2.constraints @ subsumption_constraints(Just(ty_out)), m, ); | Tuple(es) => @@ -320,7 +342,7 @@ and uexp_to_info_map = ~constraints=e.constraints, m, ); - | Seq(e1, e2) => + | Seq(e1, e2) => // TODO: whats Seq? let (e1, m) = go(~mode=Syn, e1, m); let (e2, m) = go(~mode, e2, m); add( @@ -334,7 +356,7 @@ and uexp_to_info_map = | Pipeline(arg, fn) => let fn_mode = Mode.of_ap(ctx, mode, UExp.ctr_name(fn)); let (fn, m) = go(~mode=fn_mode, fn, m); - let ((ty_in, ty_out), constraints) = + let ((ty_in, ty_out), match_constraints) = Typ.matched_arrow(ctx, UExp.rep_id(uexp), fn.ty); let (arg, m) = go(~mode=Ana(ty_in), arg, m); let self: Self.t = @@ -344,11 +366,11 @@ and uexp_to_info_map = add( ~self, ~co_ctx=CoCtx.union([fn.co_ctx, arg.co_ctx]), - ~constraints, + ~constraints = match_constraints @ fn.constraints @ arg.constraints @ subsumption_constraints(self), m, ); | Fun(p, e) => - let ((mode_pat, mode_body), constraints) = + let ((mode_pat, mode_body), match_constraints) = Mode.of_arrow(ctx, mode, UExp.rep_id(uexp)); let (p', _) = go_pat(~is_synswitch=false, ~co_ctx=CoCtx.empty, ~mode=mode_pat, p, m); @@ -359,7 +381,7 @@ and uexp_to_info_map = add( ~self=Just(Arrow(p.ty, e.ty)), ~co_ctx=CoCtx.mk(ctx, p.ctx, e.co_ctx), - ~constraints=constraints @ e.constraints @ p.constraints, + ~constraints=match_constraints @ e.constraints @ p.constraints, m, ); | Let(p, def, body) => @@ -390,7 +412,7 @@ and uexp_to_info_map = ~self=Just(body.ty), ~co_ctx= CoCtx.union([def.co_ctx, CoCtx.mk(ctx, p_ana.ctx, body.co_ctx)]), - ~constraints=p_ana.constraints @ def.constraints @ body.constraints, + ~constraints=p_syn.constraints @ p_ana'.constraints @ p_ana.constraints @ def.constraints @ body.constraints, m, ); | If(e0, e1, e2) => @@ -487,7 +509,7 @@ and uexp_to_info_map = let ty_escape = Typ.subst(ty_def, name, ty_body); let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; //TODO anand: typ aliases- should they generate new constraints too? - add(~self=Just(ty_escape), ~constraints=constraints_body, ~co_ctx, m); + add(~self=Just(ty_escape), ~constraints=constraints_body @ subsumption_constraints(Just(ty_escape)), ~co_ctx, m); | Var(_) | Invalid(_) | EmptyHole @@ -498,7 +520,7 @@ and uexp_to_info_map = ) = go'(~ctx, ~mode, body, m); let m = utyp_to_info_map(~ctx, ~ancestors, utyp, m) |> snd; - add(~self=Just(ty_body), ~constraints=constraints_body, ~co_ctx, m); + add(~self=Just(ty_body), ~constraints=constraints_body @ subsumption_constraints(Just(ty_body)), ~co_ctx, m); }; }; } From 2b3152b1e64ca13bf9ca166447fdff1b7c31034e Mon Sep 17 00:00:00 2001 From: RaefM Date: Tue, 19 Dec 2023 00:29:55 -0500 Subject: [PATCH 077/129] Review and fix issues in upat_to_info_map --- src/haz3lcore/statics/Statics.re | 87 ++++++++++++++++++++++---------- 1 file changed, 59 insertions(+), 28 deletions(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 6db090c7b5..ea8243ccf8 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -263,7 +263,10 @@ and uexp_to_info_map = add( ~self, ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es)), - ~constraints=mode_cs @ ListUtil.flat_map(Info.exp_constraints, es) @ subsumption_constraints(self), + ~constraints= + mode_cs + @ ListUtil.flat_map(Info.exp_constraints, es) + @ subsumption_constraints(self), m, ); | Cons(hd, tl) => @@ -293,12 +296,13 @@ and uexp_to_info_map = | Var(name) => let (self: Self.exp, subsumption_constraints) = switch (Ctx.lookup_var(ctx, name)) { - | None => - let boundary_hole: Self.t = Just(Unknown(AstNode(UExp.rep_id(uexp)))); - (Free(name), subsumption_constraints(boundary_hole)) - | Some(var) => + | None => + let boundary_hole: Self.t = + Just(Unknown(AstNode(UExp.rep_id(uexp)))); + (Free(name), subsumption_constraints(boundary_hole)); + | Some(var) => let self: Self.t = Just(var.typ); - (Common(self), subsumption_constraints(self)) + (Common(self), subsumption_constraints(self)); }; let (mode_ty, mode_cs) = Mode.ty_of(ctx, mode, UExp.rep_id(uexp)); add'( @@ -313,7 +317,12 @@ and uexp_to_info_map = | UnOp(op, e) => let (ty_in, ty_out) = typ_exp_unop(op); let (e, m) = go(~mode=Ana(ty_in), e, m); - add(~self=Just(ty_out), ~co_ctx=e.co_ctx, ~constraints=e.constraints @ subsumption_constraints(Just(ty_out)), m); + add( + ~self=Just(ty_out), + ~co_ctx=e.co_ctx, + ~constraints=e.constraints @ subsumption_constraints(Just(ty_out)), + m, + ); | BinOp(op, e1, e2) => let (ty1, ty2, ty_out) = typ_exp_binop(op); let (e1, m) = go(~mode=Ana(ty1), e1, m); @@ -321,7 +330,10 @@ and uexp_to_info_map = add( ~self=Just(ty_out), ~co_ctx=CoCtx.union([e1.co_ctx, e2.co_ctx]), - ~constraints=e1.constraints @ e2.constraints @ subsumption_constraints(Just(ty_out)), + ~constraints= + e1.constraints + @ e2.constraints + @ subsumption_constraints(Just(ty_out)), m, ); | Tuple(es) => @@ -342,7 +354,8 @@ and uexp_to_info_map = ~constraints=e.constraints, m, ); - | Seq(e1, e2) => // TODO: whats Seq? + | Seq(e1, e2) => + // TODO: whats Seq? let (e1, m) = go(~mode=Syn, e1, m); let (e2, m) = go(~mode, e2, m); add( @@ -366,7 +379,11 @@ and uexp_to_info_map = add( ~self, ~co_ctx=CoCtx.union([fn.co_ctx, arg.co_ctx]), - ~constraints = match_constraints @ fn.constraints @ arg.constraints @ subsumption_constraints(self), + ~constraints= + match_constraints + @ fn.constraints + @ arg.constraints + @ subsumption_constraints(self), m, ); | Fun(p, e) => @@ -412,7 +429,12 @@ and uexp_to_info_map = ~self=Just(body.ty), ~co_ctx= CoCtx.union([def.co_ctx, CoCtx.mk(ctx, p_ana.ctx, body.co_ctx)]), - ~constraints=p_syn.constraints @ p_ana'.constraints @ p_ana.constraints @ def.constraints @ body.constraints, + ~constraints= + p_syn.constraints + @ p_ana'.constraints + @ p_ana.constraints + @ def.constraints + @ body.constraints, m, ); | If(e0, e1, e2) => @@ -509,7 +531,13 @@ and uexp_to_info_map = let ty_escape = Typ.subst(ty_def, name, ty_body); let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; //TODO anand: typ aliases- should they generate new constraints too? - add(~self=Just(ty_escape), ~constraints=constraints_body @ subsumption_constraints(Just(ty_escape)), ~co_ctx, m); + add( + ~self=Just(ty_escape), + ~constraints= + constraints_body @ subsumption_constraints(Just(ty_escape)), + ~co_ctx, + m, + ); | Var(_) | Invalid(_) | EmptyHole @@ -520,7 +548,13 @@ and uexp_to_info_map = ) = go'(~ctx, ~mode, body, m); let m = utyp_to_info_map(~ctx, ~ancestors, utyp, m) |> snd; - add(~self=Just(ty_body), ~constraints=constraints_body @ subsumption_constraints(Just(ty_body)), ~co_ctx, m); + add( + ~self=Just(ty_body), + ~constraints= + constraints_body @ subsumption_constraints(Just(ty_body)), + ~co_ctx, + m, + ); }; }; } @@ -549,18 +583,10 @@ and upat_to_info_map = ); (info, add_info(ids, InfoPat(info), m)); }; + let subsumption_constraints = self => + subsumption_constraints(Pat(upat), ctx, mode, self); let atomic = self => { - let final_typ = - switch (Self.typ_of(ctx, self)) { - | Some(typ) => typ - | None => Unknown(AstNode(UPat.rep_id(upat))) - }; - add( - ~self, - ~ctx, - m, - ~constraints=subsumption_constraints(mode, final_typ), - ); + add(~self, ~ctx, m, ~constraints=subsumption_constraints(self)); }; let ancestors = [UPat.rep_id(upat)] @ ancestors; let go = upat_to_info_map(~is_synswitch, ~ancestors, ~co_ctx); @@ -581,7 +607,12 @@ and upat_to_info_map = switch (term) { | MultiHole(tms) => let (_, constraints, m) = multi(~ctx, ~ancestors, m, tms); - add(~self=IsMulti, ~ctx, ~constraints, m); + add( + ~self=IsMulti, + ~ctx, + ~constraints=constraints @ subsumption_constraints(IsMulti), + m, + ); | Invalid(token) => atomic(BadToken(token)) | EmptyHole => atomic(Just(unknown)) | Int(_) => atomic(Just(Int)) @@ -626,7 +657,7 @@ and upat_to_info_map = add( ~self=Just(unknown), ~ctx=Ctx.extend(ctx, entry), - ~constraints=subsumption_constraints(mode, ctx_typ), + ~constraints=subsumption_constraints(Just(unknown)), m, ); | Tuple(ps) => @@ -641,13 +672,13 @@ and upat_to_info_map = | Ap(fn, arg) => let fn_mode = Mode.of_ap(ctx, mode, UPat.ctr_name(fn)); let (fn, m) = go(~ctx, ~mode=fn_mode, fn, m); - let ((ty_in, ty_out), matched_constraints) = + let ((ty_in, ty_out), match_constraints) = Typ.matched_arrow(ctx, id, fn.ty); let (arg, m) = go(~ctx, ~mode=Ana(ty_in), arg, m); add( ~self=Just(ty_out), ~ctx=arg.ctx, - ~constraints=fn.constraints @ arg.constraints @ matched_constraints, + ~constraints=fn.constraints @ arg.constraints @ match_constraints, m, ); | TypeAnn(p, ann) => From ab14eebe9151155a0a4192388b4320804ca5c518 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sat, 23 Dec 2023 11:37:44 -0500 Subject: [PATCH 078/129] Refactor to use new provenances where synswitch is separated out to ensure it doesnt get overwritten and so that type holes and expholes can be traced back. Return suggestions ONLY for typeholes --- src/haz3lcore/assistant/AssistantForms.re | 4 +- src/haz3lcore/dynamics/DH.re | 2 +- src/haz3lcore/dynamics/Elaborator.re | 26 ++- src/haz3lcore/dynamics/PatternMatch.re | 18 +- src/haz3lcore/dynamics/Transition.re | 10 +- src/haz3lcore/inference/Infer.re | 50 +++-- src/haz3lcore/inference/InferenceResult.re | 14 +- src/haz3lcore/statics/CoCtx.re | 6 +- src/haz3lcore/statics/Info.re | 10 +- src/haz3lcore/statics/Mode.re | 13 +- src/haz3lcore/statics/Self.re | 4 +- src/haz3lcore/statics/Statics.re | 32 ++- src/haz3lcore/statics/Term.re | 6 +- src/haz3lcore/statics/TypBase.re | 216 ++++++++++----------- src/haz3lweb/view/CursorInspector.re | 8 +- src/haz3lweb/view/InferenceView.re | 18 +- 16 files changed, 217 insertions(+), 220 deletions(-) diff --git a/src/haz3lcore/assistant/AssistantForms.re b/src/haz3lcore/assistant/AssistantForms.re index 0aa68c0c74..7864288a18 100644 --- a/src/haz3lcore/assistant/AssistantForms.re +++ b/src/haz3lcore/assistant/AssistantForms.re @@ -11,7 +11,7 @@ let leading_expander = " " ++ AssistantExpander.c; * running Statics, but for now, new forms e.g. operators must be added * below manually. */ module Typ = { - let unk: Typ.t = Unknown(NoProvenance); + let unk: Typ.t = Unknown(NoProvenance, false); let of_const_mono_delim: list((Token.t, Typ.t)) = [ ("true", Bool), @@ -71,7 +71,7 @@ module Typ = { fun | InfoExp({mode, _}) | InfoPat({mode, _}) => Mode.assistant_ty_of(mode) - | _ => Unknown(NoProvenance); + | _ => Unknown(NoProvenance, false); let filter_by = ( diff --git a/src/haz3lcore/dynamics/DH.re b/src/haz3lcore/dynamics/DH.re index e03e3c549d..9b9ed39417 100644 --- a/src/haz3lcore/dynamics/DH.re +++ b/src/haz3lcore/dynamics/DH.re @@ -140,7 +140,7 @@ module rec DHExp: { let is_any_synswitch: Typ.t => bool = fun - | Unknown(SynSwitch(_)) => true + | Unknown(_, s) => s | _ => false; let cast = (d: t, t1: Typ.t, t2: Typ.t): t => diff --git a/src/haz3lcore/dynamics/Elaborator.re b/src/haz3lcore/dynamics/Elaborator.re index 2dee3e3db7..ac133cc87b 100644 --- a/src/haz3lcore/dynamics/Elaborator.re +++ b/src/haz3lcore/dynamics/Elaborator.re @@ -32,8 +32,12 @@ let cast = (ctx: Ctx.t, id: Id.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | Syn => d | SynFun => switch (self_ty) { - | Unknown(prov) => - DHExp.cast(d, Unknown(prov), Arrow(Unknown(prov), Unknown(prov))) + | Unknown(prov, s) => + DHExp.cast( + d, + Unknown(prov, s), + Arrow(Unknown(prov, s), Unknown(prov, s)), + ) | Arrow(_) => d | _ => failwith("Elaborator.wrap: SynFun non-arrow-type") } @@ -45,7 +49,8 @@ let cast = (ctx: Ctx.t, id: Id.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | ListConcat(_) | Cons(_) => switch (ana_ty) { - | Unknown(prov) => DHExp.cast(d, List(Unknown(prov)), Unknown(prov)) + | Unknown(prov, s) => + DHExp.cast(d, List(Unknown(prov, s)), Unknown(prov, s)) | _ => d } | Fun(_) => @@ -55,16 +60,17 @@ let cast = (ctx: Ctx.t, id: Id.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => DHExp.cast(d, Arrow(self_in, ana_out), ana_ty); | Tuple(ds) => switch (ana_ty) { - | Unknown(prov) => - let us = List.init(List.length(ds), _ => Typ.Unknown(prov)); - DHExp.cast(d, Prod(us), Unknown(prov)); + | Unknown(prov, s) => + let us = List.init(List.length(ds), _ => Typ.Unknown(prov, s)); + DHExp.cast(d, Prod(us), Unknown(prov, s)); | _ => d } | Ap(Constructor(_), _) | Constructor(_) => switch (ana_ty, self_ty) { - | (Unknown(prov), Rec(_, Sum(_))) - | (Unknown(prov), Sum(_)) => DHExp.cast(d, self_ty, Unknown(prov)) + | (Unknown(prov, s), Rec(_, Sum(_))) + | (Unknown(prov, s), Sum(_)) => + DHExp.cast(d, self_ty, Unknown(prov, s)) | _ => d } /* Forms with special ana rules but no particular typing requirements */ @@ -109,7 +115,7 @@ let wrap = (ctx: Ctx.t, id: Id.t, mode: Mode.t, self, d: DHExp.t): DHExp.t => let self_ty = switch (Self.typ_of_exp(ctx, self)) { | Some(self_ty) => Typ.normalize(ctx, self_ty) - | None => Unknown(NoProvenance) + | None => Unknown(NoProvenance, false) }; cast(ctx, id, mode, self_ty, d); | InHole(_) => NonEmptyHole(TypeInconsistent, id, 0, d) @@ -349,7 +355,7 @@ let uexp_elab = (m: Statics.Map.t, uexp: Term.UExp.t): ElaborationResult.t => let ty = switch (fixed_exp_typ(m, uexp)) { | Some(ty) => ty - | None => Typ.Unknown(NoProvenance) + | None => Typ.Unknown(NoProvenance, false) }; Elaborates(d, ty, Delta.empty); }; diff --git a/src/haz3lcore/dynamics/PatternMatch.re b/src/haz3lcore/dynamics/PatternMatch.re index cb408902ca..f30b3ec950 100644 --- a/src/haz3lcore/dynamics/PatternMatch.re +++ b/src/haz3lcore/dynamics/PatternMatch.re @@ -5,7 +5,7 @@ type match_result = | DoesNotMatch | IndetMatch; -let const_unknown: 'a => Typ.t = _ => Unknown(NoProvenance); +let const_unknown: 'a => Typ.t = _ => Unknown(NoProvenance, false); let cast_sum_maps = (sm1: Typ.sum_map, sm2: Typ.sum_map) @@ -191,9 +191,9 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => | (Cons(_) | ListLit(_), Cast(d, List(ty1), List(ty2))) => matches_cast_Cons(dp, d, [(ty1, ty2)]) | (Cons(_) | ListLit(_), Cast(d, Unknown(_), List(ty2))) => - matches_cast_Cons(dp, d, [(Unknown(NoProvenance), ty2)]) + matches_cast_Cons(dp, d, [(Unknown(NoProvenance, false), ty2)]) | (Cons(_) | ListLit(_), Cast(d, List(ty1), Unknown(_))) => - matches_cast_Cons(dp, d, [(ty1, Unknown(NoProvenance))]) + matches_cast_Cons(dp, d, [(ty1, Unknown(NoProvenance, false))]) | (Cons(_, _), Cons(_, _)) | (ListLit(_, _), Cons(_, _)) | (Cons(_, _), ListLit(_)) @@ -457,9 +457,17 @@ and matches_cast_Cons = | Cast(d', List(ty1), List(ty2)) => matches_cast_Cons(dp, d', [(ty1, ty2), ...elt_casts]) | Cast(d', List(ty1), Unknown(_)) => - matches_cast_Cons(dp, d', [(ty1, Unknown(NoProvenance)), ...elt_casts]) + matches_cast_Cons( + dp, + d', + [(ty1, Unknown(NoProvenance, false)), ...elt_casts], + ) | Cast(d', Unknown(_), List(ty2)) => - matches_cast_Cons(dp, d', [(Unknown(NoProvenance), ty2), ...elt_casts]) + matches_cast_Cons( + dp, + d', + [(Unknown(NoProvenance, false), ty2), ...elt_casts], + ) | Cast(_, _, _) => DoesNotMatch | BoundVar(_) => DoesNotMatch | FreeVar(_) => IndetMatch diff --git a/src/haz3lcore/dynamics/Transition.re b/src/haz3lcore/dynamics/Transition.re index bbc616618f..1b33b30b07 100644 --- a/src/haz3lcore/dynamics/Transition.re +++ b/src/haz3lcore/dynamics/Transition.re @@ -73,19 +73,21 @@ module CastHelpers = { | Ground | NotGroundOrHole(Typ.t) /* the argument is the corresponding ground type */; - let const_unknown: 'a => Typ.t = _ => Unknown(NoProvenance); + let const_unknown: 'a => Typ.t = _ => Unknown(NoProvenance, false); let grounded_Arrow = - NotGroundOrHole(Arrow(Unknown(NoProvenance), Unknown(NoProvenance))); + NotGroundOrHole( + Arrow(Unknown(NoProvenance, false), Unknown(NoProvenance, false)), + ); let grounded_Prod = length => NotGroundOrHole( - Prod(ListUtil.replicate(length, Typ.Unknown(NoProvenance))), + Prod(ListUtil.replicate(length, Typ.Unknown(NoProvenance, false))), ); let grounded_Sum = (sm: Typ.sum_map): ground_cases => { let sm' = sm |> ConstructorMap.map(Option.map(const_unknown)); NotGroundOrHole(Sum(sm')); }; - let grounded_List = NotGroundOrHole(List(Unknown(NoProvenance))); + let grounded_List = NotGroundOrHole(List(Unknown(NoProvenance, false))); let rec ground_cases_of = (ty: Typ.t): ground_cases => { let is_ground_arg: option(Typ.t) => bool = diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re index 2dee5805ae..90403c36d1 100644 --- a/src/haz3lcore/inference/Infer.re +++ b/src/haz3lcore/inference/Infer.re @@ -6,7 +6,7 @@ type ptyp = | Var(string) | List(pts) | Arrow(pts, pts) - | Sum(list(pts)) // TODO anand and raef: fill this in + | Sum(list(pts)) | Prod(list(pts)) and pts = UnionFind.elem(list(ptyp)); @@ -15,14 +15,9 @@ module Ctx = { let create = (): t => Hashtbl.create(100); + let lookup = Hashtbl.find_opt; + let lookup_or_create = (ctx: t, p: Typ.type_provenance): pts => { - // get rid of SynSwitch - let rec prov_to_iprov: Typ.type_provenance => Typ.type_provenance = - fun - | SynSwitch(u) => AstNode(u) - | Matched(mprov, prov) => Matched(mprov, prov_to_iprov(prov)) - | _ as prov => prov; - let p = prov_to_iprov(p); let lookup = Hashtbl.find_opt(ctx, p); switch (lookup) { | Some(pts) => pts @@ -36,7 +31,7 @@ module Ctx = { let rec pts_of_typ = (ctx: Ctx.t, t: Typ.t): pts => { switch (t) { - | Typ.Unknown(p) => Ctx.lookup_or_create(ctx, p) + | Typ.Unknown(p, _) => Ctx.lookup_or_create(ctx, p) | _ => let ptyp = ptyp_of_typ(ctx, t); UnionFind.make([ptyp]); @@ -54,7 +49,7 @@ and ptyp_of_typ = (ctx: Ctx.t, t: Typ.t): ptyp => { | Sum(_) => Sum([]) // TODO anand and raef: unimplemented | Rec(_) => Sum([]) // TODO anand and raef: unimplemented | Prod(ts) => Prod(List.map(pts_of_typ(ctx), ts)) - | Typ.Unknown(_p) => failwith("unreachable") + | Typ.Unknown(_p, _) => failwith("unreachable") }; }; @@ -132,14 +127,6 @@ and combine_if_similar = let pts1 = merge(ctx, pts1, pts3); let pts2 = merge(ctx, pts2, pts4); Some(Arrow(pts1, pts2)); - // for nary types, we're taking the approach of 'if the arity doesn't match, they are inconsistent - // this isn't true (eg ? * ? ~ ? * ? * ?) but proceeding as it they are consistent may just expose - // the programmer to more linked unknowns that they never really intended to be the same, leading to confusing suggestions. - // If they truly intend for them to be consistent, eventually they may change the program so that the arities match - // which would lead to further suggestions. - // A notable exception to this would be in currying- for arrow types, we DEFINITELY dont want this behavior - // but for products and sums, where the associativity is already often vague, it doesn't necessarily make sense to enforce one - // and derive constraints accordingly (not that it would be incorrect, but simply that it may not be the frame of reference the user is taking either) | (Sum(tys1), Sum(tys2)) => if (List.length(tys1) != List.length(tys2)) { None; @@ -174,12 +161,14 @@ type status = let unwrap_solution = (s: status): Typ.t => { switch (s) { | Solved(ty) => ty - | Unsolved([]) => Unknown(NoProvenance) // underdetermined - | Unsolved([ty]) => ty // children are unsolved - | Unsolved([_, ..._]) => Unknown(NoProvenance) // overdetermined + | Unsolved([]) => Unknown(NoProvenance, false) // underdetermined + | Unsolved([ty]) => ty // recursively contains something unsolved; return suggestion that will contain an unsolved hole + | Unsolved([_, ..._]) => Unknown(NoProvenance, false) // overdetermined }; }; +// Since inference has completed, we return all suggestions sans provenance +// If accepted, these will change to TypeHole provenances naturally let rec get_status_pts = (ctx: Ctx.t, pts: pts): status => { let tys = UnionFind.get(pts); switch (tys) { @@ -201,17 +190,19 @@ and get_status_ptyp = (ctx: Ctx.t, ptyp: ptyp): status => { | List(pts) => switch (get_status_pts(ctx, pts)) { | Solved(ty) => Solved(List(ty)) - | Unsolved(_) => Unsolved([List(Unknown(NoProvenance))]) + | Unsolved(_) => Unsolved([List(Unknown(NoProvenance, false))]) } | Arrow(pts1, pts2) => switch (get_status_pts(ctx, pts1), get_status_pts(ctx, pts2)) { | (Solved(ty1), Solved(ty2)) => Solved(Arrow(ty1, ty2)) | (Solved(ty1), Unsolved(_)) => - Unsolved([Arrow(ty1, Unknown(NoProvenance))]) + Unsolved([Arrow(ty1, Unknown(NoProvenance, false))]) | (Unsolved(_), Solved(ty2)) => - Unsolved([Arrow(Unknown(NoProvenance), ty2)]) + Unsolved([Arrow(Unknown(NoProvenance, false), ty2)]) | (Unsolved(_), Unsolved(_)) => - Unsolved([Arrow(Unknown(NoProvenance), Unknown(NoProvenance))]) + Unsolved([ + Arrow(Unknown(NoProvenance, false), Unknown(NoProvenance, false)), + ]) } | Sum(tys_inner) => let is_solved = (s: status): bool => { @@ -264,7 +255,12 @@ and get_status_ptyp = (ctx: Ctx.t, ptyp: ptyp): status => { }; }; -let get_status = (ctx: Ctx.t, id: Id.t): status => { - let pts = Ctx.lookup_or_create(ctx, Typ.AstNode(id)); +// Get suggestion will return the solution associated with the provided id +// if it exists as a typehole for which suggestions are present +// TODO: Add logic for indirect suggestions via ExpHoles constrained to TypeHoles +// eg: scan for ExpHole or Emp +let get_suggestion = (ctx: Ctx.t, id: Id.t): option(status) => { + open Util.OptUtil.Syntax; + let+ pts = Ctx.lookup(ctx, Typ.TypeHole(id)); get_status_pts(ctx, pts); }; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index b38a84761f..1f82aefd22 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -17,13 +17,15 @@ let get_suggestion_text_for_id = (id: Id.t, global_inference_info: global_inference_info) : suggestion(string) => if (global_inference_info.enabled) { - let status = Infer.get_status(global_inference_info.ctx, id); + let status = Infer.get_suggestion(global_inference_info.ctx, id); switch (status) { - | Solved(Unknown(_)) => NoSuggestion(OnlyHoleSolutions) - | Solved(typ) => Solvable(Typ.typ_to_string(typ, false)) - | Unsolved([]) => NoSuggestion(NonTypeHoleId) - | Unsolved([typ]) => NestedInconsistency(Typ.typ_to_string(typ, false)) - | Unsolved(_) => NoSuggestion(InconsistentSet) + | Some(Solved(Unknown(_))) + | Some(Unsolved([])) => NoSuggestion(OnlyHoleSolutions) + | Some(Solved(typ)) => Solvable(Typ.typ_to_string(typ, false)) + | Some(Unsolved([typ])) => + NestedInconsistency(Typ.typ_to_string(typ, false)) + | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) + | None => NoSuggestion(NonTypeHoleId) }; } else { NoSuggestion(SuggestionsDisabled); diff --git a/src/haz3lcore/statics/CoCtx.re b/src/haz3lcore/statics/CoCtx.re index 92c6c37d5b..55ecda35b7 100644 --- a/src/haz3lcore/statics/CoCtx.re +++ b/src/haz3lcore/statics/CoCtx.re @@ -63,8 +63,10 @@ let singleton = (name, id, expected_ty): t => [ let join: (Ctx.t, list(entry)) => Typ.t = (ctx, entries) => { let expected_tys = List.map(entry => entry.expected_ty, entries); - switch (Typ.join_all(~empty=Unknown(NoProvenance), ctx, expected_tys)) { - | None => Unknown(NoProvenance) + switch ( + Typ.join_all(~empty=Unknown(NoProvenance, false), ctx, expected_tys) + ) { + | None => Unknown(NoProvenance, false) | Some(ty) => ty }; }; diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 5b49215ba9..63a7e028b8 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -303,7 +303,7 @@ let rec status_common = switch ( Typ.join_fix( ctx, - Arrow(Unknown(NoProvenance), Unknown(NoProvenance)), + Arrow(Unknown(NoProvenance, false), Unknown(NoProvenance, false)), syn, ) ) { @@ -322,9 +322,9 @@ let rec status_common = } | (BadToken(name), _) => InHole(NoType(BadToken(name))) | (BadTrivAp(ty), _) => InHole(NoType(BadTrivAp(ty))) - | (IsMulti, _) => NotInHole(Syn(Unknown(NoProvenance))) + | (IsMulti, _) => NotInHole(Syn(Unknown(NoProvenance, false))) | (NoJoin(wrap, tys), Ana(ana)) => - let syn: Typ.t = Self.join_of(wrap, Unknown(NoProvenance)); + let syn: Typ.t = Self.join_of(wrap, Unknown(NoProvenance, false)); switch (Typ.join_fix(ctx, ana, syn)) { | None => InHole(Inconsistent(Expectation({ana, syn}))) | Some(_) => @@ -463,13 +463,13 @@ let fixed_typ_ok: ok_pat => Typ.t = let fixed_typ_pat = (ctx, mode: Mode.t, self: Self.pat, termId: Id.t): Typ.t => switch (status_pat(ctx, mode, self)) { - | InHole(_) => Unknown(AstNode(termId)) + | InHole(_) => Unknown(ExpHole(Error, termId), false) | NotInHole(ok) => fixed_typ_ok(ok) }; let fixed_typ_exp = (ctx, mode: Mode.t, self: Self.exp, termId: Id.t): Typ.t => switch (status_exp(ctx, mode, self)) { - | InHole(_) => Unknown(AstNode(termId)) + | InHole(_) => Unknown(ExpHole(Error, termId), false) | NotInHole(ok) => fixed_typ_ok(ok) }; diff --git a/src/haz3lcore/statics/Mode.re b/src/haz3lcore/statics/Mode.re index 0170f69dc4..1c7871cadc 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -29,18 +29,19 @@ let ana: Typ.t => t = ty => Ana(ty); let ty_of = (ctx: Ctx.t, t: t, id: Id.t): (Typ.t, Typ.constraints) => switch (t) { | Ana(ty) => (ty, []) - | Syn => (Unknown(SynSwitch(id)), []) + | Syn => (Typ.unknown_synswitch(id), []) | SynFun => let ((ty_l, ty_r), constraints) = - Typ.matched_arrow(ctx, id, Unknown(SynSwitch(id))); + Typ.matched_arrow(ctx, id, Typ.unknown_synswitch(id)); (Arrow(ty_l, ty_r), constraints); }; let assistant_ty_of: t => Typ.t = fun | Ana(ty) => ty - | Syn => Unknown(NoProvenance) - | SynFun => Arrow(Unknown(NoProvenance), Unknown(NoProvenance)); + | Syn => Unknown(NoProvenance, false) + | SynFun => + Arrow(Unknown(NoProvenance, false), Unknown(NoProvenance, false)); let of_arrow = (ctx: Ctx.t, mode: t, termId: Id.t): ((t, t), Typ.constraints) => @@ -93,7 +94,7 @@ let of_list = (ctx: Ctx.t, mode: t, termId: Id.t): (t, Typ.constraints) => let of_list_concat = (ctx: Ctx.t, id, mode: t): (t, Typ.constraints) => switch (mode) { | Syn - | SynFun => (Ana(List(Unknown(SynSwitch(id)))), []) + | SynFun => (Ana(List(Typ.unknown_synswitch(id))), []) | Ana(ty) => let (matched_typ, constraints) = Typ.matched_list(ctx, id, ty); (Ana(List(matched_typ)), constraints); @@ -135,7 +136,7 @@ let of_ctr_in_ap = (ctx: Ctx.t, mode: t, ctr: Constructor.t): option(t) => is nullary but used as unary; we reflect this by analyzing against an arrow type. Since we can't guess at what the parameter type might have be, we use Unknown. */ - Some(Ana(Arrow(Unknown(NoProvenance), ty_ana))) + Some(Ana(Arrow(Unknown(NoProvenance, false), ty_ana))) | None => None }; diff --git a/src/haz3lcore/statics/Self.re b/src/haz3lcore/statics/Self.re index abcb57f781..6ee7f0300b 100644 --- a/src/haz3lcore/statics/Self.re +++ b/src/haz3lcore/statics/Self.re @@ -101,7 +101,7 @@ let of_ctr = (ctx: Ctx.t, name: Constructor.t): t => let add_source = List.map2((id, ty) => Typ.{id, ty}); let match = (ctx: Ctx.t, tys: list(Typ.t), ids: list(Id.t)): t => - switch (Typ.join_all(~empty=Unknown(NoProvenance), ctx, tys)) { + switch (Typ.join_all(~empty=Unknown(NoProvenance, false), ctx, tys)) { | None => NoJoin(Id, add_source(ids, tys)) | Some(ty) => Just(ty) }; @@ -113,7 +113,7 @@ let listlit = (~empty, ctx: Ctx.t, tys: list(Typ.t), ids: list(Id.t)): t => }; let list_concat = (ctx: Ctx.t, tys: list(Typ.t), ids: list(Id.t)): t => - switch (Typ.join_all(~empty=Unknown(NoProvenance), ctx, tys)) { + switch (Typ.join_all(~empty=Unknown(NoProvenance, false), ctx, tys)) { | None => NoJoin(List, add_source(ids, tys)) | Some(ty) => Just(ty) }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index ea8243ccf8..3353ac92ea 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -121,7 +121,7 @@ let subsumption_constraints = let final_typ = switch (Self.typ_of(ctx, self)) { | Some(typ) => typ - | None => Unknown(AstNode(rep_id)) + | None => Unknown(ExpHole(Error, rep_id), false) }; switch (mode) { | Ana(expected_typ) => [(final_typ, expected_typ)] @@ -129,15 +129,6 @@ let subsumption_constraints = }; }; -let rec is_synswitch_rooted = (prov: Typ.type_provenance) => - switch (prov) { - | NoProvenance - | AstNode(_) - | Free(_) => false - | SynSwitch(_) => true - | Matched(_, prov) => is_synswitch_rooted(prov) - }; - let rec any_to_info_map = (~ctx: Ctx.t, ~ancestors, any: any, m: Map.t) : (CoCtx.t, Map.t, Typ.constraints) => { @@ -194,7 +185,7 @@ and uexp_to_info_map = /* Maybe switch mode to syn */ let mode = switch (mode) { - | Ana(Unknown(prov)) when is_synswitch_rooted(prov) => Mode.Syn + | Ana(Unknown(_, true)) => Mode.Syn | _ => mode }; let add' = (~self: Self.exp, ~co_ctx, ~constraints, m) => { @@ -247,7 +238,8 @@ and uexp_to_info_map = ~constraints=constraints @ subsumption_constraints(IsMulti), ); | Invalid(token) => atomic(BadToken(token)) - | EmptyHole => atomic(Just(Unknown(AstNode(UExp.rep_id(uexp))))) // TODO: replace with ExpHole prov + | EmptyHole => + atomic(Just(Unknown(ExpHole(EmptyHole, UExp.rep_id(uexp)), false))) | Triv => atomic(Just(Prod([]))) | Bool(_) => atomic(Just(Bool)) | Int(_) => atomic(Just(Int)) @@ -259,7 +251,8 @@ and uexp_to_info_map = Mode.of_list_lit(ctx, List.length(es), UExp.rep_id(uexp), mode); let (es, m) = map_m_go(m, modes, es); let tys = List.map(Info.exp_ty, es); - let self = Self.listlit(~empty=Unknown(NoProvenance), ctx, tys, ids); + let self = + Self.listlit(~empty=Unknown(NoProvenance, false), ctx, tys, ids); add( ~self, ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es)), @@ -298,7 +291,7 @@ and uexp_to_info_map = switch (Ctx.lookup_var(ctx, name)) { | None => let boundary_hole: Self.t = - Just(Unknown(AstNode(UExp.rep_id(uexp)))); + Just(Unknown(ExpHole(Error, UExp.rep_id(uexp)), false)); (Free(name), subsumption_constraints(boundary_hole)); | Some(var) => let self: Self.t = Just(var.typ); @@ -590,7 +583,7 @@ and upat_to_info_map = }; let ancestors = [UPat.rep_id(upat)] @ ancestors; let go = upat_to_info_map(~is_synswitch, ~ancestors, ~co_ctx); - let unknown = Typ.Unknown(is_synswitch ? SynSwitch(id) : NoProvenance); + let unknown = Typ.Unknown(ExpHole(Internal, id), is_synswitch); let ctx_fold = (ctx: Ctx.t, m) => List.fold_left2( (((ctx, cs), tys, m), e, mode) => @@ -645,12 +638,12 @@ and upat_to_info_map = | Var(name) => /* NOTE: The self type assigned to pattern variables (Unknown) may be SynSwitch, but SynSwitch is never added to the context; - Unknown(Internal) is used in this case */ + Internal is used in this case */ let ctx_typ = Info.fixed_typ_pat( ctx, mode, - Common(Just(Unknown(AstNode(id)))), + Common(Just(Unknown(ExpHole(Internal, id), false))), id, ); let entry = Ctx.VarEntry({name, id, typ: ctx_typ}); @@ -734,7 +727,10 @@ and utyp_to_info_map = | VariantExpected(m, sum_ty) => ConstructorExpected(m, Arrow(ty_in, sum_ty)) | _ => - ConstructorExpected(Unique, Arrow(ty_in, Unknown(NoProvenance))) + ConstructorExpected( + Unique, + Arrow(ty_in, Unknown(NoProvenance, false)), + ) }; let m = go'(~expects=t1_mode, t1, m) |> snd; let m = go'(~expects=TypeExpected, t2, m) |> snd; diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index ff1c917dca..f62fe7ef69 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -113,7 +113,7 @@ module UTyp = { switch (utyp.term) { | Invalid(_) | MultiHole(_) - | EmptyHole => Unknown(AstNode(rep_id(utyp))) + | EmptyHole => Unknown(TypeHole(rep_id(utyp)), false) | Bool => Bool | Int => Int | Float => Float @@ -121,7 +121,7 @@ module UTyp = { | Var(name) => switch (Ctx.lookup_tvar(ctx, name)) { | Some(_) => Var(name) - | None => Unknown(Free(name)) + | None => Unknown(ExpHole(Free(name), rep_id(utyp)), false) } | Arrow(u1, u2) => Arrow(to_typ(ctx, u1), to_typ(ctx, u2)) | Tuple(us) => Prod(List.map(to_typ(ctx), us)) @@ -130,7 +130,7 @@ module UTyp = { | Parens(u) => to_typ(ctx, u) /* The below cases should occur only inside sums */ | Constructor(_) - | Ap(_) => Unknown(AstNode(rep_id(utyp))) + | Ap(_) => Unknown(ExpHole(Internal, rep_id(utyp)), false) } and to_variant: (Ctx.t, variant) => option(ConstructorMap.binding(option(Typ.t))) = diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 77252187ba..3009b6bd5b 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -8,42 +8,43 @@ let precedence_Sum = 3; let precedence_Const = 4; module rec Typ: { - /* TYPE_PROVENANCE: From whence does an unknown type originate? - - Forms associated with a unique Id.t linking them to some UExp/UPat - ------------------------------------------------------------ - SynSwitch: Generated from an unannotated pattern variable - AstNode: Generated from an expression/pattern/type in the source code - - Forms without a unique Id.t of their own - ---------------------------------------- - Matched: Always derived from some other provenance for use in global inference. - Composed of a 'matched_provenenace' indicating how it was derived, - and the provenance it was derived from. - Generally, will always link to some form with its own unique Id.t - Currently supports matched list, arrow, and prod. - - NoProvenance: Generated for unknown types with no provenance. They did not originate from - any expression/pattern/type in the source program, directly or indirectly. - Consequently, NoProvenance unknown types do not accumulate constraints - or receive inference results.*/ + /* TYPE_PROVENANCE: + From whence does an unknown type originate? + Note: An unknown's provenance should be sufficient to uniquely identify it. + If the unknown is one for which global inference results aren't useful, it can be safely treated as NoProvenance. + + We identify three cases: + NoProvenance: This unknown is either not unique to any specific term in the program, or it is not derived any such term. + Unknowns created outside of the Statics.re often have this provenance. + Eg: Any unknown in Evaluator.re or the unknown type associated with a wildcard. + + Term: This unknown represents a specific term in the program (generally a UPat or UExp). + Such provenances are further distinguished by the kind of term they arise from (and potentially why). + + Matched: This unknown is derived from a specific term in the program through some Matched function. + Eg: The unknowns resulting from an invocation of matched_arrow on another unknown + */ [@deriving (show({with_path: false}), sexp, yojson)] type type_provenance = | NoProvenance - | SynSwitch(Id.t) - | AstNode(Id.t) - | Free(TypVar.t) + | TypeHole(Id.t) + | ExpHole(hole_reason, Id.t) | Matched(matched_provenance, type_provenance) and matched_provenance = | Matched_Arrow_Left | Matched_Arrow_Right | Matched_Prod_N(int) - | Matched_List; + | Matched_List + and hole_reason = + | EmptyHole + | Internal + | Error + | Free(TypVar.t); /* TYP.T: Hazel types */ [@deriving (show({with_path: false}), sexp, yojson)] type t = - | Unknown(type_provenance) + | Unknown(type_provenance, is_synswitch) | Int | Float | Bool @@ -54,7 +55,8 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) - and sum_map = ConstructorMap.t(option(t)); + and sum_map = ConstructorMap.t(option(t)) + and is_synswitch = bool; [@deriving (show({with_path: false}), sexp, yojson)] type sum_entry = ConstructorMap.binding(option(t)); @@ -102,24 +104,30 @@ module rec Typ: { let equivalence_to_string: equivalence => string; let prov_to_string: type_provenance => string; let matched_prov_to_string: matched_provenance => string; + let unknown_synswitch: Id.t => t; } = { + // We retain provenances to uniquely identify different unknowns during inference and to retain information on their sources. [@deriving (show({with_path: false}), sexp, yojson)] type type_provenance = | NoProvenance - | SynSwitch(Id.t) - | AstNode(Id.t) - | Free(TypVar.t) + | TypeHole(Id.t) + | ExpHole(hole_reason, Id.t) | Matched(matched_provenance, type_provenance) and matched_provenance = | Matched_Arrow_Left | Matched_Arrow_Right | Matched_Prod_N(int) - | Matched_List; + | Matched_List + and hole_reason = + | EmptyHole + | Internal + | Error + | Free(TypVar.t); /* TYP.T: Hazel types */ [@deriving (show({with_path: false}), sexp, yojson)] type t = - | Unknown(type_provenance) + | Unknown(type_provenance, is_synswitch) | Int | Float | Bool @@ -130,7 +138,8 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) - and sum_map = ConstructorMap.t(option(t)); + and sum_map = ConstructorMap.t(option(t)) + and is_synswitch = bool; [@deriving (show({with_path: false}), sexp, yojson)] type sum_entry = ConstructorMap.binding(option(t)); @@ -148,55 +157,31 @@ module rec Typ: { /* Strip location information from a list of sources */ let of_source = List.map((source: source) => source.ty); - /* How type provenance information should be collated when - joining unknown types. This probably requires more thought, - but right now TypeHole strictly predominates over Internal - which strictly predominates over SynSwitch. */ - // let join_type_provenance = - // (p1: type_provenance, p2: type_provenance): type_provenance => - // switch (p1, p2) { - // | (Free(tv1), Free(tv2)) when TypVar.eq(tv1, tv2) => Free(tv1) - // | (TypeHole, TypeHole | SynSwitch) - // | (SynSwitch, TypeHole) => TypeHole - // | (SynSwitch, Internal) - // | (Internal, SynSwitch) => SynSwitch - // | (Internal | Free(_), _) - // | (_, Internal | Free(_)) => Internal - // | (SynSwitch, SynSwitch) => SynSwitch - // }; - - // TODO anand: ask andrew about this... - /* - I THINK THIS MIGHT BE THE PROBLEM: WHY IS INFERENCE < SYNSWITCH? - NVM LOL - - How type provenance information should be collated when - joining unknown types. This probably requires more thought, - but right now TypeHole strictly predominates over Internal - which strictly predominates over SynSwitch, which - strictly predominates over NoProvenance. - If two provenances have different Ids, either can be taken as a - representative of the other in later computations regarding the - type as a whole. - Similarly, if two Internal provenances have different matched provenance - strucutres, either structure can be taken. Precedence: - TypeHole > Internal > SynSwitch > Matched > NoProvenance*/ + /* How type provenance information should be collated when joining unknown types. + TypeHole(id) > ExpHole(reason, id) > Matched(_, prov) > NoProvenance + + Generally, we break ties by first favoring provenances more valuable in inference, and then favoring more informative provenances. + - TypeHoles are favored over all other provenances. They can directly own displayable inference suggestions + and are thus favored over others. + - ExpHoles can be displayable suggestions only if they are constrained to some TypeHole and are thus next in precedence. + - Matched provenances have precedence over NoProvenance, as NoProvenance unknowns are entirely ignored in inference. + */ let join_type_provenance = (p1: type_provenance, p2: type_provenance): type_provenance => switch (p1, p2) { - | (Free(tv1), Free(tv2)) when TypVar.eq(tv1, tv2) => Free(tv1) - | (AstNode(_) as t, Matched(_) | AstNode(_) | SynSwitch(_) | NoProvenance) - | (Matched(_) | SynSwitch(_) | NoProvenance, AstNode(_) as t) => t - | (SynSwitch(_) as s, Matched(_) | SynSwitch(_) | NoProvenance) - | (Matched(_) | NoProvenance, SynSwitch(_) as s) => s - | (Matched(_) as inf, NoProvenance | Matched(_)) - | (NoProvenance, Matched(_) as inf) => inf - | (NoProvenance, NoProvenance) => NoProvenance - | _ => - print_endline("TODO anand: get rid of fallthrough"); - NoProvenance; + | (TypeHole(_) as p, _) + | (_, TypeHole(_) as p) => p + | (ExpHole(Free(tv1), _), ExpHole(Free(tv2), _)) + when TypVar.eq(tv1, tv2) => p1 + | (ExpHole(_, _) as p, _) + | (_, ExpHole(_, _) as p) => p + | (Matched(_, _) as p, _) + | (_, Matched(_, _) as p) => p + | (NoProvenance, NoProvenance) => p1 }; + let unknown_synswitch = id => Unknown(ExpHole(Internal, id), true); + let precedence = (ty: t): int => switch (ty) { | Int @@ -218,7 +203,7 @@ module rec Typ: { | Float => Float | Bool => Bool | String => String - | Unknown(prov) => Unknown(prov) + | Unknown(prov, flags) => Unknown(prov, flags) | Arrow(ty1, ty2) => Arrow(subst(s, x, ty1), subst(s, x, ty2)) | Prod(tys) => Prod(List.map(subst(s, x), tys)) | Sum(sm) => Sum(ConstructorMap.map(Option.map(subst(s, x)), sm)) @@ -268,19 +253,22 @@ module rec Typ: { let rec prov_to_string = (prov: type_provenance): string => { switch (prov) { | NoProvenance => "" - | SynSwitch(id) => Id.to_string(id) - | AstNode(id) => Id.to_string(id) - | Free(var) => var | Matched(mprov, type_provenance) => - matched_prov_to_string(mprov) ++ prov_to_string(type_provenance) + matched_prov_to_string(mprov) + ++ "{" + ++ prov_to_string(type_provenance) + ++ "}" + | ExpHole(Free(var), _) => var + | TypeHole(id) + | ExpHole(_, id) => Id.to_string(id) }; } and matched_prov_to_string = (mprov: matched_provenance): string => { switch (mprov) { - | Matched_Arrow_Left => "M->L @" - | Matched_Arrow_Right => "M->R @" - | Matched_Prod_N(n) => "M* " ++ string_of_int(n) - | Matched_List => "M[] @" + | Matched_Arrow_Left => "M->L" + | Matched_Arrow_Right => "M->R" + | Matched_Prod_N(n) => "M*#" ++ string_of_int(n) + | Matched_List => "M[]" }; }; @@ -291,7 +279,7 @@ module rec Typ: { //TODO: parens on ops when ambiguous let parenthesize_if_left_child = s => is_left_child ? "(" ++ s ++ ")" : s; switch (ty) { - | Unknown(prov) => "?" ++ (debug ? prov_to_string(prov) : "") + | Unknown(prov, _) => "?" ++ (debug ? prov_to_string(prov) : "") | Int => "Int" | Float => "Float" | String => "String" @@ -365,15 +353,15 @@ module rec Typ: { (~resolve=false, ~fix, ctx: Ctx.t, ty1: t, ty2: t): option(t) => { let join' = join(~resolve, ~fix, ctx); switch (ty1, ty2) { - | (_, Unknown(AstNode(_) | Free(_)) as ty) when fix => + | (_, Unknown(ExpHole(Free(_), _) | TypeHole(_), _) as ty) when fix => /* NOTE(andrew): This is load bearing for ensuring that function literals get appropriate casts. Examples/Dynamics has regression tests */ Some(ty) - | (Unknown(p1), Unknown(p2)) => - Some(Unknown(join_type_provenance(p1, p2))) + | (Unknown(p1, s1), Unknown(p2, s2)) => + Some(Unknown(join_type_provenance(p1, p2), s1 && s2)) | (Unknown(_), ty) - | (ty, Unknown(NoProvenance | SynSwitch(_))) => Some(ty) + | (ty, Unknown(_)) => Some(ty) | (Var(n1), Var(n2)) => if (n1 == n2) { Some(Var(n1)); @@ -514,60 +502,52 @@ module rec Typ: { }; }; - // Todo: anand and raef: everywhere behavior is conditioned meaningfully on synswitch instead needs to make - // a recursive check in the case of match to see if it is rooted at synswitch - let matched_arrow = (ctx: Ctx.t, termId: Id.t, ty: t): ((t, t), Typ.constraints) => { - let matched_arrow_of_prov = prov => { + let matched_arrow_of_prov = (prov, flags) => { let (arrow_lhs, arrow_rhs) = ( - Unknown(Matched(Matched_Arrow_Left, prov)), - Unknown(Matched(Matched_Arrow_Right, prov)), + Unknown(Matched(Matched_Arrow_Left, prov), flags), + Unknown(Matched(Matched_Arrow_Right, prov), flags), ); ( (arrow_lhs, arrow_rhs), - [(Unknown(prov), Arrow(arrow_lhs, arrow_rhs))], + [(Unknown(prov, flags), Arrow(arrow_lhs, arrow_rhs))], ); }; switch (weak_head_normalize(ctx, ty)) { | Arrow(ty_in, ty_out) => ((ty_in, ty_out), []) - | Unknown(prov) => matched_arrow_of_prov(prov) - | _ => matched_arrow_of_prov(AstNode(termId)) + | Unknown(prov, flags) => matched_arrow_of_prov(prov, flags) + | _ => matched_arrow_of_prov(ExpHole(Error, termId), false) }; }; let matched_prod = (ctx: Ctx.t, length, termId: Id.t, ty: t) => { - // let matched_prod_of_prov = prov => { - // let (prod_lhs, prod_rhs) = ( - // Unknown(Matched(Matched_Prod_Left, prov)), - // Unknown(Matched(Matched_Prod_Right, prov)), - // ); - // ( - // (prod_lhs, prod_rhs), - // [(Unknown(prov), Prod([prod_lhs, prod_rhs]))] // TODO anand: this is not right. - // ); - // }; - let matched_prod_of_prov = prov => { + let matched_prod_of_prov = (prov, flags) => { let matched_prod_typs = - List.init(length, n => Unknown(Matched(Matched_Prod_N(n), prov))); - (matched_prod_typs, [(Unknown(prov), Prod(matched_prod_typs))]); + List.init(length, n => + Unknown(Matched(Matched_Prod_N(n), prov), flags) + ); + ( + matched_prod_typs, + [(Unknown(prov, flags), Prod(matched_prod_typs))], + ); }; switch (weak_head_normalize(ctx, ty)) { | Prod(tys) when List.length(tys) == length => (tys, []) - | Unknown(prov) => matched_prod_of_prov(prov) - | _ => matched_prod_of_prov(AstNode(termId)) + | Unknown(prov, flags) => matched_prod_of_prov(prov, flags) + | _ => matched_prod_of_prov(ExpHole(Error, termId), false) }; }; let matched_list = (_ctx: Ctx.t, termId: Id.t, ty: t) => { - let matched_list_of_prov = prov => { - let list_elts_typ = Unknown(Matched(Matched_List, prov)); - (list_elts_typ, [(Unknown(prov), List(list_elts_typ))]); + let matched_list_of_prov = (prov, flags) => { + let list_elts_typ = Unknown(Matched(Matched_List, prov), flags); + (list_elts_typ, [(Unknown(prov, flags), List(list_elts_typ))]); }; switch (ty) { | List(ty) => (ty, []) - | Unknown(prov) => matched_list_of_prov(prov) - | _ => matched_list_of_prov(AstNode(termId)) + | Unknown(prov, flags) => matched_list_of_prov(prov, flags) + | _ => matched_list_of_prov(ExpHole(Error, termId), false) }; }; diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 86a1071996..2a10afba4f 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -91,10 +91,11 @@ let view_of_global_inference_info = ) => { let font_metrics = Some(font_metrics); if (global_inference_info.enabled) { - let status = Haz3lcore.Infer.get_status(global_inference_info.ctx, id); + let status = + Haz3lcore.Infer.get_suggestion(global_inference_info.ctx, id); switch (status) { - | Solved(ty) => div([Type.view(~font_metrics, ty)]) - | Unsolved(conflicting_typs) => + | Some(Solved(ty)) => div([Type.view(~font_metrics, ty)]) + | Some(Unsolved(conflicting_typs)) => div( ~attr=clss([infoc, "typ"]), [ @@ -138,6 +139,7 @@ let view_of_global_inference_info = ), ], ) + | None => div([]) }; } else { div([]); diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index b9aafb61fd..bb064ca46f 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -45,14 +45,15 @@ let get_suggestion_ui_for_id = ) : InferenceResult.suggestion(Node.t) => if (global_inference_info.enabled) { - let status = Infer.get_status(global_inference_info.ctx, id); + let status = Infer.get_suggestion(global_inference_info.ctx, id); switch (status) { - | Solved(typ) => + | Some(Solved(typ)) => Solvable(typ |> Type.view(~font_metrics, ~with_cls=false)) - | Unsolved([]) => NoSuggestion(NonTypeHoleId) - | Unsolved([typ]) => + | Some(Unsolved([])) => NoSuggestion(OnlyHoleSolutions) + | Some(Unsolved([typ])) => NestedInconsistency(Type.view(~font_metrics, ~with_cls=false, typ)) - | Unsolved(_tys) => NoSuggestion(InconsistentSet) // TODO anand: use tys + | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) + | None => NoSuggestion(NonTypeHoleId) }; } else { NoSuggestion(SuggestionsDisabled); @@ -100,10 +101,11 @@ let get_cursor_inspect_result = (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) : option((bool, list(Typ.t))) => if (global_inference_info.enabled) { - let status = Infer.get_status(global_inference_info.ctx, id); + let status = Infer.get_suggestion(global_inference_info.ctx, id); switch (status) { - | Unsolved(_tys) => Some((false, [])) // TODO anand use tys - | Solved(typ) => Some((true, [typ])) + | Some(Unsolved(tys)) => Some((false, tys)) // TODO anand use tys + | Some(Solved(typ)) => Some((true, [typ])) + | None => None }; } else { None; From c0b0820896bac17506861e70b79dd8ba7823a8a7 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sat, 23 Dec 2023 12:10:34 -0500 Subject: [PATCH 079/129] make debug print string more useful --- src/haz3lcore/statics/TypBase.re | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 3009b6bd5b..9e53dee1a6 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -259,8 +259,13 @@ module rec Typ: { ++ prov_to_string(type_provenance) ++ "}" | ExpHole(Free(var), _) => var - | TypeHole(id) - | ExpHole(_, id) => Id.to_string(id) + | TypeHole(id) => "TypeHole(" ++ Id.to_string(id) ++ ")" + | ExpHole(reason, id) => + "ExpHole(" + ++ reason_to_string(reason) + ++ ", " + ++ Id.to_string(id) + ++ ")" }; } and matched_prov_to_string = (mprov: matched_provenance): string => { @@ -270,6 +275,9 @@ module rec Typ: { | Matched_Prod_N(n) => "M*#" ++ string_of_int(n) | Matched_List => "M[]" }; + } + and reason_to_string = (reason: hole_reason): string => { + reason |> sexp_of_hole_reason |> string_of_sexp; }; let rec typ_to_string = (ty: t, debug): string => { From 6650633c67ffcea1fc9ef0a90f82c1d75a187270 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sat, 23 Dec 2023 12:17:23 -0500 Subject: [PATCH 080/129] sub in old inference module --- src/haz3lcore/inference/ITyp.re | 74 +++ src/haz3lcore/inference/Infer.re | 266 --------- src/haz3lcore/inference/Inference.re | 64 ++ src/haz3lcore/inference/InferenceResult.re | 117 +++- .../inference/MutablePotentialTypeSet.re | 265 ++++++++ .../inference/MutablePotentialTypeSet.rei | 35 ++ src/haz3lcore/inference/PTSGraph.re | 103 ++++ src/haz3lcore/inference/PTSGraph.rei | 23 + src/haz3lcore/inference/PotentialTypeSet.re | 564 ++++++++++++++++++ src/haz3lcore/inference/SuggestionTyp.re | 1 + 10 files changed, 1235 insertions(+), 277 deletions(-) create mode 100644 src/haz3lcore/inference/ITyp.re delete mode 100644 src/haz3lcore/inference/Infer.re create mode 100644 src/haz3lcore/inference/Inference.re create mode 100644 src/haz3lcore/inference/MutablePotentialTypeSet.re create mode 100644 src/haz3lcore/inference/MutablePotentialTypeSet.rei create mode 100644 src/haz3lcore/inference/PTSGraph.re create mode 100644 src/haz3lcore/inference/PTSGraph.rei create mode 100644 src/haz3lcore/inference/PotentialTypeSet.re create mode 100644 src/haz3lcore/inference/SuggestionTyp.re diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re new file mode 100644 index 0000000000..c06c9e5430 --- /dev/null +++ b/src/haz3lcore/inference/ITyp.re @@ -0,0 +1,74 @@ +open Sexplib.Std; +exception TypeVarUnsupported; + +[@deriving (show({with_path: false}), sexp, yojson)] +type t = + | Unknown(Typ.type_provenance) + | Unit + | Int + | Float + | Bool + | String + | List(t) + | Arrow(t, t) + | Sum(t, t) + | Prod(t, t); + +[@deriving (show({with_path: false}), sexp, yojson)] +type equivalence = (t, t) +and constraints = list(equivalence); + +let rec typ_to_ityp: Typ.t => t = + fun + | Unknown(prov) => Unknown(prov) + | Int => Int + | Float => Float + | Bool => Bool + | String => String + | List(tys) => List(typ_to_ityp(tys)) + | Arrow(t1, t2) => Arrow(typ_to_ityp(t1), typ_to_ityp(t2)) + | Sum(t1, t2) => Sum(typ_to_ityp(t1), typ_to_ityp(t2)) + | Prod([single]) => typ_to_ityp(single) + | Prod([hd_ty, ...tl_tys]) => + Prod(typ_to_ityp(hd_ty), typ_to_ityp(Prod(tl_tys))) + | Prod([]) => Unit + | Var(_) => Unknown(Anonymous); + +let unwrap_if_prod = (typ: Typ.t): list(Typ.t) => { + switch (typ) { + | Prod([hd, ...tl]) => [hd, ...tl] + | _ => [typ] + }; +}; + +let rec ityp_to_typ: t => Typ.t = + fun + | Unknown(prov) => Unknown(prov) + | Int => Int + | Float => Float + | Bool => Bool + | String => String + | List(ity) => List(ityp_to_typ(ity)) + | Arrow(t1, t2) => Arrow(ityp_to_typ(t1), ityp_to_typ(t2)) + | Sum(t1, t2) => Sum(ityp_to_typ(t1), ityp_to_typ(t2)) + | Unit => Prod([]) + | Prod(t1, t2) => + Prod([ityp_to_typ(t1)] @ (t2 |> ityp_to_typ |> unwrap_if_prod)); + +let to_ityp_constraints = (constraints: Typ.constraints): constraints => { + constraints + |> List.filter(((t1, t2)) => + t1 != Typ.Unknown(Anonymous) && t2 != Typ.Unknown(Anonymous) + ) + |> List.map(((t1, t2)) => (typ_to_ityp(t1), typ_to_ityp(t2))); +}; + +let rec contains_hole = (ty: t): bool => + switch (ty) { + | Unknown(_) => true + | Arrow(ty1, ty2) + | Sum(ty1, ty2) + | Prod(ty1, ty2) => contains_hole(ty1) || contains_hole(ty2) + | List(l_ty) => contains_hole(l_ty) + | _ => false + }; diff --git a/src/haz3lcore/inference/Infer.re b/src/haz3lcore/inference/Infer.re deleted file mode 100644 index 90403c36d1..0000000000 --- a/src/haz3lcore/inference/Infer.re +++ /dev/null @@ -1,266 +0,0 @@ -type ptyp = - | Int - | Float - | Bool - | String - | Var(string) - | List(pts) - | Arrow(pts, pts) - | Sum(list(pts)) - | Prod(list(pts)) -and pts = UnionFind.elem(list(ptyp)); - -module Ctx = { - type t = Hashtbl.t(Typ.type_provenance, pts); - - let create = (): t => Hashtbl.create(100); - - let lookup = Hashtbl.find_opt; - - let lookup_or_create = (ctx: t, p: Typ.type_provenance): pts => { - let lookup = Hashtbl.find_opt(ctx, p); - switch (lookup) { - | Some(pts) => pts - | None => - let pts = UnionFind.make([]); - Hashtbl.add(ctx, p, pts); - pts; - }; - }; -}; - -let rec pts_of_typ = (ctx: Ctx.t, t: Typ.t): pts => { - switch (t) { - | Typ.Unknown(p, _) => Ctx.lookup_or_create(ctx, p) - | _ => - let ptyp = ptyp_of_typ(ctx, t); - UnionFind.make([ptyp]); - }; -} -and ptyp_of_typ = (ctx: Ctx.t, t: Typ.t): ptyp => { - switch (t) { - | Int => Int - | Float => Float - | Bool => Bool - | String => String - | Var(s) => Var(s) - | List(t) => List(pts_of_typ(ctx, t)) - | Arrow(t1, t2) => Arrow(pts_of_typ(ctx, t1), pts_of_typ(ctx, t2)) - | Sum(_) => Sum([]) // TODO anand and raef: unimplemented - | Rec(_) => Sum([]) // TODO anand and raef: unimplemented - | Prod(ts) => Prod(List.map(pts_of_typ(ctx), ts)) - | Typ.Unknown(_p, _) => failwith("unreachable") - }; -}; - -// return true if pts1 contains pts2 -let rec contains = (pts1: pts, pts2: pts): bool => - if (UnionFind.eq(pts1, pts2)) { - true; - } else { - let pts1_tys = UnionFind.get(pts1); - List.exists(contains_helper(pts2), pts1_tys); - } -// return true if ptyp contains pts2 -and contains_helper = (pts2: pts, ptyp: ptyp): bool => { - switch (ptyp) { - | Int - | Float - | Bool - | String - | Var(_) => false - | List(pts1) => contains(pts1, pts2) - | Arrow(pts1, pts2) => contains(pts1, pts2) || contains(pts2, pts2) - | Sum(tys) => List.exists(contains(pts2), tys) - | Prod(tys) => List.exists(contains(pts2), tys) - }; -}; - -// merge two pts -let rec merge = (ctx: Ctx.t, pts1: pts, pts2: pts): pts => - // TODO: if pts1 contains pts2 or vice versa, pick one arbitrarily and return it - if (contains(pts1, pts2) || contains(pts2, pts1)) { - pts1; - } else { - let pts3 = merge_helper(ctx, pts1, pts2); - let representative = UnionFind.union(pts1, pts2); - let _ = UnionFind.set(representative, pts3); - representative; - } -and merge_helper = (ctx: Ctx.t, pts1: pts, pts2: pts): list(ptyp) => { - let tys1 = UnionFind.get(pts1); - let tys2 = UnionFind.get(pts2); - List.fold_left(extend(ctx), tys1, tys2); -} -and extend = (ctx: Ctx.t, tys: list(ptyp), ptyp: ptyp): list(ptyp) => { - let (newlist, combined) = - List.fold_left( - ((newlist, combined), element) => { - switch (combine_if_similar(ctx, ptyp, element)) { - | Some(ptyp_combined) => ([ptyp_combined, ...newlist], true) - | None => ([element, ...newlist], combined) - } - }, - ([], false), - tys, - ); - if (combined) { - newlist; - } else { - [ptyp, ...newlist]; - }; -} -and combine_if_similar = - (ctx: Ctx.t, ptyp1: ptyp, ptyp2: ptyp): Option.t(ptyp) => { - switch (ptyp1, ptyp2) { - // the same - | (Int, Int) => Some(Int) - | (Float, Float) => Some(Float) - | (Bool, Bool) => Some(Bool) - | (String, String) => Some(String) - | (Var(s1), Var(s2)) when s1 == s2 => Some(Var(s1)) - // similar, merge children - | (List(pts1), List(pts2)) => - let pts = merge(ctx, pts1, pts2); - Some(List(pts)); - | (Arrow(pts1, pts2), Arrow(pts3, pts4)) => - let pts1 = merge(ctx, pts1, pts3); - let pts2 = merge(ctx, pts2, pts4); - Some(Arrow(pts1, pts2)); - | (Sum(tys1), Sum(tys2)) => - if (List.length(tys1) != List.length(tys2)) { - None; - } else { - let tys = List.map2(merge(ctx), tys1, tys2); - Some(Sum(tys)); - } - | (Prod(tys1), Prod(tys2)) => - if (List.length(tys1) != List.length(tys2)) { - None; - } else { - let tys = List.map2(merge(ctx), tys1, tys2); - Some(Prod(tys)); - } - // different, doesn't combine - | _ => None - }; -}; - -// API -let constrain = (ctx: Ctx.t, t1: Typ.t, t2: Typ.t): unit => { - let pts1 = pts_of_typ(ctx, t1); - let pts2 = pts_of_typ(ctx, t2); - let _ = merge(ctx, pts1, pts2); - (); -}; - -type status = - | Solved(Typ.t) - | Unsolved(list(Typ.t)); - -let unwrap_solution = (s: status): Typ.t => { - switch (s) { - | Solved(ty) => ty - | Unsolved([]) => Unknown(NoProvenance, false) // underdetermined - | Unsolved([ty]) => ty // recursively contains something unsolved; return suggestion that will contain an unsolved hole - | Unsolved([_, ..._]) => Unknown(NoProvenance, false) // overdetermined - }; -}; - -// Since inference has completed, we return all suggestions sans provenance -// If accepted, these will change to TypeHole provenances naturally -let rec get_status_pts = (ctx: Ctx.t, pts: pts): status => { - let tys = UnionFind.get(pts); - switch (tys) { - | [ty] => get_status_ptyp(ctx, ty) - | [] => Unsolved([]) - | [_, ..._] as xs => - Unsolved( - xs |> List.map(get_status_ptyp(ctx)) |> List.map(unwrap_solution), - ) - }; -} -and get_status_ptyp = (ctx: Ctx.t, ptyp: ptyp): status => { - switch (ptyp) { - | Int => Solved(Int) - | Float => Solved(Float) - | Bool => Solved(Bool) - | String => Solved(String) - | Var(s) => Solved(Var(s)) - | List(pts) => - switch (get_status_pts(ctx, pts)) { - | Solved(ty) => Solved(List(ty)) - | Unsolved(_) => Unsolved([List(Unknown(NoProvenance, false))]) - } - | Arrow(pts1, pts2) => - switch (get_status_pts(ctx, pts1), get_status_pts(ctx, pts2)) { - | (Solved(ty1), Solved(ty2)) => Solved(Arrow(ty1, ty2)) - | (Solved(ty1), Unsolved(_)) => - Unsolved([Arrow(ty1, Unknown(NoProvenance, false))]) - | (Unsolved(_), Solved(ty2)) => - Unsolved([Arrow(Unknown(NoProvenance, false), ty2)]) - | (Unsolved(_), Unsolved(_)) => - Unsolved([ - Arrow(Unknown(NoProvenance, false), Unknown(NoProvenance, false)), - ]) - } - | Sum(tys_inner) => - let is_solved = (s: status): bool => { - switch (s) { - | Solved(_) => true - | Unsolved(_) => false - }; - }; - let force_unwrap_solution = (s: status): Typ.t => { - switch (s) { - | Solved(ty) => ty - | Unsolved(_) => failwith("unreachable") - }; - }; - let statuses = List.map(get_status_pts(ctx), tys_inner); - if (List.for_all(is_solved, statuses)) { - let tys3 = - statuses - |> List.map(force_unwrap_solution) - |> List.map(typ => ("", Some(typ))); // Makes all constructors the empty string! Prob a bad idea!! - Solved(Sum(tys3)); - } else { - let tys3 = - statuses - |> List.map(unwrap_solution) - |> List.map(typ => ("", Some(typ))); - Unsolved([Sum(tys3)]); - }; - | Prod(tys_inner) => - let is_solved = (s: status): bool => { - switch (s) { - | Solved(_) => true - | Unsolved(_) => false - }; - }; - let force_unwrap_solution = (s: status): Typ.t => { - switch (s) { - | Solved(ty) => ty - | Unsolved(_) => failwith("unreachable") - }; - }; - let statuses = List.map(get_status_pts(ctx), tys_inner); - if (List.for_all(is_solved, statuses)) { - let tys3 = List.map(force_unwrap_solution, statuses); - Solved(Prod(tys3)); - } else { - let tys3 = List.map(unwrap_solution, statuses); - Unsolved([Prod(tys3)]); - }; - }; -}; - -// Get suggestion will return the solution associated with the provided id -// if it exists as a typehole for which suggestions are present -// TODO: Add logic for indirect suggestions via ExpHoles constrained to TypeHoles -// eg: scan for ExpHole or Emp -let get_suggestion = (ctx: Ctx.t, id: Id.t): option(status) => { - open Util.OptUtil.Syntax; - let+ pts = Ctx.lookup(ctx, Typ.TypeHole(id)); - get_status_pts(ctx, pts); -}; diff --git a/src/haz3lcore/inference/Inference.re b/src/haz3lcore/inference/Inference.re new file mode 100644 index 0000000000..271cb775f9 --- /dev/null +++ b/src/haz3lcore/inference/Inference.re @@ -0,0 +1,64 @@ +/** + * NOTE: + * Current formulation does not unify constraints comparing inconsistent constructors. + * Unifying these would cause PotentialTypeSets to be potentially considered invalid without any + * inconsistencies within them, which is a confusing result to represent to a user and may + * pollute other equivalence classes with unhelpful error statuses that static inference can + * already give better results on. + * We decide here that we will only draw inference results on holes and the things these holes + * are compared to through their neighborhood of implied consistencies as governed by attempted + * consistency checks in synthesis and analysis. + */ +// A unification algorithm based on Huet's unification, adjusted so it does not fail +let rec unify = (pts_graph: PTSGraph.t, constraints: ITyp.constraints): unit => { + List.iter(unify_one(pts_graph), constraints); +} +and unify_one = (pts_graph: PTSGraph.t, typs: (ITyp.t, ITyp.t)): unit => { + switch (typs) { + | (List(ty1), List(ty2)) => unify_one(pts_graph, (ty1, ty2)) + | (Arrow(ty1_lhs, ty1_rhs), Arrow(ty2_lhs, ty2_rhs)) + | (Prod(ty1_lhs, ty1_rhs), Prod(ty2_lhs, ty2_rhs)) + | (Sum(ty1_lhs, ty1_rhs), Sum(ty2_lhs, ty2_rhs)) => + unify(pts_graph, [(ty1_lhs, ty2_lhs), (ty1_rhs, ty2_rhs)]) + | (Unknown(_) as hole, t) + | (t, Unknown(_) as hole) => + PTSGraph.add_typ_as_node(pts_graph, hole); + + if (ITyp.contains_hole(t)) { + // if the type it is being constrained to is a potential node, add it then connect the two nodes + PTSGraph.add_typ_as_node(pts_graph, t); + PTSGraph.make_occurs_check(pts_graph, t, hole); + PTSGraph.create_traversable_edge(pts_graph, t, hole); + } else { + // otherwise, simply add t to hole's PotentialTypeSet without making a new node + PTSGraph.create_solution_edge( + pts_graph, + hole, + t, + ); + }; + | _ => () + }; +}; + +let unify_and_report_status = + (constraints: Typ.constraints): list(InferenceResult.t) => { + let inference_pts_graph = PTSGraph.create(); + let constraints = ITyp.to_ityp_constraints(constraints); + + unify(inference_pts_graph, constraints); + + let acc_results = + ( + key: ITyp.t, + mut_potential_typ_set: MutablePotentialTypeSet.t, + acc: list(InferenceResult.t), + ) + : list(InferenceResult.t) => { + [(key, InferenceResult.condense(mut_potential_typ_set, key)), ...acc]; + }; + + let unsorted_results = Hashtbl.fold(acc_results, inference_pts_graph, []); + + List.fast_sort(InferenceResult.comp_results, unsorted_results); +}; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 1f82aefd22..b0e8b97606 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -1,6 +1,14 @@ +type status = + | Solved(ITyp.t) + | Unsolved(PotentialTypeSet.t); + +type t = (ITyp.t, status); + +type type_hole_to_solution = Hashtbl.t(Id.t, status); + type global_inference_info = { enabled: bool, - ctx: Infer.Ctx.t, + solution_statuses: type_hole_to_solution, }; type suggestion('a) = @@ -17,13 +25,16 @@ let get_suggestion_text_for_id = (id: Id.t, global_inference_info: global_inference_info) : suggestion(string) => if (global_inference_info.enabled) { - let status = Infer.get_suggestion(global_inference_info.ctx, id); - switch (status) { - | Some(Solved(Unknown(_))) - | Some(Unsolved([])) => NoSuggestion(OnlyHoleSolutions) - | Some(Solved(typ)) => Solvable(Typ.typ_to_string(typ, false)) - | Some(Unsolved([typ])) => - NestedInconsistency(Typ.typ_to_string(typ, false)) + let status_opt = + Hashtbl.find_opt(global_inference_info.solution_statuses, id); + switch (status_opt) { + | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) + | Some(Solved(ityp)) => + Solvable(ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string) + | Some(Unsolved([potential_typ])) => + NestedInconsistency( + PotentialTypeSet.string_of_potential_typ(false, potential_typ), + ) | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) | None => NoSuggestion(NonTypeHoleId) }; @@ -34,9 +45,93 @@ let get_suggestion_text_for_id = let hole_nib: Nib.t = {shape: Convex, sort: Any}; let hole_mold: Mold.t = {out: Any, in_: [], nibs: (hole_nib, hole_nib)}; -let mk_global_inference_info = (enabled, ctx) => { - {enabled, ctx}; +let empty_solutions = (): type_hole_to_solution => Hashtbl.create(20); + +let mk_global_inference_info = (enabled, annotations) => { + {enabled, solution_statuses: annotations}; }; let empty_info = (): global_inference_info => - mk_global_inference_info(true, Infer.Ctx.create()); + mk_global_inference_info(true, empty_solutions()); + +let get_desired_solutions = + (inference_results: list(t)): type_hole_to_solution => { + let id_and_status_if_type_hole = (result: t): option((Id.t, status)) => { + switch (result) { + | (Unknown(TypeHole(id)), status) => Some((id, status)) + | _ => None + }; + }; + + let elts = List.filter_map(id_and_status_if_type_hole, inference_results); + let new_map = Hashtbl.create(List.length(elts)); + + List.iter(((id, annot)) => Hashtbl.add(new_map, id, annot), elts); + + new_map; +}; + +let condense = + (potential_typ_set: MutablePotentialTypeSet.t, key: ITyp.t): status => { + let (potential_typ_set, err) = + MutablePotentialTypeSet.snapshot_class(potential_typ_set, key); + let sorted_potential_typ_set = + PotentialTypeSet.sort_potential_typ_set(potential_typ_set); + + let filtered_potential_typ_set = + PotentialTypeSet.filter_unneeded_holes( + PotentialTypeSet.is_known, + sorted_potential_typ_set, + ); + + switch (err) { + | Some(_) => Unsolved(filtered_potential_typ_set) + | None => + let solved_opt = + PotentialTypeSet.filtered_potential_typ_set_to_typ( + filtered_potential_typ_set, + ); + switch (solved_opt) { + | Some(typ) => Solved(typ) + | None => Unsolved(filtered_potential_typ_set) + }; + }; +}; + +let rec prov_to_priority = (prov: Typ.type_provenance): int => { + switch (prov) { + | Anonymous => (-1) + | SynSwitch(id) + | TypeHole(id) + | Internal(id) => id + | Inference(_, prov) => prov_to_priority(prov) + }; +}; + +let rec convert_leftmost_to_priority = (typ: ITyp.t): int => { + switch (typ) { + | Int + | Unit + | Float + | String + | Bool => (-1) + | Unknown(prov) => prov_to_priority(prov) + | List(elt_typ) => convert_leftmost_to_priority(elt_typ) + | Arrow(typ_lhs, typ_rhs) + | Prod(typ_lhs, typ_rhs) + | Sum(typ_lhs, typ_rhs) => + let lhs = convert_leftmost_to_priority(typ_lhs); + let rhs = convert_leftmost_to_priority(typ_rhs); + switch (lhs, rhs) { + | ((-1), (-1)) => (-1) + | ((-1), _) => rhs + | _ => lhs + }; + }; +}; + +let comp_results = ((ty1, _): t, (ty2, _): t): int => { + let priority1 = convert_leftmost_to_priority(ty1); + let priority2 = convert_leftmost_to_priority(ty2); + Stdlib.compare(priority1, priority2); +}; diff --git a/src/haz3lcore/inference/MutablePotentialTypeSet.re b/src/haz3lcore/inference/MutablePotentialTypeSet.re new file mode 100644 index 0000000000..322a7131b4 --- /dev/null +++ b/src/haz3lcore/inference/MutablePotentialTypeSet.re @@ -0,0 +1,265 @@ +type error_status = + | Occurs; + +type t = UnionFind.elem((mut_pot_typs, option(error_status))) +and mut_pot_typs = list(mut_pot_typ) +and mut_pot_typ = + | Base(PotentialTypeSet.base_typ) + | Unary(PotentialTypeSet.unary_ctor, t) + | Binary(PotentialTypeSet.binary_ctor, t, t); + +let wrap_without_error = (typs: mut_pot_typs): t => { + (typs, None) |> UnionFind.make; +}; + +let unwrap_and_remove_error = (t: t): mut_pot_typs => { + let (typs, _) = UnionFind.get(t); + typs; +}; + +let combine_error_status = + (err1: option(error_status), err2: option(error_status)) => { + switch (err1, err2) { + | (None, None) => None + | (Some(Occurs), Some(Occurs)) + | (Some(Occurs), None) + | (None, Some(Occurs)) => Some(Occurs) + }; +}; + +let get_combined_error_status_of_classes = + (t1: t, t2: t): option(error_status) => { + let (_, err1) = UnionFind.get(t1); + let (_, err2) = UnionFind.get(t2); + + combine_error_status(err1, err2); +}; + +let rec snapshot_class = + (mut_potential_typ_set: t, occurs_rep: ITyp.t) + : (PotentialTypeSet.t, option(error_status)) => { + let (typs, err1) = UnionFind.get(mut_potential_typ_set); + let (potential_typ_set, err2) = + snapshot_typs(typs, mut_potential_typ_set, occurs_rep); + (potential_typ_set, combine_error_status(err1, err2)); +} +and snapshot_class_from_child = + (mut_potential_typ_set: t, parent: t, occurs_rep: ITyp.t) + : (PotentialTypeSet.t, option(error_status)) => { + UnionFind.eq(mut_potential_typ_set, parent) + ? ( + [occurs_rep |> PotentialTypeSet.ityp_to_potential_typ], + Some(Occurs), + ) + : snapshot_class(mut_potential_typ_set, occurs_rep); +} +and snapshot_typs = + (mut_pot_typs: mut_pot_typs, parent: t, occurs_rep: ITyp.t) + : (PotentialTypeSet.t, option(error_status)) => { + switch (mut_pot_typs) { + | [] => ([], None) + | [hd, ...tl] => + let (pot_typ_hd, err_hd) = snapshot_typ(hd, parent, occurs_rep); + let (potential_typ_set_tl, err_tl) = + snapshot_typs(tl, parent, occurs_rep); + ( + [pot_typ_hd, ...potential_typ_set_tl], + combine_error_status(err_hd, err_tl), + ); + }; +} +and snapshot_typ = + (mut_pot_typ: mut_pot_typ, parent: t, occurs_rep: ITyp.t) + : (PotentialTypeSet.potential_typ, option(error_status)) => { + switch (mut_pot_typ) { + | Base(b) => (PotentialTypeSet.Base(b), None) + | Binary(ctor, mut_potential_typ_set_lhs, mut_potential_typ_set_rhs) => + let (potential_typ_set_lhs, err_lhs) = + snapshot_class_from_child( + mut_potential_typ_set_lhs, + parent, + occurs_rep, + ); + let (potential_typ_set_rhs, err_rhs) = + snapshot_class_from_child( + mut_potential_typ_set_rhs, + parent, + occurs_rep, + ); + ( + PotentialTypeSet.Binary( + ctor, + potential_typ_set_lhs, + potential_typ_set_rhs, + ), + combine_error_status(err_lhs, err_rhs), + ); + | Unary(ctor, mut_potential_typ_set) => + let (potential_typ_set, err) = + snapshot_class_from_child(mut_potential_typ_set, parent, occurs_rep); + (PotentialTypeSet.Unary(ctor, potential_typ_set), err); + }; +}; + +let rec pot_typ_set_to_mut_pot_typ_set = + (potential_typ_set: PotentialTypeSet.t): t => { + List.map(pot_typ_to_mut_pot_typ, potential_typ_set) |> wrap_without_error; +} +and pot_typ_to_mut_pot_typ = + (pot_typ: PotentialTypeSet.potential_typ): mut_pot_typ => { + switch (pot_typ) { + | Base(base_typ) => Base(base_typ) + | Unary(ctor, potential_typ_set) => + Unary(ctor, pot_typ_set_to_mut_pot_typ_set(potential_typ_set)) + | Binary(ctor, potential_typ_set_lhs, potential_typ_set_rhs) => + Binary( + ctor, + pot_typ_set_to_mut_pot_typ_set(potential_typ_set_lhs), + pot_typ_set_to_mut_pot_typ_set(potential_typ_set_rhs), + ) + }; +}; + +let rec preorder_elem_traversal_mut_potential_typ_set = + (mut_potential_typ_set: t): list(t) => { + [ + mut_potential_typ_set, + ...mut_potential_typ_set + |> unwrap_and_remove_error + |> List.map(preorder_traversal_mut_pot_typ) + |> List.flatten, + ]; +} +and preorder_traversal_mut_pot_typ = (mut_pot_typ: mut_pot_typ): list(t) => { + switch (mut_pot_typ) { + | Base(_) => [] + | Unary(_, potential_typ_set) => + preorder_elem_traversal_mut_potential_typ_set(potential_typ_set) + | Binary(_, lhs, rhs) => + preorder_elem_traversal_mut_potential_typ_set(lhs) + @ preorder_elem_traversal_mut_potential_typ_set(rhs) + }; +}; + +let rec preorder_key_traversal_typ = (ty: ITyp.t): list(ITyp.t) => { + switch (ty) { + | Int + | Unit + | Float + | String + | Bool + | Unknown(_) => [ty] + | Arrow(ty_lhs, ty_rhs) + | Prod(ty_lhs, ty_rhs) + | Sum(ty_lhs, ty_rhs) => [ + ty, + ...preorder_key_traversal_typ(ty_lhs) + @ preorder_key_traversal_typ(ty_rhs), + ] + | List(list_ty) => [ty, ...preorder_key_traversal_typ(list_ty)] + }; +}; + +let derive_nested_keys_and_potential_typ_sets = + (key: ITyp.t): (list(ITyp.t), list(t)) => { + let mut_potential_typ_set = + [key |> PotentialTypeSet.ityp_to_potential_typ] + |> pot_typ_set_to_mut_pot_typ_set; + + let preorder_typs = preorder_key_traversal_typ(key); + let preorder_elems = + preorder_elem_traversal_mut_potential_typ_set(mut_potential_typ_set); + + List.combine(preorder_typs, preorder_elems) + |> List.filter(((k, _)) => ITyp.contains_hole(k)) + |> List.split; +}; + +let rec extend_class_with_class = (target: t, extension: t): t => { + let merged_typs = + extend_typs_with_typs( + unwrap_and_remove_error(target), + unwrap_and_remove_error(extension), + ); + let final_rep = UnionFind.union(target, extension); + UnionFind.set( + final_rep, + (merged_typs, get_combined_error_status_of_classes(target, extension)), + ); + final_rep; +} +and extend_typs_with_typs = + (target: mut_pot_typs, extension: mut_pot_typs): mut_pot_typs => { + switch (extension) { + | [] => target + | [pot_typ_extension, ...extension_tl] => + let target = extend_typs_with_typ(target, pot_typ_extension); + extend_typs_with_typs(target, extension_tl); + }; +} +and extend_typs_with_typ = + (target: mut_pot_typs, pot_typ_extension: mut_pot_typ): mut_pot_typs => { + switch (target) { + | [] => [pot_typ_extension] + | [target_hd, ...target_tl] => + let extend_target_tl: unit => mut_pot_typs = ( + () => { + [target_hd, ...extend_typs_with_typ(target_tl, pot_typ_extension)]; + } + ); + switch (target_hd, pot_typ_extension) { + | (_, Base(_)) => + target_hd == pot_typ_extension ? target : extend_target_tl() + | ( + Unary(hd_ctor, hd_potential_typ_set), + Unary(pot_typ_ctor, potential_typ_set), + ) => + hd_ctor == pot_typ_ctor + ? [ + Unary( + hd_ctor, + extend_class_with_class(hd_potential_typ_set, potential_typ_set), + ), + ...target_tl, + ] + : extend_target_tl() + | ( + Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), + Binary(pot_typ_ctor, potential_typ_set_lt, potential_typ_set_rt), + ) => + if (hd_ctor == pot_typ_ctor) { + let hd_potential_typ_set_lt = + extend_class_with_class( + hd_potential_typ_set_lt, + potential_typ_set_lt, + ); + let hd_potential_typ_set_rt = + extend_class_with_class( + hd_potential_typ_set_rt, + potential_typ_set_rt, + ); + [ + Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), + ...target_tl, + ]; + } else { + extend_target_tl(); + } + | (Base(_) | Unary(_), Binary(_)) + | (Base(_) | Binary(_), Unary(_)) => extend_target_tl() + }; + }; +}; + +let union = (t1: t, t2: t): unit => + if (UnionFind.eq(t1, t2)) { + (); + } else { + let _ = extend_class_with_class(t1, t2); + (); + }; + +let mark_failed_occurs = (mut_potential_typ_set: t): unit => { + let (curr_typs, _) = UnionFind.get(mut_potential_typ_set); + UnionFind.set(mut_potential_typ_set, (curr_typs, Some(Occurs))); +}; diff --git a/src/haz3lcore/inference/MutablePotentialTypeSet.rei b/src/haz3lcore/inference/MutablePotentialTypeSet.rei new file mode 100644 index 0000000000..1a25bc24d7 --- /dev/null +++ b/src/haz3lcore/inference/MutablePotentialTypeSet.rei @@ -0,0 +1,35 @@ +/** + * A mutable version of the PotentialTypeSet.t type that allows extension via UnionFind + * such that if one foo: MutablePotentialTypeSet.t is extended (or unioned) with + * bar: MutablePotentialTypeSet.t, both PotentialTypeSetes and all sub-PotentialTypeSetes contained + * within them are union-found with each other. + * Consequently, if either foo or bar are extended with another MutablePotentialTypeSet, + * both will have access to the fully updated PotentialTypeSet without need to dfs + * (as will their children). + * + * NOTE: Preferred usage when not extending/unioning is to call MutablePotentialTypeSet.snapshot_class + * to get an immutable PotentialTypeSet and perform computation on that instead to avoid bugs. + */ + +type error_status = + | Occurs; + +type t = UnionFind.elem((mut_pot_typs, option(error_status))) +and mut_pot_typs = list(mut_pot_typ) +and mut_pot_typ = + | Base(PotentialTypeSet.base_typ) + | Unary(PotentialTypeSet.unary_ctor, t) + | Binary(PotentialTypeSet.binary_ctor, t, t); + +let snapshot_class: + (t, ITyp.t) => (PotentialTypeSet.t, option(error_status)); + +let pot_typ_set_to_mut_pot_typ_set: PotentialTypeSet.t => t; +let pot_typ_to_mut_pot_typ: PotentialTypeSet.potential_typ => mut_pot_typ; + +let derive_nested_keys_and_potential_typ_sets: + ITyp.t => (list(ITyp.t), list(t)); + +let union: (t, t) => unit; + +let mark_failed_occurs: t => unit; diff --git a/src/haz3lcore/inference/PTSGraph.re b/src/haz3lcore/inference/PTSGraph.re new file mode 100644 index 0000000000..c66ccfe281 --- /dev/null +++ b/src/haz3lcore/inference/PTSGraph.re @@ -0,0 +1,103 @@ +type t = Hashtbl.t(ITyp.t, MutablePotentialTypeSet.t); + +let expected_size: int = 50; + +let create = (): t => { + Hashtbl.create(expected_size); +}; + +let add = + ( + pts_graph: t, + key: ITyp.t, + mut_potential_type_set: MutablePotentialTypeSet.t, + ) + : unit => { + switch (Hashtbl.find_opt(pts_graph, key)) { + | Some(curr_mut_potential_type_set) => + MutablePotentialTypeSet.union( + curr_mut_potential_type_set, + mut_potential_type_set, + ) + | None => Hashtbl.add(pts_graph, key, mut_potential_type_set) + }; +}; + +let add_typ_as_node = (pts_graph: t, typ: ITyp.t): unit => { + let (keys, values) = + MutablePotentialTypeSet.derive_nested_keys_and_potential_typ_sets(typ); + List.iter2(add(pts_graph), keys, values); +}; + +let create_traversable_edge = (pts_graph: t, typ1: ITyp.t, typ2: ITyp.t): unit => { + let elem1 = Hashtbl.find(pts_graph, typ1); + let elem2 = Hashtbl.find(pts_graph, typ2); + + MutablePotentialTypeSet.union(elem1, elem2); +}; + +let create_solution_edge = + (pts_graph: t, node_key: ITyp.t, equated_typ: ITyp.t): unit => { + let curr_potential_type_set = Hashtbl.find(pts_graph, node_key); + let mut_potential_typs_extension = + [equated_typ |> PotentialTypeSet.ityp_to_potential_typ] + |> MutablePotentialTypeSet.pot_typ_set_to_mut_pot_typ_set; + + MutablePotentialTypeSet.union( + curr_potential_type_set, + mut_potential_typs_extension, + ); +}; + +let get_keys_in_potential_type_set = + (pts_graph: t, potential_type_set: PotentialTypeSet.t): list(ITyp.t) => { + let add_key_to_acc = + (key: ITyp.t, _: MutablePotentialTypeSet.t, acc: list(ITyp.t)) => { + [key, ...acc]; + }; + let keys = Hashtbl.fold(add_key_to_acc, pts_graph, []); + let is_in_potential_type_set = (key: ITyp.t) => { + let key_potential_typ = PotentialTypeSet.ityp_to_potential_typ(key); + PotentialTypeSet.target_typ_is_in_potential_typ_set( + key_potential_typ, + potential_type_set, + ); + }; + List.filter(is_in_potential_type_set, keys); +}; + +let fail_occurs_check = (pts_graph: t, t1: ITyp.t, t2: ITyp.t): bool => { + let c1 = Hashtbl.find(pts_graph, t1); + let c2 = Hashtbl.find(pts_graph, t2); + + let (snapshot1, err1) = MutablePotentialTypeSet.snapshot_class(c1, t1); + let (snapshot2, err2) = MutablePotentialTypeSet.snapshot_class(c2, t2); + + switch (err1, err2) { + | (Some(MutablePotentialTypeSet.Occurs), _) + | (_, Some(MutablePotentialTypeSet.Occurs)) => true + | _ => + let keys_in_snapshot1 = + get_keys_in_potential_type_set(pts_graph, snapshot1); + let keys_in_snapshot2 = + get_keys_in_potential_type_set(pts_graph, snapshot2); + + List.exists( + PotentialTypeSet.target_typ_in_domain_but_not_equal(snapshot1), + List.map(PotentialTypeSet.ityp_to_potential_typ, keys_in_snapshot2), + ) + || List.exists( + PotentialTypeSet.target_typ_in_domain_but_not_equal(snapshot2), + List.map(PotentialTypeSet.ityp_to_potential_typ, keys_in_snapshot1), + ); + }; +}; + +let make_occurs_check = (pts_graph: t, t1: ITyp.t, t2: ITyp.t): unit => + if (fail_occurs_check(pts_graph, t1, t2)) { + let elem1 = Hashtbl.find(pts_graph, t1); + let elem2 = Hashtbl.find(pts_graph, t2); + + MutablePotentialTypeSet.mark_failed_occurs(elem1); + MutablePotentialTypeSet.mark_failed_occurs(elem2); + }; diff --git a/src/haz3lcore/inference/PTSGraph.rei b/src/haz3lcore/inference/PTSGraph.rei new file mode 100644 index 0000000000..c711d48529 --- /dev/null +++ b/src/haz3lcore/inference/PTSGraph.rei @@ -0,0 +1,23 @@ +/** + * An EqGraph is effectively a map from different types (which for inference, must always contain holes) + * to their current equivalence classes. In some senses, the EqGraph is a condensed representation + * of an undirected graph where all nodes are types and edges constitute equivalences. + * + * For more context: + * The set of all constraints accumulated in static type inference constitutes a series of edges between + * types that can be used to create a graph. + * Consider the connected component a type is a member of. The solution associated with any + * type in a connected component is the least upper bound of all types within it (if it exists). + */ + +type t = Hashtbl.t(ITyp.t, MutablePotentialTypeSet.t); + +let create: unit => t; + +let add_typ_as_node: (t, ITyp.t) => unit; + +let create_traversable_edge: (t, ITyp.t, ITyp.t) => unit; + +let create_solution_edge: (t, ITyp.t, ITyp.t) => unit; + +let make_occurs_check: (t, ITyp.t, ITyp.t) => unit; diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re new file mode 100644 index 0000000000..ceb4132207 --- /dev/null +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -0,0 +1,564 @@ +open Util; +open OptUtil.Syntax; +open Sexplib.Std; + +/** + * An PotentialTypeSet.t is a condensed representation of a list of types. + * It can be a single type, or a composition of other PotentialTypeSet.t + * + * We use PotentialTypeSet to maintain all possible combinations of solutions during unification + * and properly report errors/solutions without combinatorial explosion. + * Inconsistent types and types failing an occurs check can be added to the same PotentialTypeSet without issue, + * preventing unification from ever having to crash. + */ + +[@deriving (show({with_path: false}), sexp)] +type base_typ = + | BUnit + | BInt + | BFloat + | BBool + | BString + | BUnknown(Typ.type_provenance); + +[@deriving (show({with_path: false}), sexp)] +type unary_ctor = + | CList; + +[@deriving (show({with_path: false}), sexp)] +type binary_ctor = + | CArrow + | CProd + | CSum; + +[@deriving (show({with_path: false}), sexp)] +type t = list(potential_typ) +and potential_typ = + | Base(base_typ) + | Unary(unary_ctor, t) + | Binary(binary_ctor, t, t); + +let mk_as_binary_ctor = (ctor: binary_ctor, ty1: ITyp.t, ty2: ITyp.t): ITyp.t => { + switch (ctor) { + | CArrow => Arrow(ty1, ty2) + | CProd => Prod(ty1, ty2) + | CSum => Sum(ty1, ty2) + }; +}; + +let mk_as_unary_ctor = (ctor: unary_ctor, ty: ITyp.t): ITyp.t => { + switch (ctor) { + | CList => List(ty) + }; +}; + +let rec ityp_to_potential_typ: ITyp.t => potential_typ = + fun + | Unknown(prov) => Base(BUnknown(prov)) + | Int => Base(BInt) + | Unit => Base(BUnit) + | Float => Base(BFloat) + | Bool => Base(BBool) + | String => Base(BString) + | Arrow(ty1, ty2) => + Binary( + CArrow, + [ityp_to_potential_typ(ty1)], + [ityp_to_potential_typ(ty2)], + ) + | Prod(ty1, ty2) => + Binary( + CProd, + [ityp_to_potential_typ(ty1)], + [ityp_to_potential_typ(ty2)], + ) + | Sum(ty1, ty2) => + Binary( + CProd, + [ityp_to_potential_typ(ty1)], + [ityp_to_potential_typ(ty2)], + ) + | List(ty) => Unary(CList, [ityp_to_potential_typ(ty)]); + +let typ_to_potential_typ: Typ.t => potential_typ = + typ => { + typ |> ITyp.typ_to_ityp |> ityp_to_potential_typ; + }; + +let base_typ_to_ityp: base_typ => ITyp.t = + fun + | BInt => Int + | BFloat => Float + | BBool => Bool + | BString => String + | BUnit => Unit + | BUnknown(prov) => Unknown(prov); + +let rec extend_with_potential_typ_set = + (target: t, potential_typ_set_extension: t) => { + switch (potential_typ_set_extension) { + | [] => target + | [potential_typ_extension, ...extension_tl] => + let target = extend_with_potential_typ(target, potential_typ_extension); + extend_with_potential_typ_set(target, extension_tl); + }; +} +and extend_with_potential_typ = + (target: t, potential_typ_extension: potential_typ) => { + switch (target) { + | [] => [potential_typ_extension] + | [target_hd, ...target_tl] => + let extend_target_tl: unit => t = ( + () => { + [ + target_hd, + ...extend_with_potential_typ(target_tl, potential_typ_extension), + ]; + } + ); + switch (target_hd, potential_typ_extension) { + | (_, Base(_)) => + target_hd == potential_typ_extension ? target : extend_target_tl() + | ( + Unary(hd_ctor, hd_potential_typ_set), + Unary(potential_typ_ctor, potential_typ_set), + ) => + hd_ctor == potential_typ_ctor + ? [ + Unary( + hd_ctor, + extend_with_potential_typ_set( + hd_potential_typ_set, + potential_typ_set, + ), + ), + ...target_tl, + ] + : extend_target_tl() + | ( + Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), + Binary( + potential_typ_ctor, + potential_typ_set_lt, + potential_typ_set_rt, + ), + ) => + if (hd_ctor == potential_typ_ctor) { + let hd_potential_typ_set_lt = + extend_with_potential_typ_set( + hd_potential_typ_set_lt, + potential_typ_set_lt, + ); + let hd_potential_typ_set_rt = + extend_with_potential_typ_set( + hd_potential_typ_set_rt, + potential_typ_set_rt, + ); + [ + Binary(hd_ctor, hd_potential_typ_set_lt, hd_potential_typ_set_rt), + ...target_tl, + ]; + } else { + extend_target_tl(); + } + | (Base(_) | Unary(_), Binary(_)) + | (Base(_) | Binary(_), Unary(_)) => extend_target_tl() + }; + }; +}; + +type split_result = + | Success + | Error(split_error_status) +and split_error_status = + | Unsplittable + | WrongCtor; + +let split_potential_typ: potential_typ => option((t, t)) = + fun + | Unary(_) + | Base(_) => None + | Binary(_, potential_typ_set1, potential_typ_set2) => + Some((potential_typ_set1, potential_typ_set2)); + +// not currently in use but kept for utility +let split_potential_typ_set = (ctor_used: binary_ctor, potential_typ_set: t) => { + let split_result_of: potential_typ => split_result = + fun + | Base(ty) => + switch (ty) { + | BUnknown(_) => Success + | _ => Error(Unsplittable) + } + | Unary(_) => Error(Unsplittable) + | Binary(ctor, _, _) => ctor_used == ctor ? Success : Error(WrongCtor); + + let accumulate_splits = + ((acc_class_lt, acc_class_rt): (t, t), potential_typ: potential_typ) => { + switch (split_potential_typ(potential_typ)) { + | None => (acc_class_lt, acc_class_rt) + | Some((potential_typ_set_lt, potential_typ_set_rt)) => + let acc_class_lt = + extend_with_potential_typ_set(acc_class_lt, potential_typ_set_lt); + let acc_class_rt = + extend_with_potential_typ_set(acc_class_rt, potential_typ_set_rt); + (acc_class_lt, acc_class_rt); + }; + }; + + let (potential_typ_set_lt, potential_typ_set_rt) = + List.fold_left(accumulate_splits, ([], []), potential_typ_set); + + // Unsplittable errors take precedence over WrongCtor due to strictly more severe error handling + let rec check_ctor = + (potential_typ_set: t, wrong_ctor_error_found: bool): split_result => { + switch (potential_typ_set) { + | [] => wrong_ctor_error_found ? Error(WrongCtor) : Success + | [hd, ...tl] => + switch (split_result_of(hd)) { + | Error(Unsplittable) as e => e + | Error(WrongCtor) => check_ctor(tl, true) + | _ => check_ctor(tl, wrong_ctor_error_found) + } + }; + }; + + ( + check_ctor(potential_typ_set, false), + potential_typ_set_lt, + potential_typ_set_rt, + ); +}; + +let fuse = + (ctor_used: binary_ctor, potential_typ_set_lt: t, potential_typ_set_rt: t) => { + Binary(ctor_used, potential_typ_set_lt, potential_typ_set_rt); +}; + +let rec target_typ_is_in_potential_typ_set = + (target_typ: potential_typ, potential_typ_set: t): bool => { + // is target_typ ∈ potential_typ_set? this would make them equal (via transitivity) + switch (potential_typ_set) { + | [] => false + | [hd, ...tl] => + target_typ_is_in_potential_typ(target_typ, hd) + || target_typ_is_in_potential_typ_set(target_typ, tl) + }; +} +and target_typ_is_in_potential_typ = + (target_typ: potential_typ, potential_typ: potential_typ): bool => { + switch (target_typ, potential_typ) { + | (_, Base(_)) => target_typ == potential_typ + | ( + Unary(target_ctor, target_potential_typ_set), + Unary(ctor, potential_typ_set), + ) => + target_ctor == ctor + && target_class_is_in_potential_typ_set( + target_potential_typ_set, + potential_typ_set, + ) + | ( + Binary(target_ctor, target_class_lt, target_class_rt), + Binary(ctor, potential_typ_set_lt, potential_typ_set_rt), + ) => + target_ctor == ctor + && target_class_is_in_potential_typ_set( + target_class_lt, + potential_typ_set_lt, + ) + && target_class_is_in_potential_typ_set( + target_class_rt, + potential_typ_set_rt, + ) + | (Base(_) | Binary(_), Unary(_)) + | (Base(_) | Unary(_), Binary(_)) => false + }; +} +and target_class_is_in_potential_typ_set = + (target_class: t, potential_typ_set: t): bool => { + // is target_class ∈ potential_typ_set? this would make them equal (via transitivity) + let target_typ_contained = (target_typ: potential_typ): bool => { + target_typ_is_in_potential_typ_set(target_typ, potential_typ_set); + }; + List.for_all(target_typ_contained, target_class); +}; + +let rec target_typ_used_in_potential_typ_set = + (target_typ: potential_typ, potential_typ_set: t): bool => { + // is [target_typ] ⊆ potential_typ_set? + switch (potential_typ_set) { + | [] => false + | [hd, ...tl] => + target_typ_used_in_potential_typ(target_typ, hd) + || target_typ_used_in_potential_typ_set(target_typ, tl) + }; +} +and target_typ_used_in_potential_typ = + (target_typ: potential_typ, potential_typ: potential_typ): bool => { + // target used inside, or is represented by the potential_typ itself + switch (target_typ, potential_typ) { + | (_, Base(_)) => target_typ == potential_typ + | (Unary(_), Unary(_, potential_typ_set)) => + target_typ_used_in_potential_typ_set(target_typ, potential_typ_set) + || target_typ_is_in_potential_typ(target_typ, potential_typ) + | (Binary(_), Binary(_, potential_typ_set_lt, potential_typ_set_rt)) => + target_typ_used_in_potential_typ_set(target_typ, potential_typ_set_lt) + || target_typ_used_in_potential_typ_set(target_typ, potential_typ_set_rt) + || target_typ_is_in_potential_typ(target_typ, potential_typ) + | (Base(_) | Binary(_), Unary(_, potential_typ_set)) => + target_typ_used_in_potential_typ_set(target_typ, potential_typ_set) + | ( + Base(_) | Unary(_), + Binary(_, potential_typ_set_lt, potential_typ_set_rt), + ) => + target_typ_is_in_potential_typ_set(target_typ, potential_typ_set_lt) + || target_typ_is_in_potential_typ_set(target_typ, potential_typ_set_rt) + }; +} +and target_class_used_in_potential_typ_set = + (target_class: t, potential_typ_set: t): bool => { + // is target_class ⊆ potential_typ_set? + let target_typ_used = (target_typ: potential_typ): bool => { + target_typ_used_in_potential_typ_set(target_typ, potential_typ_set); + }; + // every target typ must be used in the eq class for the whole target class to have been used + List.for_all(target_typ_used, target_class); +}; + +let rec target_typ_in_domain_but_not_equal = + (potential_typ_set: t, target_typ: potential_typ): bool => { + List.exists( + target_typ_in_domain_but_not_equal_typ(target_typ), + potential_typ_set, + ); +} +and target_typ_in_domain_but_not_equal_typ = + (target_typ: potential_typ, potential_typ: potential_typ): bool => { + // is target_typ ⊂ potential_typ? + // NOTE: + // target_typ != potential_typ ^ target_typ ⊆ potential_typ + // => target_typ ⊂ potential_typ + !target_typ_is_in_potential_typ(target_typ, potential_typ) + && target_typ_used_in_potential_typ(target_typ, potential_typ); +}; + +let is_known: potential_typ => bool = + fun + | Base(BUnknown(_)) => false + | _ => true; + +let rec filter_unneeded_holes_class = + (comp: potential_typ => bool, remove: bool, potential_typ_set: t): t => { + switch (potential_typ_set) { + | [] => [] + | [hd, ...tl] => + let (had_hole, filtered_hd_opt) = + filter_unneeded_holes_typ(comp, remove, hd); + let remove = had_hole || remove; + switch (filtered_hd_opt) { + | None => filter_unneeded_holes_class(comp, remove, tl) + | Some(filtered_hd) => [ + filtered_hd, + ...filter_unneeded_holes_class(comp, remove, tl), + ] + }; + }; +} +and filter_unneeded_holes_typ = + (comp: potential_typ => bool, remove: bool, potential_typ: potential_typ) + : (bool, option(potential_typ)) => { + switch (potential_typ) { + | Base(btyp) => + switch (btyp) { + | BUnknown(_) => + let eq_tp_opt = remove ? None : Some(potential_typ); + (true, eq_tp_opt); + | _ => (false, Some(potential_typ)) + } + | Unary(ctor, potential_typ_set) => + let delete_holes = List.exists(comp, potential_typ_set); + let potential_typ_set = + filter_unneeded_holes_class(comp, delete_holes, potential_typ_set); + (false, Some(Unary(ctor, potential_typ_set))); + | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => + let delete_holes_lt = List.exists(comp, potential_typ_set_lt); + let delete_holes_rt = List.exists(comp, potential_typ_set_rt); + let potential_typ_set_lt = + filter_unneeded_holes_class( + comp, + delete_holes_lt, + potential_typ_set_lt, + ); + let potential_typ_set_rt = + filter_unneeded_holes_class( + comp, + delete_holes_rt, + potential_typ_set_rt, + ); + (false, Some(Binary(ctor, potential_typ_set_lt, potential_typ_set_rt))); + }; +}; + +let filter_unneeded_holes = + (comp: potential_typ => bool, potential_typ_set: t): t => { + let delete_holes = List.exists(comp, potential_typ_set); + filter_unneeded_holes_class(comp, delete_holes, potential_typ_set); +}; + +let rec filtered_potential_typ_set_to_typ: t => option(ITyp.t) = + fun + | [] => None + | [Base(btyp)] => Some(btyp |> base_typ_to_ityp) + | [Binary(ctor, potential_typ_set_lt, potential_typ_set_rt)] => { + let* typ1 = filtered_potential_typ_set_to_typ(potential_typ_set_lt); + let+ typ2 = filtered_potential_typ_set_to_typ(potential_typ_set_rt); + mk_as_binary_ctor(ctor, typ1, typ2); + } + | [Unary(ctor, potential_typ_set)] => { + let+ elt_typ = filtered_potential_typ_set_to_typ(potential_typ_set); + mk_as_unary_ctor(ctor, elt_typ); + } + | _ => None; + +let comp_potential_typ = + (potential_typ1: potential_typ, potential_typ2: potential_typ): int => { + let strip_id_from_prov: Typ.type_provenance => float = + fun + | SynSwitch(id) + | TypeHole(id) + | Internal(id) => + id == 0 ? (-2.0) : Float.sub(0.0, Float.div(1.0, float_of_int(id))) + | _ => 0.0; + + let potential_typ_to_float: potential_typ => float = + fun + | Base(BInt) + | Base(BUnit) + | Base(BFloat) + | Base(BString) + | Base(BBool) => 1.0 + | Base(BUnknown(prov)) => strip_id_from_prov(prov) + | Binary(_) => 2.0 + | Unary(_) => 3.0; + + Stdlib.compare( + potential_typ_to_float(potential_typ1), + potential_typ_to_float(potential_typ2), + ); +}; + +let rec sort_potential_typ_set = (potential_typ_set: t): t => { + let potential_typ_set = + List.fast_sort(comp_potential_typ, potential_typ_set); + sort_potential_typ_set_explore(potential_typ_set); +} +and sort_potential_typ_set_explore = (potential_typ_set: t): t => { + switch (potential_typ_set) { + | [] => [] + | [hd, ...tl] => + switch (hd) { + | Base(_) => [hd, ...sort_potential_typ_set_explore(tl)] + | Unary(ctor, potential_typ_set_arg) => + let sorted_class = sort_potential_typ_set(potential_typ_set_arg); + [Unary(ctor, sorted_class), ...sort_potential_typ_set(tl)]; + | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => + let sorted_class_lt = sort_potential_typ_set(potential_typ_set_lt); + let sorted_class_rt = sort_potential_typ_set(potential_typ_set_rt); + [ + Binary(ctor, sorted_class_lt, sorted_class_rt), + ...sort_potential_typ_set_explore(tl), + ]; + } + }; +}; + +let string_of_btyp = (btyp: base_typ): string => { + btyp |> base_typ_to_ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string; +}; + +let rec potential_typ_set_to_ityp_unroll = (id: Id.t, pts: t): list(ITyp.t) => { + switch (pts) { + // TODO: raef and anand: fix this to distinguish between solved and unsolved holes + | [] => [ITyp.Unknown(Internal(id))] + | [hd] => [potential_typ_to_ityp(id, hd)] + | _ => List.map(potential_typ_to_ityp(id), pts) + }; +} +and potential_typ_set_to_ityp_no_unroll = (id: Id.t, pts: t): ITyp.t => { + switch (pts) { + // TODO: raef and anand: fix this to distinguish between solved and unsolved holes + | [] => ITyp.Unknown(Anonymous) + | [hd] => potential_typ_to_ityp(id, hd) + | _ => ITyp.Unknown(Anonymous) + }; +} +and potential_typ_to_ityp = (id: Id.t, ptyp: potential_typ): ITyp.t => { + switch (ptyp) { + | Base(btyp) => base_typ_to_ityp(btyp) + | Unary(CList, t) => ITyp.List(potential_typ_set_to_ityp_no_unroll(id, t)) + | Binary(CArrow, t1, t2) => + ITyp.Arrow( + potential_typ_set_to_ityp_no_unroll(id, t1), + potential_typ_set_to_ityp_no_unroll(id, t2), + ) + | Binary(CProd, t1, t2) => + ITyp.Prod( + potential_typ_set_to_ityp_no_unroll(id, t1), + potential_typ_set_to_ityp_no_unroll(id, t2), + ) + | Binary(CSum, t1, t2) => + ITyp.Sum( + potential_typ_set_to_ityp_no_unroll(id, t1), + potential_typ_set_to_ityp_no_unroll(id, t2), + ) + }; +}; + +let rec string_of_potential_typ_set_no_nesting = + (is_left_child, potential_typ_set: t): string => + switch (potential_typ_set) { + | [] => "" + | [hd] => string_of_potential_typ(is_left_child, hd) + | [_hd, ..._tl] => "!" + } +and string_of_potential_typ = + (is_left_child: bool, potential_typ: potential_typ) => + switch (potential_typ) { + | Base(btyp) => string_of_btyp(btyp) + | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => + let (ctor_start, ctor_string, ctor_end) = + switch (ctor) { + | CArrow => is_left_child ? ("(", " -> ", ")") : ("", " -> ", "") + | CProd => ("(", ", ", ")") + | CSum => is_left_child ? ("(", " + ", ")") : ("", " + ", "") + }; + + String.concat( + "", + [ + ctor_start, + string_of_potential_typ_set_no_nesting(true, potential_typ_set_lt), + ctor_string, + string_of_potential_typ_set_no_nesting(false, potential_typ_set_rt), + ctor_end, + ], + ); + | Unary(ctor, potential_typ_set) => + let (start_text, end_text) = + switch (ctor) { + | CList => ("[", "]") + }; + + String.concat( + "", + [ + start_text, + string_of_potential_typ_set_no_nesting(false, potential_typ_set), + end_text, + ], + ); + }; + +let strings_of_potential_typ_set = (potential_typ_set: t): list(string) => + List.map(string_of_potential_typ(false), potential_typ_set); diff --git a/src/haz3lcore/inference/SuggestionTyp.re b/src/haz3lcore/inference/SuggestionTyp.re new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/src/haz3lcore/inference/SuggestionTyp.re @@ -0,0 +1 @@ + From 26c7fa1be1f66d813c6bf06d71e7ca812e15db7b Mon Sep 17 00:00:00 2001 From: RaefM Date: Sat, 23 Dec 2023 13:46:36 -0500 Subject: [PATCH 081/129] Make things compile after substituting in the old inference algos --- src/haz3lcore/inference/ITyp.re | 28 +++-- src/haz3lcore/inference/InferenceResult.re | 22 ++-- src/haz3lcore/inference/PotentialTypeSet.re | 30 +++--- src/haz3lcore/statics/Statics.re | 13 +-- src/haz3lweb/view/Code.re | 14 +-- src/haz3lweb/view/CursorInspector.re | 106 +++++++++--------- src/haz3lweb/view/ExerciseMode.re | 2 +- src/haz3lweb/view/InferenceView.re | 98 ++++++----------- src/haz3lweb/view/Type.re | 113 ++++++++++++++++++-- 9 files changed, 253 insertions(+), 173 deletions(-) diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index c06c9e5430..7bef6b2ac7 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -20,19 +20,33 @@ and constraints = list(equivalence); let rec typ_to_ityp: Typ.t => t = fun - | Unknown(prov) => Unknown(prov) + | Unknown(prov, _) => Unknown(prov) | Int => Int | Float => Float | Bool => Bool | String => String | List(tys) => List(typ_to_ityp(tys)) | Arrow(t1, t2) => Arrow(typ_to_ityp(t1), typ_to_ityp(t2)) - | Sum(t1, t2) => Sum(typ_to_ityp(t1), typ_to_ityp(t2)) | Prod([single]) => typ_to_ityp(single) + | Sum(sum_entries) => { + let (hd_ityp, tl_entries) = unroll_constructor_map(sum_entries); + Sum(hd_ityp, typ_to_ityp(Sum(tl_entries))); + } | Prod([hd_ty, ...tl_tys]) => Prod(typ_to_ityp(hd_ty), typ_to_ityp(Prod(tl_tys))) | Prod([]) => Unit - | Var(_) => Unknown(Anonymous); + | Rec(_, _) + | Var(_) => Unknown(NoProvenance) +and unroll_constructor_map = (sum_map: ConstructorMap.t(option(Typ.t))) => { + switch (sum_map) { + | [] => (Unknown(NoProvenance), []) + | [sum_entry] => (constructor_binding_to_ityp(sum_entry), []) + | [hd_entry, ...tl] => (constructor_binding_to_ityp(hd_entry), tl) + }; +} +and constructor_binding_to_ityp = sum_entry => { + sum_entry |> snd |> Util.OptUtil.get(() => Typ.Prod([])) |> typ_to_ityp; +}; let unwrap_if_prod = (typ: Typ.t): list(Typ.t) => { switch (typ) { @@ -43,14 +57,15 @@ let unwrap_if_prod = (typ: Typ.t): list(Typ.t) => { let rec ityp_to_typ: t => Typ.t = fun - | Unknown(prov) => Unknown(prov) + | Unknown(prov) => Unknown(prov, false) | Int => Int | Float => Float | Bool => Bool | String => String | List(ity) => List(ityp_to_typ(ity)) | Arrow(t1, t2) => Arrow(ityp_to_typ(t1), ityp_to_typ(t2)) - | Sum(t1, t2) => Sum(ityp_to_typ(t1), ityp_to_typ(t2)) + | Sum(t1, t2) => + Sum([("", Some(ityp_to_typ(t1))), ("", Some(ityp_to_typ(t2)))]) | Unit => Prod([]) | Prod(t1, t2) => Prod([ityp_to_typ(t1)] @ (t2 |> ityp_to_typ |> unwrap_if_prod)); @@ -58,7 +73,8 @@ let rec ityp_to_typ: t => Typ.t = let to_ityp_constraints = (constraints: Typ.constraints): constraints => { constraints |> List.filter(((t1, t2)) => - t1 != Typ.Unknown(Anonymous) && t2 != Typ.Unknown(Anonymous) + t1 != Typ.Unknown(NoProvenance, false) + && t2 != Typ.Unknown(NoProvenance, false) ) |> List.map(((t1, t2)) => (typ_to_ityp(t1), typ_to_ityp(t2))); }; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index b0e8b97606..c9724c32c2 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -30,7 +30,8 @@ let get_suggestion_text_for_id = switch (status_opt) { | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) | Some(Solved(ityp)) => - Solvable(ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string) + let typ_to_string = x => Typ.typ_to_string(x, false); + Solvable(ityp |> ITyp.ityp_to_typ |> typ_to_string); | Some(Unsolved([potential_typ])) => NestedInconsistency( PotentialTypeSet.string_of_potential_typ(false, potential_typ), @@ -98,23 +99,22 @@ let condense = }; }; -let rec prov_to_priority = (prov: Typ.type_provenance): int => { +let rec prov_to_priority = (prov: Typ.type_provenance): string => { switch (prov) { - | Anonymous => (-1) - | SynSwitch(id) - | TypeHole(id) - | Internal(id) => id - | Inference(_, prov) => prov_to_priority(prov) + | NoProvenance => "" + | ExpHole(_, id) + | TypeHole(id) => Id.to_string(id) + | Matched(_, prov) => prov_to_priority(prov) }; }; -let rec convert_leftmost_to_priority = (typ: ITyp.t): int => { +let rec convert_leftmost_to_priority = (typ: ITyp.t): string => { switch (typ) { | Int | Unit | Float | String - | Bool => (-1) + | Bool => "" | Unknown(prov) => prov_to_priority(prov) | List(elt_typ) => convert_leftmost_to_priority(elt_typ) | Arrow(typ_lhs, typ_rhs) @@ -123,8 +123,8 @@ let rec convert_leftmost_to_priority = (typ: ITyp.t): int => { let lhs = convert_leftmost_to_priority(typ_lhs); let rhs = convert_leftmost_to_priority(typ_rhs); switch (lhs, rhs) { - | ((-1), (-1)) => (-1) - | ((-1), _) => rhs + | ("", "") => "" + | ("", _) => rhs | _ => lhs }; }; diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index ceb4132207..aca2923697 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -423,24 +423,23 @@ let rec filtered_potential_typ_set_to_typ: t => option(ITyp.t) = let comp_potential_typ = (potential_typ1: potential_typ, potential_typ2: potential_typ): int => { - let strip_id_from_prov: Typ.type_provenance => float = + let rec strip_id: Typ.type_provenance => string = fun - | SynSwitch(id) - | TypeHole(id) - | Internal(id) => - id == 0 ? (-2.0) : Float.sub(0.0, Float.div(1.0, float_of_int(id))) - | _ => 0.0; + | NoProvenance => "" + | ExpHole(_, id) + | TypeHole(id) => Id.to_string(id) + | Matched(_, prov) => strip_id(prov); - let potential_typ_to_float: potential_typ => float = + let potential_typ_to_float: potential_typ => string = fun | Base(BInt) | Base(BUnit) | Base(BFloat) | Base(BString) - | Base(BBool) => 1.0 - | Base(BUnknown(prov)) => strip_id_from_prov(prov) - | Binary(_) => 2.0 - | Unary(_) => 3.0; + | Base(BBool) => "A" + | Base(BUnknown(prov)) => strip_id(prov) + | Binary(_) => "B" + | Unary(_) => "C"; Stdlib.compare( potential_typ_to_float(potential_typ1), @@ -474,13 +473,14 @@ and sort_potential_typ_set_explore = (potential_typ_set: t): t => { }; let string_of_btyp = (btyp: base_typ): string => { - btyp |> base_typ_to_ityp |> ITyp.ityp_to_typ |> Typ.typ_to_string; + let typ_to_string = arg => Typ.typ_to_string(arg, false); + btyp |> base_typ_to_ityp |> ITyp.ityp_to_typ |> typ_to_string; }; let rec potential_typ_set_to_ityp_unroll = (id: Id.t, pts: t): list(ITyp.t) => { switch (pts) { // TODO: raef and anand: fix this to distinguish between solved and unsolved holes - | [] => [ITyp.Unknown(Internal(id))] + | [] => [ITyp.Unknown(ExpHole(Internal, id))] | [hd] => [potential_typ_to_ityp(id, hd)] | _ => List.map(potential_typ_to_ityp(id), pts) }; @@ -488,9 +488,9 @@ let rec potential_typ_set_to_ityp_unroll = (id: Id.t, pts: t): list(ITyp.t) => { and potential_typ_set_to_ityp_no_unroll = (id: Id.t, pts: t): ITyp.t => { switch (pts) { // TODO: raef and anand: fix this to distinguish between solved and unsolved holes - | [] => ITyp.Unknown(Anonymous) + | [] => ITyp.Unknown(NoProvenance) | [hd] => potential_typ_to_ityp(id, hd) - | _ => ITyp.Unknown(Anonymous) + | _ => ITyp.Unknown(ExpHole(Error, id)) }; } and potential_typ_to_ityp = (id: Id.t, ptyp: potential_typ): ITyp.t => { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 3353ac92ea..83465569bd 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -811,16 +811,9 @@ let mk_map_and_inference_solutions = print_endline("~~~Printing constraints:"); info.constraints |> Typ.constraints_to_string |> print_endline; - // rewrite is here - let ctx = Infer.Ctx.create(); - let _ = - List.iter( - c => { - let (typ1, typ2) = c; - Infer.constrain(ctx, typ1, typ2); - }, - info.constraints, - ); + let inference_results = + Inference.unify_and_report_status(info.constraints); + let ctx = InferenceResult.get_desired_solutions(inference_results); (map, ctx); }, diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index d049e64a8e..59bedeb89e 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -41,13 +41,13 @@ let of_delim = let of_grout = ( - font_metrics: FontMetrics.t, - global_inference_info: InferenceResult.global_inference_info, + ~font_metrics, + ~global_inference_info: InferenceResult.global_inference_info, id: Id.t, ) => { let suggestion: InferenceResult.suggestion(Node.t) = InferenceView.get_suggestion_ui_for_id( - ~font_metrics=Some(font_metrics), + ~font_metrics, id, global_inference_info, false, @@ -56,9 +56,9 @@ let of_grout = | NoSuggestion(SuggestionsDisabled) | NoSuggestion(NonTypeHoleId) | NoSuggestion(OnlyHoleSolutions) => [Node.text(Unicode.nbsp)] - | Solvable(_suggestion_node) - | NestedInconsistency(_suggestion_node) => [ - [Node.text("@")] |> span_c("solved-annotation"), + | Solvable(suggestion_node) + | NestedInconsistency(suggestion_node) => [ + [suggestion_node] |> span_c("solved-annotation"), ] | NoSuggestion(InconsistentSet) => [ [Node.text("!")] |> span_c("unsolved-annotation"), @@ -165,7 +165,7 @@ module Text = (M: { expected_sort, t, ) - | Grout(g) => of_grout(font_metrics, global_inference_info, g.id) + | Grout(g) => of_grout(~font_metrics, ~global_inference_info, g.id) | Secondary({content, _}) => of_secondary((content, M.settings.secondary_icons, m(p).last.col)) }; diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 2a10afba4f..115f641ab4 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -90,59 +90,65 @@ let view_of_global_inference_info = id: Id.t, ) => { let font_metrics = Some(font_metrics); - if (global_inference_info.enabled) { - let status = - Haz3lcore.Infer.get_suggestion(global_inference_info.ctx, id); - switch (status) { - | Some(Solved(ty)) => div([Type.view(~font_metrics, ty)]) - | Some(Unsolved(conflicting_typs)) => - div( - ~attr=clss([infoc, "typ"]), - [ - text("conflicting constraints"), - ...List.map( - typ => - div( - ~attr=clss(["typ-view-conflict"]), - [ - Widgets.hoverable_button( - [Type.view(~font_metrics, typ)], - _off_hover => { + switch (InferenceView.get_cursor_inspect_result(~global_inference_info, id)) { + | Some((true, solution)) => + div( + ~attr=clss([infoc, "typ"]), + [ + text("consistent constraints"), + Type.view(~font_metrics, List.nth(solution, 0)), + ], + ) + | Some((false, [typ_with_nested_conflict])) => + div( + ~attr=clss([infoc, "typ"]), + [Type.view(~font_metrics, typ_with_nested_conflict)], + ) + | Some((false, conflicting_typs)) => + div( + ~attr=clss([infoc, "typ"]), + [ + text("conflicting constraints"), + ...List.map( + typ => + div( + ~attr=clss(["typ-view-conflict"]), + [ + Widgets.hoverable_button( + [Type.view(~font_metrics, typ)], + _mouse_event => { + State.set_considering_suggestion(false); + inject(Update.SetMeta(Mouseup)); + }, + _mouse_event => { + State.set_considering_suggestion(true); + if (!State.get_suggestion_pasted()) { + State.set_suggestion_pasted(true); + inject( + Update.Paste( + Haz3lcore.Typ.typ_to_string(typ, false), + ), + ); + } else { + inject(Update.SetMeta(Mouseup)); + }; + }, + _mouse_event => + if (State.get_considering_suggestion()) { + State.set_suggestion_pasted(false); State.set_considering_suggestion(false); + inject(Update.Undo); + } else { inject(Update.SetMeta(Mouseup)); }, - _on_hover => { - State.set_considering_suggestion(true); - if (!State.get_suggestion_pasted()) { - State.set_suggestion_pasted(true); - inject( - Update.Paste( - Haz3lcore.Typ.typ_to_string(typ, false), - ), - ); - } else { - inject(Update.SetMeta(Mouseup)); - }; - }, - _on_click => - if (State.get_considering_suggestion()) { - State.set_suggestion_pasted(false); - State.set_considering_suggestion(false); - inject(Update.Undo); - } else { - inject(Update.SetMeta(Mouseup)); - }, - ), - ], - ), - conflicting_typs, - ), - ], - ) - | None => div([]) - }; - } else { - div([]); + ), + ], + ), + conflicting_typs, + ), + ], + ) + | None => div([]) }; }; diff --git a/src/haz3lweb/view/ExerciseMode.re b/src/haz3lweb/view/ExerciseMode.re index 60dba43280..e0cf653ade 100644 --- a/src/haz3lweb/view/ExerciseMode.re +++ b/src/haz3lweb/view/ExerciseMode.re @@ -82,7 +82,7 @@ let view = let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, - global_inference_info.ctx, + global_inference_info.solution_statuses, ); let (focal_zipper, focal_info_map) = Exercise.focus(exercise, stitched_dynamics); diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index bb064ca46f..97b1df5767 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -1,57 +1,35 @@ +open Util.OptUtil.Syntax; open Virtual_dom.Vdom; open Haz3lcore; -// let get_suggestion_ui_for_id = -// ( -// ~font_metrics, -// id: Id.t, -// global_inference_info: InferenceResult.global_inference_info, -// colored_ui: bool, -// ) -// : InferenceResult.suggestion(Node.t) => -// if (global_inference_info.enabled) { -// let status_opt = -// Hashtbl.find_opt(global_inference_info.solution_statuses, id); -// switch (status_opt) { -// | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) -// | Some(Solved(ityp)) => -// Solvable( -// ityp -// |> ITyp.ityp_to_typ -// |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), -// ) -// | Some(Unsolved([potential_typ])) => -// let ptyp_node = -// Type.view_of_potential_typ( -// ~font_metrics, -// ~with_cls=colored_ui, -// false, -// potential_typ, -// ); -// NestedInconsistency(ptyp_node); -// | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) -// | None => NoSuggestion(NonTypeHoleId) -// }; -// } else { -// NoSuggestion(SuggestionsDisabled); -// }; - let get_suggestion_ui_for_id = ( ~font_metrics, id: Id.t, global_inference_info: InferenceResult.global_inference_info, - _colored_ui: bool, + colored_ui: bool, ) : InferenceResult.suggestion(Node.t) => if (global_inference_info.enabled) { - let status = Infer.get_suggestion(global_inference_info.ctx, id); - switch (status) { - | Some(Solved(typ)) => - Solvable(typ |> Type.view(~font_metrics, ~with_cls=false)) - | Some(Unsolved([])) => NoSuggestion(OnlyHoleSolutions) - | Some(Unsolved([typ])) => - NestedInconsistency(Type.view(~font_metrics, ~with_cls=false, typ)) + let status_opt = + Hashtbl.find_opt(global_inference_info.solution_statuses, id); + switch (status_opt) { + | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) + | Some(Solved(ityp)) => + Solvable( + ityp + |> ITyp.ityp_to_typ + |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), + ) + | Some(Unsolved([potential_typ])) => + let ptyp_node = + Type.view_of_potential_typ( + ~font_metrics, + ~with_cls=colored_ui, + false, + potential_typ, + ); + NestedInconsistency(ptyp_node); | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) | None => NoSuggestion(NonTypeHoleId) }; @@ -77,35 +55,21 @@ let svg_display_settings = (show_svg, is_unsolved); }; -// let get_cursor_inspect_result = -// (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) -// : option((bool, list(Typ.t))) => -// if (global_inference_info.enabled) { -// let* status = -// Hashtbl.find_opt(global_inference_info.solution_statuses, id); -// switch (status) { -// | Unsolved(potential_typ_set) => -// Some(( -// false, -// potential_typ_set -// |> PotentialTypeSet.potential_typ_set_to_ityp_unroll(id) -// |> List.map(ITyp.ityp_to_typ), -// )) -// | Solved(ityp) => Some((true, [ityp |> ITyp.ityp_to_typ])) -// }; -// } else { -// None; -// }; - let get_cursor_inspect_result = (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) : option((bool, list(Typ.t))) => if (global_inference_info.enabled) { - let status = Infer.get_suggestion(global_inference_info.ctx, id); + let* status = + Hashtbl.find_opt(global_inference_info.solution_statuses, id); switch (status) { - | Some(Unsolved(tys)) => Some((false, tys)) // TODO anand use tys - | Some(Solved(typ)) => Some((true, [typ])) - | None => None + | Unsolved(potential_typ_set) => + Some(( + false, + potential_typ_set + |> PotentialTypeSet.potential_typ_set_to_ityp_unroll(id) + |> List.map(ITyp.ityp_to_typ), + )) + | Solved(ityp) => Some((true, [ityp |> ITyp.ityp_to_typ])) }; } else { None; diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index f5d13e6b2a..00dffcdf3f 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -114,11 +114,112 @@ and ctr_view = (~font_metrics, ~with_cls, (ctr, typ)) => ] }; -let view = +let rec view = + ( + ~font_metrics: option(FontMetrics.t)=None, + ~with_cls: bool=true, + ty: Typ.t, + ) + : Node.t => + div_c("typ-wrapper", [view_ty(~font_metrics, ~with_cls, ty)]) +and view_of_potential_typ_set = ( - ~font_metrics: option(FontMetrics.t)=None, - ~with_cls: bool=true, - ty: Typ.t, + ~font_metrics, + ~with_cls, + outermost, + potential_typ_set: PotentialTypeSet.t, ) - : Node.t => - div_c("typ-wrapper", [view_ty(~font_metrics, ~with_cls, ty)]); + : Node.t => { + let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); + switch (potential_typ_set) { + | [] => + view( + ~font_metrics=Some(font_metrics), + ~with_cls, + Typ.Unknown(NoProvenance, false), + ) + | [hd] => view_of_potential_typ(~font_metrics, ~with_cls, outermost, hd) + | _ => + div( + ~attr=clss(["typ-view", "atom", "unknown"]), + [ + EmptyHoleDec.relative_view( + ~font_metrics, + true, + Haz3lcore.InferenceResult.hole_mold, + ), + ], + ) + }; +} +and view_of_potential_typ = + ( + ~font_metrics, + ~with_cls: bool, + is_left_child: bool, + potential_typ: PotentialTypeSet.potential_typ, + ) + : Node.t => { + let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); + switch (potential_typ) { + | Base(btyp) => view_of_base_typ(~font_metrics, ~with_cls, btyp) + | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => + let (ctor_start, ctor_string, ctor_end, cls) = + switch (ctor) { + | CArrow => + is_left_child + ? ("(", " -> ", ")", ["typ-view", "Arrow"]) + : ("", " -> ", "", ["typ-view", "Arrow"]) + | CProd => ("(", ", ", ")", ["typ-view", "Sum"]) + | CSum => + is_left_child + ? ("(", " + ", ")", ["typ-view", "Sum"]) + : ("", " + ", "", ["typ-view", "Sum"]) + }; + div( + ~attr=clss(cls), + [ + text(ctor_start), + view_of_potential_typ_set( + ~font_metrics, + ~with_cls, + false, + potential_typ_set_lt, + ), + text(ctor_string), + view_of_potential_typ_set( + ~font_metrics, + ~with_cls, + false, + potential_typ_set_rt, + ), + text(ctor_end), + ], + ); + | Unary(ctor, potential_typ_set) => + let (start_text, end_text, cls) = + switch (ctor) { + | CList => ("[", "]", ["typ-view", "atom", "List"]) + }; + div( + ~attr=clss(cls), + [ + text(start_text), + view_of_potential_typ_set( + ~font_metrics, + ~with_cls, + false, + potential_typ_set, + ), + text(end_text), + ], + ); + }; +} +and view_of_base_typ = + (~font_metrics, ~with_cls, btyp: PotentialTypeSet.base_typ): Node.t => { + btyp + |> PotentialTypeSet.base_typ_to_ityp + |> ITyp.ityp_to_typ + |> view(~font_metrics=Some(font_metrics), ~with_cls); +}; From bf04f1c8f9f8615937ee5922ea3a5fd966fab1d7 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 24 Dec 2023 18:22:17 -0500 Subject: [PATCH 082/129] debug wip --- src/haz3lcore/Measured.re | 32 +++++++++++++++++-- src/haz3lcore/inference/InferenceResult.re | 21 +++++++++--- src/haz3lcore/zipper/Editor.re | 22 +++++++++---- src/haz3lcore/zipper/EditorUtil.re | 18 ++++++++--- src/haz3lcore/zipper/Printer.re | 4 +-- src/haz3lcore/zipper/action/Perform.re | 5 +-- src/haz3lschool/Exercise.re | 5 +-- src/haz3lschool/Gradescope.re | 1 + src/haz3lweb/Keyboard.re | 1 + src/haz3lweb/ScratchSlide.re | 2 +- src/haz3lweb/Store.re | 21 ++++++++++-- src/haz3lweb/view/Cell.re | 1 + src/haz3lweb/view/Code.re | 24 ++++++++++---- src/haz3lweb/view/CursorInspector.re | 3 +- src/haz3lweb/view/InferenceView.re | 20 +++++++++--- src/haz3lweb/view/LangDoc.re | 3 ++ .../view/assistant/UpdateAssistant.re | 4 ++- src/haz3lweb/www/style.css | 2 +- 18 files changed, 147 insertions(+), 42 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index ea5341af7d..688c5dff34 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -271,12 +271,12 @@ let of_segment = ( ~old: t=empty, ~touched=Touched.empty, - ~_global_inference_info=InferenceResult.empty_info(), + ~global_inference_info=InferenceResult.empty_info(), seg: Segment.t, ) : t => { let is_indented = is_indented_map(seg); - + print_endline("In of_segment"); // recursive across seg's bidelimited containers let rec go_nested = ( @@ -315,6 +315,7 @@ let of_segment = : (Point.t, t) => switch (seg) { | [] => + print_endline("in go_seq def []"); let map = map |> add_row( @@ -326,9 +327,13 @@ let of_segment = ); (origin, map); | [hd, ...tl] => + print_endline("in go_seq def [elts]"); let (contained_indent, origin, map) = switch (hd) { | Secondary(w) when Secondary.is_linebreak(w) => + print_endline( + "in go_seq def secondary linebreak id " ++ Id.to_string(w.id), + ); let row_indent = container_indent + contained_indent; let indent = if (Segment.sameline_secondary(tl)) { @@ -357,17 +362,38 @@ let of_segment = |> add_lb(w.id, indent); (indent, last, map); | Secondary(w) => + print_endline( + "in go_seq def secondary non linebreak " ++ Id.to_string(w.id), + ); let wspace_length = Unicode.length(Secondary.get_string(w.content)); let last = {...origin, col: origin.col + wspace_length}; let map = map |> add_w(w, {origin, last}); (contained_indent, last, map); | Grout(g) => - let annotation_offset = 1; + print_endline("in grout def " ++ Id.to_string(g.id)); + let annotation_offset = + switch ( + InferenceResult.get_suggestion_text_for_id( + g.id, + global_inference_info, + ) + ) { + | Solvable(suggestion_string) + | NestedInconsistency(suggestion_string) => + print_endline( + "Offset: " + ++ (String.length(suggestion_string) |> string_of_int), + ); + String.length(suggestion_string); + | NoSuggestion(_) => 1 + }; + let last = {...origin, col: origin.col + annotation_offset}; let map = map |> add_g(g, {origin, last}); (contained_indent, last, map); | Tile(t) => + print_endline("in tile def " ++ Id.to_string(t.id)); let token = List.nth(t.label); let add_shard = (origin, shard, map) => { let last = diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index c9724c32c2..66d06f7e9b 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -23,25 +23,36 @@ and reason_for_silence = let get_suggestion_text_for_id = (id: Id.t, global_inference_info: global_inference_info) - : suggestion(string) => + : suggestion(string) => { + print_endline("in get suggestion text for id " ++ Id.to_string(id)); if (global_inference_info.enabled) { let status_opt = Hashtbl.find_opt(global_inference_info.solution_statuses, id); switch (status_opt) { - | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) + | Some(Solved(Unknown(_))) => + print_endline("No Suggestion only holes"); + NoSuggestion(OnlyHoleSolutions); | Some(Solved(ityp)) => + print_endline("suggestion solved as a single type"); let typ_to_string = x => Typ.typ_to_string(x, false); Solvable(ityp |> ITyp.ityp_to_typ |> typ_to_string); | Some(Unsolved([potential_typ])) => + print_endline("Suggestion unsolved as a single type"); NestedInconsistency( PotentialTypeSet.string_of_potential_typ(false, potential_typ), - ) - | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) - | None => NoSuggestion(NonTypeHoleId) + ); + | Some(Unsolved(_)) => + print_endline("No suggestion unsolved as many"); + NoSuggestion(InconsistentSet); + | None => + print_endline("No Suggestion non type hole id"); + NoSuggestion(NonTypeHoleId); }; } else { + print_endline("No suggestion disabled"); NoSuggestion(SuggestionsDisabled); }; +}; let hole_nib: Nib.t = {shape: Convex, sort: Any}; let hole_mold: Mold.t = {out: Any, in_: [], nibs: (hole_nib, hole_nib)}; diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 89148bbd68..05424ed74c 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -9,11 +9,17 @@ module Meta = { col_target: int, }; - let init = (z: Zipper.t) => { + let init = (z: Zipper.t, inference_enabled: bool) => { let unselected = Zipper.unselect_and_zip(z); + print_endline("init"); + let (term, _) = MakeTerm.go(unselected); + // TODO Raef: add in flow for the enabled flag + let (_, ctx) = Statics.mk_map_and_inference_solutions(term); + let global_inference_info = + InferenceResult.mk_global_inference_info(inference_enabled, ctx); { touched: Touched.empty, - measured: Measured.of_segment(unselected), + measured: Measured.of_segment(~global_inference_info, unselected), term_ranges: TermRanges.mk(unselected), col_target: 0, }; @@ -55,11 +61,12 @@ module Meta = { let (term, _) = MakeTerm.go(unselected); // TODO Raef: add in flow for the enabled flag let (_, ctx) = Statics.mk_map_and_inference_solutions(term); + print_endline("Edit next"); let measured = Measured.of_segment( ~touched, ~old=measured, - ~_global_inference_info= + ~global_inference_info= InferenceResult.mk_global_inference_info(inference_enabled, ctx), unselected, ); @@ -82,7 +89,10 @@ module State = { meta: Meta.t, }; - let init = zipper => {zipper, meta: Meta.init(zipper)}; + let init = (zipper, inference_enabled) => { + zipper, + meta: Meta.init(zipper, inference_enabled), + }; let next = ( @@ -118,8 +128,8 @@ type t = { read_only: bool, }; -let init = (~read_only=false, z) => { - state: State.init(z), +let init = (~read_only=false, z, inference_enabled) => { + state: State.init(z, inference_enabled), history: History.empty, read_only, }; diff --git a/src/haz3lcore/zipper/EditorUtil.re b/src/haz3lcore/zipper/EditorUtil.re index 818defc18c..4e380537ad 100644 --- a/src/haz3lcore/zipper/EditorUtil.re +++ b/src/haz3lcore/zipper/EditorUtil.re @@ -6,7 +6,12 @@ let editor_of_code = (~read_only=false, code: CodeString.t) => { }; let editors_for = - (~read_only=false, xs: list('a), f: 'a => option(string)) + ( + ~read_only=false, + xs: list('a), + f: 'a => option(string), + inference_enabled, + ) : (int, list(('a, option(Editor.t)))) => { let zs = List.fold_left( @@ -28,7 +33,10 @@ let editors_for = List.map( ((a, sz)) => switch (sz) { - | Some(z) => (a, Some(Editor.init(z, ~read_only))) + | Some(z) => ( + a, + Some(Editor.init(z, ~read_only, inference_enabled)), + ) | None => (a, None) }, zs, @@ -36,8 +44,10 @@ let editors_for = ); }; -let editors_of_strings = (~read_only=false, xs: list(string)) => { - let (i, aes) = editors_for(xs, x => Some(x), ~read_only); +let editors_of_strings = + (~read_only=false, xs: list(string), inference_enabled) => { + let (i, aes) = + editors_for(xs, x => Some(x), ~read_only, inference_enabled); (i, List.map(((_, oe)) => Option.get(oe), aes)); }; diff --git a/src/haz3lcore/zipper/Printer.re b/src/haz3lcore/zipper/Printer.re index e9b88508b7..1b2e29e69f 100644 --- a/src/haz3lcore/zipper/Printer.re +++ b/src/haz3lcore/zipper/Printer.re @@ -143,10 +143,10 @@ let paste_into_zip = (z: Zipper.t, str: string): option(Zipper.t) => { insert a space, and then we immediately delete it. */ let settings = CoreSettings.off; let* z = zipper_of_string(~zipper_init=z, str); - switch (Perform.go_z(~settings, Insert(" "), z)) { + switch (Perform.go_z(~settings, Insert(" "), z, false)) { | Error(_) => None | Ok(z) => - switch (Perform.go_z(~settings, Destruct(Left), z)) { + switch (Perform.go_z(~settings, Destruct(Left), z, false)) { | Error(_) => None | Ok(z) => Some(z) } diff --git a/src/haz3lcore/zipper/action/Perform.re b/src/haz3lcore/zipper/action/Perform.re index 0f1fa5c4e9..7a93da5a3f 100644 --- a/src/haz3lcore/zipper/action/Perform.re +++ b/src/haz3lcore/zipper/action/Perform.re @@ -23,12 +23,13 @@ let go_z = ~settings: CoreSettings.t, a: Action.t, z: Zipper.t, + inference_enabled, ) : Action.Result.t(Zipper.t) => { let meta = switch (meta) { | Some(m) => m - | None => Editor.Meta.init(z) + | None => Editor.Meta.init(z, inference_enabled) }; module M = (val Editor.Meta.module_of_t(meta)); module Move = Move.Make(M); @@ -189,6 +190,6 @@ let go = open Result.Syntax; let Editor.State.{zipper, meta} = ed.state; Effect.s_clear(); - let+ z = go_z(~settings, ~meta, a, zipper); + let+ z = go_z(~settings, ~meta, a, zipper, inference_enabled); Editor.new_state(~effects=Effect.s^, a, z, ed, inference_enabled); }; diff --git a/src/haz3lschool/Exercise.re b/src/haz3lschool/Exercise.re index 026c35c6b7..09856337aa 100644 --- a/src/haz3lschool/Exercise.re +++ b/src/haz3lschool/Exercise.re @@ -339,7 +339,7 @@ module F = (ExerciseEnv: ExerciseEnv) => { }; }; - let editor_of_serialization = zipper => Editor.init(zipper); + let editor_of_serialization = zipper => Editor.init(zipper, false); let eds_of_spec: spec => eds = ( { @@ -501,13 +501,14 @@ module F = (ExerciseEnv: ExerciseEnv) => { (pos, positioned_zippers): persistent_state, ~spec: spec, ~instructor_mode: bool, + ~inference_enabled: bool, ) : state => { let lookup = (pos, default) => if (visible_in(pos, ~instructor_mode)) { let persisted_zipper = List.assoc(pos, positioned_zippers); let zipper = PersistentZipper.unpersist(persisted_zipper); - Editor.init(zipper); + Editor.init(zipper, inference_enabled); } else { editor_of_serialization(default); }; diff --git a/src/haz3lschool/Gradescope.re b/src/haz3lschool/Gradescope.re index bbcc516b27..64668cab6e 100644 --- a/src/haz3lschool/Gradescope.re +++ b/src/haz3lschool/Gradescope.re @@ -116,6 +116,7 @@ module Main = { persistent_state, ~spec, ~instructor_mode=true, + ~inference_enabled=false, ); let report = exercise |> gen_grading_report; {name, report}; diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 2c946c12c2..42c0485d81 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -53,6 +53,7 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { | (Down, "Home") => now(Select(Resize(Extreme(Left(ByToken))))) | (Down, "End") => now(Select(Resize(Extreme(Right(ByToken))))) | (_, "Enter") => + print_endline("Calling get suggestion text from keyboard"); let suggestion_opt = { open Util.OptUtil.Syntax; let+ (p, _) = Zipper.representative_piece(zipper); diff --git a/src/haz3lweb/ScratchSlide.re b/src/haz3lweb/ScratchSlide.re index d7edd72e53..61338e4532 100644 --- a/src/haz3lweb/ScratchSlide.re +++ b/src/haz3lweb/ScratchSlide.re @@ -18,7 +18,7 @@ let persist = (editor: Editor.t) => { let unpersist = (zipper: persistent_state) => { let zipper = PersistentZipper.unpersist(zipper); - Editor.init(zipper, ~read_only=false); + Editor.init(zipper, ~read_only=false, false); }; let serialize = (state: state) => { diff --git a/src/haz3lweb/Store.re b/src/haz3lweb/Store.re index dff41aab92..3f9ca0c085 100644 --- a/src/haz3lweb/Store.re +++ b/src/haz3lweb/Store.re @@ -165,7 +165,7 @@ module Examples = { let unpersist = ((name, zipper)) => { let zipper = PersistentZipper.unpersist(zipper); - (name, Editor.init(zipper, ~read_only=false)); + (name, Editor.init(zipper, ~read_only=false, false)); }; let to_persistent = ((string, slides)): persistent => ( @@ -250,7 +250,14 @@ module Exercise = { switch (JsUtil.get_localstore(keystring)) { | Some(data) => let exercise = - try(Exercise.deserialize_exercise(data, ~spec, ~instructor_mode)) { + try( + Exercise.deserialize_exercise( + data, + ~spec, + ~instructor_mode, + ~inference_enabled=false, + ) + ) { | _ => init_exercise(spec, ~instructor_mode) }; JsUtil.set_localstore(cur_exercise_key, keystring); @@ -288,7 +295,14 @@ module Exercise = { switch (JsUtil.get_localstore(keystring)) { | Some(data) => let exercise = - try(deserialize_exercise(data, ~spec, ~instructor_mode)) { + try( + deserialize_exercise( + data, + ~spec, + ~instructor_mode, + ~inference_enabled=false, + ) + ) { | _ => init_exercise(spec, ~instructor_mode) }; (n, specs, exercise); @@ -351,6 +365,7 @@ module Exercise = { persistent_state, ~spec, ~instructor_mode, + ~inference_enabled=false, ), ~instructor_mode, ) diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index fddbdab17b..bbe098c07d 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -287,6 +287,7 @@ let editor_view = * unzipping for display */ let buffer = Selection.is_buffer(zipper.selection) ? zipper.selection.content : []; + print_endline("Cell"); Id.Map.bindings(Measured.of_segment(buffer).tiles) |> List.map(fst); }; let code_base_view = diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 59bedeb89e..8ce071c02f 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -55,14 +55,24 @@ let of_grout = switch (suggestion) { | NoSuggestion(SuggestionsDisabled) | NoSuggestion(NonTypeHoleId) - | NoSuggestion(OnlyHoleSolutions) => [Node.text(Unicode.nbsp)] + | NoSuggestion(OnlyHoleSolutions) => + print_endline( + "of grout code.re for id " ++ Id.to_string(id) ++ " is blank", + ); + [Node.text(Unicode.nbsp)]; | Solvable(suggestion_node) - | NestedInconsistency(suggestion_node) => [ - [suggestion_node] |> span_c("solved-annotation"), - ] - | NoSuggestion(InconsistentSet) => [ - [Node.text("!")] |> span_c("unsolved-annotation"), - ] + | NestedInconsistency(suggestion_node) => + print_endline( + "of grout code.re for id " + ++ Id.to_string(id) + ++ " is with a suggestion", + ); + [[suggestion_node] |> span_c("solved-annotation")]; + | NoSuggestion(InconsistentSet) => + print_endline( + "of grout code.re for id " ++ Id.to_string(id) ++ " is with a unsolved", + ); + [[Node.text("!")] |> span_c("unsolved-annotation")]; }; }; diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 115f641ab4..68b1e0bdeb 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -242,6 +242,7 @@ let typ_ok_view = ) => switch (ok) { | Type(ty) => + print_endline("calling get suggestion text from CI"); switch ( Haz3lcore.InferenceResult.get_suggestion_text_for_id( id, @@ -259,7 +260,7 @@ let typ_ok_view = id, ), ] - } + }; //TODO(andrew): restore this message? //| Type(_) when cls == Typ(EmptyHole) => [text("Fillable by any type")] //| Type(ty) => [Type.view(ty)] diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index 97b1df5767..2f03d99b7a 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -11,17 +11,22 @@ let get_suggestion_ui_for_id = ) : InferenceResult.suggestion(Node.t) => if (global_inference_info.enabled) { + print_endline("in get suggestion ui for id " ++ Id.to_string(id)); let status_opt = Hashtbl.find_opt(global_inference_info.solution_statuses, id); switch (status_opt) { - | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) + | Some(Solved(Unknown(_))) => + print_endline("no suggestion only holes"); + NoSuggestion(OnlyHoleSolutions); | Some(Solved(ityp)) => + print_endline("suggestion solved as a single type"); Solvable( ityp |> ITyp.ityp_to_typ |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), - ) + ); | Some(Unsolved([potential_typ])) => + print_endline("Suggestion unsolved as a single type"); let ptyp_node = Type.view_of_potential_typ( ~font_metrics, @@ -30,10 +35,16 @@ let get_suggestion_ui_for_id = potential_typ, ); NestedInconsistency(ptyp_node); - | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) - | None => NoSuggestion(NonTypeHoleId) + | Some(Unsolved(_)) => + print_endline("No sugguestion unsolved as many"); + NoSuggestion(InconsistentSet); + | None => + print_endline("No Suggestion non type hole id"); + NoSuggestion(NonTypeHoleId); }; } else { + print_endline("in get suggestion ui"); + print_endline("no suggestion disabled"); NoSuggestion(SuggestionsDisabled); }; @@ -41,6 +52,7 @@ let svg_display_settings = (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) : (bool, bool) => { // Determines if a hexagon (svg) should be used to represent a type hole, and if so, how it should look + print_endline("calling get suggestion text from svg display settingss"); let (show_svg, is_unsolved) = switch ( InferenceResult.get_suggestion_text_for_id(id, global_inference_info) diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index 081d3f9836..9df8229730 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -262,6 +262,7 @@ let deco = ] | _ => [] }; + print_endline("langdoc1"); let specificity_menu = Node.div( ~attr= @@ -384,6 +385,7 @@ let syntactic_form_view = ~form_id, ~global_inference_info, ) => { + print_endline("langdoc2"); let map = Measured.of_segment(unselected); let code_view = Code.simple_view( @@ -429,6 +431,7 @@ let example_view = ? [text("No examples available")] : List.map( ({term, message, _} as example: LangDocMessages.example) => { + print_endline("langdoc3"); let map_code = Measured.of_segment(term); let code_view = Code.simple_view( diff --git a/src/haz3lweb/view/assistant/UpdateAssistant.re b/src/haz3lweb/view/assistant/UpdateAssistant.re index 2b25043d9f..17d41604d3 100644 --- a/src/haz3lweb/view/assistant/UpdateAssistant.re +++ b/src/haz3lweb/view/assistant/UpdateAssistant.re @@ -17,7 +17,9 @@ let reset_buffer = (model: Model.t) => { let z = ed.state.zipper; switch (z.selection.mode) { | Buffer(_) => - switch (Perform.go_z(~settings=model.settings.core, Destruct(Left), z)) { + switch ( + Perform.go_z(~settings=model.settings.core, Destruct(Left), z, false) + ) { | Error(_) => model | Ok(z) => let ed = Editor.new_state(Destruct(Left), z, ed, false); diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index 680f98bfd5..11dc3a7050 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -754,7 +754,7 @@ select { /* INFERENCE ANNOTATIONS */ .solved-annotation { - color: rgb(23, 208, 23); + color: rgb(174, 175, 180) } .unsolved-annotation { From 301117eb4597a8dfba26680e839e631f9bdb143f Mon Sep 17 00:00:00 2001 From: RaefM Date: Mon, 25 Dec 2023 11:16:41 -0500 Subject: [PATCH 083/129] remove init syn; still broken lines --- src/haz3lcore/Measured.re | 5 ++++- src/haz3lcore/zipper/Editor.re | 10 ++-------- 2 files changed, 6 insertions(+), 9 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index 688c5dff34..41b32cdf56 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -371,7 +371,10 @@ let of_segment = let map = map |> add_w(w, {origin, last}); (contained_indent, last, map); | Grout(g) => - print_endline("in grout def " ++ Id.to_string(g.id)); + print_endline( + "calling get suggestion text from measured grout def " + ++ Id.to_string(g.id), + ); let annotation_offset = switch ( InferenceResult.get_suggestion_text_for_id( diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 05424ed74c..9e1d98b10d 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -9,17 +9,11 @@ module Meta = { col_target: int, }; - let init = (z: Zipper.t, inference_enabled: bool) => { + let init = (z: Zipper.t, _inference_enabled: bool) => { let unselected = Zipper.unselect_and_zip(z); - print_endline("init"); - let (term, _) = MakeTerm.go(unselected); - // TODO Raef: add in flow for the enabled flag - let (_, ctx) = Statics.mk_map_and_inference_solutions(term); - let global_inference_info = - InferenceResult.mk_global_inference_info(inference_enabled, ctx); { touched: Touched.empty, - measured: Measured.of_segment(~global_inference_info, unselected), + measured: Measured.of_segment(unselected), term_ranges: TermRanges.mk(unselected), col_target: 0, }; From d89198aaecb13424bd895e048bf96519a6284238 Mon Sep 17 00:00:00 2001 From: RaefM Date: Mon, 25 Dec 2023 11:51:19 -0500 Subject: [PATCH 084/129] Fix UI measured-grout view mismatch issues; Add PatternVar provenance to existence of unannotated patterns --- src/haz3lcore/Measured.re | 20 +------------------- src/haz3lcore/inference/InferenceResult.re | 4 +--- src/haz3lcore/statics/Statics.re | 2 +- src/haz3lcore/statics/TypBase.re | 2 ++ src/haz3lcore/zipper/Editor.re | 1 - src/haz3lweb/view/InferenceView.re | 20 ++++---------------- src/haz3lweb/view/Type.re | 4 +++- 7 files changed, 12 insertions(+), 41 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index 41b32cdf56..1a0c4c2391 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -276,7 +276,6 @@ let of_segment = ) : t => { let is_indented = is_indented_map(seg); - print_endline("In of_segment"); // recursive across seg's bidelimited containers let rec go_nested = ( @@ -315,7 +314,6 @@ let of_segment = : (Point.t, t) => switch (seg) { | [] => - print_endline("in go_seq def []"); let map = map |> add_row( @@ -327,13 +325,9 @@ let of_segment = ); (origin, map); | [hd, ...tl] => - print_endline("in go_seq def [elts]"); let (contained_indent, origin, map) = switch (hd) { | Secondary(w) when Secondary.is_linebreak(w) => - print_endline( - "in go_seq def secondary linebreak id " ++ Id.to_string(w.id), - ); let row_indent = container_indent + contained_indent; let indent = if (Segment.sameline_secondary(tl)) { @@ -362,19 +356,12 @@ let of_segment = |> add_lb(w.id, indent); (indent, last, map); | Secondary(w) => - print_endline( - "in go_seq def secondary non linebreak " ++ Id.to_string(w.id), - ); let wspace_length = Unicode.length(Secondary.get_string(w.content)); let last = {...origin, col: origin.col + wspace_length}; let map = map |> add_w(w, {origin, last}); (contained_indent, last, map); | Grout(g) => - print_endline( - "calling get suggestion text from measured grout def " - ++ Id.to_string(g.id), - ); let annotation_offset = switch ( InferenceResult.get_suggestion_text_for_id( @@ -384,11 +371,7 @@ let of_segment = ) { | Solvable(suggestion_string) | NestedInconsistency(suggestion_string) => - print_endline( - "Offset: " - ++ (String.length(suggestion_string) |> string_of_int), - ); - String.length(suggestion_string); + String.length(suggestion_string) | NoSuggestion(_) => 1 }; @@ -396,7 +379,6 @@ let of_segment = let map = map |> add_g(g, {origin, last}); (contained_indent, last, map); | Tile(t) => - print_endline("in tile def " ++ Id.to_string(t.id)); let token = List.nth(t.label); let add_shard = (origin, shard, map) => { let last = diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 66d06f7e9b..2ed8a78131 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -23,8 +23,7 @@ and reason_for_silence = let get_suggestion_text_for_id = (id: Id.t, global_inference_info: global_inference_info) - : suggestion(string) => { - print_endline("in get suggestion text for id " ++ Id.to_string(id)); + : suggestion(string) => if (global_inference_info.enabled) { let status_opt = Hashtbl.find_opt(global_inference_info.solution_statuses, id); @@ -52,7 +51,6 @@ let get_suggestion_text_for_id = print_endline("No suggestion disabled"); NoSuggestion(SuggestionsDisabled); }; -}; let hole_nib: Nib.t = {shape: Convex, sort: Any}; let hole_mold: Mold.t = {out: Any, in_: [], nibs: (hole_nib, hole_nib)}; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 83465569bd..dc4511ac51 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -643,7 +643,7 @@ and upat_to_info_map = Info.fixed_typ_pat( ctx, mode, - Common(Just(Unknown(ExpHole(Internal, id), false))), + Common(Just(Unknown(ExpHole(PatternVar, id), false))), id, ); let entry = Ctx.VarEntry({name, id, typ: ctx_typ}); diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 9e53dee1a6..089bf21352 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -38,6 +38,7 @@ module rec Typ: { and hole_reason = | EmptyHole | Internal + | PatternVar | Error | Free(TypVar.t); @@ -121,6 +122,7 @@ module rec Typ: { and hole_reason = | EmptyHole | Internal + | PatternVar | Error | Free(TypVar.t); diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 9e1d98b10d..f7cf567868 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -55,7 +55,6 @@ module Meta = { let (term, _) = MakeTerm.go(unselected); // TODO Raef: add in flow for the enabled flag let (_, ctx) = Statics.mk_map_and_inference_solutions(term); - print_endline("Edit next"); let measured = Measured.of_segment( ~touched, diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index 2f03d99b7a..97b1df5767 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -11,22 +11,17 @@ let get_suggestion_ui_for_id = ) : InferenceResult.suggestion(Node.t) => if (global_inference_info.enabled) { - print_endline("in get suggestion ui for id " ++ Id.to_string(id)); let status_opt = Hashtbl.find_opt(global_inference_info.solution_statuses, id); switch (status_opt) { - | Some(Solved(Unknown(_))) => - print_endline("no suggestion only holes"); - NoSuggestion(OnlyHoleSolutions); + | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) | Some(Solved(ityp)) => - print_endline("suggestion solved as a single type"); Solvable( ityp |> ITyp.ityp_to_typ |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), - ); + ) | Some(Unsolved([potential_typ])) => - print_endline("Suggestion unsolved as a single type"); let ptyp_node = Type.view_of_potential_typ( ~font_metrics, @@ -35,16 +30,10 @@ let get_suggestion_ui_for_id = potential_typ, ); NestedInconsistency(ptyp_node); - | Some(Unsolved(_)) => - print_endline("No sugguestion unsolved as many"); - NoSuggestion(InconsistentSet); - | None => - print_endline("No Suggestion non type hole id"); - NoSuggestion(NonTypeHoleId); + | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) + | None => NoSuggestion(NonTypeHoleId) }; } else { - print_endline("in get suggestion ui"); - print_endline("no suggestion disabled"); NoSuggestion(SuggestionsDisabled); }; @@ -52,7 +41,6 @@ let svg_display_settings = (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) : (bool, bool) => { // Determines if a hexagon (svg) should be used to represent a type hole, and if so, how it should look - print_endline("calling get suggestion text from svg display settingss"); let (show_svg, is_unsolved) = switch ( InferenceResult.get_suggestion_text_for_id(id, global_inference_info) diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 00dffcdf3f..4a2ab870f2 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -121,7 +121,9 @@ let rec view = ty: Typ.t, ) : Node.t => - div_c("typ-wrapper", [view_ty(~font_metrics, ~with_cls, ty)]) + with_cls + ? div_c("typ-wrapper", [view_ty(~font_metrics, ~with_cls, ty)]) + : view_ty(~font_metrics, ~with_cls, ty) and view_of_potential_typ_set = ( ~font_metrics, From 51336d5dd314bcb0eda2e5d0594a0ed35e105de6 Mon Sep 17 00:00:00 2001 From: RaefM Date: Mon, 25 Dec 2023 11:53:03 -0500 Subject: [PATCH 085/129] get rid of debug logs --- src/haz3lcore/inference/InferenceResult.re | 17 ++++----------- src/haz3lweb/Keyboard.re | 1 - src/haz3lweb/view/Cell.re | 1 - src/haz3lweb/view/Code.re | 24 +++++++--------------- src/haz3lweb/view/LangDoc.re | 3 --- 5 files changed, 11 insertions(+), 35 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 2ed8a78131..c9724c32c2 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -28,27 +28,18 @@ let get_suggestion_text_for_id = let status_opt = Hashtbl.find_opt(global_inference_info.solution_statuses, id); switch (status_opt) { - | Some(Solved(Unknown(_))) => - print_endline("No Suggestion only holes"); - NoSuggestion(OnlyHoleSolutions); + | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) | Some(Solved(ityp)) => - print_endline("suggestion solved as a single type"); let typ_to_string = x => Typ.typ_to_string(x, false); Solvable(ityp |> ITyp.ityp_to_typ |> typ_to_string); | Some(Unsolved([potential_typ])) => - print_endline("Suggestion unsolved as a single type"); NestedInconsistency( PotentialTypeSet.string_of_potential_typ(false, potential_typ), - ); - | Some(Unsolved(_)) => - print_endline("No suggestion unsolved as many"); - NoSuggestion(InconsistentSet); - | None => - print_endline("No Suggestion non type hole id"); - NoSuggestion(NonTypeHoleId); + ) + | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) + | None => NoSuggestion(NonTypeHoleId) }; } else { - print_endline("No suggestion disabled"); NoSuggestion(SuggestionsDisabled); }; diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 42c0485d81..2c946c12c2 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -53,7 +53,6 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { | (Down, "Home") => now(Select(Resize(Extreme(Left(ByToken))))) | (Down, "End") => now(Select(Resize(Extreme(Right(ByToken))))) | (_, "Enter") => - print_endline("Calling get suggestion text from keyboard"); let suggestion_opt = { open Util.OptUtil.Syntax; let+ (p, _) = Zipper.representative_piece(zipper); diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index bbe098c07d..fddbdab17b 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -287,7 +287,6 @@ let editor_view = * unzipping for display */ let buffer = Selection.is_buffer(zipper.selection) ? zipper.selection.content : []; - print_endline("Cell"); Id.Map.bindings(Measured.of_segment(buffer).tiles) |> List.map(fst); }; let code_base_view = diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 8ce071c02f..59bedeb89e 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -55,24 +55,14 @@ let of_grout = switch (suggestion) { | NoSuggestion(SuggestionsDisabled) | NoSuggestion(NonTypeHoleId) - | NoSuggestion(OnlyHoleSolutions) => - print_endline( - "of grout code.re for id " ++ Id.to_string(id) ++ " is blank", - ); - [Node.text(Unicode.nbsp)]; + | NoSuggestion(OnlyHoleSolutions) => [Node.text(Unicode.nbsp)] | Solvable(suggestion_node) - | NestedInconsistency(suggestion_node) => - print_endline( - "of grout code.re for id " - ++ Id.to_string(id) - ++ " is with a suggestion", - ); - [[suggestion_node] |> span_c("solved-annotation")]; - | NoSuggestion(InconsistentSet) => - print_endline( - "of grout code.re for id " ++ Id.to_string(id) ++ " is with a unsolved", - ); - [[Node.text("!")] |> span_c("unsolved-annotation")]; + | NestedInconsistency(suggestion_node) => [ + [suggestion_node] |> span_c("solved-annotation"), + ] + | NoSuggestion(InconsistentSet) => [ + [Node.text("!")] |> span_c("unsolved-annotation"), + ] }; }; diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index 9df8229730..081d3f9836 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -262,7 +262,6 @@ let deco = ] | _ => [] }; - print_endline("langdoc1"); let specificity_menu = Node.div( ~attr= @@ -385,7 +384,6 @@ let syntactic_form_view = ~form_id, ~global_inference_info, ) => { - print_endline("langdoc2"); let map = Measured.of_segment(unselected); let code_view = Code.simple_view( @@ -431,7 +429,6 @@ let example_view = ? [text("No examples available")] : List.map( ({term, message, _} as example: LangDocMessages.example) => { - print_endline("langdoc3"); let map_code = Measured.of_segment(term); let code_view = Code.simple_view( From 4efc80405ecb96d5c438a510edcd06b56ceef37b Mon Sep 17 00:00:00 2001 From: RaefM Date: Tue, 26 Dec 2023 09:32:32 -0600 Subject: [PATCH 086/129] Add logic to also build out indirect suggestions in global_inference_info; fix issues with branch constraints --- src/haz3lcore/inference/Inference.re | 17 +-- src/haz3lcore/inference/InferenceResult.re | 117 ++++++++++++++++++--- src/haz3lcore/statics/Statics.re | 59 +++++------ src/haz3lweb/view/ExerciseMode.re | 2 +- src/haz3lweb/view/InferenceView.re | 4 +- 5 files changed, 132 insertions(+), 67 deletions(-) diff --git a/src/haz3lcore/inference/Inference.re b/src/haz3lcore/inference/Inference.re index 271cb775f9..a5bc77500e 100644 --- a/src/haz3lcore/inference/Inference.re +++ b/src/haz3lcore/inference/Inference.re @@ -41,24 +41,11 @@ and unify_one = (pts_graph: PTSGraph.t, typs: (ITyp.t, ITyp.t)): unit => { }; }; -let unify_and_report_status = - (constraints: Typ.constraints): list(InferenceResult.t) => { +let solve_constraints = (constraints: Typ.constraints): PTSGraph.t => { let inference_pts_graph = PTSGraph.create(); let constraints = ITyp.to_ityp_constraints(constraints); unify(inference_pts_graph, constraints); - let acc_results = - ( - key: ITyp.t, - mut_potential_typ_set: MutablePotentialTypeSet.t, - acc: list(InferenceResult.t), - ) - : list(InferenceResult.t) => { - [(key, InferenceResult.condense(mut_potential_typ_set, key)), ...acc]; - }; - - let unsorted_results = Hashtbl.fold(acc_results, inference_pts_graph, []); - - List.fast_sort(InferenceResult.comp_results, unsorted_results); + inference_pts_graph; }; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index c9724c32c2..d65804184a 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -6,9 +6,15 @@ type t = (ITyp.t, status); type type_hole_to_solution = Hashtbl.t(Id.t, status); +type unannotated_patterns = list(Id.t); + +type exphole_to_sugg_loc_and_solution = + Hashtbl.t(Id.t, (unannotated_patterns, status)); + type global_inference_info = { enabled: bool, - solution_statuses: type_hole_to_solution, + typehole_suggestions: type_hole_to_solution, + exphole_suggestions: exphole_to_sugg_loc_and_solution, }; type suggestion('a) = @@ -26,7 +32,7 @@ let get_suggestion_text_for_id = : suggestion(string) => if (global_inference_info.enabled) { let status_opt = - Hashtbl.find_opt(global_inference_info.solution_statuses, id); + Hashtbl.find_opt(global_inference_info.typehole_suggestions, id); switch (status_opt) { | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) | Some(Solved(ityp)) => @@ -49,27 +55,29 @@ let hole_mold: Mold.t = {out: Any, in_: [], nibs: (hole_nib, hole_nib)}; let empty_solutions = (): type_hole_to_solution => Hashtbl.create(20); let mk_global_inference_info = (enabled, annotations) => { - {enabled, solution_statuses: annotations}; + { + enabled, + typehole_suggestions: annotations, + exphole_suggestions: Hashtbl.create(0), + }; }; let empty_info = (): global_inference_info => mk_global_inference_info(true, empty_solutions()); -let get_desired_solutions = - (inference_results: list(t)): type_hole_to_solution => { - let id_and_status_if_type_hole = (result: t): option((Id.t, status)) => { - switch (result) { - | (Unknown(TypeHole(id)), status) => Some((id, status)) - | _ => None - }; +let rec get_all_pattern_var_neighbors = + (potential_typ_set: PotentialTypeSet.t): list(Id.t) => { + switch (potential_typ_set) { + | [] => [] + | [hd, ...tl] => + switch (hd) { + | Base(BUnknown(ExpHole(PatternVar, p_id))) => [ + p_id, + ...get_all_pattern_var_neighbors(tl), + ] + | _ => get_all_pattern_var_neighbors(tl) + } }; - - let elts = List.filter_map(id_and_status_if_type_hole, inference_results); - let new_map = Hashtbl.create(List.length(elts)); - - List.iter(((id, annot)) => Hashtbl.add(new_map, id, annot), elts); - - new_map; }; let condense = @@ -135,3 +143,78 @@ let comp_results = ((ty1, _): t, (ty2, _): t): int => { let priority2 = convert_leftmost_to_priority(ty2); Stdlib.compare(priority1, priority2); }; + +let build_type_hole_to_solution = + (unfiltered_inference_results: list(t)): type_hole_to_solution => { + let id_and_status_if_type_hole = (result: t): option((Id.t, status)) => { + switch (result) { + | (Unknown(TypeHole(id)), status) => Some((id, status)) + | _ => None + }; + }; + + let elts = + List.filter_map(id_and_status_if_type_hole, unfiltered_inference_results); + let new_map = Hashtbl.create(List.length(elts)); + + List.iter(((id, annot)) => Hashtbl.add(new_map, id, annot), elts); + + new_map; +}; + +let build_exphole_to_sugg_loc_and_solution = + (inference_pts_graph: PTSGraph.t): exphole_to_sugg_loc_and_solution => { + let acc_results = + ( + key: ITyp.t, + mut_potential_typ_set: MutablePotentialTypeSet.t, + acc: list((Id.t, (list(Id.t), status))), + ) + : list((Id.t, (list(Id.t), status))) => { + switch (key) { + | Unknown(ExpHole(PatternVar, _)) => acc + | Unknown(ExpHole(_, id)) => + let (potential_typ_set, _) = + MutablePotentialTypeSet.snapshot_class(mut_potential_typ_set, key); + switch (get_all_pattern_var_neighbors(potential_typ_set)) { + | [] => acc + | _ as suggestion_locations => [ + ( + id, + (suggestion_locations, condense(mut_potential_typ_set, key)), + ), + ...acc, + ] + }; + | _ => acc + }; + }; + + Hashtbl.fold(acc_results, inference_pts_graph, []) + |> List.to_seq + |> Hashtbl.of_seq; +}; + +let get_desired_solutions = + (inference_pts_graph: PTSGraph.t) + : (type_hole_to_solution, exphole_to_sugg_loc_and_solution) => { + let acc_results = + ( + key: ITyp.t, + mut_potential_typ_set: MutablePotentialTypeSet.t, + acc: list(t), + ) + : list(t) => { + [(key, condense(mut_potential_typ_set, key)), ...acc]; + }; + + let unsorted_results = Hashtbl.fold(acc_results, inference_pts_graph, []); + + let unfiltered_inference_results = + List.fast_sort(comp_results, unsorted_results); + + ( + build_type_hole_to_solution(unfiltered_inference_results), + build_exphole_to_sugg_loc_and_solution(inference_pts_graph), + ); +}; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index dc4511ac51..cd5d9b5a0d 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -91,27 +91,17 @@ let typ_exp_unop: UExp.op_un => (Typ.t, Typ.t) = | Bool(Not) => (Bool, Bool) | Int(Minus) => (Int, Int); -let join_constraints = (self: Self.t): Typ.constraints => { - let thread_constraints = (tys: list(Typ.t)): Typ.constraints => { - // find first element containing hole and constrain it to every other elt - let elts_with_hole = List.filter(Typ.contains_hole, tys); - switch (elts_with_hole) { - | [] => [] - | [hd, ..._] => - let constrain_rep_to_elt = - (acc: Typ.constraints, curr: Typ.t): Typ.constraints => { - [(hd, curr), ...acc]; - }; - List.fold_left(constrain_rep_to_elt, [], tys); +let constrain_branches = (branch_tys: list(Typ.t)): Typ.constraints => { + // find first element containing hole and constrain it to every other elt + let elts_with_hole = List.filter(Typ.contains_hole, branch_tys); + switch (elts_with_hole) { + | [] => [] + | [hd, ..._] => + let constrain_rep_to_elt = + (acc: Typ.constraints, curr: Typ.t): Typ.constraints => { + [(hd, curr), ...acc]; }; - }; - switch ((self: Self.t)) { - | NoJoin(wrap_ty, sources) => - sources - |> Typ.of_source - |> List.map(Self.join_of(wrap_ty)) - |> thread_constraints - | _ => [] + List.fold_left(constrain_rep_to_elt, [], branch_tys); }; }; @@ -189,11 +179,6 @@ and uexp_to_info_map = | _ => mode }; let add' = (~self: Self.exp, ~co_ctx, ~constraints, m) => { - let joined_constraints = - switch (self) { - | Common(t) => join_constraints(t) - | _ => [] - }; let info = Info.derived_exp( ~uexp, @@ -202,7 +187,7 @@ and uexp_to_info_map = ~ancestors, ~self, ~co_ctx, - ~constraints=constraints @ joined_constraints, + ~constraints, ); (info, add_info(ids, InfoExp(info), m)); }; @@ -438,7 +423,11 @@ and uexp_to_info_map = add( ~self=Self.match(ctx, [cons.ty, alt.ty], branch_ids), ~co_ctx=CoCtx.union([cond.co_ctx, cons.co_ctx, alt.co_ctx]), - ~constraints=cond.constraints @ cons.constraints @ alt.constraints, + ~constraints= + cond.constraints + @ cons.constraints + @ alt.constraints + @ constrain_branches([cons.ty, alt.ty]), m, ); | Match(scrut, rules) => @@ -457,6 +446,7 @@ and uexp_to_info_map = ); let p_ctxs = List.map(Info.pat_ctx, ps'); let p_constraints = ListUtil.flat_map(Info.pat_constraints, ps'); + let p_typs = List.map(Info.pat_ty, ps'); let (es, m) = List.fold_left2( ((es, m), e, ctx) => @@ -467,6 +457,7 @@ and uexp_to_info_map = ); let e_tys = List.map(Info.exp_ty, es); let e_constraints = ListUtil.flat_map(Info.exp_constraints, es); + let e_typs = List.map(Info.exp_ty, es); let e_co_ctxs = List.map2(CoCtx.mk(ctx), p_ctxs, List.map(Info.exp_co_ctx, es)); /* Add co-ctxs to patterns */ @@ -478,7 +469,12 @@ and uexp_to_info_map = m, ); add( - ~constraints=scrut.constraints @ e_constraints @ p_constraints, + ~constraints= + scrut.constraints + @ e_constraints + @ p_constraints + @ constrain_branches(p_typs) + @ constrain_branches(e_typs), ~self=Self.match(ctx, e_tys, branch_ids), ~co_ctx=CoCtx.union([scrut.co_ctx] @ e_co_ctxs), m, @@ -571,7 +567,7 @@ and upat_to_info_map = ~co_ctx, ~mode, ~ancestors, - ~constraints=constraints @ join_constraints(self), + ~constraints, ~self=Common(self), ); (info, add_info(ids, InfoPat(info), m)); @@ -811,9 +807,8 @@ let mk_map_and_inference_solutions = print_endline("~~~Printing constraints:"); info.constraints |> Typ.constraints_to_string |> print_endline; - let inference_results = - Inference.unify_and_report_status(info.constraints); - let ctx = InferenceResult.get_desired_solutions(inference_results); + let pts_graph = Inference.solve_constraints(info.constraints); + let (ctx, _) = InferenceResult.get_desired_solutions(pts_graph); (map, ctx); }, diff --git a/src/haz3lweb/view/ExerciseMode.re b/src/haz3lweb/view/ExerciseMode.re index e0cf653ade..e24b2e6beb 100644 --- a/src/haz3lweb/view/ExerciseMode.re +++ b/src/haz3lweb/view/ExerciseMode.re @@ -82,7 +82,7 @@ let view = let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, - global_inference_info.solution_statuses, + global_inference_info.typehole_suggestions, ); let (focal_zipper, focal_info_map) = Exercise.focus(exercise, stitched_dynamics); diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index 97b1df5767..7728375f0d 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -12,7 +12,7 @@ let get_suggestion_ui_for_id = : InferenceResult.suggestion(Node.t) => if (global_inference_info.enabled) { let status_opt = - Hashtbl.find_opt(global_inference_info.solution_statuses, id); + Hashtbl.find_opt(global_inference_info.typehole_suggestions, id); switch (status_opt) { | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) | Some(Solved(ityp)) => @@ -60,7 +60,7 @@ let get_cursor_inspect_result = : option((bool, list(Typ.t))) => if (global_inference_info.enabled) { let* status = - Hashtbl.find_opt(global_inference_info.solution_statuses, id); + Hashtbl.find_opt(global_inference_info.typehole_suggestions, id); switch (status) { | Unsolved(potential_typ_set) => Some(( From 115b25fcf40054daeb1d943282c94d2e1c87f3a0 Mon Sep 17 00:00:00 2001 From: RaefM Date: Tue, 26 Dec 2023 12:24:48 -0600 Subject: [PATCH 087/129] ADTs seem to work; stack overflowing on the examples page for ADTs though --- src/haz3lcore/inference/ITyp.re | 44 ++++++++++++++----- src/haz3lcore/inference/Inference.re | 16 ++++--- src/haz3lcore/inference/InferenceResult.re | 1 + .../inference/MutablePotentialTypeSet.re | 3 +- src/haz3lcore/inference/PotentialTypeSet.re | 12 +++-- 5 files changed, 52 insertions(+), 24 deletions(-) diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index 7bef6b2ac7..4172fa00e4 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -9,6 +9,7 @@ type t = | Float | Bool | String + | Var(string) | List(t) | Arrow(t, t) | Sum(t, t) @@ -35,8 +36,8 @@ let rec typ_to_ityp: Typ.t => t = | Prod([hd_ty, ...tl_tys]) => Prod(typ_to_ityp(hd_ty), typ_to_ityp(Prod(tl_tys))) | Prod([]) => Unit - | Rec(_, _) - | Var(_) => Unknown(NoProvenance) + | Rec(_, ty_body) => typ_to_ityp(ty_body) + | Var(name) => Var(name) and unroll_constructor_map = (sum_map: ConstructorMap.t(option(Typ.t))) => { switch (sum_map) { | [] => (Unknown(NoProvenance), []) @@ -55,6 +56,15 @@ let unwrap_if_prod = (typ: Typ.t): list(Typ.t) => { }; }; +let rec_type_constraints = (typs: list(Typ.t)): constraints => { + let is_rec_type = (ty: Typ.t): option(equivalence) => + switch (ty) { + | Rec(var, body) => Some((Var(var), typ_to_ityp(body))) + | _ => None + }; + List.filter_map(is_rec_type, typs); +}; + let rec ityp_to_typ: t => Typ.t = fun | Unknown(prov) => Unknown(prov, false) @@ -67,24 +77,34 @@ let rec ityp_to_typ: t => Typ.t = | Sum(t1, t2) => Sum([("", Some(ityp_to_typ(t1))), ("", Some(ityp_to_typ(t2)))]) | Unit => Prod([]) + | Var(name) => Var(name) | Prod(t1, t2) => Prod([ityp_to_typ(t1)] @ (t2 |> ityp_to_typ |> unwrap_if_prod)); let to_ityp_constraints = (constraints: Typ.constraints): constraints => { - constraints - |> List.filter(((t1, t2)) => - t1 != Typ.Unknown(NoProvenance, false) - && t2 != Typ.Unknown(NoProvenance, false) - ) - |> List.map(((t1, t2)) => (typ_to_ityp(t1), typ_to_ityp(t2))); + let statics_constraints = + constraints + |> List.filter(((t1, t2)) => + t1 != Typ.Unknown(NoProvenance, false) + && t2 != Typ.Unknown(NoProvenance, false) + ) + |> List.map(((t1, t2)) => (typ_to_ityp(t1), typ_to_ityp(t2))); + + let rec_constraints = + List.map(((a, b)) => [a, b], constraints) + |> List.flatten + |> rec_type_constraints; + + statics_constraints @ rec_constraints; }; -let rec contains_hole = (ty: t): bool => +let rec contains_node = (ty: t): bool => switch (ty) { - | Unknown(_) => true + | Unknown(_) + | Var(_) => true | Arrow(ty1, ty2) | Sum(ty1, ty2) - | Prod(ty1, ty2) => contains_hole(ty1) || contains_hole(ty2) - | List(l_ty) => contains_hole(l_ty) + | Prod(ty1, ty2) => contains_node(ty1) || contains_node(ty2) + | List(l_ty) => contains_node(l_ty) | _ => false }; diff --git a/src/haz3lcore/inference/Inference.re b/src/haz3lcore/inference/Inference.re index a5bc77500e..78837cccb5 100644 --- a/src/haz3lcore/inference/Inference.re +++ b/src/haz3lcore/inference/Inference.re @@ -20,20 +20,22 @@ and unify_one = (pts_graph: PTSGraph.t, typs: (ITyp.t, ITyp.t)): unit => { | (Prod(ty1_lhs, ty1_rhs), Prod(ty2_lhs, ty2_rhs)) | (Sum(ty1_lhs, ty1_rhs), Sum(ty2_lhs, ty2_rhs)) => unify(pts_graph, [(ty1_lhs, ty2_lhs), (ty1_rhs, ty2_rhs)]) - | (Unknown(_) as hole, t) - | (t, Unknown(_) as hole) => - PTSGraph.add_typ_as_node(pts_graph, hole); + | (Unknown(_) as node, t) + | (Var(_) as node, t) + | (t, Unknown(_) as node) + | (t, Var(_) as node) => + PTSGraph.add_typ_as_node(pts_graph, node); - if (ITyp.contains_hole(t)) { + if (ITyp.contains_node(t)) { // if the type it is being constrained to is a potential node, add it then connect the two nodes PTSGraph.add_typ_as_node(pts_graph, t); - PTSGraph.make_occurs_check(pts_graph, t, hole); - PTSGraph.create_traversable_edge(pts_graph, t, hole); + PTSGraph.make_occurs_check(pts_graph, t, node); + PTSGraph.create_traversable_edge(pts_graph, t, node); } else { // otherwise, simply add t to hole's PotentialTypeSet without making a new node PTSGraph.create_solution_edge( pts_graph, - hole, + node, t, ); }; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index d65804184a..3d6e1d2418 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -123,6 +123,7 @@ let rec convert_leftmost_to_priority = (typ: ITyp.t): string => { | Float | String | Bool => "" + | Var(name) => name | Unknown(prov) => prov_to_priority(prov) | List(elt_typ) => convert_leftmost_to_priority(elt_typ) | Arrow(typ_lhs, typ_rhs) diff --git a/src/haz3lcore/inference/MutablePotentialTypeSet.re b/src/haz3lcore/inference/MutablePotentialTypeSet.re index 322a7131b4..b8009e763a 100644 --- a/src/haz3lcore/inference/MutablePotentialTypeSet.re +++ b/src/haz3lcore/inference/MutablePotentialTypeSet.re @@ -148,6 +148,7 @@ let rec preorder_key_traversal_typ = (ty: ITyp.t): list(ITyp.t) => { | Float | String | Bool + | Var(_) | Unknown(_) => [ty] | Arrow(ty_lhs, ty_rhs) | Prod(ty_lhs, ty_rhs) @@ -171,7 +172,7 @@ let derive_nested_keys_and_potential_typ_sets = preorder_elem_traversal_mut_potential_typ_set(mut_potential_typ_set); List.combine(preorder_typs, preorder_elems) - |> List.filter(((k, _)) => ITyp.contains_hole(k)) + |> List.filter(((k, _)) => ITyp.contains_node(k)) |> List.split; }; diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index aca2923697..72aa502d68 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -19,6 +19,7 @@ type base_typ = | BFloat | BBool | BString + | BVar(string) | BUnknown(Typ.type_provenance); [@deriving (show({with_path: false}), sexp)] @@ -55,6 +56,7 @@ let mk_as_unary_ctor = (ctor: unary_ctor, ty: ITyp.t): ITyp.t => { let rec ityp_to_potential_typ: ITyp.t => potential_typ = fun | Unknown(prov) => Base(BUnknown(prov)) + | Var(name) => Base(BVar(name)) | Int => Base(BInt) | Unit => Base(BUnit) | Float => Base(BFloat) @@ -92,7 +94,8 @@ let base_typ_to_ityp: base_typ => ITyp.t = | BBool => Bool | BString => String | BUnit => Unit - | BUnknown(prov) => Unknown(prov); + | BUnknown(prov) => Unknown(prov) + | BVar(name) => Var(name); let rec extend_with_potential_typ_set = (target: t, potential_typ_set_extension: t) => { @@ -430,7 +433,7 @@ let comp_potential_typ = | TypeHole(id) => Id.to_string(id) | Matched(_, prov) => strip_id(prov); - let potential_typ_to_float: potential_typ => string = + let potential_typ_to_string: potential_typ => string = fun | Base(BInt) | Base(BUnit) @@ -438,12 +441,13 @@ let comp_potential_typ = | Base(BString) | Base(BBool) => "A" | Base(BUnknown(prov)) => strip_id(prov) + | Base(BVar(name)) => name | Binary(_) => "B" | Unary(_) => "C"; Stdlib.compare( - potential_typ_to_float(potential_typ1), - potential_typ_to_float(potential_typ2), + potential_typ_to_string(potential_typ1), + potential_typ_to_string(potential_typ2), ); }; From dcb3d72e3b06901e8daa561358142b06cccc228a Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 28 Dec 2023 11:20:55 -0600 Subject: [PATCH 088/129] fix stack overflow issue --- src/haz3lcore/inference/ITyp.re | 27 ++++++++---------- src/haz3lcore/inference/Inference.re | 1 - src/haz3lcore/inference/PotentialTypeSet.re | 4 +-- src/haz3lcore/statics/Mode.re | 2 -- src/haz3lcore/statics/Statics.re | 2 -- src/haz3lcore/statics/TypBase.re | 31 ++++++++++++++++++--- src/haz3lcore/zipper/Editor.re | 1 - 7 files changed, 39 insertions(+), 29 deletions(-) diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index 4172fa00e4..f640723477 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -29,6 +29,7 @@ let rec typ_to_ityp: Typ.t => t = | List(tys) => List(typ_to_ityp(tys)) | Arrow(t1, t2) => Arrow(typ_to_ityp(t1), typ_to_ityp(t2)) | Prod([single]) => typ_to_ityp(single) + | Sum([sum_entry]) => constructor_binding_to_ityp(sum_entry) | Sum(sum_entries) => { let (hd_ityp, tl_entries) = unroll_constructor_map(sum_entries); Sum(hd_ityp, typ_to_ityp(Sum(tl_entries))); @@ -41,8 +42,10 @@ let rec typ_to_ityp: Typ.t => t = and unroll_constructor_map = (sum_map: ConstructorMap.t(option(Typ.t))) => { switch (sum_map) { | [] => (Unknown(NoProvenance), []) - | [sum_entry] => (constructor_binding_to_ityp(sum_entry), []) - | [hd_entry, ...tl] => (constructor_binding_to_ityp(hd_entry), tl) + | [sum_entry] => + (constructor_binding_to_ityp(sum_entry), []); + | [hd_entry, ...tl] => + (constructor_binding_to_ityp(hd_entry), tl); }; } and constructor_binding_to_ityp = sum_entry => { @@ -82,20 +85,12 @@ let rec ityp_to_typ: t => Typ.t = Prod([ityp_to_typ(t1)] @ (t2 |> ityp_to_typ |> unwrap_if_prod)); let to_ityp_constraints = (constraints: Typ.constraints): constraints => { - let statics_constraints = - constraints - |> List.filter(((t1, t2)) => - t1 != Typ.Unknown(NoProvenance, false) - && t2 != Typ.Unknown(NoProvenance, false) - ) - |> List.map(((t1, t2)) => (typ_to_ityp(t1), typ_to_ityp(t2))); - - let rec_constraints = - List.map(((a, b)) => [a, b], constraints) - |> List.flatten - |> rec_type_constraints; - - statics_constraints @ rec_constraints; + constraints + |> List.filter(((t1, t2)) => + t1 != Typ.Unknown(NoProvenance, false) + && t2 != Typ.Unknown(NoProvenance, false) + ) + |> List.map(((t1, t2)) => (typ_to_ityp(t1), typ_to_ityp(t2))); }; let rec contains_node = (ty: t): bool => diff --git a/src/haz3lcore/inference/Inference.re b/src/haz3lcore/inference/Inference.re index 78837cccb5..7155eebaba 100644 --- a/src/haz3lcore/inference/Inference.re +++ b/src/haz3lcore/inference/Inference.re @@ -46,7 +46,6 @@ and unify_one = (pts_graph: PTSGraph.t, typs: (ITyp.t, ITyp.t)): unit => { let solve_constraints = (constraints: Typ.constraints): PTSGraph.t => { let inference_pts_graph = PTSGraph.create(); let constraints = ITyp.to_ityp_constraints(constraints); - unify(inference_pts_graph, constraints); inference_pts_graph; diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index 72aa502d68..1280cdb25a 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -483,7 +483,6 @@ let string_of_btyp = (btyp: base_typ): string => { let rec potential_typ_set_to_ityp_unroll = (id: Id.t, pts: t): list(ITyp.t) => { switch (pts) { - // TODO: raef and anand: fix this to distinguish between solved and unsolved holes | [] => [ITyp.Unknown(ExpHole(Internal, id))] | [hd] => [potential_typ_to_ityp(id, hd)] | _ => List.map(potential_typ_to_ityp(id), pts) @@ -491,8 +490,7 @@ let rec potential_typ_set_to_ityp_unroll = (id: Id.t, pts: t): list(ITyp.t) => { } and potential_typ_set_to_ityp_no_unroll = (id: Id.t, pts: t): ITyp.t => { switch (pts) { - // TODO: raef and anand: fix this to distinguish between solved and unsolved holes - | [] => ITyp.Unknown(NoProvenance) + | [] => ITyp.Unknown(ExpHole(Internal, id)) | [hd] => potential_typ_to_ityp(id, hd) | _ => ITyp.Unknown(ExpHole(Error, id)) }; diff --git a/src/haz3lcore/statics/Mode.re b/src/haz3lcore/statics/Mode.re index 1c7871cadc..b9365b4234 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -108,8 +108,6 @@ let of_list_lit = (typs, constraints); }; -// TODO: anand and raef; discuss if the mode ctr fns below need constraints - let ctr_ana_typ = (ctx: Ctx.t, mode: t, ctr: Constructor.t): option(Typ.t) => { /* If a ctr is being analyzed against (an arrow type returning) a sum type having that ctr as a variant, we consider the diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index cd5d9b5a0d..bb6ae68cd4 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -333,7 +333,6 @@ and uexp_to_info_map = m, ); | Seq(e1, e2) => - // TODO: whats Seq? let (e1, m) = go(~mode=Syn, e1, m); let (e2, m) = go(~mode, e2, m); add( @@ -519,7 +518,6 @@ and uexp_to_info_map = /* Make sure types don't escape their scope */ let ty_escape = Typ.subst(ty_def, name, ty_body); let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; - //TODO anand: typ aliases- should they generate new constraints too? add( ~self=Just(ty_escape), ~constraints= diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 089bf21352..763f8f0775 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -76,8 +76,6 @@ module rec Typ: { ty: t, }; - // TODO: anand and raef; change t, Id.t sigs to source (see above) - // TODO: anand and raef; figure out where the equivalent of matched sum is called and add constraints to it let of_source: list(source) => list(t); let join_type_provenance: (type_provenance, type_provenance) => type_provenance; @@ -311,8 +309,33 @@ module rec Typ: { ts, ) ++ ")" - | Sum(_) - | _ => "DISPLAYING SUM and REC NOT IMPLEMEMNTED TODO anand. Ask Andrew where the code that already does this..." + | Sum(ctr_map) => + switch (ctr_map) { + | [] => "Nullary Sum" + | [t0] => "+" ++ ctr_to_string(is_left_child, t0, debug) + | [t0, ...ts] => + List.fold_left( + (acc, hd) => + acc ++ " + " ++ ctr_to_string(is_left_child, hd, debug), + ctr_to_string(is_left_child, t0, debug), + ts, + ) + } + | Rec(var, body) => + "Rec " + ++ var + ++ ". " + ++ typ_to_string_with_parens(is_left_child, body, debug) + }; + } + and ctr_to_string = (is_left_child, (ctr, typ), debug): string => { + switch (typ) { + | None => ctr + | Some(typ) => + ctr + ++ "(" + ++ typ_to_string_with_parens(is_left_child, typ, debug) + ++ ")" }; }; diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index f7cf567868..6b05492619 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -53,7 +53,6 @@ module Meta = { let touched = Touched.update(Time.tick(), effects, touched); let unselected = Zipper.unselect_and_zip(z); let (term, _) = MakeTerm.go(unselected); - // TODO Raef: add in flow for the enabled flag let (_, ctx) = Statics.mk_map_and_inference_solutions(term); let measured = Measured.of_segment( From 4049dfe4c2d63ae607575561cc1ab4b4946d3cac Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 28 Dec 2023 13:38:51 -0600 Subject: [PATCH 089/129] Fix issue where solved as type alias and its body type val resulted in unsolved --- src/haz3lcore/inference/ITyp.re | 5 +---- src/haz3lcore/inference/InferenceResult.re | 11 +++++---- src/haz3lcore/inference/PotentialTypeSet.re | 25 +++++++++++++++++++++ 3 files changed, 33 insertions(+), 8 deletions(-) diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index f640723477..83f661dd16 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -42,10 +42,7 @@ let rec typ_to_ityp: Typ.t => t = and unroll_constructor_map = (sum_map: ConstructorMap.t(option(Typ.t))) => { switch (sum_map) { | [] => (Unknown(NoProvenance), []) - | [sum_entry] => - (constructor_binding_to_ityp(sum_entry), []); - | [hd_entry, ...tl] => - (constructor_binding_to_ityp(hd_entry), tl); + | [hd_entry, ...tl] => (constructor_binding_to_ityp(hd_entry), tl) }; } and constructor_binding_to_ityp = sum_entry => { diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 3d6e1d2418..b314650285 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -87,22 +87,25 @@ let condense = let sorted_potential_typ_set = PotentialTypeSet.sort_potential_typ_set(potential_typ_set); - let filtered_potential_typ_set = + let hole_filtered_potential_typ_set = PotentialTypeSet.filter_unneeded_holes( PotentialTypeSet.is_known, sorted_potential_typ_set, ); + let redundant_var_filtered_potential_typ_set = + PotentialTypeSet.filter_vars(hole_filtered_potential_typ_set); + switch (err) { - | Some(_) => Unsolved(filtered_potential_typ_set) + | Some(_) => Unsolved(redundant_var_filtered_potential_typ_set) | None => let solved_opt = PotentialTypeSet.filtered_potential_typ_set_to_typ( - filtered_potential_typ_set, + redundant_var_filtered_potential_typ_set, ); switch (solved_opt) { | Some(typ) => Solved(typ) - | None => Unsolved(filtered_potential_typ_set) + | None => Unsolved(redundant_var_filtered_potential_typ_set) }; }; }; diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index 1280cdb25a..ed576b643a 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -409,6 +409,31 @@ let filter_unneeded_holes = filter_unneeded_holes_class(comp, delete_holes, potential_typ_set); }; +let filter_vars = (potential_typ_set: t): t => { + let is_non_node = + fun + | Base(BVar(_)) + | Base(BUnknown(_)) => false + | _ => true; + + let is_not_var = + fun + | Base(BVar(_)) => false + | _ => true; + + let num_literals = + potential_typ_set |> List.filter(is_non_node) |> List.length; + + switch (num_literals) { + | n when n > 1 => + // do not filter vars; already unsolved, allow selection between similar aliases + potential_typ_set + | _ => + // must be solved. we arbitrarily filter out everything but the literal so it is assigned solved status + List.filter(is_not_var, potential_typ_set) + }; +}; + let rec filtered_potential_typ_set_to_typ: t => option(ITyp.t) = fun | [] => None From 36bc5af5ec18418fe788331f99e4e14d75265dec Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 28 Dec 2023 15:14:12 -0600 Subject: [PATCH 090/129] Fix CI hover issues --- src/haz3lweb/view/CursorInspector.re | 75 +++++++++++++++------------- 1 file changed, 41 insertions(+), 34 deletions(-) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 68b1e0bdeb..4117daf413 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -412,38 +412,45 @@ let view = info_map: Statics.Map.t, global_inference_info: Haz3lcore.InferenceResult.global_inference_info, ) => { - let bar_view = div(~attr=Attr.id("bottom-bar")); - let err_view = err => - bar_view([ - div( - ~attr=clss(["cursor-inspector", "no-info"]), - [div(~attr=clss(["icon"]), [Icons.magnify]), text(err)], - ), - ]); - switch (zipper.backpack, Indicated.index(zipper)) { - | _ when !settings.core.statics => div_empty - | _ when Id.Map.is_empty(info_map) => - err_view("No Static information available") - | (_, None) => err_view("No cursor in program") - | (_, Some(id)) => - switch (Id.Map.find_opt(id, info_map)) { - | None => err_view("Whitespace or Comment") - | Some(ci) => - bar_view([ - inspector_view( - ~inject, - ~font_metrics, - ~global_inference_info, - ~settings, - ~show_lang_doc, - ~id, - ci, - ), - div( - ~attr=clss(["id"]), - [text(String.sub(Id.to_string(id), 0, 4))], - ), - ]) - } - }; + let curr_view = + if (State.get_considering_suggestion()) { + State.get_last_inspector(); + } else { + let bar_view = div(~attr=Attr.id("bottom-bar")); + let err_view = err => + bar_view([ + div( + ~attr=clss(["cursor-inspector", "no-info"]), + [div(~attr=clss(["icon"]), [Icons.magnify]), text(err)], + ), + ]); + switch (zipper.backpack, Indicated.index(zipper)) { + | _ when !settings.core.statics => div_empty + | _ when Id.Map.is_empty(info_map) => + err_view("No Static information available") + | (_, None) => err_view("No cursor in program") + | (_, Some(id)) => + switch (Id.Map.find_opt(id, info_map)) { + | None => err_view("Whitespace or Comment") + | Some(ci) => + bar_view([ + inspector_view( + ~inject, + ~font_metrics, + ~global_inference_info, + ~settings, + ~show_lang_doc, + ~id, + ci, + ), + div( + ~attr=clss(["id"]), + [text(String.sub(Id.to_string(id), 0, 4))], + ), + ]) + } + }; + }; + State.set_last_inspector(curr_view); + curr_view; }; From 31879478abe6a8ca2f2b6f190cce34d1aab5a678 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 31 Dec 2023 11:51:23 -0500 Subject: [PATCH 091/129] Add logic to suggest results for unsolved exp holes, but the paste happens before the variable name. Will add direction to jump action to specify end --- src/haz3lcore/inference/InferenceResult.re | 29 +-- src/haz3lcore/statics/Statics.re | 11 +- src/haz3lcore/zipper/Editor.re | 7 +- src/haz3lweb/Keyboard.re | 4 +- src/haz3lweb/view/Cell.re | 4 +- src/haz3lweb/view/CursorInspector.re | 238 ++++++++++++++++----- src/haz3lweb/view/ExerciseMode.re | 5 +- src/haz3lweb/view/InferenceView.re | 56 +++-- src/haz3lweb/view/Page.re | 4 +- src/haz3lweb/view/ScratchMode.re | 4 +- 10 files changed, 269 insertions(+), 93 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index b314650285..1e1a760ff7 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -31,9 +31,7 @@ let get_suggestion_text_for_id = (id: Id.t, global_inference_info: global_inference_info) : suggestion(string) => if (global_inference_info.enabled) { - let status_opt = - Hashtbl.find_opt(global_inference_info.typehole_suggestions, id); - switch (status_opt) { + switch (Hashtbl.find_opt(global_inference_info.typehole_suggestions, id)) { | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) | Some(Solved(ityp)) => let typ_to_string = x => Typ.typ_to_string(x, false); @@ -43,7 +41,12 @@ let get_suggestion_text_for_id = PotentialTypeSet.string_of_potential_typ(false, potential_typ), ) | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) - | None => NoSuggestion(NonTypeHoleId) + | None => + switch (Hashtbl.find_opt(global_inference_info.exphole_suggestions, id)) { + | Some((_, Unsolved(tys))) when List.length(tys) > 1 => + NoSuggestion(InconsistentSet) + | _ => NoSuggestion(NonTypeHoleId) + } }; } else { NoSuggestion(SuggestionsDisabled); @@ -54,16 +57,18 @@ let hole_mold: Mold.t = {out: Any, in_: [], nibs: (hole_nib, hole_nib)}; let empty_solutions = (): type_hole_to_solution => Hashtbl.create(20); -let mk_global_inference_info = (enabled, annotations) => { - { - enabled, - typehole_suggestions: annotations, - exphole_suggestions: Hashtbl.create(0), - }; +let mk_global_inference_info = + (annotations_enabled, (typ_hole_sugg, exp_hole_sugg)) => { + enabled: annotations_enabled, + typehole_suggestions: typ_hole_sugg, + exphole_suggestions: exp_hole_sugg, }; -let empty_info = (): global_inference_info => - mk_global_inference_info(true, empty_solutions()); +let empty_info = (): global_inference_info => { + enabled: true, + typehole_suggestions: Hashtbl.create(20), + exphole_suggestions: Hashtbl.create(20), +}; let rec get_all_pattern_var_neighbors = (potential_typ_set: PotentialTypeSet.t): list(Id.t) => { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index bb6ae68cd4..961791f550 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -628,7 +628,7 @@ and upat_to_info_map = ~constraints=hd.constraints @ tl.constraints @ mode_cs_hd @ mode_cs_tl, m, ); - | Wild => atomic(Just(unknown)) + | Wild => atomic(Just(Typ.Unknown(NoProvenance, is_synswitch))) | Var(name) => /* NOTE: The self type assigned to pattern variables (Unknown) may be SynSwitch, but SynSwitch is never added to the context; @@ -644,7 +644,10 @@ and upat_to_info_map = add( ~self=Just(unknown), ~ctx=Ctx.extend(ctx, entry), - ~constraints=subsumption_constraints(Just(unknown)), + ~constraints= + subsumption_constraints( + Just(Unknown(ExpHole(PatternVar, id), false)), + ), m, ); | Tuple(ps) => @@ -806,9 +809,9 @@ let mk_map_and_inference_solutions = info.constraints |> Typ.constraints_to_string |> print_endline; let pts_graph = Inference.solve_constraints(info.constraints); - let (ctx, _) = InferenceResult.get_desired_solutions(pts_graph); + let solutions = InferenceResult.get_desired_solutions(pts_graph); - (map, ctx); + (map, solutions); }, ); diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 6b05492619..a89083db19 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -53,13 +53,16 @@ module Meta = { let touched = Touched.update(Time.tick(), effects, touched); let unselected = Zipper.unselect_and_zip(z); let (term, _) = MakeTerm.go(unselected); - let (_, ctx) = Statics.mk_map_and_inference_solutions(term); + let (_, suggestions) = Statics.mk_map_and_inference_solutions(term); let measured = Measured.of_segment( ~touched, ~old=measured, ~global_inference_info= - InferenceResult.mk_global_inference_info(inference_enabled, ctx), + InferenceResult.mk_global_inference_info( + inference_enabled, + suggestions, + ), unselected, ); let term_ranges = TermRanges.mk(unselected); diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 2c946c12c2..8c3bbe99f6 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -8,11 +8,11 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { let zipper = Editors.active_zipper(model.editors); let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, ctx) = Statics.mk_map_and_inference_solutions(term); + let (_, suggestions) = Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( model.langDocMessages.annotations, - ctx, + suggestions, ); let now = (a: Action.t): option(UpdateAction.t) => Some(PerformAction(a)); diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index fddbdab17b..f053c8f26e 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -274,12 +274,12 @@ let editor_view = let segment = Zipper.zip(zipper); let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, ctx) = Statics.mk_map_and_inference_solutions(term); + let (_, suggestions) = Statics.mk_map_and_inference_solutions(term); let measured = editor.state.meta.measured; let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, - ctx, + suggestions, ); let buffer_ids: list(Uuidm.t) = { /* Collect ids of tokens in buffer for styling purposes. This is diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 4117daf413..fa2599677f 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -91,20 +91,19 @@ let view_of_global_inference_info = ) => { let font_metrics = Some(font_metrics); switch (InferenceView.get_cursor_inspect_result(~global_inference_info, id)) { - | Some((true, solution)) => + | SolvedTypeHole(solution) + | SolvedExpHole(_, solution) => div( ~attr=clss([infoc, "typ"]), - [ - text("consistent constraints"), - Type.view(~font_metrics, List.nth(solution, 0)), - ], + [text("consistent constraints"), Type.view(~font_metrics, solution)], ) - | Some((false, [typ_with_nested_conflict])) => + | UnsolvedTypeHole([typ_with_nested_conflict]) + | UnsolvedExpHole(_, [typ_with_nested_conflict]) => div( ~attr=clss([infoc, "typ"]), [Type.view(~font_metrics, typ_with_nested_conflict)], ) - | Some((false, conflicting_typs)) => + | UnsolvedTypeHole(conflicting_typs) => div( ~attr=clss([infoc, "typ"]), [ @@ -148,7 +147,58 @@ let view_of_global_inference_info = ), ], ) - | None => div([]) + | UnsolvedExpHole(id, conflicting_typs) => + div( + ~attr=clss([infoc, "typ"]), + [ + text("conflicting constraints"), + ...List.map( + typ => + div( + ~attr=clss(["typ-view-conflict"]), + [ + Widgets.hoverable_button( + [Type.view(~font_metrics, typ)], + _mouse_event => { + State.set_considering_suggestion(false); + inject(Update.SetMeta(Mouseup)); + }, + _mouse_event => { + State.set_considering_suggestion(true); + if (!State.get_suggestion_pasted()) { + State.set_suggestion_pasted(true); + + Ui_effect.bind( + inject(Update.PerformAction(Jump(TileId(id)))), + ~f=_res => + inject( + Update.Paste( + Haz3lcore.Typ.typ_to_string(typ, false), + ), + ) + ); + } else { + inject(Update.SetMeta(Mouseup)); + }; + }, + _mouse_event => + if (State.get_considering_suggestion()) { + State.set_suggestion_pasted(false); + State.set_considering_suggestion(false); + Ui_effect.bind(inject(Update.Undo), ~f=_res => + inject(Update.Undo) + ); + } else { + inject(Update.SetMeta(Mouseup)); + }, + ), + ], + ), + conflicting_typs, + ), + ], + ) + | NoSuggestion => div([]) }; }; @@ -191,43 +241,71 @@ let common_err_view = (cls: Term.Cls.t, err: Info.error_common) => ] }; -let common_ok_view = (cls: Term.Cls.t, ok: Info.ok_pat) => { - switch (cls, ok) { - | (Exp(MultiHole) | Pat(MultiHole), _) => [ - text("Expecting operator or delimiter"), - ] - | (Exp(EmptyHole), Syn(_)) => [text("Fillable by any expression")] - | (Pat(EmptyHole), Syn(_)) => [text("Fillable by any pattern")] - | (Exp(EmptyHole), Ana(Consistent({ana, _}))) => [ - text("Fillable by any expression of type"), - Type.view(ana), - ] - | (Pat(EmptyHole), Ana(Consistent({ana, _}))) => [ - text("Fillable by any pattern of type"), - Type.view(ana), - ] - | (_, Syn(syn)) => [text(":"), Type.view(syn)] - | (Pat(Var) | Pat(Wild), Ana(Consistent({ana, _}))) => [ - text(":"), - Type.view(ana), - ] - | (_, Ana(Consistent({ana, syn, _}))) when ana == syn => [ - text(":"), - Type.view(syn), - text("equals expected type"), - ] - | (_, Ana(Consistent({ana, syn, _}))) => [ - text(":"), - Type.view(syn), - text("consistent with expected type"), - Type.view(ana), - ] - | (_, Ana(InternallyInconsistent({ana, nojoin: tys}))) => - [ - text(elements_noun(cls) ++ " have inconsistent types:"), - ...ListUtil.join(text(","), List.map(Type.view, tys)), +let common_ok_view = + ( + ~inject, + ~font_metrics, + ~global_inference_info, + ~id, + cls: Term.Cls.t, + ok: Info.ok_pat, + ) => { + switch ( + Haz3lcore.InferenceResult.get_suggestion_text_for_id( + id, + global_inference_info, + ) + ) { + | Solvable(_) // currently no indirect suggestions for solvable holes TODO: Raef explore this + | NestedInconsistency(_) // currently no indirect suggestions for solvable holes + | NoSuggestion(SuggestionsDisabled) + | NoSuggestion(NonTypeHoleId) + | NoSuggestion(OnlyHoleSolutions) => + switch (cls, ok) { + | (Exp(MultiHole) | Pat(MultiHole), _) => [ + text("Expecting operator or delimiter"), + ] + | (Exp(EmptyHole), Syn(_)) => [text("Fillable by any expression")] + | (Pat(EmptyHole), Syn(_)) => [text("Fillable by any pattern")] + | (Exp(EmptyHole), Ana(Consistent({ana, _}))) => [ + text("Fillable by any expression of type"), + Type.view(ana), + ] + | (Pat(EmptyHole), Ana(Consistent({ana, _}))) => [ + text("Fillable by any pattern of type"), + Type.view(ana), + ] + | (_, Syn(syn)) => [text(":"), Type.view(syn)] + | (Pat(Var) | Pat(Wild), Ana(Consistent({ana, _}))) => [ + text(":"), + Type.view(ana), + ] + | (_, Ana(Consistent({ana, syn, _}))) when ana == syn => [ + text(":"), + Type.view(syn), + text("equals expected type"), + ] + | (_, Ana(Consistent({ana, syn, _}))) => [ + text(":"), + Type.view(syn), + text("consistent with expected type"), + Type.view(ana), + ] + | (_, Ana(InternallyInconsistent({ana, nojoin: tys}))) => + [ + text(elements_noun(cls) ++ " have inconsistent types:"), + ...ListUtil.join(text(","), List.map(Type.view, tys)), + ] + @ [text("but consistent with expected"), Type.view(ana)] + } + | _ => [ + view_of_global_inference_info( + ~inject, + ~font_metrics, + ~global_inference_info, + id, + ), ] - @ [text("but consistent with expected"), Type.view(ana)] }; }; @@ -242,7 +320,9 @@ let typ_ok_view = ) => switch (ok) { | Type(ty) => - print_endline("calling get suggestion text from CI"); + print_endline( + "calling get suggestion text from CI for id " ++ Id.to_string(id), + ); switch ( Haz3lcore.InferenceResult.get_suggestion_text_for_id( id, @@ -290,19 +370,55 @@ let typ_err_view = (ok: Info.error_typ) => ] }; -let exp_view = (cls: Term.Cls.t, status: Info.status_exp) => +let exp_view = + ( + ~inject, + ~font_metrics, + ~global_inference_info, + ~id, + cls: Term.Cls.t, + status: Info.status_exp, + ) => switch (status) { | InHole(FreeVariable(name)) => div_err([code_err(name), text("not found")]) | InHole(Common(error)) => div_err(common_err_view(cls, error)) - | NotInHole(ok) => div_ok(common_ok_view(cls, ok)) + | NotInHole(ok) => + div_ok( + common_ok_view( + ~inject, + ~font_metrics, + ~global_inference_info, + ~id, + cls, + ok, + ), + ) }; -let pat_view = (cls: Term.Cls.t, status: Info.status_pat) => +let pat_view = + ( + ~inject, + ~font_metrics, + ~global_inference_info, + ~id, + cls: Term.Cls.t, + status: Info.status_pat, + ) => switch (status) { | InHole(ExpectedConstructor) => div_err([text("Expected a constructor")]) | InHole(Common(error)) => div_err(common_err_view(cls, error)) - | NotInHole(ok) => div_ok(common_ok_view(cls, ok)) + | NotInHole(ok) => + div_ok( + common_ok_view( + ~inject, + ~font_metrics, + ~global_inference_info, + ~id, + cls, + ok, + ), + ) }; let typ_view = @@ -359,8 +475,28 @@ let view_of_info = [term_view(~inject, ~settings, ~show_lang_doc, ci), status_view], ); switch (ci) { - | InfoExp({cls, status, _}) => wrapper(exp_view(cls, status)) - | InfoPat({cls, status, _}) => wrapper(pat_view(cls, status)) + | InfoExp({cls, status, _}) => + wrapper( + exp_view( + ~inject, + ~font_metrics, + ~global_inference_info, + ~id, + cls, + status, + ), + ) + | InfoPat({cls, status, _}) => + wrapper( + pat_view( + ~inject, + ~font_metrics, + ~global_inference_info, + ~id, + cls, + status, + ), + ) | InfoTyp({cls, status, _}) => wrapper( typ_view( diff --git a/src/haz3lweb/view/ExerciseMode.re b/src/haz3lweb/view/ExerciseMode.re index e24b2e6beb..da51cc9379 100644 --- a/src/haz3lweb/view/ExerciseMode.re +++ b/src/haz3lweb/view/ExerciseMode.re @@ -82,7 +82,10 @@ let view = let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, - global_inference_info.typehole_suggestions, + ( + global_inference_info.typehole_suggestions, + global_inference_info.exphole_suggestions, + ), ); let (focal_zipper, focal_info_map) = Exercise.focus(exercise, stitched_dynamics); diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index 7728375f0d..6c51d6b01f 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -1,7 +1,13 @@ -open Util.OptUtil.Syntax; open Virtual_dom.Vdom; open Haz3lcore; +type cursor_inspector_suggestion = + | SolvedTypeHole(Typ.t) + | UnsolvedTypeHole(list(Typ.t)) + | SolvedExpHole(Id.t, Typ.t) + | UnsolvedExpHole(Id.t, list(Typ.t)) + | NoSuggestion; + let get_suggestion_ui_for_id = ( ~font_metrics, @@ -31,7 +37,12 @@ let get_suggestion_ui_for_id = ); NestedInconsistency(ptyp_node); | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) - | None => NoSuggestion(NonTypeHoleId) + | None => + switch (Hashtbl.find_opt(global_inference_info.exphole_suggestions, id)) { + | Some((_, Unsolved(typs))) when List.length(typs) > 1 => + NoSuggestion(InconsistentSet) + | _ => NoSuggestion(NonTypeHoleId) + } }; } else { NoSuggestion(SuggestionsDisabled); @@ -57,20 +68,35 @@ let svg_display_settings = let get_cursor_inspect_result = (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) - : option((bool, list(Typ.t))) => + : cursor_inspector_suggestion => if (global_inference_info.enabled) { - let* status = - Hashtbl.find_opt(global_inference_info.typehole_suggestions, id); - switch (status) { - | Unsolved(potential_typ_set) => - Some(( - false, - potential_typ_set - |> PotentialTypeSet.potential_typ_set_to_ityp_unroll(id) - |> List.map(ITyp.ityp_to_typ), - )) - | Solved(ityp) => Some((true, [ityp |> ITyp.ityp_to_typ])) + switch (Hashtbl.find_opt(global_inference_info.typehole_suggestions, id)) { + | None => + switch (Hashtbl.find_opt(global_inference_info.exphole_suggestions, id)) { + | Some(([id, ..._], exp_hole_status)) => + switch (exp_hole_status) { + | Unsolved(potential_typ_set) => + UnsolvedExpHole( + id, + potential_typ_set + |> PotentialTypeSet.potential_typ_set_to_ityp_unroll(id) + |> List.map(ITyp.ityp_to_typ), + ) + | Solved(ityp) => SolvedExpHole(id, ITyp.ityp_to_typ(ityp)) + } + | _ => NoSuggestion + } + | Some(status) => + switch (status) { + | Unsolved(potential_typ_set) => + UnsolvedTypeHole( + potential_typ_set + |> PotentialTypeSet.potential_typ_set_to_ityp_unroll(id) + |> List.map(ITyp.ityp_to_typ), + ) + | Solved(ityp) => SolvedTypeHole(ITyp.ityp_to_typ(ityp)) + } }; } else { - None; + NoSuggestion; }; diff --git a/src/haz3lweb/view/Page.re b/src/haz3lweb/view/Page.re index a269764e40..8567111bc4 100644 --- a/src/haz3lweb/view/Page.re +++ b/src/haz3lweb/view/Page.re @@ -158,11 +158,11 @@ let exercises_view = let zipper = Editors.get_editor(editors).state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); - let (_, ctx) = Statics.mk_map_and_inference_solutions(term); + let (_, suggestions) = Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, - ctx, + suggestions, ); [top_bar_view(~inject, ~model, ~toolbar_buttons)] @ ExerciseMode.view( diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 314c912c8f..5a375cebac 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -24,13 +24,13 @@ let view = let editor = Editors.get_editor(editors); let zipper = editor.state.zipper; let (term, _) = MakeTerm.from_zip_for_sem(zipper); - let (info_map, ctx) = Statics.mk_map_and_inference_solutions(term); + let (info_map, suggestions) = Statics.mk_map_and_inference_solutions(term); let _ctx_init = ctx_init; //let info_map = Interface.Statics.mk_map_ctx(settings.core, ctx_init, term); // TODO anand and raef: we need to use this instead; figure out how let global_inference_info = InferenceResult.mk_global_inference_info( langDocMessages.annotations, - ctx, + suggestions, ); let result = ModelResult.get_simple( From 92c5a82b29bb76ff967aed1b1378eb8fbe138b3d Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 31 Dec 2023 12:21:15 -0500 Subject: [PATCH 092/129] Add directional jump; unsolved exphole suggestions working --- src/haz3lcore/zipper/action/Action.re | 2 +- src/haz3lcore/zipper/action/Move.re | 11 ++++++++--- src/haz3lcore/zipper/action/Perform.re | 11 ++++++++--- src/haz3lcore/zipper/action/Select.re | 4 ++-- src/haz3lweb/Keyboard.re | 2 +- src/haz3lweb/view/Cell.re | 2 +- src/haz3lweb/view/CtxInspector.re | 4 +++- src/haz3lweb/view/CursorInspector.re | 7 +++++-- src/haz3lweb/view/LangDoc.re | 6 ++++-- src/haz3lweb/view/TestView.re | 2 +- 10 files changed, 34 insertions(+), 17 deletions(-) diff --git a/src/haz3lcore/zipper/action/Action.re b/src/haz3lcore/zipper/action/Action.re index 1ee8b37380..ccf866a233 100644 --- a/src/haz3lcore/zipper/action/Action.re +++ b/src/haz3lcore/zipper/action/Action.re @@ -47,7 +47,7 @@ type select = type t = | Move(move) | MoveToNextHole(Direction.t) - | Jump(jump_target) + | Jump(jump_target, Direction.t) | Select(select) | Unselect(option(Direction.t)) | Destruct(Direction.t) diff --git a/src/haz3lcore/zipper/action/Move.re b/src/haz3lcore/zipper/action/Move.re index 1f19f0441e..9455533e50 100644 --- a/src/haz3lcore/zipper/action/Move.re +++ b/src/haz3lcore/zipper/action/Move.re @@ -227,14 +227,19 @@ module Make = (M: Editor.Meta.S) => { | Some(z) => Some(z) }; - let jump_to_id = (z: t, id: Id.t): option(t) => { - let* {origin, _} = Measured.find_by_id(id, M.measured); + let jump_to_id = (z: t, id: Id.t, direction: Direction.t): option(t) => { + let* {origin, last} = Measured.find_by_id(id, M.measured); let z = switch (to_start(z)) { | None => z | Some(z) => z }; - switch (do_towards(primary(ByChar), origin, z)) { + let goal = + switch (direction) { + | Left => origin + | Right => last + }; + switch (do_towards(primary(ByChar), goal, z)) { | None => Some(z) | Some(z) => Some(z) }; diff --git a/src/haz3lcore/zipper/action/Perform.re b/src/haz3lcore/zipper/action/Perform.re index 7a93da5a3f..aa663ce6f6 100644 --- a/src/haz3lcore/zipper/action/Perform.re +++ b/src/haz3lcore/zipper/action/Perform.re @@ -1,5 +1,6 @@ open Util; open Zipper; +open Sexplib.Std; let is_write_action = (a: Action.t) => { switch (a) { @@ -51,9 +52,13 @@ let go_z = | MoveToNextHole(d) => Move.go(Goal(Piece(Grout, d)), z) |> Result.of_option(~error=Action.Failure.Cant_move) - | Jump(jump_target) => + | Jump(jump_target, direction) => open OptUtil.Syntax; + print_endline( + "Direction: " ++ (direction |> Direction.sexp_of_t |> string_of_sexp), + ); + let idx = Indicated.index(z); let (term, _) = Util.TimeUtil.measure_time("Perform.go_z => MakeTerm.from_zip", true, () => @@ -67,8 +72,8 @@ let go_z = let* idx = idx; let* ci = Id.Map.find_opt(idx, statics); let* binding_id = Info.get_binding_site(ci); - Move.jump_to_id(z, binding_id); - | TileId(id) => Move.jump_to_id(z, id) + Move.jump_to_id(z, binding_id, Left); + | TileId(id) => Move.jump_to_id(z, id, direction) } ) |> Result.of_option(~error=Action.Failure.Cant_move); diff --git a/src/haz3lcore/zipper/action/Select.re b/src/haz3lcore/zipper/action/Select.re index 580daa910f..b94c1b98ba 100644 --- a/src/haz3lcore/zipper/action/Select.re +++ b/src/haz3lcore/zipper/action/Select.re @@ -20,7 +20,7 @@ module Make = (M: Editor.Meta.S) => { Move.do_vertical(primary, d, ed); let range = (l: Id.t, r: Id.t, z: Zipper.t): option(Zipper.t) => { - let* z = Move.jump_to_id(z, l); + let* z = Move.jump_to_id(z, l, Left); let* Measured.{last, _} = Measured.find_by_id(r, M.measured); Move.do_towards(primary, last, z); }; @@ -32,7 +32,7 @@ module Make = (M: Editor.Meta.S) => { }; let tile = (id: Id.t, z: Zipper.t): option(Zipper.t) => { - let* z = Move.jump_to_id(z, id); + let* z = Move.jump_to_id(z, id, Left); let* Measured.{last, _} = Measured.find_by_id(id, M.measured); Move.do_towards(primary, last, z); }; diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 8c3bbe99f6..eccc766cc9 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -44,7 +44,7 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { | (Up, "Delete") => now(Destruct(Right)) | (Up, "Escape") => now(Unselect(None)) | (Up, "Tab") => Some(DoTheThing) - | (Up, "F12") => now(Jump(BindingSiteOfIndicatedVar)) + | (Up, "F12") => now(Jump(BindingSiteOfIndicatedVar, Left)) | (Down, "Tab") => Some(MoveToNextHole(Left)) | (Down, "ArrowLeft") => now(Select(Resize(Local(Left(ByToken))))) | (Down, "ArrowRight") => now(Select(Resize(Local(Right(ByToken))))) diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index f053c8f26e..48e37498e2 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -46,7 +46,7 @@ let mousedown_handler = let events = [ inject(PerformAction(Move(Goal(Point(goal))))), - inject(PerformAction(Jump(BindingSiteOfIndicatedVar))), + inject(PerformAction(Jump(BindingSiteOfIndicatedVar, Left))), ]; Virtual_dom.Vdom.Effect.Many(events); | (false, 1) => diff --git a/src/haz3lweb/view/CtxInspector.re b/src/haz3lweb/view/CtxInspector.re index 82ceadc086..9ab18d983e 100644 --- a/src/haz3lweb/view/CtxInspector.re +++ b/src/haz3lweb/view/CtxInspector.re @@ -3,7 +3,9 @@ open Node; open Util.Web; let jump_to = entry => - UpdateAction.PerformAction(Jump(TileId(Haz3lcore.Ctx.get_id(entry)))); + UpdateAction.PerformAction( + Jump(TileId(Haz3lcore.Ctx.get_id(entry)), Left), + ); let context_entry_view = (~inject, entry: Haz3lcore.Ctx.entry): Node.t => { let div_name = diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index fa2599677f..3f56623041 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -169,11 +169,14 @@ let view_of_global_inference_info = State.set_suggestion_pasted(true); Ui_effect.bind( - inject(Update.PerformAction(Jump(TileId(id)))), + inject( + Update.PerformAction(Jump(TileId(id), Right)), + ), ~f=_res => inject( Update.Paste( - Haz3lcore.Typ.typ_to_string(typ, false), + " : " + ++ Haz3lcore.Typ.typ_to_string(typ, false), ), ) ); diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index 081d3f9836..586277712b 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -95,7 +95,7 @@ let highlight = Attr.many([ classes, Attr.on_click(_ => - inject(UpdateAction.PerformAction(Jump(TileId(id)))) + inject(UpdateAction.PerformAction(Jump(TileId(id), Left))) ), ]) | None => classes @@ -155,7 +155,9 @@ let mk_translation = clss(["clickable"]), Attr.on_click(_ => inject( - UpdateAction.PerformAction(Jump(TileId(id))), + UpdateAction.PerformAction( + Jump(TileId(id), Left), + ), ) ), ]), diff --git a/src/haz3lweb/view/TestView.re b/src/haz3lweb/view/TestView.re index 208a95c3d1..e70edaf3f7 100644 --- a/src/haz3lweb/view/TestView.re +++ b/src/haz3lweb/view/TestView.re @@ -25,7 +25,7 @@ let test_instance_view = let jump_to_test = (~inject, pos, id, _) => { let effect1 = inject(Update.SwitchEditor(pos)); - let effect2 = inject(Update.PerformAction(Jump(TileId(id)))); + let effect2 = inject(Update.PerformAction(Jump(TileId(id), Left))); Effect.bind(effect1, ~f=_result1 => effect2); }; From 0e757f8d65d2e6fe479b6000ec9b5ffe3d5a3226 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 31 Dec 2023 12:23:10 -0500 Subject: [PATCH 093/129] remove debug logs --- src/haz3lweb/view/CursorInspector.re | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 3f56623041..9e4231e46a 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -323,9 +323,6 @@ let typ_ok_view = ) => switch (ok) { | Type(ty) => - print_endline( - "calling get suggestion text from CI for id " ++ Id.to_string(id), - ); switch ( Haz3lcore.InferenceResult.get_suggestion_text_for_id( id, @@ -343,7 +340,7 @@ let typ_ok_view = id, ), ] - }; + } //TODO(andrew): restore this message? //| Type(_) when cls == Typ(EmptyHole) => [text("Fillable by any type")] //| Type(ty) => [Type.view(ty)] From 732fff7d06880b71164262678218ce7a6b199efa Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 31 Dec 2023 14:45:05 -0500 Subject: [PATCH 094/129] Add suggestions for solved/nested inconsistency exp holes too (easily removable if we want) --- src/haz3lcore/Measured.re | 8 +- src/haz3lcore/inference/InferenceResult.re | 36 +++-- src/haz3lweb/Keyboard.re | 4 +- src/haz3lweb/view/Code.re | 32 ++-- src/haz3lweb/view/CursorInspector.re | 175 ++++++++++----------- src/haz3lweb/view/InferenceView.re | 85 +++++----- src/haz3lweb/view/Type.re | 4 +- src/haz3lweb/view/dec/EmptyHoleDec.re | 87 ++++++---- src/haz3lweb/www/style.css | 11 ++ 9 files changed, 247 insertions(+), 195 deletions(-) diff --git a/src/haz3lcore/Measured.re b/src/haz3lcore/Measured.re index 1a0c4c2391..c01864e731 100644 --- a/src/haz3lcore/Measured.re +++ b/src/haz3lcore/Measured.re @@ -369,10 +369,12 @@ let of_segment = global_inference_info, ) ) { - | Solvable(suggestion_string) - | NestedInconsistency(suggestion_string) => + | (Solvable(suggestion_string), TypHole) + | (NestedInconsistency(suggestion_string), TypHole) => String.length(suggestion_string) - | NoSuggestion(_) => 1 + | (_, ExpHole) + | (_, None) + | (NoSuggestion(_), _) => 1 }; let last = {...origin, col: origin.col + annotation_offset}; diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 1e1a760ff7..687ba7e8a5 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -27,29 +27,37 @@ and reason_for_silence = | OnlyHoleSolutions | InconsistentSet; +type suggestion_source = + | ExpHole + | TypHole + | None; + let get_suggestion_text_for_id = (id: Id.t, global_inference_info: global_inference_info) - : suggestion(string) => + : (suggestion(string), suggestion_source) => if (global_inference_info.enabled) { + let status_to_suggestion = status => + switch (status) { + | Solved(Unknown(_)) => NoSuggestion(OnlyHoleSolutions) + | Solved(ityp) => + let typ_to_string = x => Typ.typ_to_string(x, false); + Solvable(ityp |> ITyp.ityp_to_typ |> typ_to_string); + | Unsolved([potential_typ]) => + NestedInconsistency( + PotentialTypeSet.string_of_potential_typ(false, potential_typ), + ) + | Unsolved(_) => NoSuggestion(InconsistentSet) + }; switch (Hashtbl.find_opt(global_inference_info.typehole_suggestions, id)) { - | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) - | Some(Solved(ityp)) => - let typ_to_string = x => Typ.typ_to_string(x, false); - Solvable(ityp |> ITyp.ityp_to_typ |> typ_to_string); - | Some(Unsolved([potential_typ])) => - NestedInconsistency( - PotentialTypeSet.string_of_potential_typ(false, potential_typ), - ) - | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) + | Some(status) => (status_to_suggestion(status), TypHole) | None => switch (Hashtbl.find_opt(global_inference_info.exphole_suggestions, id)) { - | Some((_, Unsolved(tys))) when List.length(tys) > 1 => - NoSuggestion(InconsistentSet) - | _ => NoSuggestion(NonTypeHoleId) + | Some((_, status)) => (status_to_suggestion(status), ExpHole) + | None => (NoSuggestion(NonTypeHoleId), None) } }; } else { - NoSuggestion(SuggestionsDisabled); + (NoSuggestion(SuggestionsDisabled), None); }; let hole_nib: Nib.t = {shape: Convex, sort: Any}; diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index eccc766cc9..144fa97c56 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -62,8 +62,8 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { ); }; switch (suggestion_opt) { - | Some(Solvable(typ_filling)) - | Some(NestedInconsistency(typ_filling)) => + | Some((Solvable(typ_filling), TypHole)) + | Some((NestedInconsistency(typ_filling), TypHole)) => // question marks (holes) can't be inserted manually, so filter them out let join = List.fold_left((s, acc) => s ++ acc, ""); let no_hole_marks = diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 59bedeb89e..339345aa3a 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -45,7 +45,7 @@ let of_grout = ~global_inference_info: InferenceResult.global_inference_info, id: Id.t, ) => { - let suggestion: InferenceResult.suggestion(Node.t) = + let suggestion = InferenceView.get_suggestion_ui_for_id( ~font_metrics, id, @@ -53,14 +53,19 @@ let of_grout = false, ); switch (suggestion) { - | NoSuggestion(SuggestionsDisabled) - | NoSuggestion(NonTypeHoleId) - | NoSuggestion(OnlyHoleSolutions) => [Node.text(Unicode.nbsp)] - | Solvable(suggestion_node) - | NestedInconsistency(suggestion_node) => [ + | (NoSuggestion(SuggestionsDisabled), _) + | (NoSuggestion(NonTypeHoleId), _) + | (NoSuggestion(OnlyHoleSolutions), _) + | (_, None) => [Node.text(Unicode.nbsp)] + | (Solvable(suggestion_node), TypHole) + | (NestedInconsistency(suggestion_node), TypHole) => [ [suggestion_node] |> span_c("solved-annotation"), ] - | NoSuggestion(InconsistentSet) => [ + | (Solvable(_), ExpHole) + | (NestedInconsistency(_), ExpHole) => [ + [Node.text("?")] |> span_c("prompt-ci"), + ] + | (NoSuggestion(InconsistentSet), _) => [ [Node.text("!")] |> span_c("unsolved-annotation"), ] }; @@ -255,20 +260,21 @@ let rec holes = t.children, ) | Grout(g) => { - let (show_dec, is_unsolved) = - InferenceView.svg_display_settings(~global_inference_info, g.id); - show_dec - ? [ + switch ( + InferenceView.svg_display_settings(~global_inference_info, g.id) + ) { + | Some(svg_style) => [ EmptyHoleDec.view( ~font_metrics, // TODO(d) fix sort - is_unsolved, + svg_style, { measurement: Measured.find_g(g, map), mold: Mold.of_grout(g, Any), }, ), ] - : []; + | None => [] + }; }, ); diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 9e4231e46a..2341853fa3 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -89,62 +89,96 @@ let view_of_global_inference_info = ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, id: Id.t, ) => { + print_endline("CI view of GI for id " ++ Id.to_string(id)); let font_metrics = Some(font_metrics); + let suggestion_button_of_typ = (~id: option(Id.t)=None, typ) => { + div( + ~attr=clss(["typ-view-conflict"]), + [ + Widgets.hoverable_button( + [Type.view(~font_metrics, typ)], + _mouse_event => { + State.set_considering_suggestion(false); + inject(Update.SetMeta(Mouseup)); + }, + _mouse_event => { + State.set_considering_suggestion(true); + if (!State.get_suggestion_pasted()) { + State.set_suggestion_pasted(true); + switch (id) { + | Some(id) => + Ui_effect.bind( + inject(Update.PerformAction(Jump(TileId(id), Right))), + ~f=_res => + inject( + Update.Paste( + " : " ++ Haz3lcore.Typ.typ_to_string(typ, false), + ), + ) + ) + | None => + inject( + Update.Paste(Haz3lcore.Typ.typ_to_string(typ, false)), + ) + }; + } else { + inject(Update.SetMeta(Mouseup)); + }; + }, + _mouse_event => + if (State.get_considering_suggestion()) { + State.set_suggestion_pasted(false); + State.set_considering_suggestion(false); + switch (id) { + | Some(_) => + Ui_effect.bind(inject(Update.Undo), ~f=_res => + inject(Update.Undo) + ) + | None => inject(Update.Undo) + }; + } else { + inject(Update.SetMeta(Mouseup)); + }, + ), + ], + ); + }; switch (InferenceView.get_cursor_inspect_result(~global_inference_info, id)) { - | SolvedTypeHole(solution) - | SolvedExpHole(_, solution) => + | SolvedTypeHole(solution) => div( ~attr=clss([infoc, "typ"]), [text("consistent constraints"), Type.view(~font_metrics, solution)], ) - | UnsolvedTypeHole([typ_with_nested_conflict]) - | UnsolvedExpHole(_, [typ_with_nested_conflict]) => + + | SolvedExpHole(id, solution) => + print_endline("Solved exphole"); + div( + ~attr=clss([infoc, "typ"]), + [ + text("consistent constraints"), + suggestion_button_of_typ(~id=Some(id), solution), + ], + ); + | UnsolvedTypeHole([typ_with_nested_conflict]) => div( ~attr=clss([infoc, "typ"]), [Type.view(~font_metrics, typ_with_nested_conflict)], ) + | UnsolvedExpHole(_, [typ_with_nested_conflict]) => + print_endline("Solved exphole nested inconsistency"); + div( + ~attr=clss([infoc, "typ"]), + [ + text("conflicting constraints"), + suggestion_button_of_typ(typ_with_nested_conflict), + ], + ); | UnsolvedTypeHole(conflicting_typs) => div( ~attr=clss([infoc, "typ"]), [ text("conflicting constraints"), - ...List.map( - typ => - div( - ~attr=clss(["typ-view-conflict"]), - [ - Widgets.hoverable_button( - [Type.view(~font_metrics, typ)], - _mouse_event => { - State.set_considering_suggestion(false); - inject(Update.SetMeta(Mouseup)); - }, - _mouse_event => { - State.set_considering_suggestion(true); - if (!State.get_suggestion_pasted()) { - State.set_suggestion_pasted(true); - inject( - Update.Paste( - Haz3lcore.Typ.typ_to_string(typ, false), - ), - ); - } else { - inject(Update.SetMeta(Mouseup)); - }; - }, - _mouse_event => - if (State.get_considering_suggestion()) { - State.set_suggestion_pasted(false); - State.set_considering_suggestion(false); - inject(Update.Undo); - } else { - inject(Update.SetMeta(Mouseup)); - }, - ), - ], - ), - conflicting_typs, - ), + ...List.map(suggestion_button_of_typ, conflicting_typs), ], ) | UnsolvedExpHole(id, conflicting_typs) => @@ -153,50 +187,7 @@ let view_of_global_inference_info = [ text("conflicting constraints"), ...List.map( - typ => - div( - ~attr=clss(["typ-view-conflict"]), - [ - Widgets.hoverable_button( - [Type.view(~font_metrics, typ)], - _mouse_event => { - State.set_considering_suggestion(false); - inject(Update.SetMeta(Mouseup)); - }, - _mouse_event => { - State.set_considering_suggestion(true); - if (!State.get_suggestion_pasted()) { - State.set_suggestion_pasted(true); - - Ui_effect.bind( - inject( - Update.PerformAction(Jump(TileId(id), Right)), - ), - ~f=_res => - inject( - Update.Paste( - " : " - ++ Haz3lcore.Typ.typ_to_string(typ, false), - ), - ) - ); - } else { - inject(Update.SetMeta(Mouseup)); - }; - }, - _mouse_event => - if (State.get_considering_suggestion()) { - State.set_suggestion_pasted(false); - State.set_considering_suggestion(false); - Ui_effect.bind(inject(Update.Undo), ~f=_res => - inject(Update.Undo) - ); - } else { - inject(Update.SetMeta(Mouseup)); - }, - ), - ], - ), + suggestion_button_of_typ(~id=Some(id)), conflicting_typs, ), ], @@ -259,11 +250,9 @@ let common_ok_view = global_inference_info, ) ) { - | Solvable(_) // currently no indirect suggestions for solvable holes TODO: Raef explore this - | NestedInconsistency(_) // currently no indirect suggestions for solvable holes - | NoSuggestion(SuggestionsDisabled) - | NoSuggestion(NonTypeHoleId) - | NoSuggestion(OnlyHoleSolutions) => + | (NoSuggestion(SuggestionsDisabled), _) + | (NoSuggestion(NonTypeHoleId), _) + | (NoSuggestion(OnlyHoleSolutions), _) => switch (cls, ok) { | (Exp(MultiHole) | Pat(MultiHole), _) => [ text("Expecting operator or delimiter"), @@ -329,9 +318,9 @@ let typ_ok_view = global_inference_info, ) ) { - | NoSuggestion(SuggestionsDisabled) - | NoSuggestion(NonTypeHoleId) - | NoSuggestion(OnlyHoleSolutions) => [Type.view(ty)] + | (NoSuggestion(SuggestionsDisabled), _) + | (NoSuggestion(NonTypeHoleId), _) + | (NoSuggestion(OnlyHoleSolutions), _) => [Type.view(ty)] | _ => [ view_of_global_inference_info( ~inject, diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index 6c51d6b01f..4592e2a26c 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -15,55 +15,64 @@ let get_suggestion_ui_for_id = global_inference_info: InferenceResult.global_inference_info, colored_ui: bool, ) - : InferenceResult.suggestion(Node.t) => + : (InferenceResult.suggestion(Node.t), InferenceResult.suggestion_source) => if (global_inference_info.enabled) { - let status_opt = - Hashtbl.find_opt(global_inference_info.typehole_suggestions, id); - switch (status_opt) { - | Some(Solved(Unknown(_))) => NoSuggestion(OnlyHoleSolutions) - | Some(Solved(ityp)) => - Solvable( - ityp - |> ITyp.ityp_to_typ - |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), - ) - | Some(Unsolved([potential_typ])) => - let ptyp_node = - Type.view_of_potential_typ( - ~font_metrics, - ~with_cls=colored_ui, - false, - potential_typ, - ); - NestedInconsistency(ptyp_node); - | Some(Unsolved(_)) => NoSuggestion(InconsistentSet) + let status_to_suggestion = + (status: InferenceResult.status): InferenceResult.suggestion(Node.t) => + switch (status) { + | Solved(Unknown(_)) => NoSuggestion(OnlyHoleSolutions) + | Solved(ityp) => + Solvable( + ityp + |> ITyp.ityp_to_typ + |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), + ) + | Unsolved([potential_typ]) => + let ptyp_node = + Type.view_of_potential_typ( + ~font_metrics, + ~with_cls=colored_ui, + false, + potential_typ, + ); + NestedInconsistency(ptyp_node); + | Unsolved(_) => NoSuggestion(InconsistentSet) + }; + switch (Hashtbl.find_opt(global_inference_info.typehole_suggestions, id)) { + | Some(status) => (status_to_suggestion(status), TypHole) | None => switch (Hashtbl.find_opt(global_inference_info.exphole_suggestions, id)) { - | Some((_, Unsolved(typs))) when List.length(typs) > 1 => - NoSuggestion(InconsistentSet) - | _ => NoSuggestion(NonTypeHoleId) + | Some((_, status)) => (status_to_suggestion(status), ExpHole) + | None => (NoSuggestion(NonTypeHoleId), None) } }; } else { - NoSuggestion(SuggestionsDisabled); + (NoSuggestion(SuggestionsDisabled), None); }; let svg_display_settings = (~global_inference_info: InferenceResult.global_inference_info, id: Id.t) - : (bool, bool) => { + : option(EmptyHoleDec.hole_svg_style) => { // Determines if a hexagon (svg) should be used to represent a type hole, and if so, how it should look - let (show_svg, is_unsolved) = - switch ( - InferenceResult.get_suggestion_text_for_id(id, global_inference_info) - ) { - | Solvable(_) => (false, false) - | NestedInconsistency(_) => (false, true) - | NoSuggestion(SuggestionsDisabled) - | NoSuggestion(OnlyHoleSolutions) => (true, false) - | NoSuggestion(NonTypeHoleId) => (true, false) - | NoSuggestion(InconsistentSet) => (true, true) - }; - (show_svg, is_unsolved); + let (suggestion, source) = + InferenceResult.get_suggestion_text_for_id(id, global_inference_info); + switch (source) { + | ExpHole => + switch (suggestion) { + | Solvable(_) + | NestedInconsistency(_) => Some(PromptHole) + | NoSuggestion(InconsistentSet) => Some(ErrorHole) + | NoSuggestion(_) => Some(StandardHole) + } + | None => Some(StandardHole) + | TypHole => + switch (suggestion) { + | Solvable(_) + | NestedInconsistency(_) => None + | NoSuggestion(InconsistentSet) => Some(ErrorHole) + | NoSuggestion(_) => Some(StandardHole) + } + }; }; let get_cursor_inspect_result = diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 4a2ab870f2..f401f6651f 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -43,7 +43,7 @@ let rec view_ty = [ EmptyHoleDec.relative_view( ~font_metrics, - false, + StandardHole, InferenceResult.hole_mold, ), ], @@ -147,7 +147,7 @@ and view_of_potential_typ_set = [ EmptyHoleDec.relative_view( ~font_metrics, - true, + ErrorHole, Haz3lcore.InferenceResult.hole_mold, ), ], diff --git a/src/haz3lweb/view/dec/EmptyHoleDec.re b/src/haz3lweb/view/dec/EmptyHoleDec.re index a981fda188..6fa42fb0f5 100644 --- a/src/haz3lweb/view/dec/EmptyHoleDec.re +++ b/src/haz3lweb/view/dec/EmptyHoleDec.re @@ -8,6 +8,11 @@ module Profile = { }; }; +type hole_svg_style = + | StandardHole + | ErrorHole + | PromptHole; + let path = (tip_l, tip_r, offset, s: float) => { let x_dilate = 1.5; List.concat( @@ -25,7 +30,7 @@ let path = (tip_l, tip_r, offset, s: float) => { }; let view = - (~font_metrics, is_unsolved, {measurement, mold}: Profile.t): Node.t => { + (~font_metrics, hole_svg_style, {measurement, mold}: Profile.t): Node.t => { let sort = mold.out; let c_cls = Sort.to_string(sort); let (tip_l, tip_r): (Haz3lcore.Nib.Shape.t, Haz3lcore.Nib.Shape.t) = @@ -35,24 +40,36 @@ let view = {sort, shape: tip_r}, ); - is_unsolved - ? DecUtil.code_svg_sized( - ~font_metrics, - ~measurement, - ~base_cls=["empty-hole"], - ~path_cls=["unsolved-empty-hole-path", c_cls], - path(tip_l, tip_r, 0., 0.6), - ) - : DecUtil.code_svg_sized( - ~font_metrics, - ~measurement, - ~base_cls=["empty-hole"], - ~path_cls=["empty-hole-path", c_cls], - path(tip_l, tip_r, 0., 0.28), - ); + switch (hole_svg_style) { + | StandardHole => + DecUtil.code_svg_sized( + ~font_metrics, + ~measurement, + ~base_cls=["empty-hole"], + ~path_cls=["empty-hole-path", c_cls], + path(tip_l, tip_r, 0., 0.28), + ) + | ErrorHole => + DecUtil.code_svg_sized( + ~font_metrics, + ~measurement, + ~base_cls=["empty-hole"], + ~path_cls=["unsolved-empty-hole-path", c_cls], + path(tip_l, tip_r, 0., 0.42), + ) + | PromptHole => + DecUtil.code_svg_sized( + ~font_metrics, + ~measurement, + ~base_cls=["empty-hole"], + ~path_cls=["solved-empty-hole-with-ci-path", c_cls], + path(tip_l, tip_r, 0., 0.42), + ) + }; }; -let relative_view = (~font_metrics, is_unsolved, mold: Mold.t): Node.t => { +let relative_view = + (~font_metrics, hole_svg_style: hole_svg_style, mold: Mold.t): Node.t => { let sort = mold.out; let c_cls = Sort.to_string(sort); let (tip_l, tip_r): (Haz3lcore.Nib.Shape.t, Haz3lcore.Nib.Shape.t) = @@ -62,17 +79,27 @@ let relative_view = (~font_metrics, is_unsolved, mold: Mold.t): Node.t => { {sort, shape: tip_r}, ); - is_unsolved - ? DecUtil.code_svg_sized_relative( - ~font_metrics, - ~base_cls=["empty-hole"], - ~path_cls=["unsolved-empty-hole-path", c_cls], - path(tip_l, tip_r, 0., 0.42), - ) - : DecUtil.code_svg_sized_relative( - ~font_metrics, - ~base_cls=["empty-hole"], - ~path_cls=["empty-hole-path", c_cls], - path(tip_l, tip_r, 0., 0.28), - ); + switch (hole_svg_style) { + | StandardHole => + DecUtil.code_svg_sized_relative( + ~font_metrics, + ~base_cls=["empty-hole"], + ~path_cls=["empty-hole-path", c_cls], + path(tip_l, tip_r, 0., 0.28), + ) + | ErrorHole => + DecUtil.code_svg_sized_relative( + ~font_metrics, + ~base_cls=["empty-hole"], + ~path_cls=["unsolved-empty-hole-path", c_cls], + path(tip_l, tip_r, 0., 0.42), + ) + | PromptHole => + DecUtil.code_svg_sized_relative( + ~font_metrics, + ~base_cls=["empty-hole"], + ~path_cls=["solved-empty-hole-with-ci-path", c_cls], + path(tip_l, tip_r, 0., 0.42), + ) + }; }; diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index 11dc3a7050..e798fff30a 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -653,6 +653,13 @@ select { vector-effect: non-scaling-stroke; } +.solved-empty-hole-with-ci-path { + fill: #f1e8cd; + stroke: #dbcca7; + stroke-width: 0.75px; + vector-effect: non-scaling-stroke; +} + .selection { position: relative; } @@ -757,6 +764,10 @@ select { color: rgb(174, 175, 180) } +.prompt-ci { + color: rgb(174, 175, 180); +} + .unsolved-annotation { color: rgb(229, 30, 30); } From 1ab2c53dd56f5c08c6a1b35b902e47b43e34481f Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 31 Dec 2023 14:46:47 -0500 Subject: [PATCH 095/129] fix issue where annotated patterns were also candidates for annot insertion --- src/haz3lcore/statics/Statics.re | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 961791f550..67ae1aba31 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -552,6 +552,7 @@ and upat_to_info_map = ~co_ctx, ~ancestors: Info.ancestors, ~mode: Mode.t=Mode.Syn, + ~annot_pat=false, {ids, term} as upat: UPat.t, m: Map.t, ) @@ -633,11 +634,12 @@ and upat_to_info_map = /* NOTE: The self type assigned to pattern variables (Unknown) may be SynSwitch, but SynSwitch is never added to the context; Internal is used in this case */ + let hole_reason: Typ.hole_reason = annot_pat ? Internal : PatternVar; let ctx_typ = Info.fixed_typ_pat( ctx, mode, - Common(Just(Unknown(ExpHole(PatternVar, id), false))), + Common(Just(Unknown(ExpHole(hole_reason, id), false))), id, ); let entry = Ctx.VarEntry({name, id, typ: ctx_typ}); @@ -646,7 +648,7 @@ and upat_to_info_map = ~ctx=Ctx.extend(ctx, entry), ~constraints= subsumption_constraints( - Just(Unknown(ExpHole(PatternVar, id), false)), + Just(Unknown(ExpHole(hole_reason, id), false)), ), m, ); @@ -673,7 +675,7 @@ and upat_to_info_map = ); | TypeAnn(p, ann) => let (ann, m) = utyp_to_info_map(~ctx, ~ancestors, ann, m); - let (p, m) = go(~ctx, ~mode=Ana(ann.ty), p, m); + let (p, m) = go(~ctx, ~mode=Ana(ann.ty), ~annot_pat=true, p, m); add(~self=Just(ann.ty), ~ctx=p.ctx, ~constraints=p.constraints, m); }; } From ba8f2a26bde372d3a46aecee8fac5c01c60c2b6f Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 31 Dec 2023 14:48:49 -0500 Subject: [PATCH 096/129] rename NonTypeHoleId to NotSuggestableHoleId --- src/haz3lcore/inference/InferenceResult.re | 4 ++-- src/haz3lweb/view/Code.re | 2 +- src/haz3lweb/view/CursorInspector.re | 4 ++-- src/haz3lweb/view/InferenceView.re | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 687ba7e8a5..e464f00eec 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -23,7 +23,7 @@ type suggestion('a) = | NoSuggestion(reason_for_silence) and reason_for_silence = | SuggestionsDisabled - | NonTypeHoleId + | NotSuggestableHoleId | OnlyHoleSolutions | InconsistentSet; @@ -53,7 +53,7 @@ let get_suggestion_text_for_id = | None => switch (Hashtbl.find_opt(global_inference_info.exphole_suggestions, id)) { | Some((_, status)) => (status_to_suggestion(status), ExpHole) - | None => (NoSuggestion(NonTypeHoleId), None) + | None => (NoSuggestion(NotSuggestableHoleId), None) } }; } else { diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index 339345aa3a..b4476f5633 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -54,7 +54,7 @@ let of_grout = ); switch (suggestion) { | (NoSuggestion(SuggestionsDisabled), _) - | (NoSuggestion(NonTypeHoleId), _) + | (NoSuggestion(NotSuggestableHoleId), _) | (NoSuggestion(OnlyHoleSolutions), _) | (_, None) => [Node.text(Unicode.nbsp)] | (Solvable(suggestion_node), TypHole) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 2341853fa3..eaa0f67087 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -251,7 +251,7 @@ let common_ok_view = ) ) { | (NoSuggestion(SuggestionsDisabled), _) - | (NoSuggestion(NonTypeHoleId), _) + | (NoSuggestion(NotSuggestableHoleId), _) | (NoSuggestion(OnlyHoleSolutions), _) => switch (cls, ok) { | (Exp(MultiHole) | Pat(MultiHole), _) => [ @@ -319,7 +319,7 @@ let typ_ok_view = ) ) { | (NoSuggestion(SuggestionsDisabled), _) - | (NoSuggestion(NonTypeHoleId), _) + | (NoSuggestion(NotSuggestableHoleId), _) | (NoSuggestion(OnlyHoleSolutions), _) => [Type.view(ty)] | _ => [ view_of_global_inference_info( diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index 4592e2a26c..dbd632faac 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -43,7 +43,7 @@ let get_suggestion_ui_for_id = | None => switch (Hashtbl.find_opt(global_inference_info.exphole_suggestions, id)) { | Some((_, status)) => (status_to_suggestion(status), ExpHole) - | None => (NoSuggestion(NonTypeHoleId), None) + | None => (NoSuggestion(NotSuggestableHoleId), None) } }; } else { From d0639da80d9c43b4ec86d47fdb3f177bba6d5d41 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 31 Dec 2023 15:00:23 -0500 Subject: [PATCH 097/129] fix issue of ? being pasted in --- src/haz3lcore/zipper/action/Perform.re | 5 ----- src/haz3lweb/view/CursorInspector.re | 9 +++++++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/haz3lcore/zipper/action/Perform.re b/src/haz3lcore/zipper/action/Perform.re index aa663ce6f6..58d8f92ae4 100644 --- a/src/haz3lcore/zipper/action/Perform.re +++ b/src/haz3lcore/zipper/action/Perform.re @@ -1,6 +1,5 @@ open Util; open Zipper; -open Sexplib.Std; let is_write_action = (a: Action.t) => { switch (a) { @@ -55,10 +54,6 @@ let go_z = | Jump(jump_target, direction) => open OptUtil.Syntax; - print_endline( - "Direction: " ++ (direction |> Direction.sexp_of_t |> string_of_sexp), - ); - let idx = Indicated.index(z); let (term, _) = Util.TimeUtil.measure_time("Perform.go_z => MakeTerm.from_zip", true, () => diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index eaa0f67087..282c9d6964 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -91,6 +91,11 @@ let view_of_global_inference_info = ) => { print_endline("CI view of GI for id " ++ Id.to_string(id)); let font_metrics = Some(font_metrics); + let no_hole_marks = (typ_filling) => + typ_filling + |> StringUtil.to_list + |> List.filter(s => s != "?" && s != "!") + |> String.concat(""); let suggestion_button_of_typ = (~id: option(Id.t)=None, typ) => { div( ~attr=clss(["typ-view-conflict"]), @@ -112,13 +117,13 @@ let view_of_global_inference_info = ~f=_res => inject( Update.Paste( - " : " ++ Haz3lcore.Typ.typ_to_string(typ, false), + " : " ++ no_hole_marks(Haz3lcore.Typ.typ_to_string(typ, false)), ), ) ) | None => inject( - Update.Paste(Haz3lcore.Typ.typ_to_string(typ, false)), + Update.Paste(no_hole_marks(Haz3lcore.Typ.typ_to_string(typ, false))), ) }; } else { From 757b07dd9d49909cdbbb0f3b4c0870baebf3d0dd Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 31 Dec 2023 15:08:54 -0500 Subject: [PATCH 098/129] autoformatting --- src/haz3lweb/view/CursorInspector.re | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 282c9d6964..625b652b2e 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -91,7 +91,7 @@ let view_of_global_inference_info = ) => { print_endline("CI view of GI for id " ++ Id.to_string(id)); let font_metrics = Some(font_metrics); - let no_hole_marks = (typ_filling) => + let no_hole_marks = typ_filling => typ_filling |> StringUtil.to_list |> List.filter(s => s != "?" && s != "!") @@ -117,13 +117,18 @@ let view_of_global_inference_info = ~f=_res => inject( Update.Paste( - " : " ++ no_hole_marks(Haz3lcore.Typ.typ_to_string(typ, false)), + " : " + ++ no_hole_marks( + Haz3lcore.Typ.typ_to_string(typ, false), + ), ), ) ) | None => inject( - Update.Paste(no_hole_marks(Haz3lcore.Typ.typ_to_string(typ, false))), + Update.Paste( + no_hole_marks(Haz3lcore.Typ.typ_to_string(typ, false)), + ), ) }; } else { From 19fc24ea7b555d113309869857eda1c7e77f08aa Mon Sep 17 00:00:00 2001 From: RaefM Date: Fri, 5 Jan 2024 18:13:23 -0500 Subject: [PATCH 099/129] fix ADT issue --- src/haz3lcore/inference/InferenceResult.re | 9 +- src/haz3lcore/inference/PotentialTypeSet.re | 126 +++++++++++--------- 2 files changed, 75 insertions(+), 60 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index e464f00eec..8775c233dc 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -101,13 +101,16 @@ let condense = PotentialTypeSet.sort_potential_typ_set(potential_typ_set); let hole_filtered_potential_typ_set = - PotentialTypeSet.filter_unneeded_holes( - PotentialTypeSet.is_known, + PotentialTypeSet.filter_unneeded_nodes( + PotentialTypeSet.is_unknown, sorted_potential_typ_set, ); let redundant_var_filtered_potential_typ_set = - PotentialTypeSet.filter_vars(hole_filtered_potential_typ_set); + PotentialTypeSet.filter_unneeded_nodes( + PotentialTypeSet.is_var, + hole_filtered_potential_typ_set, + ); switch (err) { | Some(_) => Unsolved(redundant_var_filtered_potential_typ_set) diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index ed576b643a..3e1caf32d1 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -346,92 +346,104 @@ and target_typ_in_domain_but_not_equal_typ = && target_typ_used_in_potential_typ(target_typ, potential_typ); }; -let is_known: potential_typ => bool = +let is_unknown: potential_typ => bool = fun - | Base(BUnknown(_)) => false - | _ => true; + | Base(BUnknown(_)) => true + | _ => false; -let rec filter_unneeded_holes_class = - (comp: potential_typ => bool, remove: bool, potential_typ_set: t): t => { +let is_var: potential_typ => bool = + fun + | Base(BVar(_)) => true + | _ => false; + +let rec filter_unneeded_nodes_class = + ( + is_removal_candidate: potential_typ => bool, + remove_candidates: bool, + potential_typ_set: t, + ) + : t => { switch (potential_typ_set) { | [] => [] | [hd, ...tl] => - let (had_hole, filtered_hd_opt) = - filter_unneeded_holes_typ(comp, remove, hd); - let remove = had_hole || remove; + let (found_candidate, filtered_hd_opt) = + filter_unneeded_nodes_typ(is_removal_candidate, remove_candidates, hd); + let remove_candidates = found_candidate || remove_candidates; switch (filtered_hd_opt) { - | None => filter_unneeded_holes_class(comp, remove, tl) + | None => + filter_unneeded_nodes_class(is_removal_candidate, remove_candidates, tl) | Some(filtered_hd) => [ filtered_hd, - ...filter_unneeded_holes_class(comp, remove, tl), + ...filter_unneeded_nodes_class( + is_removal_candidate, + remove_candidates, + tl, + ), ] }; }; } -and filter_unneeded_holes_typ = - (comp: potential_typ => bool, remove: bool, potential_typ: potential_typ) +and filter_unneeded_nodes_typ = + ( + is_removal_candidate: potential_typ => bool, + remove_candidates: bool, + potential_typ: potential_typ, + ) : (bool, option(potential_typ)) => { + let is_not_removal_candidate = ptyp => !is_removal_candidate(ptyp); switch (potential_typ) { - | Base(btyp) => - switch (btyp) { - | BUnknown(_) => - let eq_tp_opt = remove ? None : Some(potential_typ); - (true, eq_tp_opt); - | _ => (false, Some(potential_typ)) + | Base(_) => + if (is_removal_candidate(potential_typ)) { + ( + // only remove if previous candidates have already been found + true, + remove_candidates ? None : Some(potential_typ), + ); + } else { + (false, Some(potential_typ)); } | Unary(ctor, potential_typ_set) => - let delete_holes = List.exists(comp, potential_typ_set); + let remove_candidates = + List.exists(is_not_removal_candidate, potential_typ_set); let potential_typ_set = - filter_unneeded_holes_class(comp, delete_holes, potential_typ_set); + filter_unneeded_nodes_class( + is_removal_candidate, + remove_candidates, + potential_typ_set, + ); (false, Some(Unary(ctor, potential_typ_set))); | Binary(ctor, potential_typ_set_lt, potential_typ_set_rt) => - let delete_holes_lt = List.exists(comp, potential_typ_set_lt); - let delete_holes_rt = List.exists(comp, potential_typ_set_rt); + let remove_candidates_lt = + List.exists(is_not_removal_candidate, potential_typ_set_lt); + let remove_candidates_rt = + List.exists(is_not_removal_candidate, potential_typ_set_rt); let potential_typ_set_lt = - filter_unneeded_holes_class( - comp, - delete_holes_lt, + filter_unneeded_nodes_class( + is_removal_candidate, + remove_candidates_lt, potential_typ_set_lt, ); let potential_typ_set_rt = - filter_unneeded_holes_class( - comp, - delete_holes_rt, + filter_unneeded_nodes_class( + is_removal_candidate, + remove_candidates_rt, potential_typ_set_rt, ); (false, Some(Binary(ctor, potential_typ_set_lt, potential_typ_set_rt))); }; }; -let filter_unneeded_holes = - (comp: potential_typ => bool, potential_typ_set: t): t => { - let delete_holes = List.exists(comp, potential_typ_set); - filter_unneeded_holes_class(comp, delete_holes, potential_typ_set); -}; - -let filter_vars = (potential_typ_set: t): t => { - let is_non_node = - fun - | Base(BVar(_)) - | Base(BUnknown(_)) => false - | _ => true; - - let is_not_var = - fun - | Base(BVar(_)) => false - | _ => true; - - let num_literals = - potential_typ_set |> List.filter(is_non_node) |> List.length; - - switch (num_literals) { - | n when n > 1 => - // do not filter vars; already unsolved, allow selection between similar aliases - potential_typ_set - | _ => - // must be solved. we arbitrarily filter out everything but the literal so it is assigned solved status - List.filter(is_not_var, potential_typ_set) - }; +// removes all nodes for which is_removal_candidate is true unless no other options exist +let filter_unneeded_nodes = + (is_removal_candidate: potential_typ => bool, potential_typ_set: t): t => { + let is_not_removal_candidate = ptyp => !is_removal_candidate(ptyp); + let remove_candidates = + List.exists(is_not_removal_candidate, potential_typ_set); + filter_unneeded_nodes_class( + is_removal_candidate, + remove_candidates, + potential_typ_set, + ); }; let rec filtered_potential_typ_set_to_typ: t => option(ITyp.t) = From 32d0d554f8fae4b473153789b34c8c861f883505 Mon Sep 17 00:00:00 2001 From: RaefM Date: Fri, 5 Jan 2024 19:33:52 -0500 Subject: [PATCH 100/129] Moved acceptance logic into Tab and out of Enter. Should talk to Andrew about a more elegant way to inject these --- src/haz3lweb/Keyboard.re | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 144fa97c56..cbf79c3eff 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -43,16 +43,7 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { | (Up, "Backspace") => now(Destruct(Left)) | (Up, "Delete") => now(Destruct(Right)) | (Up, "Escape") => now(Unselect(None)) - | (Up, "Tab") => Some(DoTheThing) - | (Up, "F12") => now(Jump(BindingSiteOfIndicatedVar, Left)) - | (Down, "Tab") => Some(MoveToNextHole(Left)) - | (Down, "ArrowLeft") => now(Select(Resize(Local(Left(ByToken))))) - | (Down, "ArrowRight") => now(Select(Resize(Local(Right(ByToken))))) - | (Down, "ArrowUp") => now(Select(Resize(Local(Up)))) - | (Down, "ArrowDown") => now(Select(Resize(Local(Down)))) - | (Down, "Home") => now(Select(Resize(Extreme(Left(ByToken))))) - | (Down, "End") => now(Select(Resize(Extreme(Right(ByToken))))) - | (_, "Enter") => + | (Up, "Tab") => let suggestion_opt = { open Util.OptUtil.Syntax; let+ (p, _) = Zipper.representative_piece(zipper); @@ -72,8 +63,17 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { |> List.filter(s => s != "?" && s != "!") |> join; Some(UpdateAction.Paste(no_hole_marks)); - | _ => now(Insert(Form.linebreak)) + | _ => Some(DoTheThing) }; + | (Up, "F12") => now(Jump(BindingSiteOfIndicatedVar, Left)) + | (Down, "Tab") => Some(MoveToNextHole(Left)) + | (Down, "ArrowLeft") => now(Select(Resize(Local(Left(ByToken))))) + | (Down, "ArrowRight") => now(Select(Resize(Local(Right(ByToken))))) + | (Down, "ArrowUp") => now(Select(Resize(Local(Up)))) + | (Down, "ArrowDown") => now(Select(Resize(Local(Down)))) + | (Down, "Home") => now(Select(Resize(Extreme(Left(ByToken))))) + | (Down, "End") => now(Select(Resize(Extreme(Right(ByToken))))) + | (_, "Enter") => now(Insert(Form.linebreak)) | _ when String.length(key) == 1 => /* Note: length==1 prevent specials like * SHIFT from being captured here */ From 49163242d66bf2794576c10f15c431266d840054 Mon Sep 17 00:00:00 2001 From: RaefM Date: Fri, 5 Jan 2024 21:02:45 -0500 Subject: [PATCH 101/129] fix text alignment in CI --- src/haz3lweb/view/CursorInspector.re | 1 - src/haz3lweb/www/style.css | 3 ++- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 625b652b2e..f1107f09e4 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -89,7 +89,6 @@ let view_of_global_inference_info = ~global_inference_info: Haz3lcore.InferenceResult.global_inference_info, id: Id.t, ) => { - print_endline("CI view of GI for id " ++ Id.to_string(id)); let font_metrics = Some(font_metrics); let no_hole_marks = typ_filling => typ_filling diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index e798fff30a..efaa90c8b4 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -1362,7 +1362,7 @@ svg.tile-selected { .cursor-inspector .info { display: flex; - align-items: stretch; + align-items: inherit; gap: 0.5em; color: #8c795b; } @@ -1378,6 +1378,7 @@ svg.tile-selected { .cursor-inspector .info .error { display: flex; align-items: center; + vertical-align: middle; gap: 0.5em; white-space: nowrap; } From 051cb418eda4fb0283351d7396800b136e9b9e40 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sat, 6 Jan 2024 18:11:37 -0500 Subject: [PATCH 102/129] fix issue where holes become offset when UpdateAssistant operations occur --- .../view/assistant/UpdateAssistant.re | 30 ++++++++++++++++--- 1 file changed, 26 insertions(+), 4 deletions(-) diff --git a/src/haz3lweb/view/assistant/UpdateAssistant.re b/src/haz3lweb/view/assistant/UpdateAssistant.re index 17d41604d3..fa6f7c3d55 100644 --- a/src/haz3lweb/view/assistant/UpdateAssistant.re +++ b/src/haz3lweb/view/assistant/UpdateAssistant.re @@ -5,7 +5,12 @@ include UpdateAction; let perform_action = (model: Model.t, a: Action.t): Result.t(Model.t) => { let ed_init = Editors.get_editor(model.editors); switch ( - Haz3lcore.Perform.go(~settings=model.settings.core, a, ed_init, false) + Haz3lcore.Perform.go( + ~settings=model.settings.core, + a, + ed_init, + model.langDocMessages.annotations, + ) ) { | Error(err) => Error(FailedToPerform(err)) | Ok(ed) => Ok({...model, editors: Editors.put_editor(ed, model.editors)}) @@ -18,11 +23,22 @@ let reset_buffer = (model: Model.t) => { switch (z.selection.mode) { | Buffer(_) => switch ( - Perform.go_z(~settings=model.settings.core, Destruct(Left), z, false) + Perform.go_z( + ~settings=model.settings.core, + Destruct(Left), + z, + model.langDocMessages.annotations, + ) ) { | Error(_) => model | Ok(z) => - let ed = Editor.new_state(Destruct(Left), z, ed, false); + let ed = + Editor.new_state( + Destruct(Left), + z, + ed, + model.langDocMessages.annotations, + ); //TODO(andrew): fix double action {...model, editors: Editors.put_editor(ed, model.editors)}; } @@ -47,7 +63,13 @@ let apply = switch (TyDi.set_buffer(~settings=settings.core, ~ctx=ctx_init, z)) { | None => Ok(model) | Some(z) => - let ed = Editor.new_state(Pick_up, z, editor, false); + let ed = + Editor.new_state( + Pick_up, + z, + editor, + model.langDocMessages.annotations, + ); //TODO: add correct action to history (Pick_up is wrong) let editors = Editors.put_editor(ed, model.editors); Ok({...model, editors}); From f529616892379894080297613e02947f17a55594 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sat, 6 Jan 2024 23:26:54 -0500 Subject: [PATCH 103/129] make exp hole suggestions only pop up on directly constrained unannotated pat vars on ci hover --- src/haz3lcore/inference/InferenceResult.re | 17 ++++++---- src/haz3lcore/statics/Statics.re | 38 +++++++++++++++++++--- src/haz3lcore/statics/TypBase.re | 12 +++++-- 3 files changed, 53 insertions(+), 14 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 8775c233dc..8e54df9bdf 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -79,16 +79,21 @@ let empty_info = (): global_inference_info => { }; let rec get_all_pattern_var_neighbors = - (potential_typ_set: PotentialTypeSet.t): list(Id.t) => { + ( + potential_typ_set: PotentialTypeSet.t, + desired_parent_exp_hole_id: Id.t, + ) + : list(Id.t) => { switch (potential_typ_set) { | [] => [] | [hd, ...tl] => switch (hd) { - | Base(BUnknown(ExpHole(PatternVar, p_id))) => [ + | Base(BUnknown(ExpHole(PatternVar(parent_id), p_id))) + when parent_id == desired_parent_exp_hole_id => [ p_id, - ...get_all_pattern_var_neighbors(tl), + ...get_all_pattern_var_neighbors(tl, desired_parent_exp_hole_id), ] - | _ => get_all_pattern_var_neighbors(tl) + | _ => get_all_pattern_var_neighbors(tl, desired_parent_exp_hole_id) } }; }; @@ -192,11 +197,11 @@ let build_exphole_to_sugg_loc_and_solution = ) : list((Id.t, (list(Id.t), status))) => { switch (key) { - | Unknown(ExpHole(PatternVar, _)) => acc + | Unknown(ExpHole(PatternVar(_), _)) => acc | Unknown(ExpHole(_, id)) => let (potential_typ_set, _) = MutablePotentialTypeSet.snapshot_class(mut_potential_typ_set, key); - switch (get_all_pattern_var_neighbors(potential_typ_set)) { + switch (get_all_pattern_var_neighbors(potential_typ_set, id)) { | [] => acc | _ as suggestion_locations => [ ( diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 67ae1aba31..261d7cf219 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -367,11 +367,25 @@ and uexp_to_info_map = let ((mode_pat, mode_body), match_constraints) = Mode.of_arrow(ctx, mode, UExp.rep_id(uexp)); let (p', _) = - go_pat(~is_synswitch=false, ~co_ctx=CoCtx.empty, ~mode=mode_pat, p, m); + go_pat( + ~is_synswitch=false, + ~co_ctx=CoCtx.empty, + ~mode=mode_pat, + ~parent_id=Some(UExp.rep_id(e)), + p, + m, + ); let (e, m) = go'(~ctx=p'.ctx, ~mode=mode_body, e, m); /* add co_ctx to pattern */ let (p, m) = - go_pat(~is_synswitch=false, ~co_ctx=e.co_ctx, ~mode=mode_pat, p, m); + go_pat( + ~is_synswitch=false, + ~co_ctx=e.co_ctx, + ~mode=mode_pat, + ~parent_id=Some(UExp.rep_id(e.term)), + p, + m, + ); add( ~self=Just(Arrow(p.ty, e.ty)), ~co_ctx=CoCtx.mk(ctx, p.ctx, e.co_ctx), @@ -380,7 +394,14 @@ and uexp_to_info_map = ); | Let(p, def, body) => let (p_syn, _) = - go_pat(~is_synswitch=true, ~co_ctx=CoCtx.empty, ~mode=Syn, p, m); + go_pat( + ~is_synswitch=true, + ~co_ctx=CoCtx.empty, + ~mode=Syn, + ~parent_id=Some(UExp.rep_id(def)), + p, + m, + ); let def_ctx = extend_let_def_ctx(ctx, p, p_syn.ctx, def); let (def, m) = go'(~ctx=def_ctx, ~mode=Ana(p_syn.ty), def, m); /* Analyze pattern to incorporate def type into ctx */ @@ -389,6 +410,7 @@ and uexp_to_info_map = ~is_synswitch=false, ~co_ctx=CoCtx.empty, ~mode=Ana(def.ty), + ~parent_id=Some(UExp.rep_id(def.term)), p, m, ); @@ -399,6 +421,7 @@ and uexp_to_info_map = ~is_synswitch=false, ~co_ctx=body.co_ctx, ~mode=Ana(def.ty), + ~parent_id=Some(UExp.rep_id(def.term)), p, m, ); @@ -553,6 +576,7 @@ and upat_to_info_map = ~ancestors: Info.ancestors, ~mode: Mode.t=Mode.Syn, ~annot_pat=false, + ~parent_id: option(Id.t)=None, {ids, term} as upat: UPat.t, m: Map.t, ) @@ -577,7 +601,7 @@ and upat_to_info_map = add(~self, ~ctx, m, ~constraints=subsumption_constraints(self)); }; let ancestors = [UPat.rep_id(upat)] @ ancestors; - let go = upat_to_info_map(~is_synswitch, ~ancestors, ~co_ctx); + let go = upat_to_info_map(~is_synswitch, ~ancestors, ~co_ctx, ~parent_id); let unknown = Typ.Unknown(ExpHole(Internal, id), is_synswitch); let ctx_fold = (ctx: Ctx.t, m) => List.fold_left2( @@ -634,7 +658,11 @@ and upat_to_info_map = /* NOTE: The self type assigned to pattern variables (Unknown) may be SynSwitch, but SynSwitch is never added to the context; Internal is used in this case */ - let hole_reason: Typ.hole_reason = annot_pat ? Internal : PatternVar; + let hole_reason: Typ.hole_reason = + switch (annot_pat, parent_id) { + | (false, Some(id)) => PatternVar(id) + | _ => Internal + }; let ctx_typ = Info.fixed_typ_pat( ctx, diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 763f8f0775..2d546074e5 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -38,7 +38,7 @@ module rec Typ: { and hole_reason = | EmptyHole | Internal - | PatternVar + | PatternVar(Id.t) | Error | Free(TypVar.t); @@ -120,7 +120,7 @@ module rec Typ: { and hole_reason = | EmptyHole | Internal - | PatternVar + | PatternVar(Id.t) | Error | Free(TypVar.t); @@ -277,7 +277,13 @@ module rec Typ: { }; } and reason_to_string = (reason: hole_reason): string => { - reason |> sexp_of_hole_reason |> string_of_sexp; + switch (reason) { + | EmptyHole => "EmptyHole" + | Internal => "Internal" + | PatternVar(_) => "PatternVar" + | Error => "Error" + | Free(_) => "Free" + }; }; let rec typ_to_string = (ty: t, debug): string => { From aa06adadaf0c7201af0aa812b3b37cb6935dd01a Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 11 Jan 2024 20:04:04 -0600 Subject: [PATCH 104/129] fix sneaky internals causing not-as-good-as-they-could-be solutions --- src/haz3lcore/statics/Statics.re | 43 +++++++++++++++++++++++++++----- src/haz3lcore/statics/TypBase.re | 2 ++ 2 files changed, 39 insertions(+), 6 deletions(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 261d7cf219..5cf0d27691 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -495,7 +495,7 @@ and uexp_to_info_map = scrut.constraints @ e_constraints @ p_constraints - @ constrain_branches(p_typs) + @ constrain_branches([Info.exp_ty(scrut), ...p_typs]) @ constrain_branches(e_typs), ~self=Self.match(ctx, e_tys, branch_ids), ~co_ctx=CoCtx.union([scrut.co_ctx] @ e_co_ctxs), @@ -575,7 +575,7 @@ and upat_to_info_map = ~co_ctx, ~ancestors: Info.ancestors, ~mode: Mode.t=Mode.Syn, - ~annot_pat=false, + ~annot_pat: bool=false, ~parent_id: option(Id.t)=None, {ids, term} as upat: UPat.t, m: Map.t, @@ -601,7 +601,14 @@ and upat_to_info_map = add(~self, ~ctx, m, ~constraints=subsumption_constraints(self)); }; let ancestors = [UPat.rep_id(upat)] @ ancestors; - let go = upat_to_info_map(~is_synswitch, ~ancestors, ~co_ctx, ~parent_id); + let go = + upat_to_info_map( + ~is_synswitch, + ~ancestors, + ~co_ctx, + ~parent_id, + ~annot_pat, + ); let unknown = Typ.Unknown(ExpHole(Internal, id), is_synswitch); let ctx_fold = (ctx: Ctx.t, m) => List.fold_left2( @@ -658,10 +665,23 @@ and upat_to_info_map = /* NOTE: The self type assigned to pattern variables (Unknown) may be SynSwitch, but SynSwitch is never added to the context; Internal is used in this case */ + let parent_string = + switch (parent_id) { + | Some(id) => Id.to_string(id) + | None => "None" + }; + print_endline( + "In pat Var of " + ++ Id.to_string(id) + ++ " with annot_pat " + ++ string_of_bool(annot_pat) + ++ " and parent " + ++ parent_string, + ); let hole_reason: Typ.hole_reason = switch (annot_pat, parent_id) { | (false, Some(id)) => PatternVar(id) - | _ => Internal + | _ => Error }; let ctx_typ = Info.fixed_typ_pat( @@ -672,7 +692,7 @@ and upat_to_info_map = ); let entry = Ctx.VarEntry({name, id, typ: ctx_typ}); add( - ~self=Just(unknown), + ~self=Just(Unknown(ExpHole(hole_reason, id), is_synswitch)), ~ctx=Ctx.extend(ctx, entry), ~constraints= subsumption_constraints( @@ -703,7 +723,18 @@ and upat_to_info_map = ); | TypeAnn(p, ann) => let (ann, m) = utyp_to_info_map(~ctx, ~ancestors, ann, m); - let (p, m) = go(~ctx, ~mode=Ana(ann.ty), ~annot_pat=true, p, m); + let (p, m) = + upat_to_info_map( + ~is_synswitch, + ~ancestors, + ~co_ctx, + ~parent_id, + ~ctx, + ~mode=Ana(ann.ty), + ~annot_pat=true, + p, + m, + ); add(~self=Just(ann.ty), ~ctx=p.ctx, ~constraints=p.constraints, m); }; } diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 2d546074e5..b28e203881 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -173,6 +173,8 @@ module rec Typ: { | (_, TypeHole(_) as p) => p | (ExpHole(Free(tv1), _), ExpHole(Free(tv2), _)) when TypVar.eq(tv1, tv2) => p1 + | (ExpHole(PatternVar(_), _) as p, ExpHole(_, _)) + | (ExpHole(_, _), ExpHole(PatternVar(_), _) as p) => p | (ExpHole(_, _) as p, _) | (_, ExpHole(_, _) as p) => p | (Matched(_, _) as p, _) From ed8a2bf946a7df7c172c01605c4fa4fb297b890e Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 11 Jan 2024 20:39:23 -0600 Subject: [PATCH 105/129] Added new update settings_action --- src/haz3lcore/prog/CoreSettings.re | 10 +++++++++- src/haz3lcore/zipper/Editor.re | 1 + src/haz3lweb/Init.ml | 8 +++++++- src/haz3lweb/Update.re | 25 +++++++++++++++++++++++++ src/haz3lweb/UpdateAction.re | 1 + src/haz3lweb/view/Cell.re | 1 - src/haz3lweb/view/Page.re | 5 ++++- 7 files changed, 47 insertions(+), 4 deletions(-) diff --git a/src/haz3lcore/prog/CoreSettings.re b/src/haz3lcore/prog/CoreSettings.re index 8a1d88aefe..32accdf54f 100644 --- a/src/haz3lcore/prog/CoreSettings.re +++ b/src/haz3lcore/prog/CoreSettings.re @@ -6,6 +6,7 @@ type t = { elaborate: bool, assist: bool, dynamics: bool, + inference: bool, }; let off: t = { @@ -13,5 +14,12 @@ let off: t = { elaborate: false, assist: false, dynamics: false, + inference: false, +}; +let on: t = { + statics: true, + elaborate: true, + assist: true, + dynamics: true, + inference: true, }; -let on: t = {statics: true, elaborate: true, assist: true, dynamics: true}; diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index a89083db19..268680b660 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -9,6 +9,7 @@ module Meta = { col_target: int, }; + // TODO: anand and raef cleanup unused inference_enabled let init = (z: Zipper.t, _inference_enabled: bool) => { let unselected = Zipper.unselect_and_zip(z); { diff --git a/src/haz3lweb/Init.ml b/src/haz3lweb/Init.ml index 566d3d1c2e..3c865d7d05 100644 --- a/src/haz3lweb/Init.ml +++ b/src/haz3lweb/Init.ml @@ -5,7 +5,13 @@ let startup : PersistentData.t = captions = true; secondary_icons = false; core = - { statics = true; elaborate = false; assist = true; dynamics = true }; + { + statics = true; + elaborate = false; + assist = true; + dynamics = true; + inference = false; + }; async_evaluation = false; context_inspector = false; instructor_mode = true; diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index 3b7fd43d80..a8ea0b4b64 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -17,6 +17,7 @@ let update_settings = assist: !settings.core.statics, elaborate: settings.core.elaborate, dynamics: !settings.core.statics && settings.core.dynamics, + inference: !settings.core.inference, }, }, } @@ -29,6 +30,9 @@ let update_settings = assist: settings.core.assist, elaborate: !settings.core.elaborate, dynamics: settings.core.dynamics, + inference: + (!settings.core.elaborate || settings.core.statics) + && settings.core.inference, }, }, } @@ -41,6 +45,9 @@ let update_settings = assist: settings.core.assist, elaborate: settings.core.elaborate, dynamics: !settings.core.dynamics, + inference: + (!settings.core.dynamics || settings.core.statics) + && settings.core.inference, }, }, } @@ -53,6 +60,22 @@ let update_settings = assist: !settings.core.assist, elaborate: settings.core.elaborate, dynamics: settings.core.dynamics, + inference: + (!settings.core.assist || settings.core.statics) + && settings.core.inference, + }, + }, + } + | Inference => { + ...model, + settings: { + ...settings, + core: { + statics: settings.core.statics, + assist: settings.core.assist, + elaborate: settings.core.elaborate, + dynamics: settings.core.dynamics, + inference: settings.core.statics && !settings.core.inference, }, }, } @@ -117,6 +140,7 @@ let reevaluate_post_update = (settings: Settings.t) => | Dynamics | InstructorMode | ContextInspector + | Inference | Mode(_) => true } | SetMeta(meta_action) => @@ -173,6 +197,7 @@ let should_scroll_to_caret = | Dynamics | Benchmark | ContextInspector + | Inference | InstructorMode => false } | SetMeta(meta_action) => diff --git a/src/haz3lweb/UpdateAction.re b/src/haz3lweb/UpdateAction.re index 8ae939fa6c..fc50d025c5 100644 --- a/src/haz3lweb/UpdateAction.re +++ b/src/haz3lweb/UpdateAction.re @@ -13,6 +13,7 @@ type settings_action = | Benchmark | ContextInspector | InstructorMode + | Inference | Mode(Settings.mode); [@deriving (show({with_path: false}), sexp, yojson)] diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index 48e37498e2..2df2e0f69b 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -195,7 +195,6 @@ let deco = let (_term, terms) = MakeTerm.go(unselected); let info_map = info_map; let global_inference_info = global_inference_info; - // let term_ranges = TermRanges.mk(unselected); // TODO anand: still need this? Check with Andrew could be load-bearing let term_ranges = term_ranges; let tiles = TileMap.mk(unselected); }); diff --git a/src/haz3lweb/view/Page.re b/src/haz3lweb/view/Page.re index 8567111bc4..58e522e239 100644 --- a/src/haz3lweb/view/Page.re +++ b/src/haz3lweb/view/Page.re @@ -43,7 +43,7 @@ let nut_menu = ( ~inject: Update.t => 'a, { - core: {statics, elaborate, assist, dynamics}, + core: {statics, elaborate, assist, dynamics, inference}, benchmark, instructor_mode, _, @@ -65,6 +65,9 @@ let nut_menu = toggle("𝑒", ~tooltip="Show Elaboration", elaborate, _ => inject(Set(Elaborate)) ), + toggle("∪", ~tooltip="Toggle Inference", inference, _ => + inject(Set(Inference)) + ), toggle("b", ~tooltip="Toggle Performance Benchmark", benchmark, _ => inject(Set(Benchmark)) ), From 887c67fa19342cc7ae28bf931ef8342185c36c8d Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 11 Jan 2024 21:02:21 -0600 Subject: [PATCH 106/129] switched all logic over to new toggle in nut bar --- src/haz3lcore/zipper/Editor.re | 12 +++------ src/haz3lcore/zipper/EditorUtil.re | 18 +++---------- src/haz3lcore/zipper/Printer.re | 4 +-- src/haz3lcore/zipper/action/Perform.re | 9 +++---- src/haz3lschool/Exercise.re | 5 ++-- src/haz3lschool/Gradescope.re | 1 - src/haz3lweb/Keyboard.re | 2 +- src/haz3lweb/LangDocMessages.re | 17 ++---------- src/haz3lweb/ScratchSlide.re | 2 +- src/haz3lweb/Store.re | 21 +++------------ src/haz3lweb/Update.re | 12 +-------- src/haz3lweb/view/Cell.re | 5 +--- src/haz3lweb/view/ExerciseMode.re | 3 +-- src/haz3lweb/view/LangDoc.re | 11 -------- src/haz3lweb/view/Page.re | 2 +- src/haz3lweb/view/ScratchMode.re | 3 +-- .../view/assistant/UpdateAssistant.re | 27 +++---------------- 17 files changed, 32 insertions(+), 122 deletions(-) diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index 268680b660..a6f13440ce 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -9,8 +9,7 @@ module Meta = { col_target: int, }; - // TODO: anand and raef cleanup unused inference_enabled - let init = (z: Zipper.t, _inference_enabled: bool) => { + let init = (z: Zipper.t) => { let unselected = Zipper.unselect_and_zip(z); { touched: Touched.empty, @@ -85,10 +84,7 @@ module State = { meta: Meta.t, }; - let init = (zipper, inference_enabled) => { - zipper, - meta: Meta.init(zipper, inference_enabled), - }; + let init = zipper => {zipper, meta: Meta.init(zipper)}; let next = ( @@ -124,8 +120,8 @@ type t = { read_only: bool, }; -let init = (~read_only=false, z, inference_enabled) => { - state: State.init(z, inference_enabled), +let init = (~read_only=false, z) => { + state: State.init(z), history: History.empty, read_only, }; diff --git a/src/haz3lcore/zipper/EditorUtil.re b/src/haz3lcore/zipper/EditorUtil.re index 4e380537ad..818defc18c 100644 --- a/src/haz3lcore/zipper/EditorUtil.re +++ b/src/haz3lcore/zipper/EditorUtil.re @@ -6,12 +6,7 @@ let editor_of_code = (~read_only=false, code: CodeString.t) => { }; let editors_for = - ( - ~read_only=false, - xs: list('a), - f: 'a => option(string), - inference_enabled, - ) + (~read_only=false, xs: list('a), f: 'a => option(string)) : (int, list(('a, option(Editor.t)))) => { let zs = List.fold_left( @@ -33,10 +28,7 @@ let editors_for = List.map( ((a, sz)) => switch (sz) { - | Some(z) => ( - a, - Some(Editor.init(z, ~read_only, inference_enabled)), - ) + | Some(z) => (a, Some(Editor.init(z, ~read_only))) | None => (a, None) }, zs, @@ -44,10 +36,8 @@ let editors_for = ); }; -let editors_of_strings = - (~read_only=false, xs: list(string), inference_enabled) => { - let (i, aes) = - editors_for(xs, x => Some(x), ~read_only, inference_enabled); +let editors_of_strings = (~read_only=false, xs: list(string)) => { + let (i, aes) = editors_for(xs, x => Some(x), ~read_only); (i, List.map(((_, oe)) => Option.get(oe), aes)); }; diff --git a/src/haz3lcore/zipper/Printer.re b/src/haz3lcore/zipper/Printer.re index 1b2e29e69f..e9b88508b7 100644 --- a/src/haz3lcore/zipper/Printer.re +++ b/src/haz3lcore/zipper/Printer.re @@ -143,10 +143,10 @@ let paste_into_zip = (z: Zipper.t, str: string): option(Zipper.t) => { insert a space, and then we immediately delete it. */ let settings = CoreSettings.off; let* z = zipper_of_string(~zipper_init=z, str); - switch (Perform.go_z(~settings, Insert(" "), z, false)) { + switch (Perform.go_z(~settings, Insert(" "), z)) { | Error(_) => None | Ok(z) => - switch (Perform.go_z(~settings, Destruct(Left), z, false)) { + switch (Perform.go_z(~settings, Destruct(Left), z)) { | Error(_) => None | Ok(z) => Some(z) } diff --git a/src/haz3lcore/zipper/action/Perform.re b/src/haz3lcore/zipper/action/Perform.re index 58d8f92ae4..926ac26082 100644 --- a/src/haz3lcore/zipper/action/Perform.re +++ b/src/haz3lcore/zipper/action/Perform.re @@ -23,13 +23,12 @@ let go_z = ~settings: CoreSettings.t, a: Action.t, z: Zipper.t, - inference_enabled, ) : Action.Result.t(Zipper.t) => { let meta = switch (meta) { | Some(m) => m - | None => Editor.Meta.init(z, inference_enabled) + | None => Editor.Meta.init(z) }; module M = (val Editor.Meta.module_of_t(meta)); module Move = Move.Make(M); @@ -182,7 +181,7 @@ let go_z = }; let go = - (~settings: CoreSettings.t, a: Action.t, ed: Editor.t, inference_enabled) // TODO anand and raef: add inference_enabled to settings + (~settings: CoreSettings.t, a: Action.t, ed: Editor.t) // TODO anand and raef: add settings.inference to settings : Action.Result.t(Editor.t) => if (ed.read_only && is_write_action(a)) { Result.Ok(ed); @@ -190,6 +189,6 @@ let go = open Result.Syntax; let Editor.State.{zipper, meta} = ed.state; Effect.s_clear(); - let+ z = go_z(~settings, ~meta, a, zipper, inference_enabled); - Editor.new_state(~effects=Effect.s^, a, z, ed, inference_enabled); + let+ z = go_z(~settings, ~meta, a, zipper); + Editor.new_state(~effects=Effect.s^, a, z, ed, settings.inference); }; diff --git a/src/haz3lschool/Exercise.re b/src/haz3lschool/Exercise.re index 09856337aa..026c35c6b7 100644 --- a/src/haz3lschool/Exercise.re +++ b/src/haz3lschool/Exercise.re @@ -339,7 +339,7 @@ module F = (ExerciseEnv: ExerciseEnv) => { }; }; - let editor_of_serialization = zipper => Editor.init(zipper, false); + let editor_of_serialization = zipper => Editor.init(zipper); let eds_of_spec: spec => eds = ( { @@ -501,14 +501,13 @@ module F = (ExerciseEnv: ExerciseEnv) => { (pos, positioned_zippers): persistent_state, ~spec: spec, ~instructor_mode: bool, - ~inference_enabled: bool, ) : state => { let lookup = (pos, default) => if (visible_in(pos, ~instructor_mode)) { let persisted_zipper = List.assoc(pos, positioned_zippers); let zipper = PersistentZipper.unpersist(persisted_zipper); - Editor.init(zipper, inference_enabled); + Editor.init(zipper); } else { editor_of_serialization(default); }; diff --git a/src/haz3lschool/Gradescope.re b/src/haz3lschool/Gradescope.re index 64668cab6e..bbcc516b27 100644 --- a/src/haz3lschool/Gradescope.re +++ b/src/haz3lschool/Gradescope.re @@ -116,7 +116,6 @@ module Main = { persistent_state, ~spec, ~instructor_mode=true, - ~inference_enabled=false, ); let report = exercise |> gen_grading_report; {name, report}; diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index cbf79c3eff..873478cad4 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -11,7 +11,7 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { let (_, suggestions) = Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( - model.langDocMessages.annotations, + model.settings.core.inference, suggestions, ); let now = (a: Action.t): option(UpdateAction.t) => diff --git a/src/haz3lweb/LangDocMessages.re b/src/haz3lweb/LangDocMessages.re index a754ee8edb..1202338af8 100644 --- a/src/haz3lweb/LangDocMessages.re +++ b/src/haz3lweb/LangDocMessages.re @@ -3407,7 +3407,6 @@ let var_typ_pat: form = { type t = { show: bool, highlight: bool, - annotations: bool, specificity_open: bool, forms: list(form), groups: list((string, form_group)), @@ -3494,7 +3493,6 @@ let init_options = options => { let init = { show: true, highlight: false, - annotations: true, specificity_open: false, forms: [ // Expressions @@ -4047,7 +4045,6 @@ let init = { type update = | ToggleShow | ToggleHighlight - | ToggleAnnotations | SpecificityOpen(bool) | ToggleExplanationFeedback(string, feedback_option) | ToggleExampleFeedback(string, string, feedback_option) @@ -4060,10 +4057,6 @@ let set_update = (docLangMessages: t, u: update): t => { ...docLangMessages, highlight: !docLangMessages.highlight, } - | ToggleAnnotations => { - ...docLangMessages, - annotations: !docLangMessages.annotations, - } | SpecificityOpen(b) => {...docLangMessages, specificity_open: b} | ToggleExplanationFeedback(id, feedback_option) => let form = get_form(id, docLangMessages.forms); @@ -4134,14 +4127,13 @@ type persistent_form_group = { type persistent_state = { show: bool, highlight: bool, - annotations: bool, specificity_open: bool, forms: list(persistent_form), groups: list(persistent_form_group), }; let persist = - ({show, highlight, annotations, specificity_open, forms, groups, _}: t) + ({show, highlight, specificity_open, forms, groups, _}: t) : persistent_state => { let persist_example = ({sub_id, feedback, _}: example): persistent_example => { {sub_id, feedback}; @@ -4158,7 +4150,6 @@ let persist = { show, highlight, - annotations, specificity_open, forms: List.map(persist_form, forms), groups: @@ -4172,10 +4163,7 @@ let persist = // TODO Make more robust to added messages let unpersist = - ( - {show, highlight, annotations, specificity_open, forms, groups}: persistent_state, - ) - : t => { + ({show, highlight, specificity_open, forms, groups}: persistent_state): t => { let unpersist_examples = (persistent_examples, examples) => { List.map( ({sub_id, feedback}: persistent_example) => { @@ -4218,7 +4206,6 @@ let unpersist = { show, highlight, - annotations, specificity_open, forms: forms_unpersist, groups: groups_unpersist, diff --git a/src/haz3lweb/ScratchSlide.re b/src/haz3lweb/ScratchSlide.re index 61338e4532..d7edd72e53 100644 --- a/src/haz3lweb/ScratchSlide.re +++ b/src/haz3lweb/ScratchSlide.re @@ -18,7 +18,7 @@ let persist = (editor: Editor.t) => { let unpersist = (zipper: persistent_state) => { let zipper = PersistentZipper.unpersist(zipper); - Editor.init(zipper, ~read_only=false, false); + Editor.init(zipper, ~read_only=false); }; let serialize = (state: state) => { diff --git a/src/haz3lweb/Store.re b/src/haz3lweb/Store.re index 3f9ca0c085..dff41aab92 100644 --- a/src/haz3lweb/Store.re +++ b/src/haz3lweb/Store.re @@ -165,7 +165,7 @@ module Examples = { let unpersist = ((name, zipper)) => { let zipper = PersistentZipper.unpersist(zipper); - (name, Editor.init(zipper, ~read_only=false, false)); + (name, Editor.init(zipper, ~read_only=false)); }; let to_persistent = ((string, slides)): persistent => ( @@ -250,14 +250,7 @@ module Exercise = { switch (JsUtil.get_localstore(keystring)) { | Some(data) => let exercise = - try( - Exercise.deserialize_exercise( - data, - ~spec, - ~instructor_mode, - ~inference_enabled=false, - ) - ) { + try(Exercise.deserialize_exercise(data, ~spec, ~instructor_mode)) { | _ => init_exercise(spec, ~instructor_mode) }; JsUtil.set_localstore(cur_exercise_key, keystring); @@ -295,14 +288,7 @@ module Exercise = { switch (JsUtil.get_localstore(keystring)) { | Some(data) => let exercise = - try( - deserialize_exercise( - data, - ~spec, - ~instructor_mode, - ~inference_enabled=false, - ) - ) { + try(deserialize_exercise(data, ~spec, ~instructor_mode)) { | _ => init_exercise(spec, ~instructor_mode) }; (n, specs, exercise); @@ -365,7 +351,6 @@ module Exercise = { persistent_state, ~spec, ~instructor_mode, - ~inference_enabled=false, ), ~instructor_mode, ) diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index a8ea0b4b64..b5ce3a64c2 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -293,22 +293,12 @@ let evaluate_and_schedule = model; }; -// <<<<<<< HEAD -// let perform_action = -// (model: Model.t, a: Action.t, _state: State.t, ~schedule_action as _) -// : Result.t(Model.t) => { -// let (id, ed_init) = Editors.get_editor_and_id(model.editors); -// switch ( -// Haz3lcore.Perform.go(a, ed_init, id, model.langDocMessages.annotations) -// ) { -// ======= let perform_action = (model: Model.t, a: Action.t): Result.t(Model.t) => switch ( Haz3lcore.Perform.go( ~settings=model.settings.core, a, Editors.get_editor(model.editors), - model.langDocMessages.annotations, ) ) { | Error(err) => Error(FailedToPerform(err)) @@ -487,7 +477,7 @@ let rec apply = Pick_up, z, ed, - model.langDocMessages.annotations, + model.settings.core.inference, ); let editors = Editors.put_editor(editor, model.editors); Ok({...model, editors}); diff --git a/src/haz3lweb/view/Cell.re b/src/haz3lweb/view/Cell.re index 2df2e0f69b..64bfd2e591 100644 --- a/src/haz3lweb/view/Cell.re +++ b/src/haz3lweb/view/Cell.re @@ -265,7 +265,6 @@ let editor_view = ~test_results: option(Interface.test_results), ~footer: option(Node.t), ~color_highlighting: option(ColorSteps.colorMap), - ~langDocMessages: LangDocMessages.t, editor: Editor.t, ) => { let zipper = editor.state.zipper; @@ -277,7 +276,7 @@ let editor_view = let measured = editor.state.meta.measured; let global_inference_info = InferenceResult.mk_global_inference_info( - langDocMessages.annotations, + settings.core.inference, suggestions, ); let buffer_ids: list(Uuidm.t) = { @@ -348,7 +347,6 @@ let editor_with_result_view = ~info_map: Statics.Map.t, ~term, ~result: ModelResult.simple, - ~langDocMessages, editor: Editor.t, ) => { let test_results = ModelResult.unwrap_test_results(result); @@ -380,7 +378,6 @@ let editor_with_result_view = ~test_results, ~footer=Some(eval_result_footer), ~color_highlighting, - ~langDocMessages, editor, ); }; diff --git a/src/haz3lweb/view/ExerciseMode.re b/src/haz3lweb/view/ExerciseMode.re index da51cc9379..4fa648ca0d 100644 --- a/src/haz3lweb/view/ExerciseMode.re +++ b/src/haz3lweb/view/ExerciseMode.re @@ -81,7 +81,7 @@ let view = } = stitched_dynamics; let global_inference_info = InferenceResult.mk_global_inference_info( - langDocMessages.annotations, + settings.core.inference, ( global_inference_info.typehole_suggestions, global_inference_info.exphole_suggestions, @@ -114,7 +114,6 @@ let view = ~mousedown_updates=[Update.SwitchEditor(pos)], ~settings, ~color_highlighting, - ~langDocMessages, ); }; diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index 586277712b..143ba48139 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -2959,17 +2959,6 @@ let view = ), ) ), - toggle( - ~tooltip="Toggle inference suggestions", - "𝜏", - doc.annotations, - _ => - inject( - Update.UpdateLangDocMessages( - LangDocMessages.ToggleAnnotations, - ), - ) - ), div( ~attr= Attr.many([ diff --git a/src/haz3lweb/view/Page.re b/src/haz3lweb/view/Page.re index 58e522e239..ec759e78aa 100644 --- a/src/haz3lweb/view/Page.re +++ b/src/haz3lweb/view/Page.re @@ -164,7 +164,7 @@ let exercises_view = let (_, suggestions) = Statics.mk_map_and_inference_solutions(term); let global_inference_info = InferenceResult.mk_global_inference_info( - langDocMessages.annotations, + model.settings.core.inference, suggestions, ); [top_bar_view(~inject, ~model, ~toolbar_buttons)] diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 5a375cebac..497f174cd8 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -29,7 +29,7 @@ let view = //let info_map = Interface.Statics.mk_map_ctx(settings.core, ctx_init, term); // TODO anand and raef: we need to use this instead; figure out how let global_inference_info = InferenceResult.mk_global_inference_info( - langDocMessages.annotations, + settings.core.inference, suggestions, ); let result = @@ -65,7 +65,6 @@ let view = ~info_map, ~term, ~result, - ~langDocMessages, editor, ); let bottom_bar = diff --git a/src/haz3lweb/view/assistant/UpdateAssistant.re b/src/haz3lweb/view/assistant/UpdateAssistant.re index fa6f7c3d55..afe74f0eb2 100644 --- a/src/haz3lweb/view/assistant/UpdateAssistant.re +++ b/src/haz3lweb/view/assistant/UpdateAssistant.re @@ -4,14 +4,7 @@ include UpdateAction; /* NOTE: this is duplicated from Update */ let perform_action = (model: Model.t, a: Action.t): Result.t(Model.t) => { let ed_init = Editors.get_editor(model.editors); - switch ( - Haz3lcore.Perform.go( - ~settings=model.settings.core, - a, - ed_init, - model.langDocMessages.annotations, - ) - ) { + switch (Haz3lcore.Perform.go(~settings=model.settings.core, a, ed_init)) { | Error(err) => Error(FailedToPerform(err)) | Ok(ed) => Ok({...model, editors: Editors.put_editor(ed, model.editors)}) }; @@ -22,14 +15,7 @@ let reset_buffer = (model: Model.t) => { let z = ed.state.zipper; switch (z.selection.mode) { | Buffer(_) => - switch ( - Perform.go_z( - ~settings=model.settings.core, - Destruct(Left), - z, - model.langDocMessages.annotations, - ) - ) { + switch (Perform.go_z(~settings=model.settings.core, Destruct(Left), z)) { | Error(_) => model | Ok(z) => let ed = @@ -37,7 +23,7 @@ let reset_buffer = (model: Model.t) => { Destruct(Left), z, ed, - model.langDocMessages.annotations, + model.settings.core.inference, ); //TODO(andrew): fix double action {...model, editors: Editors.put_editor(ed, model.editors)}; @@ -64,12 +50,7 @@ let apply = | None => Ok(model) | Some(z) => let ed = - Editor.new_state( - Pick_up, - z, - editor, - model.langDocMessages.annotations, - ); + Editor.new_state(Pick_up, z, editor, model.settings.core.inference); //TODO: add correct action to history (Pick_up is wrong) let editors = Editors.put_editor(ed, model.editors); Ok({...model, editors}); From 81143131abaae2e6bcb189589f3dea3757ff8906 Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 11 Jan 2024 21:11:18 -0600 Subject: [PATCH 107/129] fix stray debug change --- src/haz3lcore/statics/Statics.re | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 5cf0d27691..6dc19eae6b 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -681,7 +681,7 @@ and upat_to_info_map = let hole_reason: Typ.hole_reason = switch (annot_pat, parent_id) { | (false, Some(id)) => PatternVar(id) - | _ => Error + | _ => Internal }; let ctx_typ = Info.fixed_typ_pat( From 7374be60203401d8533c5f27d61e65f282991d15 Mon Sep 17 00:00:00 2001 From: RaefM Date: Fri, 12 Jan 2024 20:33:53 -0600 Subject: [PATCH 108/129] cleanup prints and todos --- src/haz3lcore/statics/Statics.re | 16 ---------------- src/haz3lcore/statics/TypBase.re | 1 - src/haz3lweb/Init.ml | 2 +- src/haz3lweb/view/Type.re | 1 - 4 files changed, 1 insertion(+), 19 deletions(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 6dc19eae6b..d278235d4b 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -665,19 +665,6 @@ and upat_to_info_map = /* NOTE: The self type assigned to pattern variables (Unknown) may be SynSwitch, but SynSwitch is never added to the context; Internal is used in this case */ - let parent_string = - switch (parent_id) { - | Some(id) => Id.to_string(id) - | None => "None" - }; - print_endline( - "In pat Var of " - ++ Id.to_string(id) - ++ " with annot_pat " - ++ string_of_bool(annot_pat) - ++ " and parent " - ++ parent_string, - ); let hole_reason: Typ.hole_reason = switch (annot_pat, parent_id) { | (false, Some(id)) => PatternVar(id) @@ -866,9 +853,6 @@ let mk_map_and_inference_solutions = Id.Map.empty, ); - print_endline("~~~Printing constraints:"); - info.constraints |> Typ.constraints_to_string |> print_endline; - let pts_graph = Inference.solve_constraints(info.constraints); let solutions = InferenceResult.get_desired_solutions(pts_graph); diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index b28e203881..452f4c0199 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -292,7 +292,6 @@ module rec Typ: { typ_to_string_with_parens(false, ty, debug); } and typ_to_string_with_parens = (is_left_child: bool, ty: t, debug): string => { - //TODO: parens on ops when ambiguous let parenthesize_if_left_child = s => is_left_child ? "(" ++ s ++ ")" : s; switch (ty) { | Unknown(prov, _) => "?" ++ (debug ? prov_to_string(prov) : "") diff --git a/src/haz3lweb/Init.ml b/src/haz3lweb/Init.ml index 3c865d7d05..1ddc4d6785 100644 --- a/src/haz3lweb/Init.ml +++ b/src/haz3lweb/Init.ml @@ -10,7 +10,7 @@ let startup : PersistentData.t = elaborate = false; assist = true; dynamics = true; - inference = false; + inference = true; }; async_evaluation = false; context_inspector = false; diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index f401f6651f..d217f6f5a1 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -23,7 +23,6 @@ let rec view_ty = (~font_metrics, ~with_cls, ~is_left_child: bool=false, ty: Typ.t) : Node.t => { let view_ty' = view_ty(~font_metrics, ~with_cls); - //TODO: parens on ops when ambiguous let parenthesize_if_left_child = (n): Node.t => (is_left_child ? [Node.text("("), ...n] @ [Node.text(")")] : n) |> span; let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); From 95ddccddabce6c08be3a2db59c2c2c5d92019c7f Mon Sep 17 00:00:00 2001 From: RaefM Date: Fri, 12 Jan 2024 21:52:55 -0600 Subject: [PATCH 109/129] fix measurement issue after suggestion accept --- src/haz3lcore/statics/TypBase.re | 2 +- src/haz3lweb/Update.re | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 452f4c0199..44b834b65a 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -306,7 +306,7 @@ module rec Typ: { ++ " -> " ++ typ_to_string(t2, debug) |> parenthesize_if_left_child - | Prod([]) => "Unit" + | Prod([]) => "()" | Prod([_]) => "BadProduct" | Prod([t0, ...ts]) => "(" diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index b5ce3a64c2..760ad66644 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -495,7 +495,13 @@ let rec apply = | None => Error(CantPaste) | Some(z) => //HACK(andrew): below is not strictly a insert action... - let ed = Haz3lcore.Editor.new_state(Insert(clipboard), z, ed, false); + let ed = + Haz3lcore.Editor.new_state( + Insert(clipboard), + z, + ed, + model.settings.core.inference, + ); let editors = Editors.put_editor(ed, model.editors); Ok({...model, editors}); }; From db7ef986c93ccecfe71e7576d8cbd60a5d6bcec5 Mon Sep 17 00:00:00 2001 From: RaefM Date: Fri, 12 Jan 2024 22:31:01 -0600 Subject: [PATCH 110/129] Add inference_enabled to init to fix issue of weird offset holes on startup, slide change, or reload --- src/haz3lcore/zipper/Editor.re | 26 ++++-- src/haz3lcore/zipper/EditorUtil.re | 23 +++-- src/haz3lcore/zipper/action/Perform.re | 2 +- src/haz3lschool/Exercise.re | 31 ++++--- src/haz3lschool/Gradescope.re | 1 + src/haz3lweb/Editors.re | 24 ++--- src/haz3lweb/Export.re | 10 ++- src/haz3lweb/Model.re | 25 ++++-- src/haz3lweb/ScratchSlide.re | 4 +- src/haz3lweb/ScratchSlidesInit.re | 5 +- src/haz3lweb/Store.re | 117 ++++++++++++++++--------- src/haz3lweb/Update.re | 47 ++++++++-- 12 files changed, 220 insertions(+), 95 deletions(-) diff --git a/src/haz3lcore/zipper/Editor.re b/src/haz3lcore/zipper/Editor.re index a6f13440ce..6a4a5ebc11 100644 --- a/src/haz3lcore/zipper/Editor.re +++ b/src/haz3lcore/zipper/Editor.re @@ -9,11 +9,21 @@ module Meta = { col_target: int, }; - let init = (z: Zipper.t) => { + let init = (z: Zipper.t, ~inference_enabled) => { let unselected = Zipper.unselect_and_zip(z); + let (term, _) = MakeTerm.go(unselected); + let (_, suggestions) = Statics.mk_map_and_inference_solutions(term); { touched: Touched.empty, - measured: Measured.of_segment(unselected), + measured: + Measured.of_segment( + unselected, + ~global_inference_info= + InferenceResult.mk_global_inference_info( + inference_enabled, + suggestions, + ), + ), term_ranges: TermRanges.mk(unselected), col_target: 0, }; @@ -84,7 +94,10 @@ module State = { meta: Meta.t, }; - let init = zipper => {zipper, meta: Meta.init(zipper)}; + let init = (zipper, ~inference_enabled) => { + zipper, + meta: Meta.init(zipper, ~inference_enabled), + }; let next = ( @@ -120,12 +133,13 @@ type t = { read_only: bool, }; -let init = (~read_only=false, z) => { - state: State.init(z), +let init = (~read_only=false, ~inference_enabled, z) => { + state: State.init(z, ~inference_enabled), history: History.empty, read_only, }; -let empty = id => init(~read_only=false, Zipper.init(id)); +let empty = (id, ~inference_enabled) => + init(~read_only=false, ~inference_enabled, Zipper.init(id)); let update_z = (f: Zipper.t => Zipper.t, ed: t) => { ...ed, diff --git a/src/haz3lcore/zipper/EditorUtil.re b/src/haz3lcore/zipper/EditorUtil.re index 818defc18c..80d0ec4999 100644 --- a/src/haz3lcore/zipper/EditorUtil.re +++ b/src/haz3lcore/zipper/EditorUtil.re @@ -1,12 +1,18 @@ -let editor_of_code = (~read_only=false, code: CodeString.t) => { +let editor_of_code = + (~read_only=false, ~inference_enabled, code: CodeString.t) => { switch (Printer.zipper_of_string(code)) { | None => None - | Some(z) => Some(Editor.init(~read_only, z)) + | Some(z) => Some(Editor.init(~read_only, ~inference_enabled, z)) }; }; let editors_for = - (~read_only=false, xs: list('a), f: 'a => option(string)) + ( + ~read_only=false, + ~inference_enabled, + xs: list('a), + f: 'a => option(string), + ) : (int, list(('a, option(Editor.t)))) => { let zs = List.fold_left( @@ -28,7 +34,10 @@ let editors_for = List.map( ((a, sz)) => switch (sz) { - | Some(z) => (a, Some(Editor.init(z, ~read_only))) + | Some(z) => ( + a, + Some(Editor.init(z, ~read_only, ~inference_enabled)), + ) | None => (a, None) }, zs, @@ -36,8 +45,10 @@ let editors_for = ); }; -let editors_of_strings = (~read_only=false, xs: list(string)) => { - let (i, aes) = editors_for(xs, x => Some(x), ~read_only); +let editors_of_strings = + (~read_only=false, ~inference_enabled, xs: list(string)) => { + let (i, aes) = + editors_for(xs, x => Some(x), ~read_only, ~inference_enabled); (i, List.map(((_, oe)) => Option.get(oe), aes)); }; diff --git a/src/haz3lcore/zipper/action/Perform.re b/src/haz3lcore/zipper/action/Perform.re index 926ac26082..e7cef1259d 100644 --- a/src/haz3lcore/zipper/action/Perform.re +++ b/src/haz3lcore/zipper/action/Perform.re @@ -28,7 +28,7 @@ let go_z = let meta = switch (meta) { | Some(m) => m - | None => Editor.Meta.init(z) + | None => Editor.Meta.init(z, ~inference_enabled=settings.inference) }; module M = (val Editor.Meta.module_of_t(meta)); module Move = Move.Make(M); diff --git a/src/haz3lschool/Exercise.re b/src/haz3lschool/Exercise.re index 026c35c6b7..9ea13ea168 100644 --- a/src/haz3lschool/Exercise.re +++ b/src/haz3lschool/Exercise.re @@ -339,8 +339,9 @@ module F = (ExerciseEnv: ExerciseEnv) => { }; }; - let editor_of_serialization = zipper => Editor.init(zipper); - let eds_of_spec: spec => eds = + let editor_of_serialization = (zipper, ~inference_enabled) => + Editor.init(zipper, ~inference_enabled); + let eds_of_spec: (spec, bool) => eds = ( { title, @@ -356,23 +357,27 @@ module F = (ExerciseEnv: ExerciseEnv) => { hidden_tests, syntax_tests, }, + inference_enabled, ) => { - let prelude = editor_of_serialization(prelude); - let correct_impl = editor_of_serialization(correct_impl); + let prelude = editor_of_serialization(prelude, ~inference_enabled); + let correct_impl = + editor_of_serialization(correct_impl, ~inference_enabled); let your_tests = { - let tests = editor_of_serialization(your_tests.tests); + let tests = + editor_of_serialization(your_tests.tests, ~inference_enabled); {tests, required: your_tests.required, provided: your_tests.provided}; }; - let your_impl = editor_of_serialization(your_impl); + let your_impl = editor_of_serialization(your_impl, ~inference_enabled); let hidden_bugs = hidden_bugs |> List.map(({impl, hint}) => { - let impl = editor_of_serialization(impl); + let impl = + editor_of_serialization(impl, ~inference_enabled=false); {impl, hint}; }); let hidden_tests = { let {tests, hints} = hidden_tests; - let tests = editor_of_serialization(tests); + let tests = editor_of_serialization(tests, ~inference_enabled=false); {tests, hints}; }; { @@ -480,8 +485,9 @@ module F = (ExerciseEnv: ExerciseEnv) => { }; }; - let state_of_spec = (spec, ~instructor_mode: bool): state => { - let eds = eds_of_spec(spec); + let state_of_spec = + (spec, ~instructor_mode: bool, ~inference_enabled): state => { + let eds = eds_of_spec(spec, inference_enabled); set_instructor_mode({pos: YourImpl, eds}, instructor_mode); }; @@ -501,15 +507,16 @@ module F = (ExerciseEnv: ExerciseEnv) => { (pos, positioned_zippers): persistent_state, ~spec: spec, ~instructor_mode: bool, + ~inference_enabled, ) : state => { let lookup = (pos, default) => if (visible_in(pos, ~instructor_mode)) { let persisted_zipper = List.assoc(pos, positioned_zippers); let zipper = PersistentZipper.unpersist(persisted_zipper); - Editor.init(zipper); + Editor.init(zipper, ~inference_enabled); } else { - editor_of_serialization(default); + editor_of_serialization(default, ~inference_enabled); }; let prelude = lookup(Prelude, spec.prelude); let correct_impl = lookup(CorrectImpl, spec.correct_impl); diff --git a/src/haz3lschool/Gradescope.re b/src/haz3lschool/Gradescope.re index bbcc516b27..64668cab6e 100644 --- a/src/haz3lschool/Gradescope.re +++ b/src/haz3lschool/Gradescope.re @@ -116,6 +116,7 @@ module Main = { persistent_state, ~spec, ~instructor_mode=true, + ~inference_enabled=false, ); let report = exercise |> gen_grading_report; {name, report}; diff --git a/src/haz3lweb/Editors.re b/src/haz3lweb/Editors.re index 20bd3f7c7a..8c9ed58a5b 100644 --- a/src/haz3lweb/Editors.re +++ b/src/haz3lweb/Editors.re @@ -108,33 +108,37 @@ let set_instructor_mode = (editors: t, instructor_mode: bool): t => ) }; -let reset_nth_slide = (n, slides) => { +let reset_nth_slide = (n, slides, ~inference_enabled) => { let data = List.nth(Init.startup.scratch |> snd, n); - let init_nth = ScratchSlide.unpersist(data); + let init_nth = ScratchSlide.unpersist(data, ~inference_enabled); Util.ListUtil.put_nth(n, init_nth, slides); }; -let reset_named_slide = (name, slides) => { +let reset_named_slide = (name, slides, ~inference_enabled) => { let data = List.assoc(name, Init.startup.examples |> snd); - let init_name = ScratchSlide.unpersist(data); + let init_name = ScratchSlide.unpersist(data, ~inference_enabled); slides |> List.remove_assoc(name) |> List.cons((name, init_name)); }; -let reset_current = (editors: t, ~instructor_mode: bool): t => +let reset_current = + (editors: t, ~instructor_mode: bool, ~inference_enabled): t => switch (editors) { | DebugLoad => failwith("impossible") - | Scratch(n, slides) => Scratch(n, reset_nth_slide(n, slides)) + | Scratch(n, slides) => + Scratch(n, reset_nth_slide(n, slides, ~inference_enabled)) | Examples(name, slides) => - Examples(name, reset_named_slide(name, slides)) + Examples(name, reset_named_slide(name, slides, ~inference_enabled)) | Exercise(n, specs, _) => Exercise( n, specs, - List.nth(specs, n) |> Exercise.state_of_spec(~instructor_mode), + List.nth(specs, n) + |> Exercise.state_of_spec(~instructor_mode, ~inference_enabled), ) }; -let import_current = (editors: t, data: option(string)): t => +let import_current = + (editors: t, data: option(string), ~inference_enabled): t => switch (editors) { | DebugLoad | Examples(_) @@ -143,7 +147,7 @@ let import_current = (editors: t, data: option(string)): t => switch (data) { | None => editors | Some(data) => - let state = ScratchSlide.import(data); + let state = ScratchSlide.import(data, ~inference_enabled); let slides = Util.ListUtil.put_nth(idx, state, slides); Scratch(idx, slides); } diff --git a/src/haz3lweb/Export.re b/src/haz3lweb/Export.re index 7a1f386212..7fbbf15d84 100644 --- a/src/haz3lweb/Export.re +++ b/src/haz3lweb/Export.re @@ -53,7 +53,13 @@ let import_all = (data, ~specs) => { let settings = Store.Settings.import(all.settings); Store.LangDocMessages.import(all.langDocMessages); let instructor_mode = settings.instructor_mode; - Store.Scratch.import(all.scratch); - Store.Exercise.import(all.exercise, ~specs, ~instructor_mode); + let inference_enabled = settings.core.inference; + Store.Scratch.import(all.scratch, ~inference_enabled); + Store.Exercise.import( + all.exercise, + ~specs, + ~instructor_mode, + ~inference_enabled, + ); Log.import(all.log); }; diff --git a/src/haz3lweb/Model.re b/src/haz3lweb/Model.re index 1858fcb53e..b274beaf46 100644 --- a/src/haz3lweb/Model.re +++ b/src/haz3lweb/Model.re @@ -60,20 +60,23 @@ let mk = editors => { let blank = mk(Editors.Scratch(0, [])); let debug = mk(Editors.DebugLoad); -let load_editors = (~mode: Settings.mode, ~instructor_mode: bool): Editors.t => +let load_editors = + (~mode: Settings.mode, ~instructor_mode: bool, ~inference_enabled: bool) + : Editors.t => switch (mode) { | DebugLoad => DebugLoad | Scratch => - let (idx, slides) = Store.Scratch.load(); + let (idx, slides) = Store.Scratch.load(~inference_enabled); Scratch(idx, slides); | Examples => - let (name, slides) = Store.Examples.load(); + let (name, slides) = Store.Examples.load(~inference_enabled); Examples(name, slides); | Exercise => let (n, specs, exercise) = Store.Exercise.load( ~specs=ExerciseSettings.exercises, ~instructor_mode, + ~inference_enabled, ); Exercise(n, specs, exercise); }; @@ -94,6 +97,7 @@ let load = (init_model: t): t => { load_editors( ~mode=settings.mode, ~instructor_mode=settings.instructor_mode, + ~inference_enabled=settings.core.inference, ); let results = ModelResults.init( @@ -120,9 +124,18 @@ let reset = (model: t): t => { e.g. api keys to persist */ ignore(Store.Settings.init()); ignore(Store.LangDocMessages.init()); - ignore(Store.Scratch.init()); - ignore(Store.Examples.init()); - ignore(Store.Exercise.init(~instructor_mode=true)); + ignore( + Store.Scratch.init(~inference_enabled=model.settings.core.inference), + ); + ignore( + Store.Examples.init(~inference_enabled=model.settings.core.inference), + ); + ignore( + Store.Exercise.init( + ~instructor_mode=true, + ~inference_enabled=model.settings.core.inference, + ), + ); let new_model = load(blank); { ...new_model, diff --git a/src/haz3lweb/ScratchSlide.re b/src/haz3lweb/ScratchSlide.re index d7edd72e53..69992dc6c1 100644 --- a/src/haz3lweb/ScratchSlide.re +++ b/src/haz3lweb/ScratchSlide.re @@ -16,9 +16,9 @@ let persist = (editor: Editor.t) => { PersistentZipper.persist(editor.state.zipper); }; -let unpersist = (zipper: persistent_state) => { +let unpersist = (~inference_enabled, zipper: persistent_state) => { let zipper = PersistentZipper.unpersist(zipper); - Editor.init(zipper, ~read_only=false); + Editor.init(zipper, ~read_only=false, ~inference_enabled); }; let serialize = (state: state) => { diff --git a/src/haz3lweb/ScratchSlidesInit.re b/src/haz3lweb/ScratchSlidesInit.re index 00720b0bd9..49770c8cd5 100644 --- a/src/haz3lweb/ScratchSlidesInit.re +++ b/src/haz3lweb/ScratchSlidesInit.re @@ -11,7 +11,10 @@ let init_data = filled_slides @ List.init(num_empty, _ => empty); assert(List.length(init_data) > 0); -let init = () => (0, init_data |> List.map(ScratchSlide.unpersist)); +let init = (~inference_enabled) => ( + 0, + init_data |> List.map(ScratchSlide.unpersist(~inference_enabled)), +); let init_nth = n => { let data = List.nth(init_data, n); diff --git a/src/haz3lweb/Store.re b/src/haz3lweb/Store.re index dff41aab92..9c6be3c135 100644 --- a/src/haz3lweb/Store.re +++ b/src/haz3lweb/Store.re @@ -118,8 +118,8 @@ module Scratch = { List.map(ScratchSlide.persist, slides), ); - let of_persistent = ((idx, slides): persistent) => { - (idx, List.map(ScratchSlide.unpersist, slides)); + let of_persistent = ((idx, slides): persistent, ~inference_enabled) => { + (idx, List.map(ScratchSlide.unpersist(~inference_enabled), slides)); }; let serialize = scratch => { @@ -134,23 +134,24 @@ module Scratch = { JsUtil.set_localstore(save_scratch_key, serialize(scratch)); }; - let init = () => { - let scratch = of_persistent(Init.startup.scratch); + let init = (~inference_enabled) => { + let scratch = of_persistent(Init.startup.scratch, ~inference_enabled); save(scratch); scratch; }; - let load = () => + let load = (~inference_enabled) => switch (JsUtil.get_localstore(save_scratch_key)) { - | None => init() + | None => init(~inference_enabled) | Some(data) => - try(deserialize(data)) { - | _ => init() + try(deserialize(data, ~inference_enabled)) { + | _ => init(~inference_enabled) } }; - let export = () => serialize(load()); - let import = data => save(deserialize(data)); + let export = () => serialize(load(~inference_enabled=false)); + let import = (data, ~inference_enabled) => + save(deserialize(data, ~inference_enabled)); }; module Examples = { @@ -163,9 +164,9 @@ module Examples = { (name, PersistentZipper.persist(editor.state.zipper)); }; - let unpersist = ((name, zipper)) => { + let unpersist = (~inference_enabled, (name, zipper)) => { let zipper = PersistentZipper.unpersist(zipper); - (name, Editor.init(zipper, ~read_only=false)); + (name, Editor.init(zipper, ~read_only=false, ~inference_enabled)); }; let to_persistent = ((string, slides)): persistent => ( @@ -173,8 +174,8 @@ module Examples = { List.map(persist, slides), ); - let of_persistent = ((string, slides): persistent) => { - (string, List.map(unpersist, slides)); + let of_persistent = ((string, slides): persistent, ~inference_enabled) => { + (string, List.map(unpersist(~inference_enabled), slides)); }; let serialize = examples => { @@ -189,23 +190,23 @@ module Examples = { JsUtil.set_localstore(save_examples_key, serialize(examples)); }; - let init = () => { - let examples = of_persistent(Init.startup.examples); + let init = (~inference_enabled) => { + let examples = of_persistent(Init.startup.examples, ~inference_enabled); save(examples); examples; }; - let load = () => + let load = (~inference_enabled) => switch (JsUtil.get_localstore(save_examples_key)) { - | None => init() + | None => init(~inference_enabled) | Some(data) => - try(deserialize(data)) { - | _ => init() + try(deserialize(data, ~inference_enabled)) { + | _ => init(~inference_enabled) } }; - let export = () => serialize(load()); - let import = data => save(deserialize(data)); + let export = () => serialize(load(~inference_enabled=false)); + let import = data => save(deserialize(data, ~inference_enabled=false)); }; module Exercise = { @@ -236,26 +237,35 @@ module Exercise = { JsUtil.set_localstore(keystring, value); }; - let init_exercise = (spec, ~instructor_mode) => { + let init_exercise = (spec, ~instructor_mode, ~inference_enabled) => { let key = Exercise.key_of(spec); let keystring = keystring_of_key(key); - let exercise = Exercise.state_of_spec(spec, ~instructor_mode); + let exercise = + Exercise.state_of_spec(spec, ~instructor_mode, ~inference_enabled); save_exercise(exercise, ~instructor_mode); JsUtil.set_localstore(cur_exercise_key, keystring); exercise; }; - let load_exercise = (key, spec, ~instructor_mode): Exercise.state => { + let load_exercise = + (key, spec, ~instructor_mode, ~inference_enabled): Exercise.state => { let keystring = keystring_of_key(key); switch (JsUtil.get_localstore(keystring)) { | Some(data) => let exercise = - try(Exercise.deserialize_exercise(data, ~spec, ~instructor_mode)) { - | _ => init_exercise(spec, ~instructor_mode) + try( + Exercise.deserialize_exercise( + data, + ~spec, + ~instructor_mode, + ~inference_enabled, + ) + ) { + | _ => init_exercise(spec, ~instructor_mode, ~inference_enabled) }; JsUtil.set_localstore(cur_exercise_key, keystring); exercise; - | None => init_exercise(spec, ~instructor_mode) + | None => init_exercise(spec, ~instructor_mode, ~inference_enabled) }; }; @@ -266,20 +276,20 @@ module Exercise = { JsUtil.set_localstore(cur_exercise_key, keystring); }; - let init = (~instructor_mode) => { + let init = (~instructor_mode, ~inference_enabled) => { let exercises = { ( 0, ExerciseSettings.exercises, List.nth(ExerciseSettings.exercises, 0) - |> Exercise.state_of_spec(~instructor_mode), + |> Exercise.state_of_spec(~instructor_mode, ~inference_enabled), ); }; save(exercises, ~instructor_mode); exercises; }; - let load = (~specs, ~instructor_mode) => { + let load = (~specs, ~instructor_mode, ~inference_enabled) => { switch (JsUtil.get_localstore(cur_exercise_key)) { | Some(keystring) => let key = key_of_keystring(keystring); @@ -288,13 +298,25 @@ module Exercise = { switch (JsUtil.get_localstore(keystring)) { | Some(data) => let exercise = - try(deserialize_exercise(data, ~spec, ~instructor_mode)) { - | _ => init_exercise(spec, ~instructor_mode) + try( + deserialize_exercise( + data, + ~spec, + ~instructor_mode, + ~inference_enabled, + ) + ) { + | _ => init_exercise(spec, ~instructor_mode, ~inference_enabled) }; (n, specs, exercise); | None => // initialize exercise from spec - let exercise = Exercise.state_of_spec(spec, ~instructor_mode); + let exercise = + Exercise.state_of_spec( + spec, + ~instructor_mode, + ~inference_enabled, + ); save_exercise(exercise, ~instructor_mode); (n, specs, exercise); } @@ -302,9 +324,18 @@ module Exercise = { // invalid current exercise key saved, load the first exercise let first_spec = List.nth(specs, 0); let first_key = Exercise.key_of(first_spec); - (0, specs, load_exercise(first_key, first_spec, ~instructor_mode)); + ( + 0, + specs, + load_exercise( + first_key, + first_spec, + ~instructor_mode, + ~inference_enabled, + ), + ); }; - | None => init(~instructor_mode) + | None => init(~instructor_mode, ~inference_enabled) }; }; @@ -319,7 +350,12 @@ module Exercise = { |> List.map(spec => { let key = Exercise.key_of(spec); let exercise = - load_exercise(key, spec, ~instructor_mode) + load_exercise( + key, + spec, + ~instructor_mode, + ~inference_enabled=false, + ) |> Exercise.persistent_state_of_state(~instructor_mode); (key, exercise); }), @@ -332,11 +368,11 @@ module Exercise = { |> Sexplib.Sexp.to_string; }; - let export = (~specs, ~instructor_mode) => { - serialize_exercise_export(~specs, ~instructor_mode); + let export = (~specs) => { + serialize_exercise_export(~specs); }; - let import = (data, ~specs, ~instructor_mode) => { + let import = (data, ~specs, ~instructor_mode, ~inference_enabled) => { let exercise_export = data |> deserialize_exercise_export; save_exercise_key(exercise_export.cur_exercise); exercise_export.exercise_data @@ -351,6 +387,7 @@ module Exercise = { persistent_state, ~spec, ~instructor_mode, + ~inference_enabled, ), ~instructor_mode, ) diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index 760ad66644..ecc7d1e8c0 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -310,7 +310,8 @@ let perform_action = (model: Model.t, a: Action.t): Result.t(Model.t) => }; let switch_scratch_slide = - (editors: Editors.t, ~instructor_mode, idx: int): option(Editors.t) => + (editors: Editors.t, ~instructor_mode, ~inference_enabled, idx: int) + : option(Editors.t) => switch (editors) { | DebugLoad | Examples(_) => None @@ -321,7 +322,13 @@ let switch_scratch_slide = | Exercise(_, specs, _) => let spec = List.nth(specs, idx); let key = Exercise.key_of(spec); - let exercise = Store.Exercise.load_exercise(key, spec, ~instructor_mode); + let exercise = + Store.Exercise.load_exercise( + key, + spec, + ~instructor_mode, + ~inference_enabled, + ); Some(Exercise(idx, specs, exercise)); }; @@ -347,10 +354,12 @@ let switch_exercise_editor = state. The latter is intentional as we don't want to persist this between users. The former is a TODO, currently difficult due to the more complex architecture of Exercises. */ -let export_persistent_data = () => { +let export_persistent_data = (~inference_enabled) => { let data: PersistentData.t = { - examples: Store.Examples.load() |> Store.Examples.to_persistent, - scratch: Store.Scratch.load() |> Store.Scratch.to_persistent, + examples: + Store.Examples.load(~inference_enabled) |> Store.Examples.to_persistent, + scratch: + Store.Scratch.load(~inference_enabled) |> Store.Scratch.to_persistent, settings: Store.Settings.load(), }; let contents = @@ -403,18 +412,38 @@ let rec apply = ); Ok(model); | FinishImportScratchpad(data) => - let editors = Editors.import_current(model.editors, data); + let editors = + Editors.import_current( + model.editors, + data, + ~inference_enabled=model.settings.core.inference, + ); Model.save_and_return({...model, editors}); | ExportPersistentData => - export_persistent_data(); + export_persistent_data( + ~inference_enabled=model.settings.core.inference, + ); Ok(model); | ResetCurrentEditor => let instructor_mode = model.settings.instructor_mode; - let editors = Editors.reset_current(model.editors, ~instructor_mode); + let editors = + Editors.reset_current( + model.editors, + ~instructor_mode, + ~inference_enabled=model.settings.core.inference, + ); Model.save_and_return({...model, editors}); | SwitchScratchSlide(n) => let instructor_mode = model.settings.instructor_mode; - switch (switch_scratch_slide(model.editors, ~instructor_mode, n)) { + let inference_enabled = model.settings.core.inference; + switch ( + switch_scratch_slide( + model.editors, + ~instructor_mode, + ~inference_enabled, + n, + ) + ) { | None => Error(FailedToSwitch) | Some(editors) => Model.save_and_return({...model, editors}) }; From c98848171e1967354332b91ce144d00ef64b255f Mon Sep 17 00:00:00 2001 From: RaefM Date: Fri, 12 Jan 2024 23:21:53 -0600 Subject: [PATCH 111/129] fix stack overflow issue for nested occurs check failures --- .../inference/MutablePotentialTypeSet.re | 24 +++++++++++-------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/haz3lcore/inference/MutablePotentialTypeSet.re b/src/haz3lcore/inference/MutablePotentialTypeSet.re index b8009e763a..199694ee62 100644 --- a/src/haz3lcore/inference/MutablePotentialTypeSet.re +++ b/src/haz3lcore/inference/MutablePotentialTypeSet.re @@ -40,13 +40,13 @@ let rec snapshot_class = : (PotentialTypeSet.t, option(error_status)) => { let (typs, err1) = UnionFind.get(mut_potential_typ_set); let (potential_typ_set, err2) = - snapshot_typs(typs, mut_potential_typ_set, occurs_rep); + snapshot_typs(typs, [mut_potential_typ_set], occurs_rep); (potential_typ_set, combine_error_status(err1, err2)); } and snapshot_class_from_child = - (mut_potential_typ_set: t, parent: t, occurs_rep: ITyp.t) + (mut_potential_typ_set: t, parents: list(t), occurs_rep: ITyp.t) : (PotentialTypeSet.t, option(error_status)) => { - UnionFind.eq(mut_potential_typ_set, parent) + List.exists(UnionFind.eq(mut_potential_typ_set), parents) ? ( [occurs_rep |> PotentialTypeSet.ityp_to_potential_typ], Some(Occurs), @@ -54,14 +54,14 @@ and snapshot_class_from_child = : snapshot_class(mut_potential_typ_set, occurs_rep); } and snapshot_typs = - (mut_pot_typs: mut_pot_typs, parent: t, occurs_rep: ITyp.t) + (mut_pot_typs: mut_pot_typs, parents: list(t), occurs_rep: ITyp.t) : (PotentialTypeSet.t, option(error_status)) => { switch (mut_pot_typs) { | [] => ([], None) | [hd, ...tl] => - let (pot_typ_hd, err_hd) = snapshot_typ(hd, parent, occurs_rep); + let (pot_typ_hd, err_hd) = snapshot_typ(hd, parents, occurs_rep); let (potential_typ_set_tl, err_tl) = - snapshot_typs(tl, parent, occurs_rep); + snapshot_typs(tl, parents, occurs_rep); ( [pot_typ_hd, ...potential_typ_set_tl], combine_error_status(err_hd, err_tl), @@ -69,7 +69,7 @@ and snapshot_typs = }; } and snapshot_typ = - (mut_pot_typ: mut_pot_typ, parent: t, occurs_rep: ITyp.t) + (mut_pot_typ: mut_pot_typ, parents: list(t), occurs_rep: ITyp.t) : (PotentialTypeSet.potential_typ, option(error_status)) => { switch (mut_pot_typ) { | Base(b) => (PotentialTypeSet.Base(b), None) @@ -77,13 +77,13 @@ and snapshot_typ = let (potential_typ_set_lhs, err_lhs) = snapshot_class_from_child( mut_potential_typ_set_lhs, - parent, + [mut_potential_typ_set_lhs, ...parents], occurs_rep, ); let (potential_typ_set_rhs, err_rhs) = snapshot_class_from_child( mut_potential_typ_set_rhs, - parent, + [mut_potential_typ_set_rhs, ...parents], occurs_rep, ); ( @@ -96,7 +96,11 @@ and snapshot_typ = ); | Unary(ctor, mut_potential_typ_set) => let (potential_typ_set, err) = - snapshot_class_from_child(mut_potential_typ_set, parent, occurs_rep); + snapshot_class_from_child( + mut_potential_typ_set, + [mut_potential_typ_set, ...parents], + occurs_rep, + ); (PotentialTypeSet.Unary(ctor, potential_typ_set), err); }; }; From d533620bcc69db8d41cf155febe86dfc55c24849 Mon Sep 17 00:00:00 2001 From: RaefM Date: Fri, 12 Jan 2024 23:54:25 -0600 Subject: [PATCH 112/129] make occurs check failures have special ci text --- src/haz3lcore/inference/InferenceResult.re | 21 +++++++++-- .../inference/MutablePotentialTypeSet.re | 21 +++++------ src/haz3lweb/view/CursorInspector.re | 37 +++++++++++++------ src/haz3lweb/view/InferenceView.re | 20 ++++++---- 4 files changed, 65 insertions(+), 34 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 8e54df9bdf..461bfd485a 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -1,6 +1,7 @@ type status = | Solved(ITyp.t) - | Unsolved(PotentialTypeSet.t); + | Unsolved(occurs_failure, PotentialTypeSet.t) +and occurs_failure = bool; type t = (ITyp.t, status); @@ -32,6 +33,18 @@ type suggestion_source = | TypHole | None; +let id_has_failed_occurs = + (id: Id.t, global_inference_info: global_inference_info): bool => { + switch ( + Hashtbl.find_opt(global_inference_info.typehole_suggestions, id), + Hashtbl.find_opt(global_inference_info.exphole_suggestions, id), + ) { + | (Some(Unsolved(true, _)), _) => true + | (_, Some((_, Unsolved(true, _)))) => true + | _ => false + }; +}; + let get_suggestion_text_for_id = (id: Id.t, global_inference_info: global_inference_info) : (suggestion(string), suggestion_source) => @@ -42,7 +55,7 @@ let get_suggestion_text_for_id = | Solved(ityp) => let typ_to_string = x => Typ.typ_to_string(x, false); Solvable(ityp |> ITyp.ityp_to_typ |> typ_to_string); - | Unsolved([potential_typ]) => + | Unsolved(_, [potential_typ]) => NestedInconsistency( PotentialTypeSet.string_of_potential_typ(false, potential_typ), ) @@ -118,7 +131,7 @@ let condense = ); switch (err) { - | Some(_) => Unsolved(redundant_var_filtered_potential_typ_set) + | Some(Occurs) => Unsolved(true, redundant_var_filtered_potential_typ_set) | None => let solved_opt = PotentialTypeSet.filtered_potential_typ_set_to_typ( @@ -126,7 +139,7 @@ let condense = ); switch (solved_opt) { | Some(typ) => Solved(typ) - | None => Unsolved(redundant_var_filtered_potential_typ_set) + | None => Unsolved(false, redundant_var_filtered_potential_typ_set) }; }; }; diff --git a/src/haz3lcore/inference/MutablePotentialTypeSet.re b/src/haz3lcore/inference/MutablePotentialTypeSet.re index 199694ee62..f2d796d81f 100644 --- a/src/haz3lcore/inference/MutablePotentialTypeSet.re +++ b/src/haz3lcore/inference/MutablePotentialTypeSet.re @@ -35,12 +35,12 @@ let get_combined_error_status_of_classes = combine_error_status(err1, err2); }; -let rec snapshot_class = - (mut_potential_typ_set: t, occurs_rep: ITyp.t) +let rec snapshot_class_wrapper = + (mut_potential_typ_set: t, occurs_rep: ITyp.t, parents: list(t)) : (PotentialTypeSet.t, option(error_status)) => { let (typs, err1) = UnionFind.get(mut_potential_typ_set); let (potential_typ_set, err2) = - snapshot_typs(typs, [mut_potential_typ_set], occurs_rep); + snapshot_typs(typs, [mut_potential_typ_set, ...parents], occurs_rep); (potential_typ_set, combine_error_status(err1, err2)); } and snapshot_class_from_child = @@ -51,7 +51,7 @@ and snapshot_class_from_child = [occurs_rep |> PotentialTypeSet.ityp_to_potential_typ], Some(Occurs), ) - : snapshot_class(mut_potential_typ_set, occurs_rep); + : snapshot_class_wrapper(mut_potential_typ_set, occurs_rep, parents); } and snapshot_typs = (mut_pot_typs: mut_pot_typs, parents: list(t), occurs_rep: ITyp.t) @@ -77,13 +77,13 @@ and snapshot_typ = let (potential_typ_set_lhs, err_lhs) = snapshot_class_from_child( mut_potential_typ_set_lhs, - [mut_potential_typ_set_lhs, ...parents], + parents, occurs_rep, ); let (potential_typ_set_rhs, err_rhs) = snapshot_class_from_child( mut_potential_typ_set_rhs, - [mut_potential_typ_set_rhs, ...parents], + parents, occurs_rep, ); ( @@ -96,15 +96,14 @@ and snapshot_typ = ); | Unary(ctor, mut_potential_typ_set) => let (potential_typ_set, err) = - snapshot_class_from_child( - mut_potential_typ_set, - [mut_potential_typ_set, ...parents], - occurs_rep, - ); + snapshot_class_from_child(mut_potential_typ_set, parents, occurs_rep); (PotentialTypeSet.Unary(ctor, potential_typ_set), err); }; }; +let snapshot_class = (mut_potential_typ_set: t, occurs_rep: ITyp.t) => + snapshot_class_wrapper(mut_potential_typ_set, occurs_rep, []); + let rec pot_typ_set_to_mut_pot_typ_set = (potential_typ_set: PotentialTypeSet.t): t => { List.map(pot_typ_to_mut_pot_typ, potential_typ_set) |> wrap_without_error; diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index f1107f09e4..e7202a9b94 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -160,41 +160,54 @@ let view_of_global_inference_info = ) | SolvedExpHole(id, solution) => - print_endline("Solved exphole"); div( ~attr=clss([infoc, "typ"]), [ text("consistent constraints"), suggestion_button_of_typ(~id=Some(id), solution), ], - ); - | UnsolvedTypeHole([typ_with_nested_conflict]) => + ) + | UnsolvedTypeHole(occurs, [typ_with_nested_conflict]) => div( ~attr=clss([infoc, "typ"]), - [Type.view(~font_metrics, typ_with_nested_conflict)], + [ + text( + occurs ? "inferred type refers to self" : "conflicting constraints", + ), + Type.view(~font_metrics, typ_with_nested_conflict), + ], ) - | UnsolvedExpHole(_, [typ_with_nested_conflict]) => - print_endline("Solved exphole nested inconsistency"); + | UnsolvedExpHole(occurs, _, [typ_with_nested_conflict]) => div( ~attr=clss([infoc, "typ"]), [ - text("conflicting constraints"), + text( + occurs ? "inferred type refers to self" : "conflicting constraints", + ), suggestion_button_of_typ(typ_with_nested_conflict), ], - ); - | UnsolvedTypeHole(conflicting_typs) => + ) + | UnsolvedTypeHole(occurs, conflicting_typs) => div( ~attr=clss([infoc, "typ"]), [ - text("conflicting constraints"), + text( + occurs + ? "inferred type may refer to self and contains conflicting constraints" + : "conflicting constraints", + ), ...List.map(suggestion_button_of_typ, conflicting_typs), ], ) - | UnsolvedExpHole(id, conflicting_typs) => + | UnsolvedExpHole(occurs, id, conflicting_typs) => div( ~attr=clss([infoc, "typ"]), [ - text("conflicting constraints"), + text( + occurs + ? "inferred type may refer to self and contains conflicting constraints" + : "conflicting constraints", + ), ...List.map( suggestion_button_of_typ(~id=Some(id)), conflicting_typs, diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index dbd632faac..de83170134 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -3,10 +3,11 @@ open Haz3lcore; type cursor_inspector_suggestion = | SolvedTypeHole(Typ.t) - | UnsolvedTypeHole(list(Typ.t)) + | UnsolvedTypeHole(occurs_failure, list(Typ.t)) | SolvedExpHole(Id.t, Typ.t) - | UnsolvedExpHole(Id.t, list(Typ.t)) - | NoSuggestion; + | UnsolvedExpHole(occurs_failure, Id.t, list(Typ.t)) + | NoSuggestion +and occurs_failure = bool; let get_suggestion_ui_for_id = ( @@ -27,7 +28,7 @@ let get_suggestion_ui_for_id = |> ITyp.ityp_to_typ |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), ) - | Unsolved([potential_typ]) => + | Unsolved(_, [potential_typ]) => let ptyp_node = Type.view_of_potential_typ( ~font_metrics, @@ -56,11 +57,14 @@ let svg_display_settings = // Determines if a hexagon (svg) should be used to represent a type hole, and if so, how it should look let (suggestion, source) = InferenceResult.get_suggestion_text_for_id(id, global_inference_info); + let failed_occurs = + InferenceResult.id_has_failed_occurs(id, global_inference_info); switch (source) { | ExpHole => switch (suggestion) { | Solvable(_) - | NestedInconsistency(_) => Some(PromptHole) + | NestedInconsistency(_) => + failed_occurs ? Some(ErrorHole) : Some(PromptHole) | NoSuggestion(InconsistentSet) => Some(ErrorHole) | NoSuggestion(_) => Some(StandardHole) } @@ -84,8 +88,9 @@ let get_cursor_inspect_result = switch (Hashtbl.find_opt(global_inference_info.exphole_suggestions, id)) { | Some(([id, ..._], exp_hole_status)) => switch (exp_hole_status) { - | Unsolved(potential_typ_set) => + | Unsolved(occurs, potential_typ_set) => UnsolvedExpHole( + occurs, id, potential_typ_set |> PotentialTypeSet.potential_typ_set_to_ityp_unroll(id) @@ -97,8 +102,9 @@ let get_cursor_inspect_result = } | Some(status) => switch (status) { - | Unsolved(potential_typ_set) => + | Unsolved(occurs, potential_typ_set) => UnsolvedTypeHole( + occurs, potential_typ_set |> PotentialTypeSet.potential_typ_set_to_ityp_unroll(id) |> List.map(ITyp.ityp_to_typ), From 1247487301747ff9b1d960d44d6481b142d9d022 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sat, 13 Jan 2024 14:03:11 -0600 Subject: [PATCH 113/129] fix clunky CI types when parens involved --- src/haz3lweb/view/Type.re | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index d217f6f5a1..e9c3e6d0ae 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -24,7 +24,15 @@ let rec view_ty = : Node.t => { let view_ty' = view_ty(~font_metrics, ~with_cls); let parenthesize_if_left_child = (n): Node.t => - (is_left_child ? [Node.text("("), ...n] @ [Node.text(")")] : n) |> span; + if (is_left_child) { + if (with_cls) { + div(~attr=clss(["typ-view"]), [text("("), ...n] @ [text(")")]); + } else { + span([text("("), ...n] @ [text(")")]); + }; + } else { + span(n); + }; let div = (~attr, nodes) => with_cls ? div(~attr, nodes) : span(nodes); let ty_view = (cls: string, s: string): Node.t => div(~attr=clss(["typ-view", cls]), [text(s)]); From 52550703bbf92cbdee47ba28cea2605c64e7b81f Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 14 Jan 2024 17:54:21 -0500 Subject: [PATCH 114/129] Fix issue where occurs failures were given solved UI. Fix issue where annotated patterns had less-than-ideal results due to missing subsumption constraints. Fix issue where tab didn't accept before suggestion and only after. --- src/haz3lcore/inference/InferenceResult.re | 11 +++-- src/haz3lcore/statics/Statics.re | 10 ++++- src/haz3lweb/Keyboard.re | 29 +++---------- src/haz3lweb/view/Code.re | 1 + src/haz3lweb/view/InferenceView.re | 47 +++++++++++++++++++++- 5 files changed, 67 insertions(+), 31 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 461bfd485a..74840edece 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -26,6 +26,7 @@ and reason_for_silence = | SuggestionsDisabled | NotSuggestableHoleId | OnlyHoleSolutions + | OccursFailed | InconsistentSet; type suggestion_source = @@ -55,10 +56,12 @@ let get_suggestion_text_for_id = | Solved(ityp) => let typ_to_string = x => Typ.typ_to_string(x, false); Solvable(ityp |> ITyp.ityp_to_typ |> typ_to_string); - | Unsolved(_, [potential_typ]) => - NestedInconsistency( - PotentialTypeSet.string_of_potential_typ(false, potential_typ), - ) + | Unsolved(occurs, [potential_typ]) => + occurs + ? NoSuggestion(OccursFailed) + : NestedInconsistency( + PotentialTypeSet.string_of_potential_typ(false, potential_typ), + ) | Unsolved(_) => NoSuggestion(InconsistentSet) }; switch (Hashtbl.find_opt(global_inference_info.typehole_suggestions, id)) { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index d278235d4b..cf029a80f8 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -389,7 +389,12 @@ and uexp_to_info_map = add( ~self=Just(Arrow(p.ty, e.ty)), ~co_ctx=CoCtx.mk(ctx, p.ctx, e.co_ctx), - ~constraints=match_constraints @ e.constraints @ p.constraints, + ~constraints= + match_constraints + @ subsumption_constraints(Just(Arrow(p.ty, e.ty))) + @ e.constraints + @ p.constraints + @ p'.constraints, m, ); | Let(p, def, body) => @@ -853,6 +858,9 @@ let mk_map_and_inference_solutions = Id.Map.empty, ); + print_endline("~~~Printing constraints:"); + info.constraints |> Typ.constraints_to_string |> print_endline; + let pts_graph = Inference.solve_constraints(info.constraints); let solutions = InferenceResult.get_desired_solutions(pts_graph); diff --git a/src/haz3lweb/Keyboard.re b/src/haz3lweb/Keyboard.re index 873478cad4..53689224a8 100644 --- a/src/haz3lweb/Keyboard.re +++ b/src/haz3lweb/Keyboard.re @@ -1,5 +1,4 @@ open Haz3lcore; -open Util; let is_digit = s => Re.Str.(string_match(regexp("^[0-9]$"), s, 0)); let is_f_key = s => Re.Str.(string_match(regexp("^F[0-9][0-9]*$"), s, 0)); @@ -14,6 +13,8 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { model.settings.core.inference, suggestions, ); + let acceptSuggestionIfAvailable = + InferenceView.acceptSuggestionIfAvailable(global_inference_info, zipper); let now = (a: Action.t): option(UpdateAction.t) => Some(PerformAction(a)); switch (k) { @@ -43,30 +44,10 @@ let handle_key_event = (k: Key.t, ~model: Model.t): option(Update.t) => { | (Up, "Backspace") => now(Destruct(Left)) | (Up, "Delete") => now(Destruct(Right)) | (Up, "Escape") => now(Unselect(None)) - | (Up, "Tab") => - let suggestion_opt = { - open Util.OptUtil.Syntax; - let+ (p, _) = Zipper.representative_piece(zipper); - InferenceResult.get_suggestion_text_for_id( - Piece.id(p), - global_inference_info, - ); - }; - switch (suggestion_opt) { - | Some((Solvable(typ_filling), TypHole)) - | Some((NestedInconsistency(typ_filling), TypHole)) => - // question marks (holes) can't be inserted manually, so filter them out - let join = List.fold_left((s, acc) => s ++ acc, ""); - let no_hole_marks = - typ_filling - |> StringUtil.to_list - |> List.filter(s => s != "?" && s != "!") - |> join; - Some(UpdateAction.Paste(no_hole_marks)); - | _ => Some(DoTheThing) - }; + | (Up, "Tab") => acceptSuggestionIfAvailable(Some(DoTheThing)) | (Up, "F12") => now(Jump(BindingSiteOfIndicatedVar, Left)) - | (Down, "Tab") => Some(MoveToNextHole(Left)) + | (Down, "Tab") => + acceptSuggestionIfAvailable(Some(MoveToNextHole(Left))) | (Down, "ArrowLeft") => now(Select(Resize(Local(Left(ByToken))))) | (Down, "ArrowRight") => now(Select(Resize(Local(Right(ByToken))))) | (Down, "ArrowUp") => now(Select(Resize(Local(Up)))) diff --git a/src/haz3lweb/view/Code.re b/src/haz3lweb/view/Code.re index b4476f5633..a1ed2cb49c 100644 --- a/src/haz3lweb/view/Code.re +++ b/src/haz3lweb/view/Code.re @@ -65,6 +65,7 @@ let of_grout = | (NestedInconsistency(_), ExpHole) => [ [Node.text("?")] |> span_c("prompt-ci"), ] + | (NoSuggestion(OccursFailed), _) | (NoSuggestion(InconsistentSet), _) => [ [Node.text("!")] |> span_c("unsolved-annotation"), ] diff --git a/src/haz3lweb/view/InferenceView.re b/src/haz3lweb/view/InferenceView.re index de83170134..6f4bf36442 100644 --- a/src/haz3lweb/view/InferenceView.re +++ b/src/haz3lweb/view/InferenceView.re @@ -28,7 +28,7 @@ let get_suggestion_ui_for_id = |> ITyp.ityp_to_typ |> Type.view(~font_metrics=Some(font_metrics), ~with_cls=false), ) - | Unsolved(_, [potential_typ]) => + | Unsolved(occurs, [potential_typ]) => let ptyp_node = Type.view_of_potential_typ( ~font_metrics, @@ -36,7 +36,7 @@ let get_suggestion_ui_for_id = false, potential_typ, ); - NestedInconsistency(ptyp_node); + occurs ? NoSuggestion(OccursFailed) : NestedInconsistency(ptyp_node); | Unsolved(_) => NoSuggestion(InconsistentSet) }; switch (Hashtbl.find_opt(global_inference_info.typehole_suggestions, id)) { @@ -65,6 +65,7 @@ let svg_display_settings = | Solvable(_) | NestedInconsistency(_) => failed_occurs ? Some(ErrorHole) : Some(PromptHole) + | NoSuggestion(OccursFailed) | NoSuggestion(InconsistentSet) => Some(ErrorHole) | NoSuggestion(_) => Some(StandardHole) } @@ -73,6 +74,7 @@ let svg_display_settings = switch (suggestion) { | Solvable(_) | NestedInconsistency(_) => None + | NoSuggestion(OccursFailed) | NoSuggestion(InconsistentSet) => Some(ErrorHole) | NoSuggestion(_) => Some(StandardHole) } @@ -115,3 +117,44 @@ let get_cursor_inspect_result = } else { NoSuggestion; }; + +let acceptSuggestionIfAvailable = + (global_inference_info, zipper, defaultAction) => { + open Util; + let suggestion_of_direction = (dir: Direction.t) => { + open Util.OptUtil.Syntax; + let dir_to_tup_projector = dir == Left ? fst : snd; + let+ p = + zipper + |> Zipper.sibs_with_sel + |> Siblings.neighbors + |> dir_to_tup_projector; + InferenceResult.get_suggestion_text_for_id( + Piece.id(p), + global_inference_info, + ); + }; + let (sugg_l_opt, sugg_r_opt) = ( + suggestion_of_direction(Left), + suggestion_of_direction(Right), + ); + let suggestion_opt = + switch (sugg_l_opt) { + | Some((NoSuggestion(_), _)) + | None => sugg_r_opt + | _ => sugg_l_opt + }; + switch (suggestion_opt) { + | Some((Solvable(typ_filling), TypHole)) + | Some((NestedInconsistency(typ_filling), TypHole)) => + // question marks (holes) can't be inserted manually, so filter them out + let join = List.fold_left((s, acc) => s ++ acc, ""); + let no_hole_marks = + typ_filling + |> StringUtil.to_list + |> List.filter(s => s != "?" && s != "!") + |> join; + Some(UpdateAction.Paste(no_hole_marks)); + | _ => defaultAction + }; +}; From c7ddca2ef8c3e4261016b2588b4ca5df7848a926 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 14 Jan 2024 18:16:43 -0500 Subject: [PATCH 115/129] Make all CI unknowns be the hexagon --- src/haz3lweb/view/CursorInspector.re | 86 ++++++++++++++++++---------- src/haz3lweb/view/Type.re | 2 +- 2 files changed, 56 insertions(+), 32 deletions(-) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index e7202a9b94..6ed514adf0 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -226,7 +226,7 @@ let elements_noun: Term.Cls.t => string = | Exp(ListConcat) => "Operands" | _ => failwith("elements_noun: Cls doesn't have elements"); -let common_err_view = (cls: Term.Cls.t, err: Info.error_common) => +let common_err_view = (~font_metrics, cls: Term.Cls.t, err: Info.error_common) => switch (err) { | NoType(BadToken(token)) => switch (Form.bad_token_cls(token)) { @@ -235,25 +235,25 @@ let common_err_view = (cls: Term.Cls.t, err: Info.error_common) => } | NoType(BadTrivAp(ty)) => [ text("Function argument type"), - Type.view(ty), + Type.view(~font_metrics, ty), text("inconsistent with"), - Type.view(Prod([])), + Type.view(~font_metrics, Prod([])), ] | NoType(FreeConstructor(name)) => [code_err(name), text("not found")] | Inconsistent(WithArrow(typ)) => [ text(":"), - Type.view(typ), + Type.view(~font_metrics, typ), text("inconsistent with arrow type"), ] | Inconsistent(Expectation({ana, syn})) => [ text(":"), - Type.view(syn), + Type.view(~font_metrics, syn), text("inconsistent with expected type"), - Type.view(ana), + Type.view(~font_metrics, ana), ] | Inconsistent(Internal(tys)) => [ text(elements_noun(cls) ++ " have inconsistent types:"), - ...ListUtil.join(text(","), List.map(Type.view, tys)), + ...ListUtil.join(text(","), List.map(Type.view(~font_metrics), tys)), ] }; @@ -275,6 +275,7 @@ let common_ok_view = | (NoSuggestion(SuggestionsDisabled), _) | (NoSuggestion(NotSuggestableHoleId), _) | (NoSuggestion(OnlyHoleSolutions), _) => + let font_metrics = Some(font_metrics); switch (cls, ok) { | (Exp(MultiHole) | Pat(MultiHole), _) => [ text("Expecting operator or delimiter"), @@ -283,35 +284,41 @@ let common_ok_view = | (Pat(EmptyHole), Syn(_)) => [text("Fillable by any pattern")] | (Exp(EmptyHole), Ana(Consistent({ana, _}))) => [ text("Fillable by any expression of type"), - Type.view(ana), + Type.view(~font_metrics, ana), ] | (Pat(EmptyHole), Ana(Consistent({ana, _}))) => [ text("Fillable by any pattern of type"), - Type.view(ana), + Type.view(~font_metrics, ana), ] - | (_, Syn(syn)) => [text(":"), Type.view(syn)] + | (_, Syn(syn)) => [text(":"), Type.view(~font_metrics, syn)] | (Pat(Var) | Pat(Wild), Ana(Consistent({ana, _}))) => [ text(":"), - Type.view(ana), + Type.view(~font_metrics, ana), ] | (_, Ana(Consistent({ana, syn, _}))) when ana == syn => [ text(":"), - Type.view(syn), + Type.view(~font_metrics, syn), text("equals expected type"), ] | (_, Ana(Consistent({ana, syn, _}))) => [ text(":"), - Type.view(syn), + Type.view(~font_metrics, syn), text("consistent with expected type"), - Type.view(ana), + Type.view(~font_metrics, ana), ] | (_, Ana(InternallyInconsistent({ana, nojoin: tys}))) => [ text(elements_noun(cls) ++ " have inconsistent types:"), - ...ListUtil.join(text(","), List.map(Type.view, tys)), + ...ListUtil.join( + text(","), + List.map(Type.view(~font_metrics), tys), + ), ] - @ [text("but consistent with expected"), Type.view(ana)] - } + @ [ + text("but consistent with expected"), + Type.view(~font_metrics, ana), + ] + }; | _ => [ view_of_global_inference_info( ~inject, @@ -342,7 +349,9 @@ let typ_ok_view = ) { | (NoSuggestion(SuggestionsDisabled), _) | (NoSuggestion(NotSuggestableHoleId), _) - | (NoSuggestion(OnlyHoleSolutions), _) => [Type.view(ty)] + | (NoSuggestion(OnlyHoleSolutions), _) => [ + Type.view(~font_metrics=Some(font_metrics), ty), + ] | _ => [ view_of_global_inference_info( ~inject, @@ -357,17 +366,22 @@ let typ_ok_view = //| Type(ty) => [Type.view(ty)] //TODO(andrew): how do these interact with THI? | TypeAlias(name, ty_lookup) => [ - Type.view(Var(name)), + Type.view(~font_metrics=Some(font_metrics), Var(name)), text("is an alias for"), - Type.view(ty_lookup), + Type.view(~font_metrics=Some(font_metrics), ty_lookup), + ] + | Variant(name, _sum_ty) => [ + Type.view(~font_metrics=Some(font_metrics), Var(name)), ] - | Variant(name, _sum_ty) => [Type.view(Var(name))] | VariantIncomplete(_sum_ty) => [text("is incomplete")] }; -let typ_err_view = (ok: Info.error_typ) => +let typ_err_view = (ok: Info.error_typ, ~font_metrics) => switch (ok) { - | FreeTypeVariable(name) => [Type.view(Var(name)), text("not found")] + | FreeTypeVariable(name) => [ + Type.view(~font_metrics, Var(name)), + text("not found"), + ] | BadToken(token) => [ code_err(token), text("not a type or type operator"), @@ -376,7 +390,7 @@ let typ_err_view = (ok: Info.error_typ) => | WantConstructorFoundType(_) => [text("Expected a constructor")] | WantTypeFoundAp => [text("Must be part of a sum type")] | DuplicateConstructor(name) => [ - Type.view(Var(name)), + Type.view(~font_metrics, Var(name)), text("already used in this sum"), ] }; @@ -393,7 +407,8 @@ let exp_view = switch (status) { | InHole(FreeVariable(name)) => div_err([code_err(name), text("not found")]) - | InHole(Common(error)) => div_err(common_err_view(cls, error)) + | InHole(Common(error)) => + div_err(common_err_view(~font_metrics=Some(font_metrics), cls, error)) | NotInHole(ok) => div_ok( common_ok_view( @@ -418,7 +433,8 @@ let pat_view = ) => switch (status) { | InHole(ExpectedConstructor) => div_err([text("Expected a constructor")]) - | InHole(Common(error)) => div_err(common_err_view(cls, error)) + | InHole(Common(error)) => + div_err(common_err_view(~font_metrics=Some(font_metrics), cls, error)) | NotInHole(ok) => div_ok( common_ok_view( @@ -453,10 +469,11 @@ let typ_view = ok, ), ) - | InHole(err) => div_err(typ_err_view(err)) + | InHole(err) => + div_err(typ_err_view(~font_metrics=Some(font_metrics), err)) }; -let tpat_view = (_: Term.Cls.t, status: Info.status_tpat) => +let tpat_view = (_: Term.Cls.t, status: Info.status_tpat, ~font_metrics) => switch (status) { | NotInHole(Empty) => div_ok([text("Fillable with a new alias")]) | NotInHole(Var(name)) => div_ok([Type.alias_view(name)]) @@ -464,9 +481,15 @@ let tpat_view = (_: Term.Cls.t, status: Info.status_tpat) => div_err([text("Must begin with a capital letter")]) | InHole(NotAVar(_)) => div_err([text("Expected an alias")]) | InHole(ShadowsType(name)) when Form.is_base_typ(name) => - div_err([text("Can't shadow base type"), Type.view(Var(name))]) + div_err([ + text("Can't shadow base type"), + Type.view(~font_metrics, Var(name)), + ]) | InHole(ShadowsType(name)) => - div_err([text("Can't shadow existing alias"), Type.view(Var(name))]) + div_err([ + text("Can't shadow existing alias"), + Type.view(~font_metrics, Var(name)), + ]) }; let view_of_info = @@ -519,7 +542,8 @@ let view_of_info = status, ), ) - | InfoTPat({cls, status, _}) => wrapper(tpat_view(cls, status)) + | InfoTPat({cls, status, _}) => + wrapper(tpat_view(cls, status, ~font_metrics=Some(font_metrics))) }; }; diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index e9c3e6d0ae..64695b4d1a 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -55,7 +55,7 @@ let rec view_ty = ), ], ) - | _ => div(~attr=clss(["typ-view", "atom", "unknown"]), [text("")]) + | _ => div(~attr=clss(["typ-view", "atom", "unknown"]), [text("?")]) } | Int => ty_view("Int", "Int") | Float => ty_view("Float", "Float") From 6d9b10546ee5d5a0a2127649bc2304f5350a8aa3 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 14 Jan 2024 21:44:13 -0500 Subject: [PATCH 116/129] remove debug logs again --- src/haz3lcore/statics/Statics.re | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index cf029a80f8..987abc9745 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -858,9 +858,6 @@ let mk_map_and_inference_solutions = Id.Map.empty, ); - print_endline("~~~Printing constraints:"); - info.constraints |> Typ.constraints_to_string |> print_endline; - let pts_graph = Inference.solve_constraints(info.constraints); let solutions = InferenceResult.get_desired_solutions(pts_graph); From fe27c3af027db3d4ec6115bb2d5cbd042c3d1c36 Mon Sep 17 00:00:00 2001 From: disconcision Date: Mon, 15 Jan 2024 13:39:22 -0500 Subject: [PATCH 117/129] hackily disable cons suggestion in patterns --- src/haz3lcore/assistant/TyDi.re | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/haz3lcore/assistant/TyDi.re b/src/haz3lcore/assistant/TyDi.re index 0832e76075..7486e365a4 100644 --- a/src/haz3lcore/assistant/TyDi.re +++ b/src/haz3lcore/assistant/TyDi.re @@ -95,6 +95,10 @@ let set_buffer = (~settings, ~ctx: Ctx.t, z: Zipper.t): option(Zipper.t) => { suggestions |> List.filter(({content, _}: Suggestion.t) => String.starts_with(~prefix=tok_to_left, content) + /* HACK(andrew): Below filtering of cons suggestion + * should be done in a more principled way when a + * ranker is implemented */ + && !(Info.sort_of(ci) == Pat && content == "::") ); let* top_suggestion = suggestions |> Util.ListUtil.hd_opt; let* suggestion_suffix = suffix_of(top_suggestion.content, tok_to_left); From 12c3f124c012d70dd7442cc6fc1911558aed530b Mon Sep 17 00:00:00 2001 From: RaefM Date: Wed, 17 Jan 2024 23:11:30 -0500 Subject: [PATCH 118/129] Make occurs failures involving type holes show conflicts in CI. Shift more logic for occurs failure handling into CI, where prompts can explain the unsolved status --- src/haz3lcore/inference/InferenceResult.re | 61 ++++++++++++++-------- src/haz3lcore/statics/Statics.re | 18 +++---- src/haz3lweb/view/CursorInspector.re | 6 +-- 3 files changed, 50 insertions(+), 35 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index 74840edece..d733652099 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -95,21 +95,18 @@ let empty_info = (): global_inference_info => { }; let rec get_all_pattern_var_neighbors = - ( - potential_typ_set: PotentialTypeSet.t, - desired_parent_exp_hole_id: Id.t, - ) + (potential_typ_set: PotentialTypeSet.t, desired_exp_hole_id: Id.t) : list(Id.t) => { switch (potential_typ_set) { | [] => [] | [hd, ...tl] => switch (hd) { - | Base(BUnknown(ExpHole(PatternVar(parent_id), p_id))) - when parent_id == desired_parent_exp_hole_id => [ + | Base(BUnknown(ExpHole(PatternVar(bound_exp), p_id))) + when bound_exp == desired_exp_hole_id => [ p_id, - ...get_all_pattern_var_neighbors(tl, desired_parent_exp_hole_id), + ...get_all_pattern_var_neighbors(tl, desired_exp_hole_id), ] - | _ => get_all_pattern_var_neighbors(tl, desired_parent_exp_hole_id) + | _ => get_all_pattern_var_neighbors(tl, desired_exp_hole_id) } }; }; @@ -121,28 +118,46 @@ let condense = let sorted_potential_typ_set = PotentialTypeSet.sort_potential_typ_set(potential_typ_set); - let hole_filtered_potential_typ_set = - PotentialTypeSet.filter_unneeded_nodes( - PotentialTypeSet.is_unknown, - sorted_potential_typ_set, - ); + // When prepping solutions, it often isn't useful to have holes or type variables + // as suggestions when alternatives exist. This method filters 'not useful' suggestions. + let filter_redundant_nodes = occurs => { + // Always filter holes eagerly where alternatives exist when populating suggestions + // as even if occurs failure happens, suggesting ? will never be useful + // and ? and A -> ? are consistent with one another + let filter_redundant_holes = + PotentialTypeSet.filter_unneeded_nodes(PotentialTypeSet.is_unknown); - let redundant_var_filtered_potential_typ_set = - PotentialTypeSet.filter_unneeded_nodes( - PotentialTypeSet.is_var, - hole_filtered_potential_typ_set, - ); + // Filter all type vars when alternatives exist, as their assigned value must be in the pts + // unless an occurs failure has occurred- in that case, filter all but one variable + // Why: + // Unlike holes, consistency of a type variable and another nonhole type requires equality to it + // * Suppose the occurs check failed and our solution S = {a, {b} -> S, c}. + // a and {b} -> S cannot be equal as doing so triggers unbound expansion. + // Therefore, both must different possible suggestions. + // * Suppose the occurs check was passed and our solution S = {c, {b} -> {a}}. + // c and {b} -> {a} can be treated as equivalent without issue + // (this is barring transitively generated inconsistencies which may on their own cause multiple suggestions) + // We choose to suggest {b} -> {a} as it is more specific (and therefore arguably more helpful) + let filter_redundant_vars = + occurs + ? PotentialTypeSet.filter_unneeded_nodes_class( + PotentialTypeSet.is_var, + false, + ) + : PotentialTypeSet.filter_unneeded_nodes(PotentialTypeSet.is_var); + + sorted_potential_typ_set |> filter_redundant_holes |> filter_redundant_vars; + }; switch (err) { - | Some(Occurs) => Unsolved(true, redundant_var_filtered_potential_typ_set) + | Some(Occurs) => Unsolved(true, filter_redundant_nodes(true)) | None => + let filtered_pts = filter_redundant_nodes(false); let solved_opt = - PotentialTypeSet.filtered_potential_typ_set_to_typ( - redundant_var_filtered_potential_typ_set, - ); + PotentialTypeSet.filtered_potential_typ_set_to_typ(filtered_pts); switch (solved_opt) { | Some(typ) => Solved(typ) - | None => Unsolved(false, redundant_var_filtered_potential_typ_set) + | None => Unsolved(false, filtered_pts) }; }; }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 987abc9745..32d86f1a0e 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -371,7 +371,7 @@ and uexp_to_info_map = ~is_synswitch=false, ~co_ctx=CoCtx.empty, ~mode=mode_pat, - ~parent_id=Some(UExp.rep_id(e)), + ~bound_exp_id=Some(UExp.rep_id(e)), p, m, ); @@ -382,7 +382,7 @@ and uexp_to_info_map = ~is_synswitch=false, ~co_ctx=e.co_ctx, ~mode=mode_pat, - ~parent_id=Some(UExp.rep_id(e.term)), + ~bound_exp_id=Some(UExp.rep_id(e.term)), p, m, ); @@ -403,7 +403,7 @@ and uexp_to_info_map = ~is_synswitch=true, ~co_ctx=CoCtx.empty, ~mode=Syn, - ~parent_id=Some(UExp.rep_id(def)), + ~bound_exp_id=Some(UExp.rep_id(def)), p, m, ); @@ -415,7 +415,7 @@ and uexp_to_info_map = ~is_synswitch=false, ~co_ctx=CoCtx.empty, ~mode=Ana(def.ty), - ~parent_id=Some(UExp.rep_id(def.term)), + ~bound_exp_id=Some(UExp.rep_id(def.term)), p, m, ); @@ -426,7 +426,7 @@ and uexp_to_info_map = ~is_synswitch=false, ~co_ctx=body.co_ctx, ~mode=Ana(def.ty), - ~parent_id=Some(UExp.rep_id(def.term)), + ~bound_exp_id=Some(UExp.rep_id(def.term)), p, m, ); @@ -581,7 +581,7 @@ and upat_to_info_map = ~ancestors: Info.ancestors, ~mode: Mode.t=Mode.Syn, ~annot_pat: bool=false, - ~parent_id: option(Id.t)=None, + ~bound_exp_id: option(Id.t)=None, {ids, term} as upat: UPat.t, m: Map.t, ) @@ -611,7 +611,7 @@ and upat_to_info_map = ~is_synswitch, ~ancestors, ~co_ctx, - ~parent_id, + ~bound_exp_id, ~annot_pat, ); let unknown = Typ.Unknown(ExpHole(Internal, id), is_synswitch); @@ -671,7 +671,7 @@ and upat_to_info_map = may be SynSwitch, but SynSwitch is never added to the context; Internal is used in this case */ let hole_reason: Typ.hole_reason = - switch (annot_pat, parent_id) { + switch (annot_pat, bound_exp_id) { | (false, Some(id)) => PatternVar(id) | _ => Internal }; @@ -720,7 +720,7 @@ and upat_to_info_map = ~is_synswitch, ~ancestors, ~co_ctx, - ~parent_id, + ~bound_exp_id, ~ctx, ~mode=Ana(ann.ty), ~annot_pat=true, diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 6ed514adf0..a592ec9769 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -174,17 +174,17 @@ let view_of_global_inference_info = text( occurs ? "inferred type refers to self" : "conflicting constraints", ), - Type.view(~font_metrics, typ_with_nested_conflict), + suggestion_button_of_typ(typ_with_nested_conflict), ], ) - | UnsolvedExpHole(occurs, _, [typ_with_nested_conflict]) => + | UnsolvedExpHole(occurs, id, [typ_with_nested_conflict]) => div( ~attr=clss([infoc, "typ"]), [ text( occurs ? "inferred type refers to self" : "conflicting constraints", ), - suggestion_button_of_typ(typ_with_nested_conflict), + suggestion_button_of_typ(~id=Some(id), typ_with_nested_conflict), ], ) | UnsolvedTypeHole(occurs, conflicting_typs) => From 7f60039ba3be2fa3ddfa235eec0dddbef40d8a00 Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 18 Jan 2024 00:28:14 -0500 Subject: [PATCH 119/129] Simplify CI text; fix bug where sum was being printed as prod --- src/haz3lcore/inference/InferenceResult.re | 4 ++-- src/haz3lcore/inference/PotentialTypeSet.re | 2 +- src/haz3lweb/view/CursorInspector.re | 16 ++++------------ 3 files changed, 7 insertions(+), 15 deletions(-) diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index d733652099..f61b8b6645 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -129,13 +129,13 @@ let condense = // Filter all type vars when alternatives exist, as their assigned value must be in the pts // unless an occurs failure has occurred- in that case, filter all but one variable - // Why: + // Why: // Unlike holes, consistency of a type variable and another nonhole type requires equality to it // * Suppose the occurs check failed and our solution S = {a, {b} -> S, c}. // a and {b} -> S cannot be equal as doing so triggers unbound expansion. // Therefore, both must different possible suggestions. // * Suppose the occurs check was passed and our solution S = {c, {b} -> {a}}. - // c and {b} -> {a} can be treated as equivalent without issue + // c and {b} -> {a} can be treated as equivalent without issue // (this is barring transitively generated inconsistencies which may on their own cause multiple suggestions) // We choose to suggest {b} -> {a} as it is more specific (and therefore arguably more helpful) let filter_redundant_vars = diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index 3e1caf32d1..22adb043c5 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -76,7 +76,7 @@ let rec ityp_to_potential_typ: ITyp.t => potential_typ = ) | Sum(ty1, ty2) => Binary( - CProd, + CSum, [ityp_to_potential_typ(ty1)], [ityp_to_potential_typ(ty2)], ) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index a592ec9769..f93ffbef03 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -187,27 +187,19 @@ let view_of_global_inference_info = suggestion_button_of_typ(~id=Some(id), typ_with_nested_conflict), ], ) - | UnsolvedTypeHole(occurs, conflicting_typs) => + | UnsolvedTypeHole(_, conflicting_typs) => div( ~attr=clss([infoc, "typ"]), [ - text( - occurs - ? "inferred type may refer to self and contains conflicting constraints" - : "conflicting constraints", - ), + text("conflicting constraints"), ...List.map(suggestion_button_of_typ, conflicting_typs), ], ) - | UnsolvedExpHole(occurs, id, conflicting_typs) => + | UnsolvedExpHole(_, id, conflicting_typs) => div( ~attr=clss([infoc, "typ"]), [ - text( - occurs - ? "inferred type may refer to self and contains conflicting constraints" - : "conflicting constraints", - ), + text("conflicting constraints"), ...List.map( suggestion_button_of_typ(~id=Some(id)), conflicting_typs, From 6ce7dc7e0be047597e6d409af6c334637a3e620a Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 18 Jan 2024 01:00:38 -0500 Subject: [PATCH 120/129] Add names when ityps are made into sum types based on position --- src/haz3lcore/inference/ITyp.re | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index 83f661dd16..2b3ce1d742 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -65,21 +65,29 @@ let rec_type_constraints = (typs: list(Typ.t)): constraints => { List.filter_map(is_rec_type, typs); }; -let rec ityp_to_typ: t => Typ.t = - fun +let rec ityp_to_typ_ = (prefix, t): Typ.t => { + let go = ityp_to_typ_(prefix); + switch (t) { | Unknown(prov) => Unknown(prov, false) | Int => Int | Float => Float | Bool => Bool | String => String - | List(ity) => List(ityp_to_typ(ity)) - | Arrow(t1, t2) => Arrow(ityp_to_typ(t1), ityp_to_typ(t2)) + | List(ity) => List(go(ity)) + | Arrow(t1, t2) => Arrow(go(t1), go(t2)) | Sum(t1, t2) => - Sum([("", Some(ityp_to_typ(t1))), ("", Some(ityp_to_typ(t2)))]) + let prefix_l = prefix ++ "L"; + let prefix_r = prefix ++ "R"; + Sum([ + (prefix_l, Some(ityp_to_typ_(prefix_l, t1))), + (prefix_r, Some(ityp_to_typ_(prefix_r, t2))), + ]); | Unit => Prod([]) | Var(name) => Var(name) - | Prod(t1, t2) => - Prod([ityp_to_typ(t1)] @ (t2 |> ityp_to_typ |> unwrap_if_prod)); + | Prod(t1, t2) => Prod([go(t1)] @ (t2 |> go |> unwrap_if_prod)) + }; +}; +let ityp_to_typ = ityp_to_typ_(""); let to_ityp_constraints = (constraints: Typ.constraints): constraints => { constraints From c765aac679e9fd2ca08a2d8e54bcb8419aea31c4 Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 18 Jan 2024 01:31:58 -0500 Subject: [PATCH 121/129] Fix stack overflow issue when nullary sum occurs --- src/haz3lcore/inference/ITyp.re | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index 2b3ce1d742..0ecb24af6f 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -29,22 +29,15 @@ let rec typ_to_ityp: Typ.t => t = | List(tys) => List(typ_to_ityp(tys)) | Arrow(t1, t2) => Arrow(typ_to_ityp(t1), typ_to_ityp(t2)) | Prod([single]) => typ_to_ityp(single) + | Sum([]) => Unit | Sum([sum_entry]) => constructor_binding_to_ityp(sum_entry) - | Sum(sum_entries) => { - let (hd_ityp, tl_entries) = unroll_constructor_map(sum_entries); - Sum(hd_ityp, typ_to_ityp(Sum(tl_entries))); - } + | Sum([hd, ...tl]) => + Sum(constructor_binding_to_ityp(hd), typ_to_ityp(Sum(tl))) | Prod([hd_ty, ...tl_tys]) => Prod(typ_to_ityp(hd_ty), typ_to_ityp(Prod(tl_tys))) | Prod([]) => Unit | Rec(_, ty_body) => typ_to_ityp(ty_body) | Var(name) => Var(name) -and unroll_constructor_map = (sum_map: ConstructorMap.t(option(Typ.t))) => { - switch (sum_map) { - | [] => (Unknown(NoProvenance), []) - | [hd_entry, ...tl] => (constructor_binding_to_ityp(hd_entry), tl) - }; -} and constructor_binding_to_ityp = sum_entry => { sum_entry |> snd |> Util.OptUtil.get(() => Typ.Prod([])) |> typ_to_ityp; }; From e263e23f962afdff17db6e4bb94b6d1c596b2d2a Mon Sep 17 00:00:00 2001 From: RaefM Date: Thu, 18 Jan 2024 01:44:19 -0500 Subject: [PATCH 122/129] fix ambiguous parens on sums in arrows --- src/haz3lcore/statics/TypBase.re | 25 ++++++++++++++----------- src/haz3lweb/view/Type.re | 25 ++++++++++++++----------- 2 files changed, 28 insertions(+), 22 deletions(-) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 44b834b65a..6631b887de 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -317,17 +317,20 @@ module rec Typ: { ) ++ ")" | Sum(ctr_map) => - switch (ctr_map) { - | [] => "Nullary Sum" - | [t0] => "+" ++ ctr_to_string(is_left_child, t0, debug) - | [t0, ...ts] => - List.fold_left( - (acc, hd) => - acc ++ " + " ++ ctr_to_string(is_left_child, hd, debug), - ctr_to_string(is_left_child, t0, debug), - ts, - ) - } + ( + switch (ctr_map) { + | [] => "Nullary Sum" + | [t0] => "+" ++ ctr_to_string(is_left_child, t0, debug) + | [t0, ...ts] => + List.fold_left( + (acc, hd) => + acc ++ " + " ++ ctr_to_string(is_left_child, hd, debug), + ctr_to_string(is_left_child, t0, debug), + ts, + ) + } + ) + |> parenthesize_if_left_child | Rec(var, body) => "Rec " ++ var diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 64695b4d1a..6b604ef043 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -98,17 +98,20 @@ let rec view_ty = ) | Sum(ts) => let ctr_view' = ctr_view(~font_metrics, ~with_cls); - div( - ~attr=clss(["typ-view", "Sum"]), - switch (ts) { - | [] => [text("Nullary Sum")] - | [t0] => [text("+")] @ ctr_view'(t0) - | [t0, ...ts] => - let ts_views = - List.map(t => [text(" + ")] @ ctr_view'(t), ts) |> List.flatten; - ctr_view'(t0) @ ts_views; - }, - ); + [ + div( + ~attr=clss(["typ-view", "Sum"]), + switch (ts) { + | [] => [text("Nullary Sum")] + | [t0] => [text("+")] @ ctr_view'(t0) + | [t0, ...ts] => + let ts_views = + List.map(t => [text(" + ")] @ ctr_view'(t), ts) |> List.flatten; + ctr_view'(t0) @ ts_views; + }, + ), + ] + |> parenthesize_if_left_child; }; } and ctr_view = (~font_metrics, ~with_cls, (ctr, typ)) => From 76c382eb80868c5b759a3203e87a618f9ef65cf5 Mon Sep 17 00:00:00 2001 From: RaefM Date: Mon, 22 Jan 2024 01:23:53 -0500 Subject: [PATCH 123/129] merge updated nut menu --- src/haz3lcore/dynamics/Builtin.re | 69 ------- src/haz3lcore/dynamics/Builtin.rei | 30 --- src/haz3lcore/dynamics/Builtins.re | 122 +++++++------ src/haz3lcore/dynamics/DH.re | 15 +- src/haz3lcore/dynamics/Elaborator.re | 1 + src/haz3lcore/dynamics/EvaluatorPost.re | 23 ++- src/haz3lcore/dynamics/PatternMatch.re | 3 + src/haz3lcore/dynamics/Substitution.re | 7 +- src/haz3lcore/dynamics/Transition.re | 28 ++- src/haz3lweb/Log.re | 1 - src/haz3lweb/Update.re | 5 - src/haz3lweb/UpdateAction.re | 1 - src/haz3lweb/view/DebugMode.re | 22 +-- src/haz3lweb/view/ExerciseMode.re | 182 +++++++++---------- src/haz3lweb/view/Icons.re | 37 ++++ src/haz3lweb/view/NutMenu.re | 141 ++++++++++++++ src/haz3lweb/view/Page.re | 140 +------------- src/haz3lweb/view/ScratchMode.re | 81 ++++----- src/haz3lweb/view/Widgets.re | 21 +++ src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re | 25 ++- src/haz3lweb/www/style.css | 93 +++++++++- 21 files changed, 552 insertions(+), 495 deletions(-) delete mode 100644 src/haz3lcore/dynamics/Builtin.re delete mode 100644 src/haz3lcore/dynamics/Builtin.rei create mode 100644 src/haz3lweb/view/NutMenu.re diff --git a/src/haz3lcore/dynamics/Builtin.re b/src/haz3lcore/dynamics/Builtin.re deleted file mode 100644 index 6e1f2f63b3..0000000000 --- a/src/haz3lcore/dynamics/Builtin.re +++ /dev/null @@ -1,69 +0,0 @@ -open Sexplib.Std; -/* Evaluator alias. */ -[@deriving (show({with_path: false}), sexp, yojson)] -type evaluate = (ClosureEnvironment.t, DHExp.t) => DHExp.t; -[@deriving (show({with_path: false}), sexp, yojson)] -type args = list(DHExp.t); -[@deriving (show({with_path: false}), sexp, yojson)] -type builtin_evaluate = args => DHExp.t; -[@deriving (show({with_path: false}), sexp, yojson)] -type t = { - typ: Typ.t, - eval: builtin_evaluate, - elab: DHExp.t, -}; - -let mk_elab = (name: Var.t, typ: Typ.t): DHExp.t => { - let rec mk_elab_inner = - (typ': Typ.t, n: int, bindings: list(Var.t)): DHExp.t => { - switch (typ') { - | Arrow(_, typ'') => - let var = "x" ++ string_of_int(n); - Fun( - Var(var), - typ', - Closure( - ClosureEnvironment.of_environment(Environment.empty), - mk_elab_inner(typ'', n + 1, [var, ...bindings]), - ), - Some(name), - ); - | _ => - let bindings = List.rev_map(x => DHExp.BoundVar(x), bindings); - ApBuiltin(name, bindings); - }; - }; - mk_elab_inner(typ, 0, []); -}; -let mk = (name: Var.t, typ: Typ.t, eval: builtin_evaluate): t => { - let elab = mk_elab(name, typ); - {typ, eval, elab}; -}; - -let mk_zero = (name: Var.t, typ: Typ.t, v: DHExp.t): t => { - let fn = args => { - switch (args) { - | [] => v - | _ => raise(EvaluatorError.Exception(BadBuiltinAp(name, args))) - }; - }; - mk(name, typ, fn); -}; -let mk_one = (name: Var.t, typ: Typ.t, fn: DHExp.t => DHExp.t): t => { - let fn = args => { - switch (args) { - | [r1] => fn(r1) - | _ => raise(EvaluatorError.Exception(BadBuiltinAp(name, args))) - }; - }; - mk(name, typ, fn); -}; -let mk_two = (name: Var.t, ty: Typ.t, fn: (DHExp.t, DHExp.t) => DHExp.t): t => { - let fn = args => { - switch (args) { - | [r1, r2] => fn(r1, r2) - | _ => raise(EvaluatorError.Exception(BadBuiltinAp(name, args))) - }; - }; - mk(name, ty, fn); -}; diff --git a/src/haz3lcore/dynamics/Builtin.rei b/src/haz3lcore/dynamics/Builtin.rei deleted file mode 100644 index 6e302b1965..0000000000 --- a/src/haz3lcore/dynamics/Builtin.rei +++ /dev/null @@ -1,30 +0,0 @@ -[@deriving (show({with_path: false}), sexp, yojson)] -type evaluate = (ClosureEnvironment.t, DHExp.t) => DHExp.t; -[@deriving (show({with_path: false}), sexp, yojson)] -type args = list(DHExp.t); -[@deriving (show({with_path: false}), sexp, yojson)] -type builtin_evaluate = args => DHExp.t; -[@deriving (show({with_path: false}), sexp, yojson)] -type t = { - typ: Typ.t, - eval: builtin_evaluate, - elab: DHExp.t, -}; -/* - Create a built-in function. - */ -let mk: (Var.t, Typ.t, builtin_evaluate) => t; -/* - Create a built-in constant. - */ -let mk_zero: (Var.t, Typ.t, DHExp.t) => t; -/* - Create a built-in function that takes a single argument. The given type - must be correct. - */ -let mk_one: (Var.t, Typ.t, DHExp.t => DHExp.t) => t; -/* - Create a built-in function that takes two arguments. The given type must be - correct. - */ -let mk_two: (Var.t, Typ.t, (DHExp.t, DHExp.t) => DHExp.t) => t; diff --git a/src/haz3lcore/dynamics/Builtins.re b/src/haz3lcore/dynamics/Builtins.re index 2ec3db3097..a34bf49336 100644 --- a/src/haz3lcore/dynamics/Builtins.re +++ b/src/haz3lcore/dynamics/Builtins.re @@ -10,19 +10,24 @@ open DHExp; */ [@deriving (show({with_path: false}), sexp, yojson)] -type t = VarMap.t_(Builtin.t); +type builtin = + | Const(Typ.t, DHExp.t) + | Fn(Typ.t, Typ.t, DHExp.t => DHExp.t); [@deriving (show({with_path: false}), sexp, yojson)] -type forms = VarMap.t_(Builtin.builtin_evaluate); +type t = VarMap.t_(builtin); -type pervasive = DHExp.t => DHExp.t; +[@deriving (show({with_path: false}), sexp, yojson)] +type forms = VarMap.t_(DHExp.t => DHExp.t); type result = Result.t(DHExp.t, EvaluatorError.t); let const = (name: Var.t, typ: Typ.t, v: DHExp.t, builtins: t): t => - VarMap.extend(builtins, (name, Builtin.mk_zero(name, typ, v))); -let fn = (name: Var.t, typ: Typ.t, impl: pervasive, builtins: t): t => - VarMap.extend(builtins, (name, Builtin.mk_one(name, typ, impl))); + VarMap.extend(builtins, (name, Const(typ, v))); +let fn = + (name: Var.t, t1: Typ.t, t2: Typ.t, impl: DHExp.t => DHExp.t, builtins: t) + : t => + VarMap.extend(builtins, (name, Fn(t1, t2, impl))); module Pervasives = { module Impls = { @@ -133,7 +138,7 @@ module Pervasives = { switch (convert(s)) { | Some(n) => Ok(wrap(n)) | None => - let d' = DHExp.ApBuiltin(name, [d]); + let d' = DHExp.Ap(DHExp.BuiltinFun(name), d); Ok(InvalidOperation(d', InvalidOfString)); } | d => Error(InvalidBoxedStringLit(d)), @@ -147,7 +152,11 @@ module Pervasives = { switch (d1) { | Tuple([IntLit(n), IntLit(m)]) => switch (m) { - | 0 => InvalidOperation(ApBuiltin(name, [d1]), DivideByZero) + | 0 => + InvalidOperation( + DHExp.Ap(DHExp.BuiltinFun(name), d1), + DivideByZero, + ) | _ => IntLit(n mod m) } | d1 => raise(EvaluatorError.Exception(InvalidBoxedTuple(d1))) @@ -197,7 +206,7 @@ module Pervasives = { | Tuple([StringLit(s), IntLit(idx), IntLit(len)]) as d => try(Ok(StringLit(String.sub(s, idx, len)))) { | _ => - let d' = DHExp.ApBuiltin(name, [d]); + let d' = DHExp.Ap(DHExp.BuiltinFun(name), d); Ok(InvalidOperation(d', IndexOutOfBounds)); } | d => Error(InvalidBoxedTuple(d)), @@ -214,80 +223,77 @@ module Pervasives = { |> const("pi", Float, pi) |> const("max_int", Int, max_int) |> const("min_int", Int, min_int) - |> fn("is_finite", Arrow(Float, Bool), is_finite) - |> fn("is_infinite", Arrow(Float, Bool), is_infinite) - |> fn("is_nan", Arrow(Float, Bool), is_nan) - |> fn("int_of_float", Arrow(Float, Int), int_of_float) - |> fn("float_of_int", Arrow(Int, Float), float_of_int) - |> fn("string_of_int", Arrow(Int, String), string_of_int) - |> fn("string_of_float", Arrow(Float, String), string_of_float) - |> fn("string_of_bool", Arrow(Bool, String), string_of_bool) - |> fn( - "int_of_string", - Arrow(String, Int), - int_of_string("int_of_string"), - ) + |> fn("is_finite", Float, Bool, is_finite) + |> fn("is_infinite", Float, Bool, is_infinite) + |> fn("is_nan", Float, Bool, is_nan) + |> fn("int_of_float", Float, Int, int_of_float) + |> fn("float_of_int", Int, Float, float_of_int) + |> fn("string_of_int", Int, String, string_of_int) + |> fn("string_of_float", Float, String, string_of_float) + |> fn("string_of_bool", Bool, String, string_of_bool) + |> fn("int_of_string", String, Int, int_of_string("int_of_string")) |> fn( "float_of_string", - Arrow(String, Float), + String, + Float, float_of_string("float_of_string"), ) - |> fn( - "bool_of_string", - Arrow(String, Bool), - bool_of_string("bool_of_string"), - ) - |> fn("abs", Arrow(Int, Int), abs) - |> fn("abs_float", Arrow(Float, Float), abs_float) - |> fn("ceil", Arrow(Float, Float), ceil) - |> fn("floor", Arrow(Float, Float), floor) - |> fn("exp", Arrow(Float, Float), exp) - |> fn("log", Arrow(Float, Float), log) - |> fn("log10", Arrow(Float, Float), log10) - |> fn("sqrt", Arrow(Float, Float), sqrt) - |> fn("sin", Arrow(Float, Float), sin) - |> fn("cos", Arrow(Float, Float), cos) - |> fn("tan", Arrow(Float, Float), tan) - |> fn("asin", Arrow(Float, Float), asin) - |> fn("acos", Arrow(Float, Float), acos) - |> fn("atan", Arrow(Float, Float), atan) - |> fn("mod", Arrow(Prod([Int, Int]), Int), int_mod("mod")) - |> fn("string_length", Arrow(String, Int), string_length) - |> fn( - "string_compare", - Arrow(Prod([String, String]), Int), - string_compare, - ) - |> fn("string_trim", Arrow(String, String), string_trim) + |> fn("bool_of_string", String, Bool, bool_of_string("bool_of_string")) + |> fn("abs", Int, Int, abs) + |> fn("abs_float", Float, Float, abs_float) + |> fn("ceil", Float, Float, ceil) + |> fn("floor", Float, Float, floor) + |> fn("exp", Float, Float, exp) + |> fn("log", Float, Float, log) + |> fn("log10", Float, Float, log10) + |> fn("sqrt", Float, Float, sqrt) + |> fn("sin", Float, Float, sin) + |> fn("cos", Float, Float, cos) + |> fn("tan", Float, Float, tan) + |> fn("asin", Float, Float, asin) + |> fn("acos", Float, Float, acos) + |> fn("atan", Float, Float, atan) + |> fn("mod", Prod([Int, Int]), Int, int_mod("mod")) + |> fn("string_length", String, Int, string_length) + |> fn("string_compare", Prod([String, String]), Int, string_compare) + |> fn("string_trim", String, String, string_trim) |> fn( "string_concat", - Arrow(Prod([String, List(String)]), String), + Prod([String, List(String)]), + String, string_concat, ) |> fn( "string_sub", - Arrow(Prod([String, Int, Int]), String), + Prod([String, Int, Int]), + String, string_sub("string_sub"), ); }; let ctx_init: Ctx.t = List.map( - ((name, Builtin.{typ, _})) => - Ctx.VarEntry({name, typ, id: Id.invalid}), + fun + | (name, Const(typ, _)) => Ctx.VarEntry({name, typ, id: Id.invalid}) + | (name, Fn(t1, t2, _)) => + Ctx.VarEntry({name, typ: Arrow(t1, t2), id: Id.invalid}), Pervasives.builtins, ); let forms_init: forms = - List.map( - ((name, Builtin.{eval, _})) => (name, eval), + List.filter_map( + fun + | (_, Const(_)) => None + | (name, Fn(_, _, f)) => Some((name, f)), Pervasives.builtins, ); let env_init: Environment.t = List.fold_left( - (env, (name, Builtin.{elab, _})) => - Environment.extend(env, (name, elab)), + env => + fun + | (name, Const(_, d)) => Environment.extend(env, (name, d)) + | (name, Fn(_)) => Environment.extend(env, (name, BuiltinFun(name))), Environment.empty, Pervasives.builtins, ); diff --git a/src/haz3lcore/dynamics/DH.re b/src/haz3lcore/dynamics/DH.re index 9b9ed39417..92b5ab5c1a 100644 --- a/src/haz3lcore/dynamics/DH.re +++ b/src/haz3lcore/dynamics/DH.re @@ -16,7 +16,8 @@ module rec DHExp: { | FixF(Var.t, Typ.t, t) | Fun(DHPat.t, Typ.t, t, option(Var.t)) | Ap(t, t) - | ApBuiltin(string, list(t)) + | ApBuiltin(string, t) + | BuiltinFun(string) | Test(KeywordID.t, t) | BoolLit(bool) | IntLit(int) @@ -70,7 +71,8 @@ module rec DHExp: { | FixF(Var.t, Typ.t, t) | Fun(DHPat.t, Typ.t, t, option(Var.t)) | Ap(t, t) - | ApBuiltin(string, list(t)) + | ApBuiltin(string, t) + | BuiltinFun(string) | Test(KeywordID.t, t) | BoolLit(bool) | IntLit(int) @@ -110,6 +112,7 @@ module rec DHExp: { | Closure(_, _) => "Closure" | Ap(_, _) => "Ap" | ApBuiltin(_, _) => "ApBuiltin" + | BuiltinFun(_) => "BuiltinFun" | Test(_) => "Test" | BoolLit(_) => "BoolLit" | IntLit(_) => "IntLit" @@ -170,7 +173,8 @@ module rec DHExp: { | Fun(a, b, c, d) => Fun(a, b, strip_casts(c), d) | Ap(a, b) => Ap(strip_casts(a), strip_casts(b)) | Test(id, a) => Test(id, strip_casts(a)) - | ApBuiltin(fn, args) => ApBuiltin(fn, List.map(strip_casts, args)) + | ApBuiltin(fn, args) => ApBuiltin(fn, strip_casts(args)) + | BuiltinFun(fn) => BuiltinFun(fn) | BinBoolOp(a, b, c) => BinBoolOp(a, strip_casts(b), strip_casts(c)) | BinIntOp(a, b, c) => BinIntOp(a, strip_casts(b), strip_casts(c)) | BinFloatOp(a, b, c) => BinFloatOp(a, strip_casts(b), strip_casts(c)) @@ -230,8 +234,8 @@ module rec DHExp: { List.length(ds1) == List.length(ds2) && List.for_all2(fast_equal, ds1, ds2) | (Prj(d1, n), Prj(d2, m)) => n == m && fast_equal(d1, d2) - | (ApBuiltin(f1, args1), ApBuiltin(f2, args2)) => - f1 == f2 && List.for_all2(fast_equal, args1, args2) + | (ApBuiltin(f1, d1), ApBuiltin(f2, d2)) => f1 == f2 && d1 == d2 + | (BuiltinFun(f1), BuiltinFun(f2)) => f1 == f2 | (ListLit(_, _, _, ds1), ListLit(_, _, _, ds2)) => List.for_all2(fast_equal, ds1, ds2) | (BinBoolOp(op1, d11, d21), BinBoolOp(op2, d12, d22)) => @@ -258,6 +262,7 @@ module rec DHExp: { | (Test(_), _) | (Ap(_), _) | (ApBuiltin(_), _) + | (BuiltinFun(_), _) | (Cons(_), _) | (ListConcat(_), _) | (ListLit(_), _) diff --git a/src/haz3lcore/dynamics/Elaborator.re b/src/haz3lcore/dynamics/Elaborator.re index ac133cc87b..3d94cfe940 100644 --- a/src/haz3lcore/dynamics/Elaborator.re +++ b/src/haz3lcore/dynamics/Elaborator.re @@ -94,6 +94,7 @@ let cast = (ctx: Ctx.t, id: Id.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | BoundVar(_) | Ap(_) | ApBuiltin(_) + | BuiltinFun(_) | Prj(_) | BoolLit(_) | IntLit(_) diff --git a/src/haz3lcore/dynamics/EvaluatorPost.re b/src/haz3lcore/dynamics/EvaluatorPost.re index 39d0a22cc9..658cc1501b 100644 --- a/src/haz3lcore/dynamics/EvaluatorPost.re +++ b/src/haz3lcore/dynamics/EvaluatorPost.re @@ -58,15 +58,17 @@ let rec pp_eval = (d: DHExp.t): m(DHExp.t) => let* d2' = pp_eval(d2); Ap(d1', d2') |> return; - | ApBuiltin(f, args) => - let* args' = args |> List.map(pp_eval) |> sequence; - ApBuiltin(f, args') |> return; + | ApBuiltin(f, d1) => + let* d1' = pp_eval(d1); + ApBuiltin(f, d1') |> return; | BinBoolOp(op, d1, d2) => let* d1' = pp_eval(d1); let* d2' = pp_eval(d2); BinBoolOp(op, d1', d2') |> return; + | BuiltinFun(f) => BuiltinFun(f) |> return + | BinIntOp(op, d1, d2) => let* d1' = pp_eval(d1); let* d2' = pp_eval(d2); @@ -288,9 +290,10 @@ and pp_uneval = (env: ClosureEnvironment.t, d: DHExp.t): m(DHExp.t) => let* d2' = pp_uneval(env, d2); Ap(d1', d2') |> return; - | ApBuiltin(f, args) => - let* args' = args |> List.map(pp_uneval(env)) |> sequence; - ApBuiltin(f, args') |> return; + | ApBuiltin(f, d1) => + let* d1' = pp_uneval(env, d1); + ApBuiltin(f, d1') |> return; + | BuiltinFun(f) => BuiltinFun(f) |> return | BinBoolOp(op, d1, d2) => let* d1' = pp_uneval(env, d1); @@ -436,6 +439,7 @@ let rec track_children_of_hole = | IntLit(_) | FloatLit(_) | StringLit(_) + | BuiltinFun(_) | BoundVar(_) => hii | Test(_, d) | FixF(_, _, d) @@ -481,12 +485,7 @@ let rec track_children_of_hole = track_children_of_hole_rules(hii, parent, rules) ); - | ApBuiltin(_, args) => - List.fold_right( - (arg, hii) => track_children_of_hole(hii, parent, arg), - args, - hii, - ) + | ApBuiltin(_, d) => track_children_of_hole(hii, parent, d) /* Hole types */ | NonEmptyHole(_, u, i, d) => diff --git a/src/haz3lcore/dynamics/PatternMatch.re b/src/haz3lcore/dynamics/PatternMatch.re index f30b3ec950..f72d161225 100644 --- a/src/haz3lcore/dynamics/PatternMatch.re +++ b/src/haz3lcore/dynamics/PatternMatch.re @@ -251,6 +251,7 @@ and matches_cast_Sum = | FailedCast(_, _, _) | Test(_) | InvalidOperation(_) => IndetMatch + | BuiltinFun(_) | Cast(_) | BoundVar(_) | FixF(_) @@ -342,6 +343,7 @@ and matches_cast_Tuple = | BoolLit(_) => DoesNotMatch | IntLit(_) => DoesNotMatch | Sequence(_) + | BuiltinFun(_) | Test(_) => DoesNotMatch | FloatLit(_) => DoesNotMatch | StringLit(_) => DoesNotMatch @@ -484,6 +486,7 @@ and matches_cast_Cons = | BinFloatOp(_, _, _) | BinStringOp(_) | ListConcat(_) + | BuiltinFun(_) => DoesNotMatch | BoolLit(_) => DoesNotMatch | IntLit(_) => DoesNotMatch | Sequence(_) diff --git a/src/haz3lcore/dynamics/Substitution.re b/src/haz3lcore/dynamics/Substitution.re index fe1c3ae115..27b90f5174 100644 --- a/src/haz3lcore/dynamics/Substitution.re +++ b/src/haz3lcore/dynamics/Substitution.re @@ -48,9 +48,10 @@ let rec subst_var = (d1: DHExp.t, x: Var.t, d2: DHExp.t): DHExp.t => let d3 = subst_var(d1, x, d3); let d4 = subst_var(d1, x, d4); Ap(d3, d4); - | ApBuiltin(ident, args) => - let args = List.map(subst_var(d1, x), args); - ApBuiltin(ident, args); + | ApBuiltin(ident, d1) => + let d2 = subst_var(d1, x, d1); + ApBuiltin(ident, d2); + | BuiltinFun(ident) => BuiltinFun(ident) | Test(id, d3) => Test(id, subst_var(d1, x, d3)) | BoolLit(_) | IntLit(_) diff --git a/src/haz3lcore/dynamics/Transition.re b/src/haz3lcore/dynamics/Transition.re index 1b33b30b07..a71590400d 100644 --- a/src/haz3lcore/dynamics/Transition.re +++ b/src/haz3lcore/dynamics/Transition.re @@ -53,7 +53,8 @@ type step_kind = | UpdateTest | FunAp | CastAp - | Builtin(string) + | BuiltinWrap + | BuiltinAp(string) | BinBoolOp(TermBase.UExp.op_bin_bool) | BinIntOp(TermBase.UExp.op_bin_int) | BinFloatOp(TermBase.UExp.op_bin_float) @@ -250,6 +251,18 @@ module Transition = (EV: EV_MODE) => { kind: CastAp, value: false, }) + | BuiltinFun(ident) => + Step({ + apply: () => { + //HACK[Matt]: This step is just so we can check that d2' is not indet + ApBuiltin( + ident, + d2', + ); + }, + kind: BuiltinWrap, + value: false // Not necessarily a value because of InvalidOperations + }) | _ => Step({ apply: () => { @@ -259,9 +272,9 @@ module Transition = (EV: EV_MODE) => { value: true, }) }; - | ApBuiltin(ident, args) => - let. _ = otherwise(args => ApBuiltin(ident, args)) - and. args' = req_all_value(req(state, env), 0, args); + | ApBuiltin(ident, arg) => + let. _ = otherwise(arg => ApBuiltin(ident, arg)) + and. arg' = req_value(req(state, env), 0, arg); Step({ apply: () => { let builtin = @@ -269,16 +282,17 @@ module Transition = (EV: EV_MODE) => { |> OptUtil.get(() => { raise(EvaluatorError.Exception(InvalidBuiltin(ident))) }); - builtin(args'); + builtin(arg'); }, - kind: Builtin(ident), + kind: BuiltinAp(ident), value: false // Not necessarily a value because of InvalidOperations }); | BoolLit(_) | IntLit(_) | FloatLit(_) | StringLit(_) - | Constructor(_) => + | Constructor(_) + | BuiltinFun(_) => let. _ = otherwise(d); Constructor; | BinBoolOp(And, d1, d2) => diff --git a/src/haz3lweb/Log.re b/src/haz3lweb/Log.re index c43f4f1f70..761f5a405d 100644 --- a/src/haz3lweb/Log.re +++ b/src/haz3lweb/Log.re @@ -8,7 +8,6 @@ let is_action_logged: UpdateAction.t => bool = | Save | InitImportAll(_) | InitImportScratchpad(_) - | DebugAction(_) | ExportPersistentData | FinishImportAll(_) | FinishImportScratchpad(_) diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index ecc7d1e8c0..5c0c26d263 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -162,7 +162,6 @@ let reevaluate_post_update = (settings: Settings.t) => | InitImportAll(_) | InitImportScratchpad(_) | UpdateLangDocMessages(_) - | DebugAction(_) | DoTheThing => false | ExportPersistentData | DebugConsole(_) => false @@ -244,7 +243,6 @@ let should_scroll_to_caret = | InitImportAll(_) | InitImportScratchpad(_) | UpdateLangDocMessages(_) - | DebugAction(_) | ExportPersistentData | DebugConsole(_) | Benchmark(_) => false; @@ -389,9 +387,6 @@ let rec apply = let langDocMessages = LangDocMessages.set_update(model.langDocMessages, u); Model.save_and_return({...model, langDocMessages}); - | DebugAction(a) => - DebugAction.perform(a); - Ok(model); | DebugConsole(key) => DebugConsole.print(model, key); Ok(model); diff --git a/src/haz3lweb/UpdateAction.re b/src/haz3lweb/UpdateAction.re index fc50d025c5..4ec96049df 100644 --- a/src/haz3lweb/UpdateAction.re +++ b/src/haz3lweb/UpdateAction.re @@ -45,7 +45,6 @@ type t = | Set(settings_action) | SetMeta(set_meta) | UpdateLangDocMessages(LangDocMessages.update) - | DebugAction(DebugAction.t) | ExportPersistentData | DebugConsole(string) /* editors */ diff --git a/src/haz3lweb/view/DebugMode.re b/src/haz3lweb/view/DebugMode.re index ee01231c44..0f055289da 100644 --- a/src/haz3lweb/view/DebugMode.re +++ b/src/haz3lweb/view/DebugMode.re @@ -1,9 +1,15 @@ open Virtual_dom.Vdom; -let btn = (~inject, caption, action) => { +let btn = (~inject as _, caption, action) => { Node.( button( - ~attr=Attr.many([Attr.on_click(_ => inject(action))]), + ~attr= + Attr.many([ + Attr.on_click(_ => { + DebugAction.perform(action); + Ui_effect.Ignore; + }), + ]), [text(caption)], ) ); @@ -12,16 +18,8 @@ let btn = (~inject, caption, action) => { let view = (~inject) => { Node.( div([ - btn( - ~inject, - "turn off dynamics", - UpdateAction.DebugAction(TurnOffDynamics), - ), - btn( - ~inject, - "clear local storage (LOSE ALL DATA!)", - UpdateAction.DebugAction(ClearStore), - ), + btn(~inject, "turn off dynamics", TurnOffDynamics), + btn(~inject, "clear local storage (LOSE ALL DATA!)", ClearStore), ]) ); }; diff --git a/src/haz3lweb/view/ExerciseMode.re b/src/haz3lweb/view/ExerciseMode.re index 4fa648ca0d..f9a0589a73 100644 --- a/src/haz3lweb/view/ExerciseMode.re +++ b/src/haz3lweb/view/ExerciseMode.re @@ -406,104 +406,94 @@ let view = @ bottom_bar; }; -let toolbar_buttons = (~inject, editors: Editors.t, ~settings: Settings.t) => { - let (_idx, _specs, exercise): Editors.exercises = - switch (editors) { - | Exercise(idx, specs, exercise) => (idx, specs, exercise) - | _ => assert(false) - }; - let Exercise.{pos: _, eds} = exercise; +let reset_button = inject => + Widgets.button_named( + Icons.trash, + _ => { + let confirmed = + JsUtil.confirm( + "Are you SURE you want to reset this exercise? You will lose any existing code that you have written, and course staff have no way to restore it!", + ); + if (confirmed) { + inject(UpdateAction.ResetCurrentEditor); + } else { + Virtual_dom.Vdom.Effect.Ignore; + }; + }, + ~tooltip="Reset Exercise", + ); - let reset_button = - Widgets.button( - Icons.trash, - _ => { - let confirmed = - JsUtil.confirm( - "Are you SURE you want to reset this exercise? You will lose any existing code that you have written, and course staff have no way to restore it!", - ); - if (confirmed) { - inject(Update.ResetCurrentEditor); - } else { - Virtual_dom.Vdom.Effect.Ignore; - }; - }, - ~tooltip="Reset Exercise", - ); +let instructor_export = (exercise: Exercise.state) => + Widgets.button_named( + Icons.star, + _ => { + // .ml files because show uses OCaml syntax (dune handles seamlessly) + let module_name = exercise.eds.module_name; + let filename = exercise.eds.module_name ++ ".ml"; + let content_type = "text/plain"; + let contents = Exercise.export_module(module_name, exercise); + JsUtil.download_string_file(~filename, ~content_type, ~contents); + Virtual_dom.Vdom.Effect.Ignore; + }, + ~tooltip="Export Exercise Module", + ); - let instructor_export = - settings.instructor_mode - ? Some( - Widgets.button( - Icons.export, // TODO(cyrus) distinct icon - _ => { - // .ml files because show uses OCaml syntax (dune handles seamlessly) - let module_name = eds.module_name; - let filename = eds.module_name ++ ".ml"; - let content_type = "text/plain"; - let contents = Exercise.export_module(module_name, exercise); - JsUtil.download_string_file( - ~filename, - ~content_type, - ~contents, - ); - Virtual_dom.Vdom.Effect.Ignore; - }, - ~tooltip="Export Exercise Module (Instructor Mode)", - ), - ) - : None; +let instructor_transitionary_export = (exercise: Exercise.state) => + Widgets.button_named( + Icons.star, + _ => { + // .ml files because show uses OCaml syntax (dune handles seamlessly) + let module_name = exercise.eds.module_name; + let filename = exercise.eds.module_name ++ ".ml"; + let content_type = "text/plain"; + let contents = + Exercise.export_transitionary_module(module_name, exercise); + JsUtil.download_string_file(~filename, ~content_type, ~contents); + Virtual_dom.Vdom.Effect.Ignore; + }, + ~tooltip="Export Transitionary Exercise Module", + ); - let instructor_transitionary_export = - settings.instructor_mode - ? Some( - Widgets.button( - Icons.export, // TODO(cyrus) distinct icon - _ => { - // .ml files because show uses OCaml syntax (dune handles seamlessly) - let module_name = eds.module_name; - let filename = eds.module_name ++ ".ml"; - let content_type = "text/plain"; - let contents = - Exercise.export_transitionary_module(module_name, exercise); - JsUtil.download_string_file( - ~filename, - ~content_type, - ~contents, - ); - Virtual_dom.Vdom.Effect.Ignore; - }, - ~tooltip="Export Transitionary Exercise Module (Instructor Mode)", - ), - ) - : None; +let instructor_grading_export = (exercise: Exercise.state) => + Widgets.button_named( + Icons.star, + _ => { + // .ml files because show uses OCaml syntax (dune handles seamlessly) + let module_name = exercise.eds.module_name; + let filename = exercise.eds.module_name ++ "_grading.ml"; + let content_type = "text/plain"; + let contents = Exercise.export_grading_module(module_name, exercise); + JsUtil.download_string_file(~filename, ~content_type, ~contents); + Virtual_dom.Vdom.Effect.Ignore; + }, + ~tooltip="Export Grading Exercise Module", + ); - let instructor_grading_export = - settings.instructor_mode - ? Some( - Widgets.button( - Icons.export, // TODO(cyrus) distinct icon - _ => { - // .ml files because show uses OCaml syntax (dune handles seamlessly) - let module_name = eds.module_name; - let filename = eds.module_name ++ "_grading.ml"; - let content_type = "text/plain"; - let contents = - Exercise.export_grading_module(module_name, exercise); - JsUtil.download_string_file( - ~filename, - ~content_type, - ~contents, - ); - Virtual_dom.Vdom.Effect.Ignore; - }, - ~tooltip="Export Grading Exercise Module (Instructor Mode)", - ), - ) - : None; +let download_editor_state = (~instructor_mode) => + Log.get_and(log => { + let data = Export.export_all(~instructor_mode, ~log); + JsUtil.download_json(ExerciseSettings.filename, data); + }); - [reset_button] - @ Option.to_list(instructor_export) - @ Option.to_list(instructor_transitionary_export) - @ Option.to_list(instructor_grading_export); -}; +let export_submission = (~settings: Settings.t) => + Widgets.button_named( + Icons.star, + _ => { + download_editor_state(~instructor_mode=settings.instructor_mode); + Virtual_dom.Vdom.Effect.Ignore; + }, + ~tooltip="Export Submission", + ); + +let import_submission = (~inject) => + Widgets.file_select_button_named( + "import-submission", + Icons.star, + file => { + switch (file) { + | None => Virtual_dom.Vdom.Effect.Ignore + | Some(file) => inject(UpdateAction.InitImportAll(file)) + } + }, + ~tooltip="Import Submission", + ); diff --git a/src/haz3lweb/view/Icons.re b/src/haz3lweb/view/Icons.re index 543690448f..9211c98f45 100644 --- a/src/haz3lweb/view/Icons.re +++ b/src/haz3lweb/view/Icons.re @@ -33,6 +33,43 @@ let simple_icon = (~transform="", ~view: string, ds: list(string)) => ), ); +let gear = + simple_icon( + ~view="0 0 1200 1200", + [ + "m1193.2 690.95c4.4883-29.664 6.8281-60.047 6.8281-90.961 0-30.91-2.3398-61.273-6.8281-90.938l-151.37-74.305c-3.8398-10.262-8.0156-20.363-12.562-30.266l54.469-159.52c-36.109-49.148-79.527-92.566-128.66-128.67l-159.53 54.469c-9.8984-4.5234-19.992-8.7109-30.266-12.551l-74.301-151.36c-29.664-4.5234-60.051-6.8516-90.961-6.8516s-61.285 2.3281-90.949 6.8516l-74.305 151.36c-10.262 3.8398-20.352 8.0273-30.266 12.551l-159.52-54.465c-49.129 36.109-92.543 79.535-128.66 128.66l54.457 159.52c-4.5117 9.8984-8.6875 20.004-12.539 30.266l-151.36 74.312c-4.5117 29.664-6.8516 60.023-6.8516 90.938 0 30.91 2.3398 61.297 6.8516 90.961l151.36 74.305c3.8516 10.262 8.0273 20.352 12.539 30.277l-54.453 159.51c36.121 49.129 79.535 92.543 128.66 128.68l159.52-54.457c9.9102 4.5117 20.004 8.6875 30.266 12.527l74.305 151.37c29.672 4.5039 60.047 6.8438 90.957 6.8438s61.297-2.3398 90.961-6.8398l74.293-151.37c10.273-3.8398 20.363-8.0156 30.289-12.527l159.5 54.457c49.129-36.133 92.543-79.547 128.65-128.68l-54.461-159.51c4.5469-9.9258 8.7227-20.016 12.562-30.277zm-593.17 48.516c-77.016 0-139.44-62.449-139.44-139.48 0-77.016 62.426-139.45 139.44-139.45s139.48 62.438 139.48 139.45c0 77.027-62.461 139.48-139.48 139.48z", + ], + ); + +let info = + simple_icon( + ~view="0 0 1200 1200", + [ + "m1120.5 531.75c-17.062-130.24-82.332-249.36-182.92-333.83-100.59-84.477-229.19-128.18-360.42-122.48-131.23 5.7031-255.56 60.395-348.44 153.28s-147.57 217.21-153.28 348.44c-5.6992 131.23 38 259.83 122.48 360.42 84.477 100.59 203.59 165.86 333.83 182.92 106.75 13.984 215.22-5.1875 310.71-54.922 95.488-49.734 173.38-127.62 223.11-223.11 49.734-95.492 68.906-203.96 54.922-310.71zm-445.5 317.25c0 26.793-14.293 51.555-37.5 64.953-23.207 13.395-51.793 13.395-75 0-23.207-13.398-37.5-38.16-37.5-64.953v-225c0-26.793 14.293-51.555 37.5-64.953 23.207-13.395 51.793-13.395 75 0 23.207 13.398 37.5 38.16 37.5 64.953zm-75-423c-19.891 0-38.969-7.9023-53.031-21.969-14.066-14.062-21.969-33.141-21.969-53.031s7.9023-38.969 21.969-53.031c14.062-14.066 33.141-21.969 53.031-21.969s38.969 7.9023 53.031 21.969c14.066 14.062 21.969 33.141 21.969 53.031s-7.9023 38.969-21.969 53.031c-14.062 14.066-33.141 21.969-53.031 21.969z", + ], + ); + +let star = + simple_icon( + ~view="0 0 1200 1200", + [ + "m1045.2 459.6-270-57.602-136.8-238.8c-16.801-28.801-58.801-28.801-75.602 0l-138 238.8-270 57.602c-32.398 7.1992-45.602 46.801-24 72l184.8 205.2-28.801 273.6c-3.6016 33.598 30 57.598 61.199 44.398l252-111.6 252 111.6c31.199 13.199 64.801-10.801 61.199-44.398l-28.801-273.6 184.8-205.2c21.602-25.203 9.6016-64.801-24-72z", + ], + ); + +let bomb = + simple_icon( + ~view="0 0 1200 1200", + [ + "m700.88 364.88v-94.312c0-10.5-8.4375-18.75-18.75-18.75h-98.812c1.3125-22.5 9.5625-94.688 61.5-123.19 52.688-29.062 140.25-6.1875 253.31 66.375 8.625 5.625 20.25 3.1875 25.875-5.625 5.625-8.625 3-20.25-5.625-25.875-127.12-81.562-225.38-104.44-291.94-67.688-70.312 38.812-79.5 129.75-80.625 156h-99c-10.312 0-18.75 8.25-18.75 18.75v92.438c0 0.5625 0 1.3125 0.1875 1.875-153.19 55.688-262.69 202.69-262.69 374.81 0 219.94 178.88 398.81 398.81 398.81s399-178.88 399-398.81c0-171.94-109.5-318.75-262.5-374.81zm-82.688 90.75c-9.9375-3.1875-15.375-13.688-12.375-23.625 3.1875-9.75 13.688-15.375 23.438-12.188 2.8125 0.9375 279 90.75 237.75 385.31-1.3125 9.375-9.375 16.125-18.562 16.125-0.9375 0-1.6875 0-2.625-0.1875-10.312-1.3125-17.438-10.875-15.938-21 36.938-263.62-201.56-341.25-211.69-344.44z", + "m893.25 244.88-30.562 29.25c-3.5625 3.5625-8.25 5.25-12.938 5.25-4.875 0-9.9375-1.875-13.5-5.8125-7.3125-7.5-6.9375-19.312 0.5625-26.438l30.562-29.25c7.5-7.3125 19.5-6.9375 26.625 0.5625s6.75 19.312-0.75 26.438z", + "m958.31 83.25-6.75 41.625c-1.3125 9.375-9.375 15.75-18.375 15.75-0.9375 0-2.0625 0-3-0.1875-10.312-1.6875-17.25-11.25-15.562-21.375l6.75-41.812c1.6875-10.312 11.438-17.25 21.562-15.562s17.062 11.25 15.375 21.562z", + "m1028.4 249.94c-3.5625 4.5-9 6.9375-14.625 6.9375-4.125 0-8.25-1.3125-11.625-4.125l-33-26.438c-8.0625-6.5625-9.375-18.375-2.8125-26.438 6.375-8.0625 18.188-9.375 26.25-2.8125l33 26.438c8.0625 6.5625 9.375 18.375 2.8125 26.438z", + "m1023.6 155.06-38.438 17.812c-2.4375 1.125-5.25 1.6875-7.875 1.6875-6.9375 0-13.875-4.125-17.062-10.875-4.3125-9.375-0.1875-20.625 9.1875-24.938l38.438-17.812c9.375-4.3125 20.625-0.1875 24.938 9.1875s0.1875 20.625-9.1875 24.938z", + "m956.62 284.06c0.75 10.312-7.125 19.312-17.438 19.875-0.5625 0.1875-0.9375 0.1875-1.3125 0.1875-9.75 0-18-7.6875-18.75-17.625l-2.8125-42.188c-0.5625-10.312 7.125-19.312 17.625-19.875 10.312-0.75 19.125 7.125 19.875 17.438z", + ], + ); + let export = simple_icon( ~view="0 0 67.671 67.671", diff --git a/src/haz3lweb/view/NutMenu.re b/src/haz3lweb/view/NutMenu.re new file mode 100644 index 0000000000..931a39da95 --- /dev/null +++ b/src/haz3lweb/view/NutMenu.re @@ -0,0 +1,141 @@ +open Virtual_dom.Vdom; +open Js_of_ocaml; +open Node; +open Util.Web; +open Widgets; + +let export_persistent_data = (~inject: Update.t => 'a) => + button_named( + Icons.sprout, + _ => inject(ExportPersistentData), + ~tooltip="Export All Persistent Data", + ); + +let reset_hazel_button = + button( + Icons.bomb, + _ => { + let confirmed = + JsUtil.confirm( + "Are you SURE you want to reset Hazel to its initial state? You will lose any existing code that you have written, and course staff have no way to restore it!", + ); + if (confirmed) { + DebugAction.perform(DebugAction.ClearStore); + Dom_html.window##.location##reload; + Virtual_dom.Vdom.Effect.Ignore; + } else { + Virtual_dom.Vdom.Effect.Ignore; + }; + }, + ~tooltip="Clear Local Storage and Reload (LOSE ALL DATA)", + ); + +let settings_menu = + ( + ~inject: Update.t => 'a, + { + core: {statics, elaborate, assist, dynamics, inference}, + benchmark, + secondary_icons, + _, + }: Settings.t, + ) => { + let set = (icon, tooltip, bool, setting) => + toggle_named(icon, ~tooltip, bool, _ => + inject(UpdateAction.Set(setting)) + ); + div( + ~attr=clss(["submenu", "settings"]), + [ + set("τ", "Toggle Statics", statics, Statics), + set("⇲", "Toggle Completion", assist, Assist), + set("𝛿", "Toggle Dynamics", dynamics, Dynamics), + set("∪", "Toggle Inference", inference, Inference), + set("𝑒", "Show Elaboration", elaborate, Elaborate), + set("↵", "Show Whitespace", secondary_icons, SecondaryIcons), + set("✓", "Print Benchmarks", benchmark, Benchmark), + ], + ); +}; + +let export_menu = (~inject, ~settings: Settings.t, editors: Editors.t) => + div( + ~attr=clss(["submenu", "export"]), + switch (editors) { + | DebugLoad => [] + | Scratch(slide_idx, slides) => + let state = List.nth(slides, slide_idx); + [ScratchMode.export_button(state)]; + | Examples(name, slides) => + let state = List.assoc(name, slides); + [ScratchMode.export_button(state)]; + | Exercise(_, _, exercise) when settings.instructor_mode => [ + export_persistent_data(~inject), + ExerciseMode.export_submission(~settings), + ExerciseMode.instructor_export(exercise), + ExerciseMode.instructor_transitionary_export(exercise), + ExerciseMode.instructor_grading_export(exercise), + ] + | Exercise(_) => [ExerciseMode.export_submission(~settings)] + }, + ); + +let import_menu = (~inject, editors: Editors.t) => + div( + ~attr=clss(["submenu", "export"]), + switch (editors) { + | DebugLoad => [] + | Scratch(_) + | Examples(_) => [ + ScratchMode.import_button(inject), + ScratchMode.reset_button(inject), + ] + | Exercise(_) => [ + ExerciseMode.import_submission(~inject), + ExerciseMode.reset_button(inject), + ] + }, + ); + +let submenu = (~tooltip, ~icon, menu) => + div( + ~attr=clss(["top-menu-item"]), + [ + div( + ~attr=Attr.many([clss(["menu-item-iconic"]), Attr.title(tooltip)]), + [div(~attr=Attr.many([clss(["icon"])]), [icon])], + ), + menu, + ], + ); + +let view = (~inject: Update.t => 'a, {settings, editors, _}: Model.t) => [ + a(~attr=clss(["menu-icon"]), [Icons.hazelnut]), + div( + ~attr=clss(["menu"]), + [ + submenu( + ~tooltip="Settings", + ~icon=Icons.gear, + settings_menu(~inject, settings), + ), + submenu( + ~tooltip="Export", + ~icon=Icons.export, + export_menu(~inject, ~settings, editors), + ), + submenu( + ~tooltip="Import", + ~icon=Icons.import, + import_menu(~inject, editors), + ), + reset_hazel_button, + link( + Icons.github, + "https://github.com/hazelgrove/hazel", + ~tooltip="Hazel on GitHub", + ), + link(Icons.info, "https://hazel.org", ~tooltip="Hazel Homepage"), + ], + ), +]; diff --git a/src/haz3lweb/view/Page.re b/src/haz3lweb/view/Page.re index ec759e78aa..99df9a9a5f 100644 --- a/src/haz3lweb/view/Page.re +++ b/src/haz3lweb/view/Page.re @@ -1,133 +1,18 @@ open Virtual_dom.Vdom; open Js_of_ocaml; open Node; -open Util.Web; open Haz3lcore; -open Widgets; - -let download_editor_state = (~instructor_mode) => - Log.get_and(log => { - let data = Export.export_all(~instructor_mode, ~log); - JsUtil.download_json(ExerciseSettings.filename, data); - }); - -let menu_icon = { - let attr = - Attr.many( - Attr.[ - clss(["menu-icon"]), - href("https://hazel.org"), - title("Hazel"), - create("target", "_blank"), - ], - ); - a(~attr, [Icons.hazelnut]); -}; - -let history_bar = (ed: Editor.t, ~inject: Update.t => 'a) => [ - button_d( - Icons.undo, - inject(Undo), - ~disabled=!Editor.can_undo(ed), - ~tooltip="Undo", - ), - button_d( - Icons.redo, - inject(Redo), - ~disabled=!Editor.can_redo(ed), - ~tooltip="Redo", - ), -]; - -let nut_menu = - ( - ~inject: Update.t => 'a, - { - core: {statics, elaborate, assist, dynamics, inference}, - benchmark, - instructor_mode, - _, - }: Settings.t, - ) => [ - menu_icon, - div( - ~attr=clss(["menu"]), - [ - toggle("τ", ~tooltip="Toggle Statics", statics, _ => - inject(Set(Statics)) - ), - toggle("𝑐", ~tooltip="Code Completion", assist, _ => - inject(Set(Assist)) - ), - toggle("𝛿", ~tooltip="Toggle Dynamics", dynamics, _ => - inject(Set(Dynamics)) - ), - toggle("𝑒", ~tooltip="Show Elaboration", elaborate, _ => - inject(Set(Elaborate)) - ), - toggle("∪", ~tooltip="Toggle Inference", inference, _ => - inject(Set(Inference)) - ), - toggle("b", ~tooltip="Toggle Performance Benchmark", benchmark, _ => - inject(Set(Benchmark)) - ), - button( - Icons.export, - _ => { - download_editor_state(~instructor_mode); - Virtual_dom.Vdom.Effect.Ignore; - }, - ~tooltip="Export Submission", - ), - file_select_button( - "import-submission", - Icons.import, - file => { - switch (file) { - | None => Virtual_dom.Vdom.Effect.Ignore - | Some(file) => inject(InitImportAll(file)) - } - }, - ~tooltip="Import Submission", - ), - button( - Icons.eye, - _ => inject(Set(SecondaryIcons)), - ~tooltip="Toggle Visible Secondary", - ), - link( - Icons.github, - "https://github.com/hazelgrove/hazel", - ~tooltip="Hazel on GitHub", - ), - ] - @ ( - instructor_mode - ? [ - button( - Icons.sprout, - _ => inject(ExportPersistentData), - ~tooltip="Export Persistent Data", - ), - ] - : [] - ), - ), -]; let top_bar_view = ( ~inject: Update.t => 'a, - ~toolbar_buttons: list(Node.t), - ~model as {editors, settings, _}: Model.t, + ~model as {editors, settings, _} as model: Model.t, ) => div( ~attr=Attr.id("top-bar"), - nut_menu(~inject, settings) + NutMenu.view(~inject, model) @ [div(~attr=Attr.id("title"), [text("hazel")])] - @ [EditorModeView.view(~inject, ~settings, ~editors)] - @ history_bar(Editors.get_editor(editors), ~inject) - @ toolbar_buttons, + @ [EditorModeView.view(~inject, ~settings, ~editors)], ); let exercises_view = @@ -153,11 +38,6 @@ let exercises_view = ~results=settings.core.dynamics ? Some(results) : None, ~langDocMessages, ); - let toolbar_buttons = - ExerciseMode.toolbar_buttons(~inject, ~settings, editors) - @ [ - Grading.GradingReport.view_overall_score(exercise_mode.grading_report), - ]; let zipper = Editors.get_editor(editors).state.zipper; let unselected = Zipper.unselect_and_zip(zipper); let (term, _) = MakeTerm.go(unselected); @@ -167,7 +47,8 @@ let exercises_view = model.settings.core.inference, suggestions, ); - [top_bar_view(~inject, ~model, ~toolbar_buttons)] + [top_bar_view(~inject, ~model)] + @ [Grading.GradingReport.view_overall_score(exercise_mode.grading_report)] @ ExerciseMode.view( ~inject, ~font_metrics, @@ -178,9 +59,8 @@ let exercises_view = ); }; -let slide_view = (~inject, ~model, ~ctx_init, slide_state) => { - let toolbar_buttons = ScratchMode.toolbar_buttons(~inject, slide_state); - [top_bar_view(~inject, ~toolbar_buttons, ~model)] +let slide_view = (~inject, ~model, ~ctx_init) => { + [top_bar_view(~inject, ~model)] @ ScratchMode.view(~inject, ~model, ~ctx_init); }; @@ -189,10 +69,8 @@ let editors_view = (~inject, model: Model.t) => { Editors.get_ctx_init(~settings=model.settings, model.editors); switch (model.editors) { | DebugLoad => [DebugMode.view(~inject)] - | Scratch(slide_idx, slides) => - slide_view(~inject, ~model, ~ctx_init, List.nth(slides, slide_idx)) - | Examples(name, slides) => - slide_view(~inject, ~model, ~ctx_init, List.assoc(name, slides)) + | Scratch(_) + | Examples(_) => slide_view(~inject, ~model, ~ctx_init) | Exercise(_, _, exercise) => exercises_view(~inject, ~exercise, model) }; }; diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 497f174cd8..8dd90a157f 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -99,49 +99,42 @@ let view = ]; }; -let download_slide_state = state => { - let json_data = ScratchSlide.export(state); - JsUtil.download_json("hazel-scratchpad", json_data); -}; +let export_button = state => + Widgets.button_named( + Icons.star, + _ => { + let json_data = ScratchSlide.export(state); + JsUtil.download_json("hazel-scratchpad", json_data); + Virtual_dom.Vdom.Effect.Ignore; + }, + ~tooltip="Export Scratchpad", + ); +let import_button = inject => + Widgets.file_select_button_named( + "import-scratchpad", + Icons.star, + file => { + switch (file) { + | None => Virtual_dom.Vdom.Effect.Ignore + | Some(file) => inject(UpdateAction.InitImportScratchpad(file)) + } + }, + ~tooltip="Import Scratchpad", + ); -let toolbar_buttons = (~inject, state: ScratchSlide.state) => { - let export_button = - Widgets.button( - Icons.export, - _ => { - download_slide_state(state); +let reset_button = inject => + Widgets.button_named( + Icons.trash, + _ => { + let confirmed = + JsUtil.confirm( + "Are you SURE you want to reset this scratchpad? You will lose any existing code.", + ); + if (confirmed) { + inject(UpdateAction.ResetCurrentEditor); + } else { Virtual_dom.Vdom.Effect.Ignore; - }, - ~tooltip="Export Scratchpad", - ); - let import_button = - Widgets.file_select_button( - "import-scratchpad", - Icons.import, - file => { - switch (file) { - | None => Virtual_dom.Vdom.Effect.Ignore - | Some(file) => inject(UpdateAction.InitImportScratchpad(file)) - } - }, - ~tooltip="Import Scratchpad", - ); - - let reset_button = - Widgets.button( - Icons.trash, - _ => { - let confirmed = - JsUtil.confirm( - "Are you SURE you want to reset this scratchpad? You will lose any existing code.", - ); - if (confirmed) { - inject(ResetCurrentEditor); - } else { - Virtual_dom.Vdom.Effect.Ignore; - }; - }, - ~tooltip="Reset Scratchpad", - ); - [export_button, import_button] @ [reset_button]; -}; + }; + }, + ~tooltip="Reset Scratchpad", + ); diff --git a/src/haz3lweb/view/Widgets.re b/src/haz3lweb/view/Widgets.re index 5bb5eac14c..bcbf6a4e6f 100644 --- a/src/haz3lweb/view/Widgets.re +++ b/src/haz3lweb/view/Widgets.re @@ -32,6 +32,11 @@ let hoverable_button = ]), icon, ); +let button_named = (~tooltip="", icon, action) => + div( + ~attr=Attr.many([clss(["named-menu-item"]), Attr.on_click(action)]), + [button(icon, _ => Effect.Ignore), div([text(tooltip)])], + ); let button_d = (~tooltip="", icon, action, ~disabled: bool) => div( @@ -69,6 +74,16 @@ let toggle = (~tooltip="", label, active, action) => [div(~attr=clss(["toggle-knob"]), [text(label)])], ); +let toggle_named = (~tooltip="", icon, active, action) => + div( + ~attr= + Attr.many([ + clss(["named-menu-item"] @ (active ? ["active"] : [])), + Attr.on_click(action), + ]), + [toggle(icon, active, _ => Effect.Ignore), div([text(tooltip)])], + ); + let file_select_button = (~tooltip="", id, icon, on_input) => { /* https://stackoverflow.com/questions/572768/styling-an-input-type-file-button */ label( @@ -84,3 +99,9 @@ let file_select_button = (~tooltip="", id, icon, on_input) => { ], ); }; + +let file_select_button_named = (~tooltip="", id, icon, on_input) => + div( + ~attr=Attr.many([clss(["named-menu-item"])]), + [file_select_button(id, icon, on_input), div([text(tooltip)])], + ); diff --git a/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re b/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re index 799dec9658..09ec1aa6db 100644 --- a/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re +++ b/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re @@ -60,7 +60,8 @@ let rec precedence = (~show_casts: bool, d: DHExp.t) => { | FailedCast(_) | InvalidOperation(_) | Fun(_) - | Closure(_) => DHDoc_common.precedence_const + | Closure(_) + | BuiltinFun(_) => DHDoc_common.precedence_const | Cast(d1, _, _) => show_casts ? DHDoc_common.precedence_const : precedence'(d1) | Let(_) @@ -175,6 +176,7 @@ let rec mk = | InconsistentBranches(u, i, Case(dscrut, drs, _)) => go_case(dscrut, drs) |> annot(DHAnnot.InconsistentBranches((u, i))) | BoundVar(x) => text(x) + | BuiltinFun(f) => text(f) | Constructor(name) => DHDoc_common.mk_ConstructorLit(name) | BoolLit(b) => DHDoc_common.mk_BoolLit(b) | IntLit(n) => DHDoc_common.mk_IntLit(n) @@ -193,19 +195,14 @@ let rec mk = go'(~parenthesize=false, d2), ); DHDoc_common.mk_Ap(mk_cast(doc1), mk_cast(doc2)); - | ApBuiltin(ident, args) => - switch (args) { - | [hd, ...tl] => - let d' = List.fold_left((d1, d2) => DHExp.Ap(d1, d2), hd, tl); - let (doc1, doc2) = - mk_left_associative_operands( - DHDoc_common.precedence_Ap, - BoundVar(ident), - d', - ); - DHDoc_common.mk_Ap(mk_cast(doc1), mk_cast(doc2)); - | [] => text(ident) - } + | ApBuiltin(ident, d) => + let (doc1, doc2) = + mk_left_associative_operands( + DHDoc_common.precedence_Ap, + BoundVar(ident), + d, + ); + DHDoc_common.mk_Ap(mk_cast(doc1), mk_cast(doc2)); | BinIntOp(op, d1, d2) => // TODO assumes all bin int ops are left associative let (doc1, doc2) = diff --git a/src/haz3lweb/www/style.css b/src/haz3lweb/www/style.css index efaa90c8b4..6e9279a67d 100644 --- a/src/haz3lweb/www/style.css +++ b/src/haz3lweb/www/style.css @@ -367,15 +367,74 @@ select { top: 2.75em; left: 0; width: 2.75em; - padding-top: 1em; + /*padding-top: 1em; padding-bottom: 1em; - gap: 1em; + gap: 1em;*/ flex-direction: column; justify-content: center; align-items: center; background-color: #a69461; } +#top-bar .menu .submenu { + display: none; + transform-origin: top; + transform: scaleY(0); + transition: transform 0.07s ease; + position: absolute; + width: max-content; + top: 0em; + left: 2.75em; + flex-direction: column; + justify-content: center; + /*align-items: center;*/ + background-color: #bba874; + border-radius: 0 0 1.3em 0; +} + +#top-bar .menu .menu-item-iconic { + display: flex; + justify-content: center; + align-items: center; + width: 2.75em; + height: 2.75em; +} + +#top-bar .menu .named-menu-item { + height: 2.75em; + display: flex; + align-items: center; + color: antiquewhite; + cursor: pointer; + padding-right: 1em; +} +#top-bar .menu .named-menu-item:last-child { + border-radius: 0 0 1.3em 0; +} +#top-bar .menu .named-menu-item:hover { + background-color: #c7b480; + color: white; +} +#top-bar .menu .named-menu-item .toggle-switch { + margin-left:0.5em; + margin-right:0.5em; +} + +#top-bar .menu .menu-item-iconic:hover + .submenu, +#top-bar .menu .menu-item-iconic + .submenu:hover { + display: flex; + transform: scaleY(1); +} + +#top-bar .menu .top-menu-item:hover, +#top-bar .menu .top-menu-item:has(+ .submenu:hover) { + background-color: #bba874;/*c7b480*/ +} +#top-bar .menu .top-menu-item:hover .icon svg, +#top-bar .menu .top-menu-item:has(+ .submenu:hover) .icon svg { + fill: var(--light-page-color); +} + #top-bar .menu:hover, #top-bar .menu-icon:hover+.menu { transform: scaleY(1); @@ -383,6 +442,25 @@ select { border-radius: 0 0 1.3em 0; } +#top-bar .menu .top-menu-item { + position: relative; +} +#top-bar .menu .icon, +#top-bar .menu .link { + display: flex; + height: 2.75em; + width: 2.75em; + align-items: center; + justify-content: center; +} +#top-bar .menu .top-menu-item:last-child { + border-radius: 0 0 1.3em 0; +} +#top-bar .menu .top-menu-item:hover { + background-color: #bba874; + color: white; +} + #top-bar .menu-icon { width: 2.75em; min-width: 2.75em; @@ -2041,15 +2119,16 @@ svg.expandable path { } .test-percent { + position: absolute; + right: 0; + margin: 1em; height: 1.7em; display: flex; padding: 0 1em 0 1em; font-size: 0.7em; - border-radius: 1em; + border-radius: 1.08em; background-color: #c7b480; align-items: center; - margin-left: auto; - margin-right: 1em; } .test-percent.all-pass { @@ -2155,14 +2234,14 @@ svg.expandable path { } .toggle-switch.active { - background-color: #c7b480; + background-color: #4fad66;/*#c7b480;*/ /*#f6cb3f;*/ border: solid 1px transparent; } .toggle-switch.active .toggle-knob { margin-left: 0.9em; - color: #c7b480; + color: #4fad66; } /* END TOGGLE */ From 5fad8815eb48c92dfa9fb3708e59df56d774eaaf Mon Sep 17 00:00:00 2001 From: RaefM Date: Mon, 22 Jan 2024 01:40:56 -0500 Subject: [PATCH 124/129] make it so if statics turns off, infernce does too --- src/haz3lweb/Update.re | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index 5c0c26d263..657053ba6b 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -17,7 +17,7 @@ let update_settings = assist: !settings.core.statics, elaborate: settings.core.elaborate, dynamics: !settings.core.statics && settings.core.dynamics, - inference: !settings.core.inference, + inference: !settings.core.statics && !settings.core.inference, }, }, } From 14f1e19a92f89901e0c4b42dcee3640cc8fa84d9 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 25 Feb 2024 22:35:05 -0500 Subject: [PATCH 125/129] Fix empty list type paste bug and solutions --- src/haz3lcore/statics/Statics.re | 22 ++++++++++++++++------ src/haz3lcore/statics/TypBase.re | 16 +++++++++------- 2 files changed, 25 insertions(+), 13 deletions(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 32d86f1a0e..f17123cc5e 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -232,17 +232,24 @@ and uexp_to_info_map = | String(_) => atomic(Just(String)) | ListLit(es) => let ids = List.map(UExp.rep_id, es); + let list_id = UExp.rep_id(uexp); let (modes, mode_cs) = - Mode.of_list_lit(ctx, List.length(es), UExp.rep_id(uexp), mode); + Mode.of_list_lit(ctx, List.length(es), list_id, mode); let (es, m) = map_m_go(m, modes, es); let tys = List.map(Info.exp_ty, es); - let self = - Self.listlit(~empty=Unknown(NoProvenance, false), ctx, tys, ids); + let (elt_ty, term_cs) = + Typ.matched_list( + ctx, + list_id, + Unknown(ExpHole(Internal, list_id), false), + ); + let self = Self.listlit(~empty=elt_ty, ctx, tys, ids); add( ~self, ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es)), ~constraints= mode_cs + @ term_cs @ ListUtil.flat_map(Info.exp_constraints, es) @ subsumption_constraints(self), m, @@ -648,16 +655,19 @@ and upat_to_info_map = let ids = List.map(UPat.rep_id, ps); let (modes, mode_cs) = Mode.of_list_lit(ctx, List.length(ps), id, mode); let ((ctx, constraints), tys, m) = ctx_fold(ctx, m, ps, modes); + let (elt_ty, term_cs) = Typ.matched_list(ctx, id, unknown); + let self = Self.listlit(~empty=elt_ty, ctx, tys, ids); add( - ~self=Self.listlit(~empty=unknown, ctx, tys, ids), + ~self, ~ctx, - ~constraints=mode_cs @ constraints, + ~constraints= + mode_cs @ term_cs @ constraints @ subsumption_constraints(self), m, ); | Cons(hd, tl) => let (mode_hd, mode_cs_hd) = Mode.of_cons_hd(ctx, mode, id); let (hd, m) = go(~ctx, ~mode=mode_hd, hd, m); - let (mode_tl, mode_cs_tl) = Mode.of_cons_tl(ctx, mode_hd, hd.ty, id); + let (mode_tl, mode_cs_tl) = Mode.of_cons_tl(ctx, mode, hd.ty, id); let (tl, m) = go(~ctx=hd.ctx, ~mode=mode_tl, tl, m); add( ~self=Just(List(hd.ty)), diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 6631b887de..51a89c2926 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -96,8 +96,8 @@ module rec Typ: { let sum_entry: (Constructor.t, sum_map) => option(sum_entry); let get_sum_constructors: (Ctx.t, t) => option(sum_map); let is_unknown: t => bool; - let typ_to_string: (t, bool) => string; - let typ_to_string_with_parens: (bool, t, bool) => string; + let typ_to_string: (~list: bool=?, t, bool) => string; + let typ_to_string_with_parens: (~list: bool=?, bool, t, bool) => string; let contains_hole: t => bool; let constraints_to_string: constraints => string; let equivalence_to_string: equivalence => string; @@ -288,19 +288,21 @@ module rec Typ: { }; }; - let rec typ_to_string = (ty: t, debug): string => { - typ_to_string_with_parens(false, ty, debug); + let rec typ_to_string = (~list=false, ty: t, debug): string => { + typ_to_string_with_parens(~list, false, ty, debug); } - and typ_to_string_with_parens = (is_left_child: bool, ty: t, debug): string => { + and typ_to_string_with_parens = + (~list=false, is_left_child: bool, ty: t, debug): string => { let parenthesize_if_left_child = s => is_left_child ? "(" ++ s ++ ")" : s; switch (ty) { - | Unknown(prov, _) => "?" ++ (debug ? prov_to_string(prov) : "") + | Unknown(prov, _) => + debug ? "?" ++ prov_to_string(prov) : list ? " " : "?" | Int => "Int" | Float => "Float" | String => "String" | Bool => "Bool" | Var(name) => name - | List(t) => "[" ++ typ_to_string(t, debug) ++ "]" + | List(t) => "[" ++ typ_to_string(~list=true, t, debug) ++ "]" | Arrow(t1, t2) => typ_to_string_with_parens(true, t1, debug) ++ " -> " From dc83c58ccb09bb17e08b0bd3bed22a2d7bca4ab2 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 25 Feb 2024 22:56:03 -0500 Subject: [PATCH 126/129] Fix issue where type aliases weren't always constrainted to self --- src/haz3lcore/statics/Statics.re | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index f17123cc5e..5a65aa4661 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -556,7 +556,11 @@ and uexp_to_info_map = add( ~self=Just(ty_escape), ~constraints= - constraints_body @ subsumption_constraints(Just(ty_escape)), + constraints_body + @ [ + (Var(name), ty_escape), + ...subsumption_constraints(Just(ty_escape)), + ], ~co_ctx, m, ); @@ -868,6 +872,9 @@ let mk_map_and_inference_solutions = Id.Map.empty, ); + print_endline("!!PRINTING CONSTRAINTS: "); + info.constraints |> Typ.constraints_to_string |> print_endline; + let pts_graph = Inference.solve_constraints(info.constraints); let solutions = InferenceResult.get_desired_solutions(pts_graph); From 298a51dd0ce557f962498d86d7eaabd8102a8689 Mon Sep 17 00:00:00 2001 From: RaefM Date: Sun, 25 Feb 2024 22:57:55 -0500 Subject: [PATCH 127/129] whoops- fix usage of wrong type in prev commit --- src/haz3lcore/statics/Statics.re | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 5a65aa4661..32c2103052 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -558,7 +558,7 @@ and uexp_to_info_map = ~constraints= constraints_body @ [ - (Var(name), ty_escape), + (Var(name), ty_def), ...subsumption_constraints(Just(ty_escape)), ], ~co_ctx, From d7f07bf1f4b6e3e0ce983d0584479b40e3af1c1f Mon Sep 17 00:00:00 2001 From: thomasporter522 Date: Fri, 29 Mar 2024 12:48:44 -0400 Subject: [PATCH 128/129] test - rerun GitHub Action --- note.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 note.txt diff --git a/note.txt b/note.txt new file mode 100644 index 0000000000..37b671d4fc --- /dev/null +++ b/note.txt @@ -0,0 +1 @@ +Note: this push is a test to reactivate the GitHub Action and rerun test cases, in case there was a collision during the last push. \ No newline at end of file From 55273cb799da95c38fa966594a2d6f954c5cf2ff Mon Sep 17 00:00:00 2001 From: thomasporter522 Date: Mon, 1 Apr 2024 17:37:42 -0400 Subject: [PATCH 129/129] added constructor names to internal types --- src/haz3lcore/inference/ITyp.re | 50 +++++++++++++------ src/haz3lcore/inference/InferenceResult.re | 1 + .../inference/MutablePotentialTypeSet.re | 1 + src/haz3lcore/inference/PotentialTypeSet.re | 41 +++++++++------ src/haz3lweb/view/Type.re | 39 ++++++++------- 5 files changed, 85 insertions(+), 47 deletions(-) diff --git a/src/haz3lcore/inference/ITyp.re b/src/haz3lcore/inference/ITyp.re index 0ecb24af6f..ce0a158756 100644 --- a/src/haz3lcore/inference/ITyp.re +++ b/src/haz3lcore/inference/ITyp.re @@ -11,6 +11,7 @@ type t = | String | Var(string) | List(t) + | Named(Constructor.t, bool, t) // the boolean represents whether the constructor is matched with "None" in the original sum type | Arrow(t, t) | Sum(t, t) | Prod(t, t); @@ -38,8 +39,11 @@ let rec typ_to_ityp: Typ.t => t = | Prod([]) => Unit | Rec(_, ty_body) => typ_to_ityp(ty_body) | Var(name) => Var(name) -and constructor_binding_to_ityp = sum_entry => { - sum_entry |> snd |> Util.OptUtil.get(() => Typ.Prod([])) |> typ_to_ityp; +and constructor_binding_to_ityp = ((c, typ)) => { + switch (typ) { + | None => Named(c, true, Unit) + | Some(t) => Named(c, false, typ_to_ityp(t)) + }; }; let unwrap_if_prod = (typ: Typ.t): list(Typ.t) => { @@ -58,29 +62,45 @@ let rec_type_constraints = (typs: list(Typ.t)): constraints => { List.filter_map(is_rec_type, typs); }; -let rec ityp_to_typ_ = (prefix, t): Typ.t => { - let go = ityp_to_typ_(prefix); +let rec ityp_to_typ = (t): Typ.t => { switch (t) { | Unknown(prov) => Unknown(prov, false) | Int => Int | Float => Float | Bool => Bool | String => String - | List(ity) => List(go(ity)) - | Arrow(t1, t2) => Arrow(go(t1), go(t2)) - | Sum(t1, t2) => - let prefix_l = prefix ++ "L"; - let prefix_r = prefix ++ "R"; - Sum([ - (prefix_l, Some(ityp_to_typ_(prefix_l, t1))), - (prefix_r, Some(ityp_to_typ_(prefix_r, t2))), - ]); + | List(ity) => List(ityp_to_typ(ity)) + | Arrow(t1, t2) => Arrow(ityp_to_typ(t1), ityp_to_typ(t2)) + | Named(_) + | Sum(_) => Sum(sum_ityp_to_typlist_(t)) | Unit => Prod([]) | Var(name) => Var(name) - | Prod(t1, t2) => Prod([go(t1)] @ (t2 |> go |> unwrap_if_prod)) + | Prod(t1, t2) => + Prod([ityp_to_typ(t1)] @ (t2 |> ityp_to_typ |> unwrap_if_prod)) + }; +} +and sum_ityp_to_typlist_ = t => { + switch (t) { + | Named(c, tag, t) => [(c, tagged_ityp_to_typ(tag, t))] + | Sum(Named(c1, tag, t1), t2) => [ + (c1, tagged_ityp_to_typ(tag, t1)), + ...sum_ityp_to_typlist_(t2), + ] + | Unknown(p) => [("?", Some(ityp_to_typ(Unknown(p))))] + | Sum(Unknown(p), t2) => [ + ("?", Some(ityp_to_typ(Unknown(p)))), + ...sum_ityp_to_typlist_(t2), + ] + | _ => failwith("Sum ITyps must be named" ++ show(t)) + }; +} +and tagged_ityp_to_typ = (tag, ty) => { + switch (tag, ty) { + | (true, Unit) => None + | (true, _) => failwith("Constructor tag inconsistent") + | (false, t) => Some(ityp_to_typ(t)) }; }; -let ityp_to_typ = ityp_to_typ_(""); let to_ityp_constraints = (constraints: Typ.constraints): constraints => { constraints diff --git a/src/haz3lcore/inference/InferenceResult.re b/src/haz3lcore/inference/InferenceResult.re index f61b8b6645..bf9c229d13 100644 --- a/src/haz3lcore/inference/InferenceResult.re +++ b/src/haz3lcore/inference/InferenceResult.re @@ -181,6 +181,7 @@ let rec convert_leftmost_to_priority = (typ: ITyp.t): string => { | Var(name) => name | Unknown(prov) => prov_to_priority(prov) | List(elt_typ) => convert_leftmost_to_priority(elt_typ) + | Named(_, _, named_typ) => convert_leftmost_to_priority(named_typ) | Arrow(typ_lhs, typ_rhs) | Prod(typ_lhs, typ_rhs) | Sum(typ_lhs, typ_rhs) => diff --git a/src/haz3lcore/inference/MutablePotentialTypeSet.re b/src/haz3lcore/inference/MutablePotentialTypeSet.re index f2d796d81f..bd83557997 100644 --- a/src/haz3lcore/inference/MutablePotentialTypeSet.re +++ b/src/haz3lcore/inference/MutablePotentialTypeSet.re @@ -161,6 +161,7 @@ let rec preorder_key_traversal_typ = (ty: ITyp.t): list(ITyp.t) => { @ preorder_key_traversal_typ(ty_rhs), ] | List(list_ty) => [ty, ...preorder_key_traversal_typ(list_ty)] + | Named(_, _, named_ty) => [ty, ...preorder_key_traversal_typ(named_ty)] }; }; diff --git a/src/haz3lcore/inference/PotentialTypeSet.re b/src/haz3lcore/inference/PotentialTypeSet.re index 22adb043c5..c59a0948d4 100644 --- a/src/haz3lcore/inference/PotentialTypeSet.re +++ b/src/haz3lcore/inference/PotentialTypeSet.re @@ -24,7 +24,8 @@ type base_typ = [@deriving (show({with_path: false}), sexp)] type unary_ctor = - | CList; + | CList + | CNamed(Constructor.t, bool); [@deriving (show({with_path: false}), sexp)] type binary_ctor = @@ -50,6 +51,7 @@ let mk_as_binary_ctor = (ctor: binary_ctor, ty1: ITyp.t, ty2: ITyp.t): ITyp.t => let mk_as_unary_ctor = (ctor: unary_ctor, ty: ITyp.t): ITyp.t => { switch (ctor) { | CList => List(ty) + | CNamed(c, tag) => Named(c, tag, ty) }; }; @@ -80,7 +82,9 @@ let rec ityp_to_potential_typ: ITyp.t => potential_typ = [ityp_to_potential_typ(ty1)], [ityp_to_potential_typ(ty2)], ) - | List(ty) => Unary(CList, [ityp_to_potential_typ(ty)]); + | List(ty) => Unary(CList, [ityp_to_potential_typ(ty)]) + | Named(c, tag, ty) => + Unary(CNamed(c, tag), [ityp_to_potential_typ(ty)]); let typ_to_potential_typ: Typ.t => potential_typ = typ => { @@ -536,6 +540,8 @@ and potential_typ_to_ityp = (id: Id.t, ptyp: potential_typ): ITyp.t => { switch (ptyp) { | Base(btyp) => base_typ_to_ityp(btyp) | Unary(CList, t) => ITyp.List(potential_typ_set_to_ityp_no_unroll(id, t)) + | Unary(CNamed(c, tag), t) => + ITyp.Named(c, tag, potential_typ_set_to_ityp_no_unroll(id, t)) | Binary(CArrow, t1, t2) => ITyp.Arrow( potential_typ_set_to_ityp_no_unroll(id, t1), @@ -584,19 +590,24 @@ and string_of_potential_typ = ], ); | Unary(ctor, potential_typ_set) => - let (start_text, end_text) = - switch (ctor) { - | CList => ("[", "]") - }; - - String.concat( - "", - [ - start_text, - string_of_potential_typ_set_no_nesting(false, potential_typ_set), - end_text, - ], - ); + switch (ctor) { + | CNamed(c, true) => c + | _ => + let (start_text, end_text) = + switch (ctor) { + | CList => ("[", "]") + | CNamed(c, _) => (c ++ "(", ")") + }; + + String.concat( + "", + [ + start_text, + string_of_potential_typ_set_no_nesting(false, potential_typ_set), + end_text, + ], + ); + } }; let strings_of_potential_typ_set = (potential_typ_set: t): list(string) => diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 6b604ef043..75d5dcfa06 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -209,23 +209,28 @@ and view_of_potential_typ = ], ); | Unary(ctor, potential_typ_set) => - let (start_text, end_text, cls) = - switch (ctor) { - | CList => ("[", "]", ["typ-view", "atom", "List"]) - }; - div( - ~attr=clss(cls), - [ - text(start_text), - view_of_potential_typ_set( - ~font_metrics, - ~with_cls, - false, - potential_typ_set, - ), - text(end_text), - ], - ); + switch (ctor) { + | CNamed(c, true) => div(~attr=clss(["typ-view", "Named"]), [text(c)]) + | _ => + let (start_text, end_text, cls) = + switch (ctor) { + | CList => ("[", "]", ["typ-view", "atom", "List"]) + | CNamed(c, _) => (c ++ "(", ")", ["typ-view", "Named"]) + }; + div( + ~attr=clss(cls), + [ + text(start_text), + view_of_potential_typ_set( + ~font_metrics, + ~with_cls, + false, + potential_typ_set, + ), + text(end_text), + ], + ); + } }; } and view_of_base_typ =