Skip to content

Commit

Permalink
Check if there is an inconsistency with InconsistentBranch
Browse files Browse the repository at this point in the history
  • Loading branch information
ruiz-m committed May 22, 2024
2 parents 14045dd + 3511a3b commit cc76722
Show file tree
Hide file tree
Showing 50 changed files with 6,994 additions and 3,166 deletions.
4 changes: 3 additions & 1 deletion src/haz3lcore/Measured.re
Original file line number Diff line number Diff line change
Expand Up @@ -233,7 +233,9 @@ let post_tile_indent = (t: Tile.t) => {
let complete_fun =
Tile.is_complete(t)
&& (
t.label == Form.get("fun_").label || t.label == Form.get("if_").label
t.label == Form.get("fun_").label
|| t.label == Form.get("typfun").label
|| t.label == Form.get("if_").label
);
let missing_right_extreme = Tile.r_shard(t) < List.length(t.label) - 1;
complete_fun || missing_right_extreme;
Expand Down
1 change: 1 addition & 0 deletions src/haz3lcore/assistant/AssistantForms.re
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,7 @@ module Typ = {
let of_leading_delim: list((Token.t, Typ.t)) = [
("case" ++ leading_expander, unk),
("fun" ++ leading_expander, Arrow(unk, unk)),
("typfun" ++ leading_expander, Forall("", unk)),
("if" ++ leading_expander, unk),
("let" ++ leading_expander, unk),
("test" ++ leading_expander, Prod([])),
Expand Down
153 changes: 153 additions & 0 deletions src/haz3lcore/dynamics/Constraint.re
Original file line number Diff line number Diff line change
@@ -0,0 +1,153 @@
open Sexplib.Std;

[@deriving (show({with_path: false}), sexp, yojson)]
type t =
| Truth
| Falsity
| Hole
| Int(int)
| NotInt(int)
| Float(float)
| NotFloat(float)
| String(string)
| NotString(string)
| And(t, t)
| Or(t, t)
| InjL(t)
| InjR(t)
| Pair(t, t);

let rec dual = (c: t): t =>
switch (c) {
| Truth => Falsity
| Falsity => Truth
| Hole => Hole
| Int(n) => NotInt(n)
| NotInt(n) => Int(n)
| Float(n) => NotFloat(n)
| NotFloat(n) => Float(n)
| String(s) => NotString(s)
| NotString(s) => String(s)
| And(c1, c2) => Or(dual(c1), dual(c2))
| Or(c1, c2) => And(dual(c1), dual(c2))
| InjL(c1) => Or(InjL(dual(c1)), InjR(Truth))
| InjR(c2) => Or(InjR(dual(c2)), InjL(Truth))
| Pair(c1, c2) =>
Or(
Pair(c1, dual(c2)),
Or(Pair(dual(c1), c2), Pair(dual(c1), dual(c2))),
)
};

/** substitute Truth for Hole */
let rec truify = (c: t): t =>
switch (c) {
| Hole => Truth
| Truth
| Falsity
| Int(_)
| NotInt(_)
| Float(_)
| NotFloat(_)
| String(_)
| NotString(_) => c
| And(c1, c2) => And(truify(c1), truify(c2))
| Or(c1, c2) => Or(truify(c1), truify(c2))
| InjL(c) => InjL(truify(c))
| InjR(c) => InjR(truify(c))
| Pair(c1, c2) => Pair(truify(c1), truify(c2))
};

/** substitute Falsity for Hole */
let rec falsify = (c: t): t =>
switch (c) {
| Hole => Falsity
| Truth
| Falsity
| Int(_)
| NotInt(_)
| Float(_)
| NotFloat(_)
| String(_)
| NotString(_) => c
| And(c1, c2) => And(falsify(c1), falsify(c2))
| Or(c1, c2) => Or(falsify(c1), falsify(c2))
| InjL(c) => InjL(falsify(c))
| InjR(c) => InjR(falsify(c))
| Pair(c1, c2) => Pair(falsify(c1), falsify(c2))
};

let is_injL =
fun
| InjL(_) => true
| _ => false;

let is_injR =
fun
| InjR(_) => true
| _ => false;

let unwrapL =
fun
| InjL(c) => c
| _ => failwith("input can only be InjL(_)");

let unwrapR =
fun
| InjR(c) => c
| _ => failwith("input can only be InjR(_)");

let unwrap_pair =
fun
| Pair(c1, c2) => (c1, c2)
| _ => failwith("input can only be pair(_, _)");

let rec or_constraints = (lst: list(t)): t =>
switch (lst) {
| [] => Falsity
| [xi] => xi
| [xi, ...xis] => Or(xi, or_constraints(xis))
};

let rec ctr_of_nth_variant = (num_variants, nth): (t => t) =>
if (num_variants == 1) {
Fun.id;
} else if (nth == 0) {
xi => InjL(xi);
} else {
xi => InjR(xi |> ctr_of_nth_variant(num_variants - 1, nth - 1));
};

let of_ap = (ctx, mode, ctr: option(Constructor.t), arg: t, syn_ty): t =>
switch (ctr) {
| Some(name) =>
let ty =
switch (mode) {
| Mode.Ana(ty) => Some(ty)
| Syn => syn_ty
| _ => None
};
switch (ty) {
| Some(ty) =>
switch (Typ.weak_head_normalize(ctx, ty)) {
| Sum(map) =>
let num_variants = ConstructorMap.cardinal(map);
switch (ConstructorMap.nth(map, name)) {
| Some(nth) => arg |> ctr_of_nth_variant(num_variants, nth)
| None => Falsity
};
| _ => Falsity
}
| None => Falsity
};
| None => Falsity
};

let of_ctr = (ctx, mode, name, self) => {
let syn_ty =
switch (self) {
| Self.IsConstructor({syn_ty, _}) => syn_ty
| _ => assert(false) // impossible
};
of_ap(ctx, mode, Some(name), Truth, syn_ty);
};
95 changes: 88 additions & 7 deletions src/haz3lcore/dynamics/DH.re
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ module rec DHExp: {
type t =
| EmptyHole(MetaVar.t, HoleInstanceId.t)
| NonEmptyHole(ErrStatus.HoleReason.t, MetaVar.t, HoleInstanceId.t, t)
| ExpandingKeyword(MetaVar.t, HoleInstanceId.t, ExpandingKeyword.t)
| FreeVar(MetaVar.t, HoleInstanceId.t, Var.t)
| InvalidText(MetaVar.t, HoleInstanceId.t, string)
| InconsistentBranches(MetaVar.t, HoleInstanceId.t, case)
Expand All @@ -21,6 +20,8 @@ module rec DHExp: {
| Let(DHPat.t, t, t)
| FixF(Var.t, Typ.t, t)
| Fun(DHPat.t, Typ.t, t, option(Var.t))
| TypFun(Term.UTPat.t, t, option(Var.t))
| TypAp(t, Typ.t)
| Ap(t, t)
| ApBuiltin(string, t)
| BuiltinFun(string)
Expand Down Expand Up @@ -59,13 +60,15 @@ module rec DHExp: {
let strip_casts: t => t;

let fast_equal: (t, t) => bool;

let assign_name_if_none: (t, option(Var.t)) => t;
let ty_subst: (Typ.t, TypVar.t, t) => t;
} = {
[@deriving (show({with_path: false}), sexp, yojson)]
type t =
/* Hole types */
| EmptyHole(MetaVar.t, HoleInstanceId.t)
| NonEmptyHole(ErrStatus.HoleReason.t, MetaVar.t, HoleInstanceId.t, t)
| ExpandingKeyword(MetaVar.t, HoleInstanceId.t, ExpandingKeyword.t)
| FreeVar(MetaVar.t, HoleInstanceId.t, Var.t)
| InvalidText(MetaVar.t, HoleInstanceId.t, string)
| InconsistentBranches(MetaVar.t, HoleInstanceId.t, case)
Expand All @@ -78,6 +81,8 @@ module rec DHExp: {
| Let(DHPat.t, t, t)
| FixF(Var.t, Typ.t, t)
| Fun(DHPat.t, Typ.t, t, option(Var.t))
| TypFun(Term.UTPat.t, t, option(Var.t))
| TypAp(t, Typ.t)
| Ap(t, t)
| ApBuiltin(string, t)
| BuiltinFun(string)
Expand Down Expand Up @@ -110,7 +115,6 @@ module rec DHExp: {
switch (d) {
| EmptyHole(_, _) => "EmptyHole"
| NonEmptyHole(_, _, _, _) => "NonEmptyHole"
| ExpandingKeyword(_, _, _) => "ExpandingKeyword"
| FreeVar(_, _, _) => "FreeVar"
| InvalidText(_) => "InvalidText"
| BoundVar(_) => "BoundVar"
Expand All @@ -119,8 +123,10 @@ module rec DHExp: {
| Let(_, _, _) => "Let"
| FixF(_, _, _) => "FixF"
| Fun(_, _, _, _) => "Fun"
| TypFun(_) => "TypFun"
| Closure(_, _) => "Closure"
| Ap(_, _) => "Ap"
| TypAp(_) => "TypAp"
| ApBuiltin(_, _) => "ApBuiltin"
| BuiltinFun(_) => "BuiltinFun"
| Test(_) => "Test"
Expand Down Expand Up @@ -178,7 +184,9 @@ module rec DHExp: {
| Let(dp, b, c) => Let(dp, strip_casts(b), strip_casts(c))
| FixF(a, b, c) => FixF(a, b, strip_casts(c))
| Fun(a, b, c, d) => Fun(a, b, strip_casts(c), d)
| TypFun(a, b, c) => TypFun(a, strip_casts(b), c)
| Ap(a, b) => Ap(strip_casts(a), strip_casts(b))
| TypAp(a, b) => TypAp(strip_casts(a), b)
| Test(id, a) => Test(id, strip_casts(a))
| ApBuiltin(fn, args) => ApBuiltin(fn, strip_casts(args))
| BuiltinFun(fn) => BuiltinFun(fn)
Expand All @@ -198,7 +206,6 @@ module rec DHExp: {
Case(strip_casts(scrut), List.map(strip_casts_rule, rules), n),
)
| EmptyHole(_) as d
| ExpandingKeyword(_) as d
| FreeVar(_) as d
| InvalidText(_) as d
| BoundVar(_) as d
Expand Down Expand Up @@ -241,6 +248,9 @@ module rec DHExp: {
f1 == f2 && ty1 == ty2 && fast_equal(d1, d2)
| (Fun(dp1, ty1, d1, s1), Fun(dp2, ty2, d2, s2)) =>
dp1 == dp2 && ty1 == ty2 && fast_equal(d1, d2) && s1 == s2
| (TypFun(_tpat1, d1, s1), TypFun(_tpat2, d2, s2)) =>
_tpat1 == _tpat2 && fast_equal(d1, d2) && s1 == s2
| (TypAp(d1, ty1), TypAp(d2, ty2)) => fast_equal(d1, d2) && ty1 == ty2
| (Ap(d11, d21), Ap(d12, d22))
| (Cons(d11, d21), Cons(d12, d22)) =>
fast_equal(d11, d12) && fast_equal(d21, d22)
Expand Down Expand Up @@ -282,8 +292,10 @@ module rec DHExp: {
| (Let(_), _)
| (FixF(_), _)
| (Fun(_), _)
| (TypFun(_), _)
| (Test(_), _)
| (Ap(_), _)
| (TypAp(_), _)
| (ApBuiltin(_), _)
| (BuiltinFun(_), _)
| (Cons(_), _)
Expand All @@ -308,8 +320,6 @@ module rec DHExp: {
| (EmptyHole(u1, i1), EmptyHole(u2, i2)) => u1 == u2 && i1 == i2
| (NonEmptyHole(reason1, u1, i1, d1), NonEmptyHole(reason2, u2, i2, d2)) =>
reason1 == reason2 && u1 == u2 && i1 == i2 && fast_equal(d1, d2)
| (ExpandingKeyword(u1, i1, kw1), ExpandingKeyword(u2, i2, kw2)) =>
u1 == u2 && i1 == i2 && kw1 == kw2
| (FreeVar(u1, i1, x1), FreeVar(u2, i2, x2)) =>
u1 == u2 && i1 == i2 && x1 == x2
| (InvalidText(u1, i1, text1), InvalidText(u2, i2, text2)) =>
Expand All @@ -323,7 +333,6 @@ module rec DHExp: {
u1 == u2 && i1 == i2 && fast_equal_case(case1, case2)
| (EmptyHole(_), _)
| (NonEmptyHole(_), _)
| (ExpandingKeyword(_), _)
| (FreeVar(_), _)
| (InvalidText(_), _)
| (Closure(_), _)
Expand All @@ -341,6 +350,78 @@ module rec DHExp: {
)
&& i1 == i2;
};

let assign_name_if_none = (t, name) =>
switch (t) {
| Fun(arg, ty, body, None) => Fun(arg, ty, body, name)
| TypFun(utpat, body, None) => TypFun(utpat, body, name)
| _ => t
};

let rec ty_subst = (s: Typ.t, x: TypVar.t, exp: DHExp.t): t => {
let re = e2 => ty_subst(s, x, e2);
let t_re = ty => Typ.subst(s, x, ty);
switch (exp) {
| Cast(t, t1, t2) => Cast(re(t), t_re(t1), t_re(t2))
| FixF(arg, ty, body) => FixF(arg, t_re(ty), re(body))
| Fun(arg, ty, body, var) => Fun(arg, t_re(ty), re(body), var)
| TypAp(tfun, ty) => TypAp(re(tfun), t_re(ty))
| ListLit(mv, mvi, t, lst) =>
ListLit(mv, mvi, t_re(t), List.map(re, lst))
| TypFun(utpat, body, var) =>
switch (Term.UTPat.tyvar_of_utpat(utpat)) {
| Some(x') when x == x' => exp
| _ =>
/* Note that we do not have to worry about capture avoidance, since s will always be closed. */
TypFun(utpat, re(body), var)
}
| NonEmptyHole(errstat, mv, hid, t) =>
NonEmptyHole(errstat, mv, hid, re(t))
| Test(id, t) => Test(id, re(t))
| InconsistentBranches(mv, hid, case) =>
InconsistentBranches(mv, hid, ty_subst_case(s, x, case))
| Closure(ce, t) => Closure(ce, re(t))
| Sequence(t1, t2) => Sequence(re(t1), re(t2))
| Let(dhpat, t1, t2) => Let(dhpat, re(t1), re(t2))
| Ap(t1, t2) => Ap(re(t1), re(t2))
| ApBuiltin(s, args) => ApBuiltin(s, re(args))
| BinBoolOp(op, t1, t2) => BinBoolOp(op, re(t1), re(t2))
| BinIntOp(op, t1, t2) => BinIntOp(op, re(t1), re(t2))
| BinFloatOp(op, t1, t2) => BinFloatOp(op, re(t1), re(t2))
| BinStringOp(op, t1, t2) => BinStringOp(op, re(t1), re(t2))
| Cons(t1, t2) => Cons(re(t1), re(t2))
| ListConcat(t1, t2) => ListConcat(re(t1), re(t2))
| Tuple(args) => Tuple(List.map(re, args))
| Prj(t, n) => Prj(re(t), n)
| ConsistentCase(case) => ConsistentCase(ty_subst_case(s, x, case))
| InvalidOperation(t, err) => InvalidOperation(re(t), err)
| Filter(filt, exp) => Filter(DHFilter.map(re, filt), re(exp))
| IfThenElse(consis, i, t, e) =>
IfThenElse(consis, re(i), re(t), re(e))

| BuiltinFun(_)
| EmptyHole(_)
| FreeVar(_, _, _)
| InvalidText(_, _, _)
| Constructor(_)
| BoundVar(_)
| BoolLit(_)
| IntLit(_)
| FloatLit(_)
| StringLit(_)
| FailedCast(_, _, _) => exp
};
}
and ty_subst_case = (s, x, Case(t, rules, n)) =>
Case(
ty_subst(s, x, t),
List.map(
(DHExp.Rule(dhpat, t)) => DHExp.Rule(dhpat, ty_subst(s, x, t)),
rules,
),
n,
);
//TODO: Inconsistent cases: need to check again for inconsistency?
}

and Environment: {
Expand Down
7 changes: 2 additions & 5 deletions src/haz3lcore/dynamics/DHPat.re
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,6 @@ type t =
| EmptyHole(MetaVar.t, MetaVarInst.t)
| NonEmptyHole(ErrStatus.HoleReason.t, MetaVar.t, MetaVarInst.t, t)
| Wild
| ExpandingKeyword(MetaVar.t, MetaVarInst.t, ExpandingKeyword.t)
| InvalidText(MetaVar.t, MetaVarInst.t, string)
| BadConstructor(MetaVar.t, MetaVarInst.t, string)
| Var(Var.t)
Expand Down Expand Up @@ -39,8 +38,7 @@ let rec binds_var = (x: Var.t, dp: t): bool =>
| FloatLit(_)
| BoolLit(_)
| StringLit(_)
| Constructor(_)
| ExpandingKeyword(_, _, _) => false
| Constructor(_) => false
| Var(y) => Var.eq(x, y)
| Tuple(dps) => dps |> List.exists(binds_var(x))
| Cons(dp1, dp2) => binds_var(x, dp1) || binds_var(x, dp2)
Expand All @@ -61,8 +59,7 @@ let rec bound_vars = (dp: t): list(Var.t) =>
| FloatLit(_)
| BoolLit(_)
| StringLit(_)
| Constructor(_)
| ExpandingKeyword(_, _, _) => []
| Constructor(_) => []
| Var(y) => [y]
| Tuple(dps) => List.flatten(List.map(bound_vars, dps))
| Cons(dp1, dp2) => bound_vars(dp1) @ bound_vars(dp2)
Expand Down
Loading

0 comments on commit cc76722

Please sign in to comment.