diff --git a/Makefile b/Makefile index c1f5943d07..9bbf3c910a 100644 --- a/Makefile +++ b/Makefile @@ -64,7 +64,7 @@ test: node $(TEST_DIR)/haz3ltest.bc.js watch-test: - dune build @fmt @runtest --auto-promote --watch + dune build @fmt @runtest @default --profile dev --auto-promote --watch clean: dune clean diff --git a/src/haz3lcore/LabeledTuple.re b/src/haz3lcore/LabeledTuple.re new file mode 100644 index 0000000000..fbbfdee19c --- /dev/null +++ b/src/haz3lcore/LabeledTuple.re @@ -0,0 +1,290 @@ +open Util; + +exception Exception; + +[@deriving (show({with_path: false}), sexp, yojson)] +type label = string; + +let equal: (option((label, 'a)), option((label, 'b))) => bool = + (left, right) => { + switch (left, right) { + | (Some((s1, _)), Some((s2, _))) => String.equal(s1, s2) + | (_, _) => false + }; + }; + +let length = String.length; + +let compare = String.compare; + +let find_opt: ('a => bool, list('a)) => option('a) = List.find_opt; + +// returns a pair containing a list of option(t) and a list of 'a +// if 'a is a tuplabel, separates the label from the element held by it. +let separate_labels: + ('a => option((label, 'a)), list('a)) => + (list(option(label)), list('a)) = + (get_label, es) => { + let results = + List.fold_left( + ((ls, ns), e) => + switch (get_label(e)) { + | Some((s1, e)) => (ls @ [Some(s1)], ns @ [e]) + | None => (ls @ [None], ns @ [e]) + }, + ([], []), + es, + ); + results; + }; + +// returns a pair containing a list of option(t) and a list of 'a +// if 'a is a tuplabel, extracts the label but keeps the tuplabel together +let separate_and_keep_labels: + ('a => option((label, 'a)), list('a)) => + (list(option(label)), list('a)) = + (get_label, es) => { + let results = + List.fold_left( + ((ls, ns), e) => + switch (get_label(e)) { + | Some((s1, _)) => (ls @ [Some(s1)], ns @ [e]) + | None => (ls @ [None], ns @ [e]) + }, + ([], []), + es, + ); + results; + }; + +// returns ordered list of (Some(string), TupLabel) +// and another of (None, not-TupLabel) +// TODO: Actually validate uniqueness in statics +// TODO: Make more efficient +// let validate_uniqueness: +// 'a. +// ('a => option((t, 'a)), list('a)) => +// (bool, list((option(t), 'a)), list('a)) +// = +// (get_label, es) => { +// let results = +// List.fold_left( +// ((b, ls, ns), e) => +// switch (get_label(e)) { +// | Some((s1, _)) +// when +// b +// && List.fold_left( +// (v, l) => +// switch (l) { +// | (Some(s2), _) when v => compare(s1, s2) != 0 +// | _ => false +// }, +// true, +// ls, +// ) => ( +// b, +// ls @ [(Some(s1), e)], +// ns, +// ) +// | None => (b, ls, ns @ [e]) +// | _ => (false, ls, ns) +// }, +// (true, [], []), +// es, +// ); +// results; +// }; + +// TODO consider adding a t = (option(label), 'a) + +let separate_labeled = (xs: list((option(label), 'a))) => { + List.partition_map( + ((l, a)) => + switch (l) { + | None => Right(a) + | Some(l) => Left((l, a)) + }, + xs, + ); +}; + +// TODO Performance +let intersect = (xs, ys) => { + List.filter_map(x => List.find_opt((==)(x), ys), xs); +}; + +// Assumes all labels are unique +// Rearranges all the labels in l2 to match the order of the labels in l1. Labels are optional and should me reordered for all present labels first and then unlabled fields matched up pairwise. So labeled fields can be reordered and unlabeled ones can't. Also add labels to the unlabeled. +// TODO Handle the unequal length case and extra labels case +let rec rearrange_base: + 'b. + ( + ~show_b: 'b => string=?, + list(option(label)), + list((option(label), 'b)) + ) => + list((option(label), 'b)) + = + (~show_b=?, l1: list(option(label)), l2: list((option(label), 'b))) => { + let l1_labels = List.filter_map(Fun.id, l1); + let l2_labels = List.filter_map(fst, l2); + let common_labels = intersect(l1_labels, l2_labels); + + switch (l1, l2) { + | ([], _) => l2 + | (_, []) => [] + | ([Some(expected_label), ...remaining_expectations], remaining) => + let maybe_found = List.assoc_opt(Some(expected_label), remaining); + + switch (maybe_found) { + | Some(found) => + [(Some(expected_label), found)] + @ rearrange_base( + ~show_b?, + remaining_expectations, + List.remove_assoc(Some(expected_label), remaining), + ) + | None => + let ( + pre: list((option(label), 'b)), + current: option((option(label), 'b)), + post: list((option(label), 'b)), + ) = + ListUtil.split(remaining, ((label: option(label), _)) => { + switch (label) { + | Some(label) => !List.mem(label, common_labels) + | None => true + } + }); + + switch (current) { + | Some((_existing_label, b)) => + [(Some(expected_label), b)] + @ rearrange_base(~show_b?, remaining_expectations, pre @ post) + | None => remaining + }; + }; + | ([None, ...remaining_expectations], remaining) => + // Pick the first one that's not in common labels and then keep the rest in remaining + let ( + pre: list((option(label), 'b)), + current: option((option(label), 'b)), + post: list((option(label), 'b)), + ) = + ListUtil.split(remaining, ((label: option(label), _)) => { + switch (label) { + | Some(label) => !List.mem(label, common_labels) + | None => true + } + }); + switch (current) { + | Some((_existing_label, b)) => + [(None, b)] + @ rearrange_base(~show_b?, remaining_expectations, pre @ post) + | None => remaining + }; + }; + }; + +// Basically another way to call rearrange_base using the raw lists, functions to extract labels from TupLabels, and constructor for new TupLabels. +// Maintains the same ids if possible +// TODO: clean up more +let rearrange: + 'a 'b. + ( + 'a => option((label, 'a)), + 'b => option((label, 'b)), + list('a), + list('b), + (label, 'b) => 'b + ) => + list('b) + = + (get_label1, get_label2, l1, l2, constructor) => { + // TODO: Error handling in case of bad arguments + let l1' = fst(separate_and_keep_labels(get_label1, l1)); + let (l2_labels, l2_vals) = separate_and_keep_labels(get_label2, l2); + let l2' = List.combine(l2_labels, l2_vals); + let l2_reordered = rearrange_base(l1', l2'); + List.map( + ((optional_label, b)) => + switch (optional_label) { + | Some(label) => + // TODO: probably can keep the same ids in a cleaner way + switch (get_label2(b)) { + | Some(_) => b + | None => constructor(label, b) + } + | None => b + }, + l2_reordered, + ); + }; + +// rearrange two other lists to match the first list of labels. +// TODO: Ensure that the two lists match up with each other +// TODO: This function currently exists only to make the elaborator code cleaner. Probably can make more efficient +let rearrange2: + 'a 'b. + ( + list(option(label)), + 'a => option((label, 'a)), + 'b => option((label, 'b)), + list('a), + list('b), + (label, 'a) => 'a, + (label, 'b) => 'b + ) => + (list('a), list('b)) + = + (labels, get_label1, get_label2, l1, l2, constructor1, constructor2) => { + let (l1_labels, l1_vals) = separate_and_keep_labels(get_label1, l1); + let l1' = List.combine(l1_labels, l1_vals); + let l1_reordered = rearrange_base(labels, l1'); + let l1_rearranged = + List.map( + ((optional_label, b)) => + switch (optional_label) { + | Some(label) => + // TODO: probably can keep the same ids in a cleaner way + switch (get_label1(b)) { + | Some(_) => b + | None => constructor1(label, b) + } + | None => b + }, + l1_reordered, + ); + let (l2_labels, l2_vals) = separate_and_keep_labels(get_label2, l2); + let l2' = List.combine(l2_labels, l2_vals); + let l2_reordered = rearrange_base(labels, l2'); + let l2_rearranged = + List.map( + ((optional_label, b)) => + switch (optional_label) { + | Some(label) => + // TODO: probably can keep the same ids in a cleaner way + switch (get_label2(b)) { + | Some(_) => b + | None => constructor2(label, b) + } + | None => b + }, + l2_reordered, + ); + (l1_rearranged, l2_rearranged); + }; + +let find_label: ('a => option((label, 'a)), list('a), label) => option('a) = + (filt, es, label) => { + find_opt( + e => { + switch (filt(e)) { + | Some((s, _)) => compare(s, label) == 0 + | None => false + } + }, + es, + ); + }; diff --git a/src/haz3lcore/dynamics/Casts.re b/src/haz3lcore/dynamics/Casts.re index 170d057e76..6c02edf05a 100644 --- a/src/haz3lcore/dynamics/Casts.re +++ b/src/haz3lcore/dynamics/Casts.re @@ -58,8 +58,10 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { | Int | Float | String + | Label(_) | Var(_) | Rec(_) + | TupLabel(_, {term: Unknown(_), _}) | Forall(_, {term: Unknown(_), _}) | Arrow({term: Unknown(_), _}, {term: Unknown(_), _}) | List({term: Unknown(_), _}) => Ground @@ -81,6 +83,10 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { | Arrow(_, _) => grounded_Arrow | Forall(_) => grounded_Forall | List(_) => grounded_List + | TupLabel(label, _) => + NotGroundOrHole( + TupLabel(label, Unknown(Internal) |> Typ.temp) |> Typ.temp, + ) | Ap(_) => failwith("type application in dynamics") }; }; diff --git a/src/haz3lcore/dynamics/Constraint.re b/src/haz3lcore/dynamics/Constraint.re index 3fcff59bea..ca505933e4 100644 --- a/src/haz3lcore/dynamics/Constraint.re +++ b/src/haz3lcore/dynamics/Constraint.re @@ -15,6 +15,7 @@ type t = | Or(t, t) | InjL(t) | InjR(t) + | TupLabel(t, t) | Pair(t, t); let rec dual = (c: t): t => @@ -32,6 +33,7 @@ let rec dual = (c: t): t => | Or(c1, c2) => And(dual(c1), dual(c2)) | InjL(c1) => Or(InjL(dual(c1)), InjR(Truth)) | InjR(c2) => Or(InjR(dual(c2)), InjL(Truth)) + | TupLabel(c1, c2) => TupLabel(dual(c1), dual(c2)) | Pair(c1, c2) => Or( Pair(c1, dual(c2)), @@ -55,6 +57,7 @@ let rec truify = (c: t): t => | Or(c1, c2) => Or(truify(c1), truify(c2)) | InjL(c) => InjL(truify(c)) | InjR(c) => InjR(truify(c)) + | TupLabel(c1, c2) => TupLabel(truify(c1), truify(c2)) | Pair(c1, c2) => Pair(truify(c1), truify(c2)) }; @@ -74,6 +77,7 @@ let rec falsify = (c: t): t => | Or(c1, c2) => Or(falsify(c1), falsify(c2)) | InjL(c) => InjL(falsify(c)) | InjR(c) => InjR(falsify(c)) + | TupLabel(c1, c2) => TupLabel(falsify(c1), falsify(c2)) | Pair(c1, c2) => Pair(falsify(c1), falsify(c2)) }; diff --git a/src/haz3lcore/dynamics/DHExp.re b/src/haz3lcore/dynamics/DHExp.re index f7651ba963..23be9372fa 100644 --- a/src/haz3lcore/dynamics/DHExp.re +++ b/src/haz3lcore/dynamics/DHExp.re @@ -45,6 +45,8 @@ let rec strip_casts = switch (term_of(exp)) { /* Leave non-casts unchanged */ | Tuple(_) + | TupLabel(_) + | Dot(_) | Cons(_) | ListConcat(_) | ListLit(_) @@ -71,6 +73,7 @@ let rec strip_casts = | Int(_) | Float(_) | String(_) + | Label(_) | Constructor(_) | DynamicErrorHole(_) | Closure(_) @@ -126,6 +129,8 @@ let ty_subst = (s: Typ.t, tpat: TPat.t, exp: t): t => { | Cons(_) | ListConcat(_) | Tuple(_) + | TupLabel(_) + | Dot(_) | Match(_) | DynamicErrorHole(_) | Filter(_) @@ -139,6 +144,7 @@ let ty_subst = (s: Typ.t, tpat: TPat.t, exp: t): t => { | Int(_) | Float(_) | String(_) + | Label(_) | FailedCast(_, _, _) | MultiHole(_) | Deferral(_) diff --git a/src/haz3lcore/dynamics/DHPat.re b/src/haz3lcore/dynamics/DHPat.re index f9e4adbddb..dc0c8456c9 100644 --- a/src/haz3lcore/dynamics/DHPat.re +++ b/src/haz3lcore/dynamics/DHPat.re @@ -20,10 +20,12 @@ let rec binds_var = (m: Statics.Map.t, x: Var.t, dp: t): bool => | Float(_) | Bool(_) | String(_) + | Label(_) | Constructor(_) => false | Cast(y, _, _) | Parens(y) => binds_var(m, x, y) | Var(y) => Var.eq(x, y) + | TupLabel(_, dp) => binds_var(m, x, dp) | Tuple(dps) => dps |> List.exists(binds_var(m, x)) | Cons(dp1, dp2) => binds_var(m, x, dp1) || binds_var(m, x, dp2) | ListLit(d_list) => @@ -43,12 +45,22 @@ let rec bound_vars = (dp: t): list(Var.t) => | Float(_) | Bool(_) | String(_) + | Label(_) | Constructor(_) => [] | Cast(y, _, _) | Parens(y) => bound_vars(y) | Var(y) => [y] + | TupLabel(_, dp) => bound_vars(dp) | Tuple(dps) => List.flatten(List.map(bound_vars, dps)) | Cons(dp1, dp2) => bound_vars(dp1) @ bound_vars(dp2) | ListLit(dps) => List.flatten(List.map(bound_vars, dps)) | Ap(_, dp1) => bound_vars(dp1) }; + +let rec get_label: t => option((LabeledTuple.label, t)) = + dp => + switch (dp |> term_of) { + | Parens(dp) => get_label(dp) + | TupLabel({term: Label(name), _}, t') => Some((name, t')) + | _ => None + }; diff --git a/src/haz3lcore/dynamics/Elaborator.re b/src/haz3lcore/dynamics/Elaborator.re index c1f3aa12d7..68a6a6693e 100644 --- a/src/haz3lcore/dynamics/Elaborator.re +++ b/src/haz3lcore/dynamics/Elaborator.re @@ -18,18 +18,59 @@ module ElaborationResult = { | DoesNotElaborate; }; -let fresh_cast = (d: DHExp.t, t1: Typ.t, t2: Typ.t): DHExp.t => { - Typ.eq(t1, t2) - ? d - : { - let d' = - DHExp.Cast(d, t1, Typ.temp(Unknown(Internal))) +let rec fresh_cast = (d: DHExp.t, t1: Typ.t, t2: Typ.t): DHExp.t => { + switch (t1.term) { + | Label(_) => + // TODO Remove duplication in cases + Typ.eq(t1, t2) + ? d + : { + let d' = + DHExp.Cast(d, t1, Typ.temp(Unknown(Internal))) + |> DHExp.fresh + |> Casts.transition_multiple; + DHExp.Cast(d', Typ.temp(Unknown(Internal)), t2) |> DHExp.fresh |> Casts.transition_multiple; - DHExp.Cast(d', Typ.temp(Unknown(Internal)), t2) - |> DHExp.fresh - |> Casts.transition_multiple; - }; + } // These should be a different sort. I don't think we should be casting them. + | _ => + switch (t2.term) { + | Prod([{term: TupLabel({term: Label(l), _}, t), _}]) => + switch (t1.term) { + | Prod([{term: TupLabel({term: Label(l'), _}, _), _}]) when l == l' => + Typ.eq(t1, t2) + ? d + : { + let d' = + DHExp.Cast(d, t1, Typ.temp(Unknown(Internal))) + |> DHExp.fresh + |> Casts.transition_multiple; + DHExp.Cast(d', Typ.temp(Unknown(Internal)), t2) + |> DHExp.fresh + |> Casts.transition_multiple; + } + | _ => + Tuple([ + TupLabel(Label(l) |> DHExp.fresh, fresh_cast(d, t1, t)) + |> DHExp.fresh, + ]) + |> DHExp.fresh + } + | _ => + // TODO Remove duplication in cases + Typ.eq(t1, t2) + ? d + : { + let d' = + DHExp.Cast(d, t1, Typ.temp(Unknown(Internal))) + |> DHExp.fresh + |> Casts.transition_multiple; + DHExp.Cast(d', Typ.temp(Unknown(Internal)), t2) + |> DHExp.fresh + |> Casts.transition_multiple; + } + } + }; }; let fresh_pat_cast = (p: DHPat.t, t1: Typ.t, t2: Typ.t): DHPat.t => { @@ -105,8 +146,11 @@ let elaborated_pat_type = (m: Statics.Map.t, upat: UPat.t): (Typ.t, Ctx.t) => { }; let rec elaborate_pattern = - (m: Statics.Map.t, upat: UPat.t): (DHPat.t, Typ.t) => { + (m: Statics.Map.t, upat: UPat.t, in_container: bool) + : (DHPat.t, Typ.t) => { let (elaborated_type, ctx) = elaborated_pat_type(m, upat); + let elaborate_pattern = (~in_container=false, m, upat) => + elaborate_pattern(m, upat, in_container); let cast_from = (ty, exp) => fresh_pat_cast(exp, ty, elaborated_type); let (term, rewrap) = UPat.unwrap(upat); let dpat = @@ -115,6 +159,7 @@ let rec elaborate_pattern = | Bool(_) => upat |> cast_from(Bool |> Typ.temp) | Float(_) => upat |> cast_from(Float |> Typ.temp) | String(_) => upat |> cast_from(String |> Typ.temp) + | Label(name) => upat |> cast_from(Label(name) |> Typ.temp) | ListLit(ps) => let (ps, tys) = List.map(elaborate_pattern(m), ps) |> ListUtil.unzip; let inner_type = @@ -141,8 +186,62 @@ let rec elaborate_pattern = DHPat.Cons(p1'', p2'') |> rewrap |> cast_from(List(ty_inner) |> Typ.temp); + | TupLabel(lab, p) => + let (plab, labty) = elaborate_pattern(m, lab); + let (p', pty) = elaborate_pattern(m, p); + if (in_container) { + DHPat.TupLabel(plab, p') + |> rewrap + |> cast_from(Typ.TupLabel(labty, pty) |> Typ.temp); + } else { + DHPat.Tuple([DHPat.TupLabel(plab, p') |> rewrap]) + |> DHPat.fresh + |> cast_from( + Typ.Prod([Typ.TupLabel(labty, pty) |> Typ.temp]) |> Typ.temp, + ); + }; | Tuple(ps) => - let (ps', tys) = List.map(elaborate_pattern(m), ps) |> ListUtil.unzip; + let (ps', tys) = + List.map(elaborate_pattern(m, ~in_container=true), ps) + |> ListUtil.unzip; + let expected_labels: list(option(string)) = + Typ.get_labels(ctx, elaborated_type); + // let elaborated_labeled: list((option(string), DHPat.t)) = + // List.map( + // pat => { + // switch (DHPat.term_of(pat)) { + // | TupLabel({term: Label(l), _}, pat) => (Some(l), pat) + // | _ => (None, pat) + // } + // }, + // ps', + // ); + + // let reordered: list((option(string), DHPat.t)) = + // LabeledTuple.rearrange_base(expected_labels, elaborated_labeled); + + // let ps': list(DHPat.t) = + // List.map( + // ((optional_label, pat: DHPat.t)) => { + // switch (optional_label) { + // | Some(label) => + // DHPat.TupLabel(Label(label) |> DHPat.fresh, pat) |> DHPat.fresh + // | None => pat + // } + // }, + // reordered, + // ); + let (ps', tys) = + LabeledTuple.rearrange2( + expected_labels, + DHPat.get_label, + Typ.get_label, + ps', + tys, + (name, p) => + DHPat.TupLabel(Label(name) |> DHPat.fresh, p) |> DHPat.fresh, + (name, t) => Typ.TupLabel(Label(name) |> Typ.temp, t) |> Typ.temp, + ); DHPat.Tuple(ps') |> rewrap |> cast_from(Typ.Prod(tys) |> Typ.temp); | Ap(p1, p2) => let (p1', ty1) = elaborate_pattern(m, p1); @@ -207,6 +306,7 @@ let rec elaborate_pattern = a comment explaining why it's redundant. */ let rec elaborate = (m: Statics.Map.t, uexp: UExp.t): (DHExp.t, Typ.t) => { let (elaborated_type, ctx, co_ctx) = elaborated_type(m, uexp); + let elaborate = (m, uexp) => elaborate(m, uexp); let cast_from = (ty, exp) => fresh_cast(exp, ty, elaborated_type); let (term, rewrap) = UExp.unwrap(uexp); let dhexp = @@ -217,7 +317,7 @@ let rec elaborate = (m: Statics.Map.t, uexp: UExp.t): (DHExp.t, Typ.t) => { | MultiHole(stuff) => Any.map_term( ~f_exp=(_, exp) => {elaborate(m, exp) |> fst}, - ~f_pat=(_, pat) => {elaborate_pattern(m, pat) |> fst}, + ~f_pat=(_, pat) => {elaborate_pattern(m, pat, false) |> fst}, _, ) |> List.map(_, stuff) @@ -242,6 +342,7 @@ let rec elaborate = (m: Statics.Map.t, uexp: UExp.t): (DHExp.t, Typ.t) => { | Bool(_) => uexp |> cast_from(Bool |> Typ.temp) | Float(_) => uexp |> cast_from(Float |> Typ.temp) | String(_) => uexp |> cast_from(String |> Typ.temp) + | Label(name) => uexp |> cast_from(Label(name) |> Typ.temp) | ListLit(es) => let (ds, tys) = List.map(elaborate(m), es) |> ListUtil.unzip; let inner_type = @@ -264,7 +365,7 @@ let rec elaborate = (m: Statics.Map.t, uexp: UExp.t): (DHExp.t, Typ.t) => { let t = t |> Typ.normalize(ctx); Constructor(c, t) |> rewrap |> cast_from(t); | Fun(p, e, env, n) => - let (p', typ) = elaborate_pattern(m, p); + let (p', typ) = elaborate_pattern(m, p, false); let (e', tye) = elaborate(m, e); Exp.Fun(p', e', env, n) |> rewrap @@ -274,9 +375,74 @@ let rec elaborate = (m: Statics.Map.t, uexp: UExp.t): (DHExp.t, Typ.t) => { Exp.TypFun(tpat, e', name) |> rewrap |> cast_from(Typ.Forall(tpat, tye) |> Typ.temp); + | TupLabel(label, e) => + let (label', labty) = elaborate(m, label); + let (e', ety) = elaborate(m, e); + Exp.TupLabel(label', e') + |> rewrap + |> cast_from(Typ.TupLabel(labty, ety) |> Typ.temp); | Tuple(es) => let (ds, tys) = List.map(elaborate(m), es) |> ListUtil.unzip; + + let expected_labels: list(option(string)) = + Typ.get_labels(ctx, elaborated_type); + // let elaborated_labeled: list((option(string), DHExp.t)) = + // List.map( + // exp => { + // switch (DHExp.term_of(exp)) { + // | TupLabel({term: Label(l), _}, exp) => (Some(l), exp) + // | _ => (None, exp) + // } + // }, + // ds, + // ); + + // let reordered: list((option(string), DHExp.t)) = + // LabeledTuple.rearrange_base(expected_labels, elaborated_labeled); + + // let ds: list(DHExp.t) = + // List.map( + // ((optional_label, exp: DHExp.t)) => { + // switch (optional_label) { + // | Some(label) => + // Exp.TupLabel(Label(label) |> Exp.fresh, exp) |> Exp.fresh + // | None => exp + // } + // }, + // reordered, + // ); + let (ds, tys) = + LabeledTuple.rearrange2( + expected_labels, + DHExp.get_label, + Typ.get_label, + ds, + tys, + (name, e) => { + DHExp.TupLabel(Label(name) |> DHExp.fresh, e) |> DHExp.fresh + }, + (name, t) => Typ.TupLabel(Label(name) |> Typ.temp, t) |> Typ.temp, + ); Exp.Tuple(ds) |> rewrap |> cast_from(Prod(tys) |> Typ.temp); + + | Dot(e1, e2) => + let (e1, ty1) = elaborate(m, e1); + // I don't think we need to elaborate labels + // let (e2, ty2) = elaborate(m, e2); + let ty = + switch (Typ.weak_head_normalize(ctx, ty1).term, e2.term) { + | (Prod(tys), Var(name)) => + let element = LabeledTuple.find_label(Typ.get_label, tys, name); + switch (element) { + | Some({term: TupLabel(_, ty), _}) => ty + | _ => Unknown(Internal) |> Typ.temp + }; + | (TupLabel(_, ty), Var(name)) + when LabeledTuple.equal(Typ.get_label(ty1), Some((name, e2))) => ty + | _ => Unknown(Internal) |> Typ.temp + }; + // Freshcast this, if necessary? + Exp.Dot(e1, e2) |> rewrap |> cast_from(ty); | Var(v) => uexp |> cast_from( @@ -295,7 +461,21 @@ let rec elaborate = (m: Statics.Map.t, uexp: UExp.t): (DHExp.t, Typ.t) => { }; } ); - let (p, ty1) = elaborate_pattern(m, p); + let (p, ty1) = elaborate_pattern(m, p, false); + // attach labels if needed for labeled tuples + let (def_term, def_rewrap) = DHExp.unwrap(def); + let def = + switch (def_term, Typ.term_of(Typ.normalize(ctx, ty1))) { + | (Tuple(ds), Prod(tys)) => + Tuple( + LabeledTuple.rearrange( + Typ.get_label, DHExp.get_label, tys, ds, (t, b) => + TupLabel(Label(t) |> Exp.fresh, b) |> Exp.fresh + ), + ) + |> def_rewrap + | (_, _) => def + }; let is_recursive = Statics.is_recursive(ctx, p, def, ty1) && Pat.get_bindings(p) @@ -305,7 +485,15 @@ let rec elaborate = (m: Statics.Map.t, uexp: UExp.t): (DHExp.t, Typ.t) => { let def = add_name(Pat.get_var(p), def); let (def, ty2) = elaborate(m, def); let (body, ty) = elaborate(m, body); - Exp.Let(p, fresh_cast(def, ty2, ty1), body) + Exp.Let( + p, + fresh_cast( + def, + Typ.weak_head_normalize(ctx, ty2), + Typ.weak_head_normalize(ctx, ty1), + ), // TODO abanduk: Is it safe to normalize here? + body, + ) |> rewrap |> cast_from(ty); } else { @@ -314,11 +502,21 @@ let rec elaborate = (m: Statics.Map.t, uexp: UExp.t): (DHExp.t, Typ.t) => { let def = add_name(Option.map(s => s ++ "+", Pat.get_var(p)), def); let (def, ty2) = elaborate(m, def); let (body, ty) = elaborate(m, body); - let fixf = FixF(p, fresh_cast(def, ty2, ty1), None) |> DHExp.fresh; + let fixf = + FixF( + p, + fresh_cast( + def, + Typ.weak_head_normalize(ctx, ty2), + Typ.weak_head_normalize(ctx, ty1), + ), + None, + ) + |> DHExp.fresh; // TODO abanduk: Is it safe to normalize here? Exp.Let(p, fixf, body) |> rewrap |> cast_from(ty); }; | FixF(p, e, env) => - let (p', typ) = elaborate_pattern(m, p); + let (p', typ) = elaborate_pattern(m, p, false); let (e', tye) = elaborate(m, e); Exp.FixF(p', fresh_cast(e', tye, typ), env) |> rewrap @@ -337,7 +535,10 @@ let rec elaborate = (m: Statics.Map.t, uexp: UExp.t): (DHExp.t, Typ.t) => { let (f', tyf) = elaborate(m, f); let (args', tys) = List.map(elaborate(m), args) |> ListUtil.unzip; let (tyf1, tyf2) = Typ.matched_arrow(ctx, tyf); - let ty_fargs = Typ.matched_prod(ctx, List.length(args), tyf1); + let (args, ty_fargs) = + Typ.matched_prod(ctx, args, Exp.get_label, tyf1, (name, b) => + TupLabel(Label(name) |> Exp.fresh, b) |> Exp.fresh + ); let f'' = fresh_cast( f', @@ -539,7 +740,7 @@ let rec elaborate = (m: Statics.Map.t, uexp: UExp.t): (DHExp.t, Typ.t) => { let (e', t) = elaborate(m, e); let (ps, es) = ListUtil.unzip(cases); let (ps', ptys) = - List.map(elaborate_pattern(m), ps) |> ListUtil.unzip; + List.map(p => elaborate_pattern(m, p, false), ps) |> ListUtil.unzip; let joined_pty = Typ.join_all(~empty=Typ.Unknown(Internal) |> Typ.temp, ctx, ptys) |> Option.value(~default=Typ.temp(Typ.Unknown(Internal))); diff --git a/src/haz3lcore/dynamics/EvalCtx.re b/src/haz3lcore/dynamics/EvalCtx.re index bed931c8d3..d70d1e74ce 100644 --- a/src/haz3lcore/dynamics/EvalCtx.re +++ b/src/haz3lcore/dynamics/EvalCtx.re @@ -21,7 +21,10 @@ type term = | UnOp(Operators.op_un, t) | BinOp1(Operators.op_bin, t, DHExp.t) | BinOp2(Operators.op_bin, DHExp.t, t) + | TupLabel(DHExp.t, t) | Tuple(t, (list(DHExp.t), list(DHExp.t))) + | Dot1(t, DHExp.t) + | Dot2(DHExp.t, t) | Test(t) | ListLit(t, (list(DHExp.t), list(DHExp.t))) | MultiHole(t, (list(Any.t), list(Any.t))) @@ -110,6 +113,15 @@ let rec compose = (ctx: t, d: DHExp.t): DHExp.t => { | ListConcat2(d1, ctx) => let d2 = compose(ctx, d); ListConcat(d1, d2) |> wrap; + | TupLabel(label, ctx) => + let d = compose(ctx, d); + TupLabel(label, d) |> wrap; + | Dot1(ctx, d2) => + let d1 = compose(ctx, d); + Dot(d1, d2) |> wrap; + | Dot2(d1, ctx) => + let d2 = compose(ctx, d); + Dot(d1, d2) |> wrap; | Tuple(ctx, (ld, rd)) => let d = compose(ctx, d); Tuple(ListUtil.rev_concat(ld, [d, ...rd])) |> wrap; diff --git a/src/haz3lcore/dynamics/EvaluatorStep.re b/src/haz3lcore/dynamics/EvaluatorStep.re index f25f25603f..abcdfed6b6 100644 --- a/src/haz3lcore/dynamics/EvaluatorStep.re +++ b/src/haz3lcore/dynamics/EvaluatorStep.re @@ -330,6 +330,15 @@ let rec matches = | Tuple(ctx, ds) => let+ ctx = matches(env, flt, ctx, exp, act, idx); Tuple(ctx, ds) |> wrap_ids(ids); + | TupLabel(label, ctx) => + let+ ctx = matches(env, flt, ctx, exp, act, idx); + TupLabel(label, ctx) |> wrap_ids(ids); + | Dot1(ctx, d2) => + let+ ctx = matches(env, flt, ctx, exp, act, idx); + Dot1(ctx, d2) |> wrap_ids(ids); + | Dot2(d1, ctx) => + let+ ctx = matches(env, flt, ctx, exp, act, idx); + Dot2(d1, ctx) |> wrap_ids(ids); | MultiHole(ctx, ds) => let+ ctx = matches(env, flt, ctx, exp, act, idx); MultiHole(ctx, ds) |> wrap_ids(ids); diff --git a/src/haz3lcore/dynamics/FilterMatcher.re b/src/haz3lcore/dynamics/FilterMatcher.re index d6d0bcc543..7a5a5b6a35 100644 --- a/src/haz3lcore/dynamics/FilterMatcher.re +++ b/src/haz3lcore/dynamics/FilterMatcher.re @@ -110,6 +110,13 @@ let rec matches_exp = | (Constructor("$e", _), _) => failwith("$e in matched expression") | (Constructor("$v", _), _) => failwith("$v in matched expression") + // TODO (Anthony): Is this right? + /* Labels are a special case*/ + | (TupLabel(dl, dv), TupLabel(fl, fv)) => + matches_exp(dl, fl) && matches_exp(dv, fv) + | (TupLabel(_, dv), _) => matches_exp(dv, f) + | (_, TupLabel(_, fv)) => matches_exp(d, fv) + // HACK[Matt]: ignore fixpoints in comparison, to allow pausing on fixpoint steps | (FixF(dp, dc, None), FixF(fp, fc, None)) => switch (tangle(dp, denv, fp, fenv)) { @@ -214,6 +221,9 @@ let rec matches_exp = | (String(dv), String(fv)) => dv == fv | (String(_), _) => false + | (Label(dv), Label(fv)) => dv == fv + | (Label(_), _) => false + | ( Constructor(_), Ap(_, {term: Constructor("~MVal", _), _}, {term: Tuple([]), _}), @@ -285,6 +295,10 @@ let rec matches_exp = List.fold_left2((acc, d, f) => acc && matches_exp(d, f), true, dv, fv) | (ListLit(_), _) => false + | (Dot(d1, d2), Dot(f1, f2)) => + matches_exp(d1, f1) && matches_exp(d2, f2) + | (Dot(_), _) => false + | (Tuple(dv), Tuple(fv)) => List.fold_left2((acc, d, f) => acc && matches_exp(d, f), true, dv, fv) | (Tuple(_), _) => false diff --git a/src/haz3lcore/dynamics/Incon.re b/src/haz3lcore/dynamics/Incon.re index 6f5c6af13f..72033bfe57 100644 --- a/src/haz3lcore/dynamics/Incon.re +++ b/src/haz3lcore/dynamics/Incon.re @@ -118,6 +118,7 @@ let rec is_inconsistent = (xis: list(Constraint.t)): bool => | (ss, []) => is_inconsistent_string(ss) | (ss, others) => is_inconsistent(others @ ss) } + | TupLabel(_, xi') => is_inconsistent([xi', ...xis']) | Pair(_, _) => switch ( List.partition( diff --git a/src/haz3lcore/dynamics/PatternMatch.re b/src/haz3lcore/dynamics/PatternMatch.re index 329ca1efd8..bf72b024fc 100644 --- a/src/haz3lcore/dynamics/PatternMatch.re +++ b/src/haz3lcore/dynamics/PatternMatch.re @@ -17,6 +17,7 @@ let rec matches = (dp: Pat.t, d: DHExp.t): match_result => | EmptyHole | MultiHole(_) | Wild => Matches(Environment.empty) + /* Labels are a special case */ | Int(n) => let* n' = Unboxing.unbox(Int, d); n == n' ? Matches(Environment.empty) : DoesNotMatch; @@ -29,6 +30,12 @@ let rec matches = (dp: Pat.t, d: DHExp.t): match_result => | String(s) => let* s' = Unboxing.unbox(String, d); s == s' ? Matches(Environment.empty) : DoesNotMatch; + | Label(name) => + let* name' = Unboxing.unbox(Label, d); + name == name' ? Matches(Environment.empty) : DoesNotMatch; + | TupLabel(_, x) => + let* x' = Unboxing.unbox(TupLabel(dp), d); + matches(x, x'); | ListLit(xs) => let* s' = Unboxing.unbox(List, d); if (List.length(xs) == List.length(s')) { @@ -52,6 +59,10 @@ let rec matches = (dp: Pat.t, d: DHExp.t): match_result => | Var(x) => Matches(Environment.singleton((x, d))) | Tuple(ps) => let* ds = Unboxing.unbox(Tuple(List.length(ps)), d); + // let ds = + // LabeledTuple.rearrange(DHPat.get_label, DHExp.get_label, ps, ds, (t, e) => + // TupLabel(Label(t) |> DHExp.fresh, e) |> DHExp.fresh + // ); List.map2(matches, ps, ds) |> List.fold_left(combine_result, Matches(Environment.empty)); | Parens(p) => matches(p, d) diff --git a/src/haz3lcore/dynamics/Stepper.re b/src/haz3lcore/dynamics/Stepper.re index 8b977cdf5f..1380ccfad4 100644 --- a/src/haz3lcore/dynamics/Stepper.re +++ b/src/haz3lcore/dynamics/Stepper.re @@ -121,6 +121,15 @@ let rec matches = | BinOp2(op, d1, ctx) => let+ ctx = matches(env, flt, ctx, exp, act, idx); BinOp2(op, d1, ctx) |> rewrap; + | Dot1(ctx, d2) => + let+ ctx = matches(env, flt, ctx, exp, act, idx); + Dot1(ctx, d2) |> rewrap; + | Dot2(d1, ctx) => + let+ ctx = matches(env, flt, ctx, exp, act, idx); + Dot2(d1, ctx) |> rewrap; + | TupLabel(label, ctx) => + let+ ctx = matches(env, flt, ctx, exp, act, idx); + TupLabel(label, ctx) |> rewrap; | Tuple(ctx, ds) => let+ ctx = matches(env, flt, ctx, exp, act, idx); Tuple(ctx, ds) |> rewrap; @@ -331,6 +340,7 @@ let get_justification: step_kind => string = | BinStringOp(Concat) => "string manipulation" | UnOp(Bool(Not)) | BinBoolOp(_) => "boolean logic" + | Dot => "dot operation" | Conditional(_) => "conditional" | ListCons => "list manipulation" | ListConcat => "list manipulation" diff --git a/src/haz3lcore/dynamics/Substitution.re b/src/haz3lcore/dynamics/Substitution.re index 5d918e520b..ece1585c9d 100644 --- a/src/haz3lcore/dynamics/Substitution.re +++ b/src/haz3lcore/dynamics/Substitution.re @@ -64,6 +64,7 @@ let rec subst_var = (m, d1: DHExp.t, x: Var.t, d2: DHExp.t): DHExp.t => { | Int(_) | Float(_) | String(_) + | Label(_) | Constructor(_) => d2 | ListLit(ds) => ListLit(List.map(subst_var(m, d1, x), ds)) |> rewrap | Cons(d3, d4) => @@ -74,6 +75,11 @@ let rec subst_var = (m, d1: DHExp.t, x: Var.t, d2: DHExp.t): DHExp.t => { let d3 = subst_var(m, d1, x, d3); let d4 = subst_var(m, d1, x, d4); ListConcat(d3, d4) |> rewrap; + | TupLabel(label, d) => TupLabel(label, subst_var(m, d1, x, d)) |> rewrap + | Dot(d3, d4) => + let d3 = subst_var(m, d1, x, d3); + let d4 = subst_var(m, d1, x, d4); + Dot(d3, d4) |> rewrap; | Tuple(ds) => Tuple(List.map(subst_var(m, d1, x), ds)) |> rewrap | UnOp(op, d3) => let d3 = subst_var(m, d1, x, d3); diff --git a/src/haz3lcore/dynamics/Transition.re b/src/haz3lcore/dynamics/Transition.re index a54c9d18d8..57bd4931ed 100644 --- a/src/haz3lcore/dynamics/Transition.re +++ b/src/haz3lcore/dynamics/Transition.re @@ -64,6 +64,7 @@ type step_kind = | BinIntOp(Operators.op_bin_int) | BinFloatOp(Operators.op_bin_float) | BinStringOp(Operators.op_bin_string) + | Dot | Conditional(bool) | Projection | ListCons @@ -161,6 +162,7 @@ module Transition = (EV: EV_MODE) => { // Split DHExp into term and id information let (term, rewrap) = DHExp.unwrap(d); let wrap_ctx = (term): EvalCtx.t => Term({term, ids: [rep_id(d)]}); + // print_endline(Exp.show(d)); // Transition rules switch (term) { @@ -345,6 +347,55 @@ module Transition = (EV: EV_MODE) => { switch (DHExp.term_of(d1')) { | Constructor(_) => Constructor | Fun(dp, d3, Some(env'), _) => + // Wrap the arguments into labels for label rearrangement + // And implicitly wrap args into singleton tuples if necessary + // This should be done in elaborator instead + // let dp: DHPat.t = + // switch (DHPat.term_of(dp)) { + // | Tuple(args) => + // let labeled_args = + // List.map( + // (p): DHPat.t => + // switch (DHPat.term_of(p)) { + // | DHPat.Var(name) => + // TupLabel(DHPat.Label(name) |> DHPat.fresh, p) + // |> DHPat.fresh + // | _ => p + // }, + // args, + // ); + // Tuple(labeled_args) |> DHPat.fresh; + // | TupLabel(_, _) => Tuple([dp]) |> DHPat.fresh + // | Var(name) => + // Tuple([ + // TupLabel(DHPat.Label(name) |> DHPat.fresh, dp) |> DHPat.fresh, + // ]) + // |> DHPat.fresh + // | _ => dp + // }; + // TODO: Probably not the right way to deal with casts + // let d2' = + // switch (d2'.term, DHPat.term_of(dp)) { + // | (Tuple(_), Tuple(_)) => d2' + // | (Cast({term: Tuple(_), _}, _, {term: Prod(_), _}), Tuple(_)) => d2' + // | (Cast(d, {term: Prod(t1), _}, {term: Prod(t2), _}), Tuple(_)) => + // Cast( + // Tuple([d]) |> DHExp.fresh, + // Prod(t1) |> Typ.temp, + // Prod(t2) |> Typ.temp, + // ) + // |> DHExp.fresh + // | (Cast(d, t1, {term: Prod(t2), _}), Tuple(_)) => + // Cast( + // Tuple([d]) |> DHExp.fresh, + // Prod([t1]) |> Typ.temp, + // Prod(t2) |> Typ.temp, + // ) + // |> DHExp.fresh + // | (_, Tuple([{term: TupLabel(_), _}])) => + // Tuple([d2']) |> DHExp.fresh + // | (_, _) => d2' + // }; let.match env'' = (env', matches(dp, d2')); Step({ expr: Closure(env'', d3) |> fresh, @@ -446,6 +497,7 @@ module Transition = (EV: EV_MODE) => { | Int(_) | Float(_) | String(_) + | Label(_) | Constructor(_) | BuiltinFun(_) => let. _ = otherwise(env, d); @@ -642,6 +694,71 @@ module Transition = (EV: EV_MODE) => { kind: BinStringOp(op), is_value: true, }); + | Dot(d1, d2) => + let. _ = otherwise(env, (d1, d2) => Dot(d1, d2) |> rewrap) + and. d1' = + req_final(req(state, env), d1 => Dot1(d1, d2) |> wrap_ctx, d1) + and. d2' = + req_final(req(state, env), d2 => Dot2(d1, d2) |> wrap_ctx, d2); + // TODO: Holes and other cases handled? + switch (DHExp.term_of(d1'), DHExp.term_of(d2')) { + | (Tuple(ds), Var(name)) => + Step({ + expr: + switch (LabeledTuple.find_label(DHExp.get_label, ds, name)) { + | Some({term: TupLabel(_, exp), _}) => exp + | _ => Undefined |> DHExp.fresh + }, + state_update, + kind: Dot, + is_value: false, + }) + | (_, Cast(d2', ty, ty')) => + // TODO: Probably not right + Step({ + expr: Cast(Dot(d1, d2') |> fresh, ty, ty') |> fresh, + state_update, + kind: CastAp, + is_value: false, + }) + | (Cast(d3', t2, t3), Var(name)) => + // TODO: doen't work because you get to a cast(1, Unknown, Int) which is Indet + let rec get_typs = (t2, t3) => + switch (Typ.term_of(t2), Typ.term_of(t3)) { + | (Prod(ts), Prod(ts')) => (ts, ts') + | (Parens(t2), _) => get_typs(t2, t3) + | (_, Parens(t3)) => get_typs(t2, t3) + | (_, _) => ([], []) + }; + let (ts, ts') = get_typs(t2, t3); + let ty = + switch (LabeledTuple.find_label(Typ.get_label, ts, name)) { + | Some({term: TupLabel(_, ty), _}) => ty + | _ => Typ.Unknown(Internal) |> Typ.temp + }; + let ty' = + switch (LabeledTuple.find_label(Typ.get_label, ts', name)) { + | Some({term: TupLabel(_, ty), _}) => ty + | _ => Typ.Unknown(Internal) |> Typ.temp + }; + Step({ + expr: Cast(Dot(d3', d2) |> fresh, ty, ty') |> fresh, + state_update, + kind: CastAp, + is_value: false, + }); + | _ => raise(EvaluatorError.Exception(BadPatternMatch)) + }; + | TupLabel(label, d1) => + // TODO (Anthony): Fix this if needed + let. _ = otherwise(env, d1 => TupLabel(label, d1) |> rewrap) + and. _ = + req_final( + req(state, env), + d1 => TupLabel(label, d1) |> wrap_ctx, + d1, + ); + Constructor; | Tuple(ds) => let. _ = otherwise(env, ds => Tuple(ds) |> rewrap) and. _ = @@ -790,6 +907,7 @@ let should_hide_step_kind = (~settings: CoreSettings.Evaluation.t) => | BinIntOp(_) | BinFloatOp(_) | BinStringOp(_) + | Dot | UnOp(_) | ListCons | ListConcat diff --git a/src/haz3lcore/dynamics/TypeAssignment.re b/src/haz3lcore/dynamics/TypeAssignment.re index f4979d94bf..40f91f172a 100644 --- a/src/haz3lcore/dynamics/TypeAssignment.re +++ b/src/haz3lcore/dynamics/TypeAssignment.re @@ -33,12 +33,31 @@ let ground = (ty: Typ.t): bool => { let dhpat_extend_ctx = (dhpat: DHPat.t, ty: Typ.t, ctx: Ctx.t): option(Ctx.t) => { let rec dhpat_var_entry = (dhpat: DHPat.t, ty: Typ.t): option(list(Ctx.entry)) => { + let ty' = ty; + let ty = + switch (ty.term) { + | TupLabel(_, ty) => ty + | _ => ty + }; switch (dhpat |> Pat.term_of) { + | TupLabel(_, dp1) => + // TODO: use matched_label + switch (ty'.term) { + | TupLabel(_, ty2) + when + LabeledTuple.equal(DHPat.get_label(dhpat), Typ.get_label(ty')) => + dhpat_var_entry(dp1, ty2) + | TupLabel(_, _) => None + | _ => dhpat_var_entry(dp1, ty) + } | Var(name) => let entry = Ctx.VarEntry({name, id: Id.invalid, typ: ty}); Some([entry]); | Tuple(l1) => - let* ts = Typ.matched_prod_strict(ctx, List.length(l1), ty); + let (l1, ts) = + Typ.matched_prod(ctx, l1, Pat.get_label, ty, (name, b) => + TupLabel(Label(name) |> Pat.fresh, b) |> Pat.fresh + ); let* l = List.map2((dhp, typ) => {dhpat_var_entry(dhp, typ)}, l1, ts) |> OptUtil.sequence; @@ -69,6 +88,7 @@ let dhpat_extend_ctx = (dhpat: DHPat.t, ty: Typ.t, ctx: Ctx.t): option(Ctx.t) => | Float(_) => Typ.eq(ty, Float |> Typ.temp) ? Some([]) : None | Bool(_) => Typ.eq(ty, Bool |> Typ.temp) ? Some([]) : None | String(_) => Typ.eq(ty, String |> Typ.temp) ? Some([]) : None + | Label(name) => Typ.eq(ty, Label(name) |> Typ.temp) ? Some([]) : None | Constructor(_) => Some([]) // TODO: make this stricter | Cast(dhp, ty1, ty2) => Typ.eq(ty, ty2) ? dhpat_var_entry(dhp, ty1) : None @@ -87,6 +107,10 @@ let rec dhpat_synthesize = (dhpat: DHPat.t, ctx: Ctx.t): option(Typ.t) => { | Tuple(dhs) => let* l = List.map(dhpat_synthesize(_, ctx), dhs) |> OptUtil.sequence; Some(Prod(l) |> Typ.temp); + | TupLabel(dlab, d) => + let* tlab = dhpat_synthesize(dlab, ctx); + let* ty = dhpat_synthesize(d, ctx); + Some(Typ.TupLabel(tlab, ty) |> Typ.temp); | Cons(dhp1, _) => let* t = dhpat_synthesize(dhp1, ctx); Some(List(t) |> Typ.temp); @@ -103,6 +127,7 @@ let rec dhpat_synthesize = (dhpat: DHPat.t, ctx: Ctx.t): option(Typ.t) => { | Float(_) => Some(Float |> Typ.temp) | Bool(_) => Some(Bool |> Typ.temp) | String(_) => Some(String |> Typ.temp) + | Label(name) => Some(Label(name) |> Typ.temp) | Cast(_, _, ty) => Some(ty) }; }; @@ -226,6 +251,7 @@ and typ_of_dhexp = (ctx: Ctx.t, m: Statics.Map.t, dh: DHExp.t): option(Typ.t) => | Int(_) => Some(Int |> Typ.temp) | Float(_) => Some(Float |> Typ.temp) | String(_) => Some(String |> Typ.temp) + | Label(name) => Some(Label(name) |> Typ.temp) | BinOp(Bool(_), d1, d2) => let* ty1 = typ_of_dhexp(ctx, m, d1); let* ty2 = typ_of_dhexp(ctx, m, d2); @@ -308,6 +334,23 @@ and typ_of_dhexp = (ctx: Ctx.t, m: Statics.Map.t, dh: DHExp.t): option(Typ.t) => let* ty2 = typ_of_dhexp(ctx, m, d2); let* ty2l = Typ.matched_list_strict(ctx, ty2); Typ.eq(ty1l, ty2l) ? Some(ty1) : None; + | TupLabel(dlab, d) => + let* tlab = typ_of_dhexp(ctx, m, dlab); + let* ty = typ_of_dhexp(ctx, m, d); + Some(Typ.TupLabel(tlab, ty) |> Typ.temp); + | Dot(d1, d2) => + switch (d1.term, d2.term) { + | (Tuple(ds), Var(name)) => + let element = LabeledTuple.find_label(DHExp.get_label, ds, name); + switch (element) { + | Some({term: TupLabel(_, exp), _}) => typ_of_dhexp(ctx, m, exp) + | _ => None + }; + | (TupLabel(_, de), Var(name)) + when LabeledTuple.equal(DHExp.get_label(d1), Some((name, d2))) => + typ_of_dhexp(ctx, m, de) + | _ => None + } | Tuple(dhs) => let+ typ_list = dhs |> List.map(typ_of_dhexp(ctx, m)) |> OptUtil.sequence; diff --git a/src/haz3lcore/dynamics/Unboxing.re b/src/haz3lcore/dynamics/Unboxing.re index 400620026c..1902309b12 100644 --- a/src/haz3lcore/dynamics/Unboxing.re +++ b/src/haz3lcore/dynamics/Unboxing.re @@ -20,7 +20,9 @@ type unbox_request('a) = | Float: unbox_request(float) | Bool: unbox_request(bool) | String: unbox_request(string) + | Label: unbox_request(string) | Tuple(int): unbox_request(list(DHExp.t)) + | TupLabel(DHPat.t): unbox_request(DHExp.t) | List: unbox_request(list(DHExp.t)) | Cons: unbox_request((DHExp.t, DHExp.t)) | SumNoArg(string): unbox_request(unit) @@ -53,11 +55,64 @@ let rec unbox: type a. (unbox_request(a), DHExp.t) => unboxed(a) = | (_, Cast(d, x, {term: Parens(y), _})) => unbox(request, Cast(d, x, y) |> DHExp.fresh) + /* TupLabels can be anything except for tuplabels with unmatching labels */ + // TODO: Fix this + | (TupLabel(tuplabel), TupLabel(_, e)) => + if (LabeledTuple.equal( + DHPat.get_label(tuplabel), + DHExp.get_label(expr), + )) { + Matches(e); + } else { + DoesNotMatch; + } + // | ( + // TupLabel(tuplabel), + // Cast(e, {term: TupLabel(name1, _), _}, {term: TupLabel(name2, _), _}), + // ) when String.equal(name1, name2) => + // switch (DHExp.term_of(e)) { + // | TupLabel(_, e) => unbox(request, e) + // | _ => unbox(request, e) + // } + // | ( + // TupLabel(_), + // Cast(e, {term: TupLabel(_, _), _}, {term: Unknown(_), _}), + // ) => + // switch (DHExp.term_of(e)) { + // | TupLabel(_, e) => unbox(request, e) + // | _ => unbox(request, e) + // } + | ( + TupLabel(tl), + Cast(t, {term: TupLabel(_, ty1), _}, {term: TupLabel(_, ty2), _}), + ) => + let* t = unbox(TupLabel(tl), t); + let t = fixup_cast(Cast(t, ty1, ty2) |> DHExp.fresh); + Matches(t); + | (TupLabel(tl), Cast(t, ty1, ty2)) => + let* t = unbox(TupLabel(tl), t); + let t = fixup_cast(Cast(t, ty1, ty2) |> DHExp.fresh); + Matches(t); + | (TupLabel(_), _) => Matches(expr) + + /* Remove Tuplabels from casts otherwise */ + | (_, Cast(e, {term: TupLabel(_, e1), _}, e2)) => + switch (DHExp.term_of(e)) { + | TupLabel(_, e) => unbox(request, Cast(e, e1, e2) |> DHExp.fresh) + | _ => unbox(request, Cast(e, e1, e2) |> DHExp.fresh) + } + | (_, Cast(e, e1, {term: TupLabel(_, e2), _})) => + switch (DHExp.term_of(e)) { + | TupLabel(_, e) => unbox(request, Cast(e, e1, e2) |> DHExp.fresh) // shouldn't happen? + | _ => unbox(request, Cast(e, e1, e2) |> DHExp.fresh) + } + /* Base types are always already unboxed because of the ITCastID rule*/ | (Bool, Bool(b)) => Matches(b) | (Int, Int(i)) => Matches(i) | (Float, Float(f)) => Matches(f) | (String, String(s)) => Matches(s) + | (Label, Label(s)) => Matches(s) /* Lists can be either lists or list casts */ | (List, ListLit(l)) => Matches(l) @@ -89,6 +144,11 @@ let rec unbox: type a. (unbox_request(a), DHExp.t) => unboxed(a) = | (Tuple(n), Cast(t, {term: Prod(t1s), _}, {term: Prod(t2s), _})) when n == List.length(t1s) && n == List.length(t2s) => let* t = unbox(Tuple(n), t); + // let t1s = + // LabeledTuple.rearrange( + // Typ.get_label, Typ.get_label, t2s, t1s, (name, t) => + // Typ.TupLabel(Typ.Label(name) |> Typ.temp, t) |> Typ.temp + // ); let t = ListUtil.map3( (d, t1, t2) => Cast(d, t1, t2) |> DHExp.fresh, @@ -145,12 +205,13 @@ let rec unbox: type a. (unbox_request(a), DHExp.t) => unboxed(a) = in elaboration or in the cast calculus. */ | ( _, - Bool(_) | Int(_) | Float(_) | String(_) | Constructor(_) | + Bool(_) | Int(_) | Float(_) | String(_) | Label(_) | Constructor(_) | BuiltinFun(_) | Deferral(_) | DeferredAp(_) | Fun(_, _, _, Some(_)) | ListLit(_) | + TupLabel(_) | Tuple(_) | Cast(_) | Ap(_, {term: Constructor(_), _}, _) | @@ -158,11 +219,17 @@ let rec unbox: type a. (unbox_request(a), DHExp.t) => unboxed(a) = TypAp(_), ) => switch (request) { + | TupLabel(_) => + // TODO: TupLabel error or remove tuplabel and try again? + raise(EvaluatorError.Exception(InvalidBoxedStringLit(expr))) | Bool => raise(EvaluatorError.Exception(InvalidBoxedBoolLit(expr))) | Int => raise(EvaluatorError.Exception(InvalidBoxedIntLit(expr))) | Float => raise(EvaluatorError.Exception(InvalidBoxedFloatLit(expr))) | String => raise(EvaluatorError.Exception(InvalidBoxedStringLit(expr))) + | Label => + // TODO: Label error + raise(EvaluatorError.Exception(InvalidBoxedStringLit(expr))) | Tuple(_) => raise(EvaluatorError.Exception(InvalidBoxedTuple(expr))) | List | Cons => raise(EvaluatorError.Exception(InvalidBoxedListLit(expr))) @@ -189,6 +256,7 @@ let rec unbox: type a. (unbox_request(a), DHExp.t) => unboxed(a) = Parens(_) | Cons(_) | ListConcat(_) | + Dot(_) | UnOp(_) | BinOp(_) | Match(_), diff --git a/src/haz3lcore/lang/Form.re b/src/haz3lcore/lang/Form.re index 1990461239..481b5fee59 100644 --- a/src/haz3lcore/lang/Form.re +++ b/src/haz3lcore/lang/Form.re @@ -110,13 +110,15 @@ let is_keyword = match(keyword_regexp); /* Potential tokens: These are fallthrough classes which determine * the behavior when inserting a character in contact with a token */ -let is_potential_operand = match(regexp("^[a-zA-Z0-9_'\\.?]+$")); +let is_potential_operand = x => + match(regexp("^[a-zA-Z0-9_'?]+$"), x) + || match(regexp("^[0-9_'\\.?]+$"), x); /* Anything else is considered a potential operator, as long * as it does not contain any whitespace, linebreaks, comment * delimiters, string delimiters, or the instant expanding paired * delimiters: ()[]| */ let potential_operator_regexp = - regexp("^[^a-zA-Z0-9_'?\"#\n\\s\\[\\]\\(\\)]+$"); /* Multiline operators not supported */ + regexp("^[^a-zA-Z0-9_'\\.?\"#\n\\s\\[\\]\\(\\)]+$"); /* Multiline operators not supported */ let is_potential_operator = match(potential_operator_regexp); let is_potential_token = t => is_potential_operand(t) @@ -280,6 +282,11 @@ let forms: list((string, t)) = [ ("cons_exp", mk_infix("::", Exp, P.cons)), ("cons_pat", mk_infix("::", Pat, P.cons)), ("typeann", mk(ss, [":"], mk_bin'(P.ann, Pat, Pat, [], Typ))), + ("tuple_labeled_exp", mk_infix("=", Exp, P.lab)), + ("tuple_labeled_pat", mk_infix("=", Pat, P.lab)), + ("tuple_labeled_typ", mk_infix("=", Typ, P.lab)), + ("dot_exp", mk_infix(".", Exp, P.dot)), + ("dot_typ", mk_infix(".", Typ, P.dot)), // UNARY PREFIX OPERATORS ("not", mk(ii, ["!"], mk_pre(P.not_, Exp, []))), ("typ_sum_single", mk(ss, ["+"], mk_pre(P.or_, Typ, []))), diff --git a/src/haz3lcore/lang/Precedence.re b/src/haz3lcore/lang/Precedence.re index 7d72b66404..7dbc91a9b5 100644 --- a/src/haz3lcore/lang/Precedence.re +++ b/src/haz3lcore/lang/Precedence.re @@ -9,32 +9,34 @@ type t = int; let max: t = 0; let unquote = 1; -let ap = 2; -let neg = 3; -let power = 4; -let mult = 5; -let not_ = 5; -let plus = 6; -let cons = 7; -let concat = 8; -let eqs = 9; -let and_ = 10; -let or_ = 11; -let ann = 12; -let if_ = 13; -let fun_ = 14; -let semi = 16; -let let_ = 17; -let filter = 18; -let rule_arr = 19; -let rule_pre = 20; -let rule_sep = 21; -let case_ = 22; - -let comma = 15; - -let type_plus = 4; -let type_arrow = 5; +let dot = 2; +let ap = 3; +let neg = 4; +let power = 5; +let mult = 6; +let not_ = 6; +let plus = 7; +let cons = 8; +let concat = 9; +let eqs = 10; +let and_ = 11; +let or_ = 12; +let ann = 13; +let if_ = 14; +let fun_ = 15; +let lab = 16; +let semi = 17; +let let_ = 18; +let filter = 19; +let rule_arr = 20; +let rule_pre = 21; +let rule_sep = 22; +let case_ = 23; + +let comma = 18; + +let type_plus = 5; +let type_arrow = 6; let type_prod = comma; let min = 26; @@ -52,6 +54,7 @@ let associativity_map: IntMap.t(Direction.t) = (concat, Right), (ann, Left), (eqs, Left), + (dot, Left), (type_arrow, Right), ] |> List.to_seq diff --git a/src/haz3lcore/lang/term/IdTagged.re b/src/haz3lcore/lang/term/IdTagged.re index 3812b0e83f..9874567881 100644 --- a/src/haz3lcore/lang/term/IdTagged.re +++ b/src/haz3lcore/lang/term/IdTagged.re @@ -19,7 +19,9 @@ type t('a) = { // (fmt_a, formatter, ta) => { // fmt_a(formatter, ta.term); // }; + let fresh = term => { + let _x: ((Format.formatter, 'a) => unit, t('a)) => string = show; {ids: [Id.mk()], copied: false, term}; }; diff --git a/src/haz3lcore/lang/term/Typ.re b/src/haz3lcore/lang/term/Typ.re index 5dc0b73aaa..d844d878b3 100644 --- a/src/haz3lcore/lang/term/Typ.re +++ b/src/haz3lcore/lang/term/Typ.re @@ -12,8 +12,10 @@ type cls = | Float | Bool | String + | Label | Arrow | Prod + | TupLabel | Sum | List | Var @@ -51,10 +53,12 @@ let cls_of_term: term => cls = | Float => Float | Bool => Bool | String => String + | Label(_) => Label | List(_) => List | Arrow(_) => Arrow | Var(_) => Var | Prod(_) => Prod + | TupLabel(_) => TupLabel | Parens(_) => Parens | Ap(_) => Ap | Sum(_) => Sum @@ -72,11 +76,13 @@ let show_cls: cls => string = | Float | String | Bool => "Base type" + | Label => "Label type" | Var => "Type variable" | Constructor => "Sum constructor" | List => "List type" | Arrow => "Function type" | Prod => "Product type" + | TupLabel => "Labeled element type" | Sum => "Sum type" | Parens => "Parenthesized type" | Ap => "Constructor application" @@ -85,13 +91,15 @@ let show_cls: cls => string = let rec is_arrow = (typ: t) => { switch (typ.term) { - | Parens(typ) => is_arrow(typ) + | Parens(typ) + | TupLabel(_, typ) => is_arrow(typ) | Arrow(_) => true | Unknown(_) | Int | Float | Bool | String + | Label(_) | List(_) | Prod(_) | Var(_) @@ -104,13 +112,15 @@ let rec is_arrow = (typ: t) => { let rec is_forall = (typ: t) => { switch (typ.term) { - | Parens(typ) => is_forall(typ) + | Parens(typ) + | TupLabel(_, typ) => is_forall(typ) | Forall(_) => true | Unknown(_) | Int | Float | Bool | String + | Label(_) | Arrow(_) | List(_) | Prod(_) @@ -149,13 +159,25 @@ let join_type_provenance = | (SynSwitch, SynSwitch) => SynSwitch }; +let rec get_label = ty => + switch (term_of(ty)) { + | Parens(ty) => get_label(ty) + | TupLabel(label, t') => + switch (term_of(label)) { + | Label(name) => Some((name, t')) + | _ => None + } + | _ => None + }; + let rec free_vars = (~bound=[], ty: t): list(Var.t) => switch (term_of(ty)) { | Unknown(_) | Int | Float | Bool - | String => [] + | String + | Label(_) => [] | Ap(t1, t2) => free_vars(~bound, t1) @ free_vars(~bound, t2) | Var(v) => List.mem(v, bound) ? [] : [v] | Parens(ty) => free_vars(~bound, ty) @@ -163,6 +185,7 @@ let rec free_vars = (~bound=[], ty: t): list(Var.t) => | Arrow(t1, t2) => free_vars(~bound, t1) @ free_vars(~bound, t2) | Sum(sm) => ConstructorMap.free_variables(free_vars(~bound), sm) | Prod(tys) => ListUtil.flat_map(free_vars(~bound), tys) + | TupLabel(_, ty) => free_vars(~bound, ty) | Rec(x, ty) | Forall(x, ty) => free_vars(~bound=(x |> TPat.tyvar_of_utpat |> Option.to_list) @ bound, ty) @@ -222,6 +245,15 @@ let rec join = (~resolve=false, ~fix, ctx: Ctx.t, ty1: t, ty2: t): option(t) => let+ ty_join = join'(ty_name, ty1); !resolve && eq(ty_name, ty_join) ? ty2 : ty_join; /* Note: Ordering of Unknown, Var, and Rec above is load-bearing! */ + /* Labels have special rules. TODO (Anthony): Fix them */ + | (TupLabel(_, ty1'), TupLabel(lab2, ty2')) => + if (LabeledTuple.equal(get_label(ty1), get_label(ty2))) { + let+ ty = join'(ty1', ty2'); + TupLabel(lab2, ty) |> temp; + } else { + None; + } + | (TupLabel(_), _) => None | (Rec(tp1, ty1), Rec(tp2, ty2)) => let ctx = Ctx.extend_dummy_tvar(ctx, tp1); let ty1' = @@ -256,15 +288,27 @@ let rec join = (~resolve=false, ~fix, ctx: Ctx.t, ty1: t, ty2: t): option(t) => | (Bool, _) => None | (String, String) => Some(ty1) | (String, _) => None + | (Label(name1), Label(name2)) when String.equal(name1, name2) => + Some(ty1) + | (Label(_), _) => None | (Arrow(ty1, ty2), Arrow(ty1', ty2')) => let* ty1 = join'(ty1, ty1'); let+ ty2 = join'(ty2, ty2'); Arrow(ty1, ty2) |> temp; | (Arrow(_), _) => None | (Prod(tys1), Prod(tys2)) => - let* tys = ListUtil.map2_opt(join', tys1, tys2); - let+ tys = OptUtil.sequence(tys); - Prod(tys) |> temp; + //TODO (Anthony): Clean up the repetition and check for validity. Maybe in statics though + // let (l1_valid, _, _) = LabeledTuple.validate_uniqueness(get_label, tys1); + // let (l2_valid, _, _) = LabeledTuple.validate_uniqueness(get_label, tys2); + let l1_valid = true; + let l2_valid = true; + if (!l1_valid || !l2_valid || List.length(tys1) != List.length(tys2)) { + None; + } else { + let* tys = ListUtil.map2_opt(join', tys1, tys2); + let+ tys = OptUtil.sequence(tys); + Prod(tys) |> temp; + }; | (Prod(_), _) => None | (Sum(sm1), Sum(sm2)) => let+ sm' = ConstructorMap.join(eq, join(~resolve, ~fix, ctx), sm1, sm2); @@ -291,6 +335,7 @@ let rec match_synswitch = (t1: t, t2: t) => { | (Float, _) | (Bool, _) | (String, _) + | (Label(_), _) | (Var(_), _) | (Ap(_), _) | (Rec(_), _) @@ -302,9 +347,18 @@ let rec match_synswitch = (t1: t, t2: t) => { Arrow(match_synswitch(ty1, ty1'), match_synswitch(ty2, ty2')) |> rewrap1 | (Arrow(_), _) => t1 | (Prod(tys1), Prod(tys2)) when List.length(tys1) == List.length(tys2) => + // TODO: Rearrange this prod? + let tys1 = + LabeledTuple.rearrange(get_label, get_label, tys1, tys2, (t, x) => + TupLabel(Label(t) |> temp, x) |> temp + ); let tys = List.map2(match_synswitch, tys1, tys2); Prod(tys) |> rewrap1; | (Prod(_), _) => t1 + | (TupLabel(label1, ty1), TupLabel(label2, ty2)) => + TupLabel(match_synswitch(label1, label2), match_synswitch(ty1, ty2)) + |> rewrap1 + | (TupLabel(_, _), _) => t1 | (Sum(sm1), Sum(sm2)) => let sm' = ConstructorMap.match_synswitch(match_synswitch, eq, sm1, sm2); Sum(sm') |> rewrap1; @@ -347,13 +401,16 @@ let rec normalize = (ctx: Ctx.t, ty: t): t => { | Int | Float | Bool - | String => ty + | String + | Label(_) => ty | Parens(t) => Parens(normalize(ctx, t)) |> rewrap | List(t) => List(normalize(ctx, t)) |> rewrap | Ap(t1, t2) => Ap(normalize(ctx, t1), normalize(ctx, t2)) |> rewrap | Arrow(t1, t2) => Arrow(normalize(ctx, t1), normalize(ctx, t2)) |> rewrap | Prod(ts) => Prod(List.map(normalize(ctx), ts)) |> rewrap + | TupLabel(label, ty) => + TupLabel(normalize(ctx, label), normalize(ctx, ty)) |> rewrap | Sum(ts) => Sum(ConstructorMap.map(Option.map(normalize(ctx)), ts)) |> rewrap | Rec(tpat, ty) => @@ -393,18 +450,79 @@ let matched_forall = (ctx, ty) => matched_forall_strict(ctx, ty) |> Option.value(~default=(None, Unknown(Internal) |> temp)); -let rec matched_prod_strict = (ctx, length, ty) => +let matched_label = (ctx, ty) => switch (term_of(weak_head_normalize(ctx, ty))) { - | Parens(ty) => matched_prod_strict(ctx, length, ty) - | Prod(tys) when List.length(tys) == length => Some(tys) - | Unknown(SynSwitch) => - Some(List.init(length, _ => Unknown(SynSwitch) |> temp)) - | _ => None + | TupLabel(lab, ty) => (lab, ty) + | Prod([ty]) => + switch (term_of(weak_head_normalize(ctx, ty))) { + | TupLabel(lab, ty) => (lab, ty) + | _ => (Unknown(Internal) |> temp, ty) + } + | Unknown(SynSwitch) => ( + Unknown(SynSwitch) |> temp, + Unknown(SynSwitch) |> temp, + ) + | _ => (Unknown(Internal) |> temp, ty) }; -let matched_prod = (ctx, length, ty) => - matched_prod_strict(ctx, length, ty) - |> Option.value(~default=List.init(length, _ => Unknown(Internal) |> temp)); +let rec get_labels = (ctx, ty): list(option(string)) => { + let ty = weak_head_normalize(ctx, ty); + switch (term_of(ty)) { + | Parens(ty) => get_labels(ctx, ty) + | Prod(tys) => List.map(x => Option.map(fst, get_label(x)), tys) + | _ => [] + }; +}; + +let rec matched_prod_strict: + 'a. + (Ctx.t, list('a), 'a => option((string, 'a)), t, (string, 'a) => 'a) => + (list('a), option(list(t))) + = + ( + ctx: Ctx.t, + es, + get_label_es: 'a => option((string, 'a)), + ty: t, + constructor, + ) => { + switch (term_of(weak_head_normalize(ctx, ty))) { + | Parens(ty) => + matched_prod_strict(ctx, es, get_label_es, ty, constructor) + | Prod(tys: list(t)) => + if (List.length(es) != List.length(tys)) { + (es, None); + } else { + ( + LabeledTuple.rearrange( + get_label, + get_label_es, + tys, + es, + constructor, + ), + Some(tys), + ); + } + | Unknown(SynSwitch) => ( + es, + Some(List.init(List.length(es), _ => Unknown(SynSwitch) |> temp)), + ) + | _ => (es, None) + }; + }; + +let matched_prod = (ctx, es, get_label_es, ty, constructor) => { + let (es, tys_opt) = + matched_prod_strict(ctx, es, get_label_es, ty, constructor); + ( + es, + tys_opt + |> Option.value( + ~default=List.init(List.length(es), _ => Unknown(Internal) |> temp), + ), + ); +}; let rec matched_list_strict = (ctx, ty) => switch (term_of(weak_head_normalize(ctx, ty))) { @@ -463,6 +581,7 @@ let rec get_sum_constructors = (ctx: Ctx.t, ty: t): option(sum_map) => { let rec is_unknown = (ty: t): bool => switch (ty |> term_of) { + | TupLabel(_, x) | Parens(x) => is_unknown(x) | Unknown(_) => true | _ => false @@ -477,7 +596,9 @@ let rec needs_parens = (ty: t): bool => | Int | Float | String + | Label(_) | Bool + | TupLabel(_, _) | Var(_) => false | Rec(_, _) | Forall(_, _) => true @@ -505,6 +626,7 @@ let rec pretty_print = (ty: t): string => | Float => "Float" | Bool => "Bool" | String => "String" + | Label(name) => name | Var(tvar) => tvar | List(t) => "[" ++ pretty_print(t) ++ "]" | Arrow(t1, t2) => paren_pretty_print(t1) ++ " -> " ++ pretty_print(t2) @@ -528,6 +650,7 @@ let rec pretty_print = (ty: t): string => ts, ) ++ ")" + | TupLabel(label, t) => pretty_print(label) ++ "=" ++ pretty_print(t) | Rec(tv, t) => "rec " ++ pretty_print_tvar(tv) ++ " -> " ++ pretty_print(t) | Forall(tv, t) => diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 8aaaeaae3d..8406edcb66 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -132,6 +132,7 @@ type status_variant = [@deriving (show({with_path: false}), sexp, yojson)] type typ_expects = | TypeExpected + | TupleExpected | ConstructorExpected(status_variant, Typ.t) | VariantExpected(status_variant, Typ.t); @@ -145,6 +146,7 @@ type error_typ = | FreeTypeVariable(string) /* Free type variable */ | DuplicateConstructor(Constructor.t) /* Duplicate ctr in same sum */ | WantTypeFoundAp + | WantTuple | WantConstructorFoundType(Typ.t) | WantConstructorFoundAp; @@ -464,6 +466,12 @@ let status_typ = (ctx: Ctx.t, expects: typ_expects, ty: Typ.t): status_typ => | VariantExpected(Duplicate, _) | ConstructorExpected(Duplicate, _) => InHole(DuplicateConstructor(name)) + | TupleExpected => + switch (Ctx.lookup_alias(ctx, name)) { + | Some({term: Prod(_), _}) => + NotInHole(TypeAlias(name, Typ.weak_head_normalize(ctx, ty))) + | _ => InHole(WantTuple) + } | TypeExpected => switch (Ctx.is_alias(ctx, name)) { | false => @@ -484,11 +492,22 @@ let status_typ = (ctx: Ctx.t, expects: typ_expects, ty: Typ.t): status_typ => NotInHole(VariantIncomplete(Arrow(ty_in, ty_variant) |> Typ.temp)) } | ConstructorExpected(_) => InHole(WantConstructorFoundAp) + | TupleExpected => InHole(WantTuple) | TypeExpected => InHole(WantTypeFoundAp) } + // | Dot(t1, _) => + // switch (expects, ty) { + // | (TupleExpected, _) => + // switch (t1.term) { + // | Tuple(_) => NotInHole(Type(ty)) + // | _ => InHole(WantTuple) + // } + // | _ => NotInHole(Type(ty)) + // } | _ => switch (expects) { | TypeExpected => NotInHole(Type(ty)) + | TupleExpected => InHole(WantTuple) | ConstructorExpected(_) | VariantExpected(_) => InHole(WantConstructorFoundType(ty)) } diff --git a/src/haz3lcore/statics/MakeTerm.re b/src/haz3lcore/statics/MakeTerm.re index 673af0bb89..2e9bd585df 100644 --- a/src/haz3lcore/statics/MakeTerm.re +++ b/src/haz3lcore/statics/MakeTerm.re @@ -277,7 +277,20 @@ and exp_term: unsorted => (UExp.term, list(Id.t)) = { } | Bin(Exp(l), tiles, Exp(r)) as tm => switch (is_tuple_exp(tiles)) { - | Some(between_kids) => ret(Tuple([l] @ between_kids @ [r])) + | Some(between_kids) => + let tuple_children: list(TermBase.Exp.t) = [l] @ between_kids @ [r]; + let mapping_fn: UExp.t => UExp.t = ( + (child: UExp.t) => { + switch (child) { + | {term: Tuple([{term: TupLabel(_), _} as tl]), _} => tl + | _ => child + }; + } + ); + let tuple_children: list(UExp.t) = + List.map(mapping_fn, tuple_children); + + ret(Tuple(tuple_children)); | None => switch (tiles) { | ([(_id, t)], []) => @@ -311,6 +324,21 @@ and exp_term: unsorted => (UExp.term, list(Id.t)) = { | ([";"], []) => Seq(l, r) | (["++"], []) => BinOp(String(Concat), l, r) | (["$=="], []) => BinOp(String(Equals), l, r) + | (["="], []) => + // TODO (Anthony): Other cases to convert to string + switch (l.term) { + | String(name) + | Var(name) => + Tuple([ + TupLabel( + {ids: l.ids, copied: l.copied, term: Label(name)}, + r, + ) + |> Exp.fresh, + ]) + | _ => TupLabel(l, r) + } + | (["."], []) => Dot(l, r) | (["|>"], []) => Ap(Reverse, r, l) | (["@"], []) => ListConcat(l, r) | _ => hole(tm) @@ -378,9 +406,32 @@ and pat_term: unsorted => (UPat.term, list(Id.t)) = { } | Bin(Pat(l), tiles, Pat(r)) as tm => switch (is_tuple_pat(tiles)) { - | Some(between_kids) => ret(Tuple([l] @ between_kids @ [r])) + | Some(between_kids) => + let tuple_children = [l] @ between_kids @ [r]; + let mapping_fn = (child: Pat.t) => { + switch (child) { + | {term: Tuple([{term: TupLabel(_), _} as tl]), _} => tl + | _ => child + }; + }; + let tuple_children = List.map(mapping_fn, tuple_children); + ret(Tuple(tuple_children)); + | None => switch (tiles) { + | ([(_id, (["="], []))], []) => + // TODO (Anthony): Other cases to convert to string + switch (l.term) { + | String(name) + | Var(name) => + ret( + Tuple([ + TupLabel({ids: l.ids, copied: l.copied, term: Label(name)}, r) + |> Pat.fresh, + ]), + ) + | _ => ret(TupLabel(l, r)) + } | ([(_id, (["::"], []))], []) => ret(Cons(l, r)) | _ => ret(hole(tm)) } @@ -453,10 +504,33 @@ and typ_term: unsorted => (UTyp.term, list(Id.t)) = { } | Bin(Typ(l), tiles, Typ(r)) as tm => switch (is_tuple_typ(tiles)) { - | Some(between_kids) => ret(Prod([l] @ between_kids @ [r])) + | Some(between_kids) => + let tuple_children = [l] @ between_kids @ [r]; + let mapping_fn = (child: Typ.t) => { + switch (child) { + | {term: Prod([{term: TupLabel(_), _} as tl]), _} => tl + | _ => child + }; + }; + let tuple_children: list(Typ.t) = List.map(mapping_fn, tuple_children); + + ret(Prod(tuple_children)); | None => switch (tiles) { | ([(_id, (["->"], []))], []) => ret(Arrow(l, r)) + | ([(_id, (["="], []))], []) => + // TODO (Anthony): Other cases to convert to string + switch (l.term) { + | Var(name) => + ret( + Prod([ + TupLabel({ids: l.ids, copied: l.copied, term: Label(name)}, r) + |> Typ.fresh, + ]), + ) + | _ => ret(TupLabel(l, r)) + } + // | ([(_id, (["."], []))], []) => ret(Dot(l, r)) | _ => ret(hole(tm)) } } diff --git a/src/haz3lcore/statics/Mode.re b/src/haz3lcore/statics/Mode.re index 5a85dbecd9..155d91f6bb 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -60,12 +60,32 @@ let of_forall = (ctx: Ctx.t, name_opt: option(string), mode: t): t => }; }; -let of_prod = (ctx: Ctx.t, mode: t, length): list(t) => +let of_label = (ctx: Ctx.t, mode: t): (t, t) => switch (mode) { | Syn | SynFun - | SynTypFun => List.init(length, _ => Syn) - | Ana(ty) => ty |> Typ.matched_prod(ctx, length) |> List.map(ana) + | SynTypFun => (Syn, Syn) + | Ana(ty) => + let (ty1, ty2) = Typ.matched_label(ctx, ty); + (ana(ty1), ana(ty2)); + }; + +let of_prod = + ( + ctx: Ctx.t, + mode: t, + es: list('a), + filt: 'a => option((string, 'a)), + constructor: (string, 'a) => 'a, + ) + : (list('a), list(t)) => + switch (mode) { + | Syn + | SynFun + | SynTypFun => (es, List.init(List.length(es), _ => Syn)) + | Ana(ty) => + let (es, tys) = Typ.matched_prod(ctx, es, filt, ty, constructor); + (es, tys |> List.map(ana)); }; let of_cons_hd = (ctx: Ctx.t, mode: t): t => diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index aca1ce0389..bfcca349d8 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -185,9 +185,25 @@ and uexp_to_info_map = let add' = (~self, ~co_ctx, m) => { let info = Info.derived_exp(~uexp, ~ctx, ~mode, ~ancestors, ~self, ~co_ctx); + (info, add_info(ids, InfoExp(info), m)); }; - let add = (~self, ~co_ctx, m) => add'(~self=Common(self), ~co_ctx, m); + let add = (~self, ~co_ctx, m) => { + add'(~self=Common(self), ~co_ctx, m); + }; + // add if uexp changed + // let add_exp = (~self, ~co_ctx, ~uexp, m) => { + // let info = + // Info.derived_exp( + // ~uexp, + // ~ctx, + // ~mode, + // ~ancestors, + // ~self=Common(self), + // ~co_ctx, + // ); + // (info, add_info(ids, InfoExp(info), m)); + // }; let ancestors = [UExp.rep_id(uexp)] @ ancestors; let uexp_to_info_map = ( @@ -209,458 +225,634 @@ 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); - switch (term) { - | Closure(_) => - failwith( - "TODO: implement closure type checking - see how dynamic type assignment does it", - ) - | MultiHole(tms) => - let (co_ctxs, m) = multi(~ctx, ~ancestors, m, tms); - add(~self=IsMulti, ~co_ctx=CoCtx.union(co_ctxs), m); - | Cast(e, t1, t2) - | FailedCast(e, t1, t2) => - let (e, m) = go(~mode=Ana(t1), e, m); - add(~self=Just(t2), ~co_ctx=e.co_ctx, m); - | Invalid(token) => atomic(BadToken(token)) - | EmptyHole => atomic(Just(Unknown(Internal) |> Typ.temp)) - | Deferral(position) => - add'(~self=IsDeferral(position), ~co_ctx=CoCtx.empty, m) - | Undefined => atomic(Just(Unknown(Hole(EmptyHole)) |> Typ.temp)) - | Bool(_) => atomic(Just(Bool |> Typ.temp)) - | Int(_) => atomic(Just(Int |> Typ.temp)) - | Float(_) => atomic(Just(Float |> Typ.temp)) - | String(_) => atomic(Just(String |> Typ.temp)) - | ListLit(es) => - let ids = List.map(UExp.rep_id, es); - let modes = Mode.of_list_lit(ctx, List.length(es), 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) |> Typ.temp, ctx, tys, ids), - ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es)), - 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); - add( - ~self=Just(List(hd.ty) |> Typ.temp), - ~co_ctx=CoCtx.union([hd.co_ctx, tl.co_ctx]), - m, - ); - | ListConcat(e1, e2) => - let mode = Mode.of_list_concat(ctx, mode); - let ids = List.map(UExp.rep_id, [e1, e2]); - 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]), - m, - ); - | Var(name) => - add'( - ~self=Self.of_exp_var(ctx, name), - ~co_ctx=CoCtx.singleton(name, UExp.rep_id(uexp), Mode.ty_of(mode)), - m, - ) - | DynamicErrorHole(e, _) - | Parens(e) => - let (e, m) = go(~mode, e, m); - add(~self=Just(e.ty), ~co_ctx=e.co_ctx, m); - | UnOp(Meta(Unquote), e) when is_in_filter => - let e: UExp.t = { - ids: e.ids, - copied: false, - term: - switch (e.term) { - | Var("e") => UExp.Constructor("$e", Unknown(Internal) |> Typ.temp) - | Var("v") => UExp.Constructor("$v", Unknown(Internal) |> Typ.temp) - | _ => e.term - }, - }; - let ty_in = Typ.Var("$Meta") |> Typ.temp; - let ty_out = Typ.Unknown(Internal) |> Typ.temp; - let (e, m) = go(~mode=Ana(ty_in), e, m); - add(~self=Just(ty_out), ~co_ctx=e.co_ctx, 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); - | 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); - | BuiltinFun(string) => - add'( - ~self=Self.of_exp_var(Builtins.ctx_init, string), - ~co_ctx=CoCtx.empty, - m, - ) - | Tuple(es) => - let modes = Mode.of_prod(ctx, mode, List.length(es)); - let (es, m) = map_m_go(m, modes, es); - add( - ~self=Just(Prod(List.map(Info.exp_ty, es)) |> Typ.temp), - ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es)), - m, - ); - | Test(e) => - let (e, m) = go(~mode=Ana(Bool |> Typ.temp), e, m); - add(~self=Just(Prod([]) |> Typ.temp), ~co_ctx=e.co_ctx, m); - | Filter(Filter({pat: cond, _}), body) => - let (cond, m) = go(~mode=Syn, cond, m, ~is_in_filter=true); - let (body, m) = go(~mode, body, m); - add( - ~self=Just(body.ty), - ~co_ctx=CoCtx.union([cond.co_ctx, body.co_ctx]), - m, - ); - | Filter(Residue(_), body) => - let (body, m) = go(~mode, body, m); - add(~self=Just(body.ty), ~co_ctx=CoCtx.union([body.co_ctx]), 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); - | 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 (arg, m) = go(~mode=Ana(ty_in), arg, m); - let self: Self.t = - Id.is_nullary_ap_flag(arg.term.ids) - && !Typ.is_consistent(ctx, ty_in, Prod([]) |> Typ.temp) - ? BadTrivAp(ty_in) : Just(ty_out); - add(~self, ~co_ctx=CoCtx.union([fn.co_ctx, arg.co_ctx]), m); - | TypAp(fn, utyp) => - let typfn_mode = Mode.typap_mode; - let (fn, m) = go(~mode=typfn_mode, fn, m); - let (_, m) = utyp_to_info_map(~ctx, ~ancestors, utyp, m); - let (option_name, ty_body) = Typ.matched_forall(ctx, fn.ty); - switch (option_name) { - | Some(name) => - add(~self=Just(Typ.subst(utyp, name, ty_body)), ~co_ctx=fn.co_ctx, m) - | None => add(~self=Just(ty_body), ~co_ctx=fn.co_ctx, m) /* invalid name matches with no free type variables. */ - }; - | DeferredAp(fn, args) => - 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 num_args = List.length(args); - let ty_ins = Typ.matched_args(ctx, num_args, ty_in); - let self: Self.exp = Self.of_deferred_ap(args, ty_ins, ty_out); - let modes = Mode.of_deferred_ap_args(num_args, ty_ins); - let (args, m) = map_m_go(m, modes, args); - let arg_co_ctx = CoCtx.union(List.map(Info.exp_co_ctx, args)); - add'(~self, ~co_ctx=CoCtx.union([fn.co_ctx, arg_co_ctx]), m); - | Fun(p, e, _, _) => - let (mode_pat, mode_body) = Mode.of_arrow(ctx, mode); - let (p', _) = - go_pat(~is_synswitch=false, ~co_ctx=CoCtx.empty, ~mode=mode_pat, 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); - // TODO: factor out code - let unwrapped_self: Self.exp = - Common(Just(Arrow(p.ty, e.ty) |> Typ.temp)); - let is_exhaustive = p |> Info.pat_constraint |> Incon.is_exhaustive; - let self = - is_exhaustive ? unwrapped_self : InexhaustiveMatch(unwrapped_self); - add'(~self, ~co_ctx=CoCtx.mk(ctx, p.ctx, e.co_ctx), m); - | TypFun({term: Var(name), _} as utpat, body, _) - when !Ctx.shadows_typ(ctx, name) => - let mode_body = Mode.of_forall(ctx, Some(name), mode); - let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; - let ctx_body = - Ctx.extend_tvar(ctx, {name, id: TPat.rep_id(utpat), kind: Abstract}); - let (body, m) = go'(~ctx=ctx_body, ~mode=mode_body, body, m); - add( - ~self=Just(Forall(utpat, body.ty) |> Typ.temp), - ~co_ctx=body.co_ctx, - m, - ); - | TypFun(utpat, body, _) => - let mode_body = Mode.of_forall(ctx, None, mode); - let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; - let (body, m) = go(~mode=mode_body, body, m); - add( - ~self=Just(Forall(utpat, body.ty) |> Typ.temp), - ~co_ctx=body.co_ctx, - m, - ); - | Let(p, def, body) => - let (p_syn, _) = - go_pat(~is_synswitch=true, ~co_ctx=CoCtx.empty, ~mode=Syn, p, m); - let (def, p_ana_ctx, m, ty_p_ana) = - if (!is_recursive(ctx, p, def, p_syn.ty)) { - let (def, m) = go(~mode=Ana(p_syn.ty), def, m); - let ty_p_ana = def.ty; - let (p_ana', _) = - go_pat( - ~is_synswitch=false, - ~co_ctx=CoCtx.empty, - ~mode=Ana(ty_p_ana), - p, - m, - ); - (def, p_ana'.ctx, m, ty_p_ana); - } else { - let (def_base, _) = - go'(~ctx=p_syn.ctx, ~mode=Ana(p_syn.ty), def, m); - let ty_p_ana = def_base.ty; - /* Analyze pattern to incorporate def type into ctx */ - let (p_ana', _) = - go_pat( - ~is_synswitch=false, - ~co_ctx=CoCtx.empty, - ~mode=Ana(ty_p_ana), - p, - m, - ); - let def_ctx = p_ana'.ctx; - let (def_base2, _) = go'(~ctx=def_ctx, ~mode=Ana(p_syn.ty), def, m); - let ana_ty_fn = ((ty_fn1, ty_fn2), ty_p) => { - Typ.term_of(ty_p) == Typ.Unknown(SynSwitch) - && !Typ.eq(ty_fn1, ty_fn2) - ? ty_fn1 : ty_p; + let atomic = self => { + add(~self, ~co_ctx=CoCtx.empty, m); + }; + + let default_case = () => { + switch (term) { + | Closure(_) => + failwith( + "TODO: implement closure type checking - see how dynamic type assignment does it", + ) + | MultiHole(tms) => + let (co_ctxs, m) = multi(~ctx, ~ancestors, m, tms); + add(~self=IsMulti, ~co_ctx=CoCtx.union(co_ctxs), m); + | Cast(e, t1, t2) + | FailedCast(e, t1, t2) => + let (e, m) = go(~mode=Ana(t1), e, m); + add(~self=Just(t2), ~co_ctx=e.co_ctx, m); + | Invalid(token) => atomic(BadToken(token)) + | EmptyHole => atomic(Just(Unknown(Internal) |> Typ.temp)) + | Deferral(position) => + add'(~self=IsDeferral(position), ~co_ctx=CoCtx.empty, m) + | Undefined => atomic(Just(Unknown(Hole(EmptyHole)) |> Typ.temp)) + | Bool(_) => atomic(Just(Bool |> Typ.temp)) + | Int(_) => atomic(Just(Int |> Typ.temp)) + | Float(_) => atomic(Just(Float |> Typ.temp)) + | String(_) => atomic(Just(String |> Typ.temp)) + | Label(name) => atomic(Just(Label(name) |> Typ.temp)) + | ListLit(es) => + let ids = List.map(UExp.rep_id, es); + let modes = Mode.of_list_lit(ctx, List.length(es), 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) |> Typ.temp, ctx, tys, ids), + ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es)), + 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); + add( + ~self=Just(List(hd.ty) |> Typ.temp), + ~co_ctx=CoCtx.union([hd.co_ctx, tl.co_ctx]), + m, + ); + | ListConcat(e1, e2) => + let mode = Mode.of_list_concat(ctx, mode); + let ids = List.map(UExp.rep_id, [e1, e2]); + 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]), + m, + ); + | Var(name) => + add'( + ~self=Self.of_exp_var(ctx, name), + ~co_ctx=CoCtx.singleton(name, UExp.rep_id(uexp), Mode.ty_of(mode)), + m, + ) + | DynamicErrorHole(e, _) + | Parens(e) => + let (e, m) = go(~mode, e, m); + add(~self=Just(e.ty), ~co_ctx=e.co_ctx, m); + | UnOp(Meta(Unquote), e) when is_in_filter => + let e: UExp.t = { + ids: e.ids, + copied: false, + term: + switch (e.term) { + | Var("e") => UExp.Constructor("$e", Unknown(Internal) |> Typ.temp) + | Var("v") => UExp.Constructor("$v", Unknown(Internal) |> Typ.temp) + | _ => e.term + }, + }; + let ty_in = Typ.Var("$Meta") |> Typ.temp; + let ty_out = Typ.Unknown(Internal) |> Typ.temp; + let (e, m) = go(~mode=Ana(ty_in), e, m); + add(~self=Just(ty_out), ~co_ctx=e.co_ctx, 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); + | 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, + ); + | TupLabel(label, e) => + let (labmode, mode) = Mode.of_label(ctx, mode); + let (lab, m) = go(~mode=labmode, label, m); + let (e, m) = go(~mode, e, m); + add( + ~self=Just(TupLabel(lab.ty, e.ty) |> Typ.temp), + ~co_ctx=CoCtx.union([lab.co_ctx, e.co_ctx]), + m, + ); + | BuiltinFun(string) => + add'( + ~self=Self.of_exp_var(Builtins.ctx_init, string), + ~co_ctx=CoCtx.empty, + m, + ) + | Tuple(es) => + let (es, modes) = + Mode.of_prod(ctx, mode, es, UExp.get_label, (name, b) => + TupLabel(Label(name) |> Exp.fresh, b) |> Exp.fresh + ); + let (es', m) = map_m_go(m, modes, es); + add( + ~self=Just(Prod(List.map(Info.exp_ty, es')) |> Typ.temp), + ~co_ctx=CoCtx.union(List.map(Info.exp_co_ctx, es')), + m, + ); + | Dot(e1, e2) => + let (info_e1, m) = go(~mode=Syn, e1, m); + let (ty, m) = { + switch (e2.term, info_e1.ty.term) { + | (Var(name), Unknown(_)) => + let ty = + Typ.Prod([ + TupLabel( + Label(name) |> Typ.temp, + Unknown(Internal) |> Typ.temp, + ) + |> Typ.temp, + ]) + |> Typ.temp; + let (_, m) = go(~mode=Mode.Ana(ty), e1, m); + (ty, m); + | (_, Var(_)) => (Typ.weak_head_normalize(ctx, info_e1.ty), m) + | _ => (info_e1.ty, m) }; - let ana = - switch ( - (def_base.ty |> Typ.term_of, def_base2.ty |> Typ.term_of), - p_syn.ty |> Typ.term_of, - ) { - | ((Prod(ty_fns1), Prod(ty_fns2)), Prod(ty_ps)) => - let tys = - List.map2(ana_ty_fn, List.combine(ty_fns1, ty_fns2), ty_ps); - Typ.Prod(tys) |> Typ.temp; - | ((_, _), _) => ana_ty_fn((def_base.ty, def_base2.ty), p_syn.ty) + }; + switch (ty.term) { + | Prod(ts) => + switch (e2.term) { + | Var(name) => + let element: option(Typ.t) = + LabeledTuple.find_label(Typ.get_label, ts, name); + // let m = + // e2.ids + // |> List.fold_left( + // (m, id) => + // Id.Map.update( + // id, + // fun + // | Some(Info.InfoExp(exp)) => + // Some(Info.InfoExp({...exp, ctx})) + // | _ as info => info, + // m, + // ), + // m, + // ); + switch (element) { + | Some({term: TupLabel(_, typ), _}) + | Some(typ) => + let (body, m) = + go'( + ~ctx=[ + VarEntry({ + name, + id: List.nth(e2.ids, 0), + typ: Unknown(Internal) |> Typ.temp, + }), + ], + ~mode, + e2, + m, + ); + add(~self=Just(typ), ~co_ctx=body.co_ctx, m); + | None => + let (body, m) = go'(~ctx=[], ~mode, e2, m); + add(~self=Just(body.ty), ~co_ctx=body.co_ctx, m); }; - let (def, m) = go'(~ctx=def_ctx, ~mode=Ana(ana), def, m); - (def, def_ctx, m, ty_p_ana); + | _ => + let (body, m) = go'(~ctx=[], ~mode, e2, m); + add(~self=Just(body.ty), ~co_ctx=body.co_ctx, m); + } + | _ => + let (body, m) = go'(~ctx=[], ~mode, e2, m); + add(~self=Just(body.ty), ~co_ctx=body.co_ctx, m); }; - let (body, m) = go'(~ctx=p_ana_ctx, ~mode, body, m); - /* add co_ctx to pattern */ - let (p_ana, m) = - go_pat( - ~is_synswitch=false, - ~co_ctx=body.co_ctx, - ~mode=Ana(ty_p_ana), - p, + | Test(e) => + let (e, m) = go(~mode=Ana(Bool |> Typ.temp), e, m); + add(~self=Just(Prod([]) |> Typ.temp), ~co_ctx=e.co_ctx, m); + | Filter(Filter({pat: cond, _}), body) => + let (cond, m) = go(~mode=Syn, cond, m, ~is_in_filter=true); + let (body, m) = go(~mode, body, m); + add( + ~self=Just(body.ty), + ~co_ctx=CoCtx.union([cond.co_ctx, body.co_ctx]), m, ); - // TODO: factor out code - let unwrapped_self: Self.exp = Common(Just(body.ty)); - let is_exhaustive = p_ana |> Info.pat_constraint |> Incon.is_exhaustive; - let self = - is_exhaustive ? unwrapped_self : InexhaustiveMatch(unwrapped_self); - add'( - ~self, - ~co_ctx= - CoCtx.union([def.co_ctx, CoCtx.mk(ctx, p_ana.ctx, body.co_ctx)]), - m, - ); - | FixF(p, e, _) => - let (p', _) = - go_pat(~is_synswitch=false, ~co_ctx=CoCtx.empty, ~mode, p, m); - let (e', m) = go'(~ctx=p'.ctx, ~mode=Ana(p'.ty), e, m); - let (p'', m) = - go_pat(~is_synswitch=false, ~co_ctx=e'.co_ctx, ~mode, p, m); - add( - ~self=Just(p'.ty), - ~co_ctx=CoCtx.union([CoCtx.mk(ctx, p''.ctx, e'.co_ctx)]), - m, - ); - | If(e0, e1, e2) => - let branch_ids = List.map(UExp.rep_id, [e1, e2]); - let (cond, m) = go(~mode=Ana(Bool |> Typ.temp), e0, m); - let (cons, m) = go(~mode, e1, m); - let (alt, m) = go(~mode, e2, m); - add( - ~self=Self.match(ctx, [cons.ty, alt.ty], branch_ids), - ~co_ctx=CoCtx.union([cond.co_ctx, cons.co_ctx, alt.co_ctx]), - m, - ); - | Match(scrut, rules) => - let (scrut, m) = go(~mode=Syn, scrut, m); - let (ps, es) = List.split(rules); - let branch_ids = List.map(UExp.rep_id, es); - let (ps', _) = - map_m( + | Filter(Residue(_), body) => + let (body, m) = go(~mode, body, m); + add(~self=Just(body.ty), ~co_ctx=CoCtx.union([body.co_ctx]), 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, + ); + | 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); + // In case of singleton tuple for fun ty_in, implicitly convert arg if necessary + // TODO: Is needed for TypAp or Deferred Ap? + let arg = + switch (arg.term, Typ.weak_head_normalize(ctx, ty_in).term) { + | (Tuple(es), Prod(ts)) => + let es' = + LabeledTuple.rearrange( + Typ.get_label, Exp.get_label, ts, es, (name, e) => + TupLabel(Label(name) |> Exp.fresh, e) |> Exp.fresh + ); + let arg: Exp.t = { + term: Exp.Tuple(es'), + ids: arg.ids, + copied: arg.copied, + }; + arg; + | (TupLabel(_), Prod([{term: TupLabel(_), _}])) => + Tuple([arg]) |> Exp.fresh + | (_, Prod([{term: TupLabel({term: Label(name), _}, _), _}])) => + Tuple([TupLabel(Label(name) |> Exp.fresh, arg) |> Exp.fresh]) + |> Exp.fresh + | (_, _) => arg + }; + let (arg, m) = go(~mode=Ana(ty_in), arg, m); + let self: Self.t = + Id.is_nullary_ap_flag(arg.term.ids) + && !Typ.is_consistent(ctx, ty_in, Prod([]) |> Typ.temp) + ? BadTrivAp(ty_in) : Just(ty_out); + add(~self, ~co_ctx=CoCtx.union([fn.co_ctx, arg.co_ctx]), m); + | TypAp(fn, utyp) => + let typfn_mode = Mode.typap_mode; + let (fn, m) = go(~mode=typfn_mode, fn, m); + let (_, m) = utyp_to_info_map(~ctx, ~ancestors, utyp, m); + let (option_name, ty_body) = Typ.matched_forall(ctx, fn.ty); + switch (option_name) { + | Some(name) => + add( + ~self=Just(Typ.subst(utyp, name, ty_body)), + ~co_ctx=fn.co_ctx, + m, + ) + | None => add(~self=Just(ty_body), ~co_ctx=fn.co_ctx, m) /* invalid name matches with no free type variables. */ + }; + | DeferredAp(fn, args) => + 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 num_args = List.length(args); + let ty_ins = Typ.matched_args(ctx, num_args, ty_in); + let self: Self.exp = Self.of_deferred_ap(args, ty_ins, ty_out); + let modes = Mode.of_deferred_ap_args(num_args, ty_ins); + let (args, m) = map_m_go(m, modes, args); + let arg_co_ctx = CoCtx.union(List.map(Info.exp_co_ctx, args)); + add'(~self, ~co_ctx=CoCtx.union([fn.co_ctx, arg_co_ctx]), m); + | Fun(p, e, _, _) => + let (mode_pat, mode_body) = Mode.of_arrow(ctx, mode); + let (p', _) = go_pat( ~is_synswitch=false, ~co_ctx=CoCtx.empty, - ~mode=Mode.Ana(scrut.ty), - ), - ps, + ~mode=mode_pat, + 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); + // TODO: factor out code + let unwrapped_self: Self.exp = + Common(Just(Arrow(p''.ty, e.ty) |> Typ.temp)); + let is_exhaustive = p'' |> Info.pat_constraint |> Incon.is_exhaustive; + let self = + is_exhaustive ? unwrapped_self : InexhaustiveMatch(unwrapped_self); + add'(~self, ~co_ctx=CoCtx.mk(ctx, p''.ctx, e.co_ctx), m); + | TypFun({term: Var(name), _} as utpat, body, _) + when !Ctx.shadows_typ(ctx, name) => + let mode_body = Mode.of_forall(ctx, Some(name), mode); + let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; + let ctx_body = + Ctx.extend_tvar( + ctx, + {name, id: TPat.rep_id(utpat), kind: Abstract}, + ); + let (body, m) = go'(~ctx=ctx_body, ~mode=mode_body, body, m); + add( + ~self=Just(Forall(utpat, body.ty) |> Typ.temp), + ~co_ctx=body.co_ctx, m, ); - let p_ctxs = List.map(Info.pat_ctx, ps'); - let (es, m) = - List.fold_left2( - ((es, m), e, ctx) => - go'(~ctx, ~mode, e, m) |> (((e, m)) => (es @ [e], m)), - ([], m), - es, - p_ctxs, + | TypFun(utpat, body, _) => + let mode_body = Mode.of_forall(ctx, None, mode); + let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; + let (body, m) = go(~mode=mode_body, body, m); + add( + ~self=Just(Forall(utpat, body.ty) |> Typ.temp), + ~co_ctx=body.co_ctx, + m, ); - let e_tys = List.map(Info.exp_ty, es); - let e_co_ctxs = - List.map2(CoCtx.mk(ctx), p_ctxs, List.map(Info.exp_co_ctx, es)); - let unwrapped_self: Self.exp = - Common(Self.match(ctx, e_tys, branch_ids)); - let constraint_ty = - switch (scrut.ty.term) { - | Unknown(_) => - map_m(go_pat(~is_synswitch=false, ~co_ctx=CoCtx.empty), ps, m) - |> fst - |> List.map(Info.pat_ty) - |> Typ.join_all(~empty=Unknown(Internal) |> Typ.temp, ctx) - | _ => Some(scrut.ty) - }; - let (self, m) = - switch (constraint_ty) { - | Some(constraint_ty) => - let pats_to_info_map = (ps: list(UPat.t), m) => { + | Let(p, def, body) => + let (p_syn, _) = + go_pat(~is_synswitch=true, ~co_ctx=CoCtx.empty, ~mode=Syn, p, m); + let (def, p_ana_ctx, m, ty_p_ana) = + if (!is_recursive(ctx, p, def, p_syn.ty)) { + let (def, m) = go(~mode=Ana(p_syn.ty), def, m); + let ty_p_ana = def.ty; + let (p_ana', _) = + go_pat( + ~is_synswitch=false, + ~co_ctx=CoCtx.empty, + ~mode=Ana(ty_p_ana), + p, + m, + ); + (def, p_ana'.ctx, m, ty_p_ana); + } else { + let (def_base, _) = + go'(~ctx=p_syn.ctx, ~mode=Ana(p_syn.ty), def, m); + let ty_p_ana = def_base.ty; + /* Analyze pattern to incorporate def type into ctx */ + let (p_ana', _) = + go_pat( + ~is_synswitch=false, + ~co_ctx=CoCtx.empty, + ~mode=Ana(ty_p_ana), + p, + m, + ); + let def_ctx = p_ana'.ctx; + let (def_base2, _) = + go'(~ctx=def_ctx, ~mode=Ana(p_syn.ty), def, m); + let ana_ty_fn = ((ty_fn1, ty_fn2), ty_p) => { + Typ.term_of(ty_p) == Typ.Unknown(SynSwitch) + && !Typ.eq(ty_fn1, ty_fn2) + ? ty_fn1 : ty_p; + }; + let ana = + switch ( + (def_base.ty |> Typ.term_of, def_base2.ty |> Typ.term_of), + p_syn.ty |> Typ.term_of, + ) { + | ((Prod(ty_fns1), Prod(ty_fns2)), Prod(ty_ps)) => + let tys = + List.map2(ana_ty_fn, List.combine(ty_fns1, ty_fns2), ty_ps); + Typ.Prod(tys) |> Typ.temp; + | ((_, _), _) => + ana_ty_fn((def_base.ty, def_base2.ty), p_syn.ty) + }; + let (def, m) = go'(~ctx=def_ctx, ~mode=Ana(ana), def, m); + (def, def_ctx, m, ty_p_ana); + }; + let (body, m) = go'(~ctx=p_ana_ctx, ~mode, body, m); + /* add co_ctx to pattern */ + let (p_ana, m) = + go_pat( + ~is_synswitch=false, + ~co_ctx=body.co_ctx, + ~mode=Ana(ty_p_ana), + p, + m, + ); + // TODO: factor out code + let unwrapped_self: Self.exp = Common(Just(body.ty)); + let is_exhaustive = p_ana |> Info.pat_constraint |> Incon.is_exhaustive; + let self = + is_exhaustive ? unwrapped_self : InexhaustiveMatch(unwrapped_self); + add'( + ~self, + ~co_ctx= + CoCtx.union([def.co_ctx, CoCtx.mk(ctx, p_ana.ctx, body.co_ctx)]), + m, + ); + | FixF(p, e, _) => + let (p', _) = + go_pat(~is_synswitch=false, ~co_ctx=CoCtx.empty, ~mode, p, m); + let (e', m) = go'(~ctx=p'.ctx, ~mode=Ana(p'.ty), e, m); + let (p'', m) = + go_pat(~is_synswitch=false, ~co_ctx=e'.co_ctx, ~mode, p, m); + add( + ~self=Just(p'.ty), + ~co_ctx=CoCtx.union([CoCtx.mk(ctx, p''.ctx, e'.co_ctx)]), + m, + ); + | If(e0, e1, e2) => + let branch_ids = List.map(UExp.rep_id, [e1, e2]); + let (cond, m) = go(~mode=Ana(Bool |> Typ.temp), e0, m); + let (cons, m) = go(~mode, e1, m); + let (alt, m) = go(~mode, e2, m); + add( + ~self=Self.match(ctx, [cons.ty, alt.ty], branch_ids), + ~co_ctx=CoCtx.union([cond.co_ctx, cons.co_ctx, alt.co_ctx]), + m, + ); + | Match(scrut, rules) => + let (scrut, m) = go(~mode=Syn, scrut, m); + let (ps, es) = List.split(rules); + let branch_ids = List.map(UExp.rep_id, es); + let (ps', _) = + map_m( + go_pat( + ~is_synswitch=false, + ~co_ctx=CoCtx.empty, + ~mode=Mode.Ana(scrut.ty), + ), + ps, + m, + ); + let p_ctxs = List.map(Info.pat_ctx, ps'); + let (es, m) = + List.fold_left2( + ((es, m), e, ctx) => + go'(~ctx, ~mode, e, m) |> (((e, m)) => (es @ [e], m)), + ([], m), + es, + p_ctxs, + ); + let e_tys = List.map(Info.exp_ty, es); + let e_co_ctxs = + List.map2(CoCtx.mk(ctx), p_ctxs, List.map(Info.exp_co_ctx, es)); + let unwrapped_self: Self.exp = + Common(Self.match(ctx, e_tys, branch_ids)); + let constraint_ty = + switch (scrut.ty.term) { + | Unknown(_) => + map_m(go_pat(~is_synswitch=false, ~co_ctx=CoCtx.empty), ps, m) + |> fst + |> List.map(Info.pat_ty) + |> Typ.join_all(~empty=Unknown(Internal) |> Typ.temp, ctx) + | _ => Some(scrut.ty) + }; + let (self, m) = + switch (constraint_ty) { + | Some(constraint_ty) => + let pats_to_info_map = (ps: list(UPat.t), m) => { + /* Add co-ctxs to patterns */ + List.fold_left( + ((m, acc_constraint), (p, co_ctx)) => { + let p_constraint = + go_pat( + ~is_synswitch=false, + ~co_ctx, + ~mode=Mode.Ana(constraint_ty), + p, + m, + ) + |> fst + |> Info.pat_constraint; + let (p, m) = + go_pat( + ~is_synswitch=false, + ~co_ctx, + ~mode=Mode.Ana(scrut.ty), + p, + m, + ); + let is_redundant = + Incon.is_redundant(p_constraint, acc_constraint); + let self = is_redundant ? Self.Redundant(p.self) : p.self; + let info = + Info.derived_pat( + ~upat=p.term, + ~ctx=p.ctx, + ~co_ctx=p.co_ctx, + ~mode=p.mode, + ~ancestors=p.ancestors, + ~prev_synswitch=None, + ~self, + // Mark patterns as redundant at the top level + // because redundancy doesn't make sense in a smaller context + ~constraint_=p_constraint, + ); + ( + // Override the info for the single upat + add_info(p.term.ids, InfoPat(info), m), + is_redundant + ? acc_constraint // Redundant patterns are ignored + : Constraint.Or(p_constraint, acc_constraint), + ); + }, + (m, Constraint.Falsity), + List.combine(ps, e_co_ctxs), + ); + }; + let (m, final_constraint) = pats_to_info_map(ps, m); + let is_exhaustive = Incon.is_exhaustive(final_constraint); + let self = + is_exhaustive + ? unwrapped_self : InexhaustiveMatch(unwrapped_self); + (self, m); + | None => /* Add co-ctxs to patterns */ - List.fold_left( - ((m, acc_constraint), (p, co_ctx)) => { - let p_constraint = - go_pat( - ~is_synswitch=false, - ~co_ctx, - ~mode=Mode.Ana(constraint_ty), - p, - m, - ) - |> fst - |> Info.pat_constraint; - let (p, m) = + let (_, m) = + map_m( + ((p, co_ctx)) => go_pat( ~is_synswitch=false, ~co_ctx, ~mode=Mode.Ana(scrut.ty), p, - m, - ); - let is_redundant = - Incon.is_redundant(p_constraint, acc_constraint); - let self = is_redundant ? Self.Redundant(p.self) : p.self; - let info = - Info.derived_pat( - ~upat=p.term, - ~ctx=p.ctx, - ~co_ctx=p.co_ctx, - ~mode=p.mode, - ~ancestors=p.ancestors, - ~prev_synswitch=None, - ~self, - // Mark patterns as redundant at the top level - // because redundancy doesn't make sense in a smaller context - ~constraint_=p_constraint, - ); - ( - // Override the info for the single upat - add_info(p.term.ids, InfoPat(info), m), - is_redundant - ? acc_constraint // Redundant patterns are ignored - : Constraint.Or(p_constraint, acc_constraint), - ); - }, - (m, Constraint.Falsity), - List.combine(ps, e_co_ctxs), - ); + ), + List.combine(ps, e_co_ctxs), + m, + ); + (unwrapped_self, m); }; - let (m, final_constraint) = pats_to_info_map(ps, m); - let is_exhaustive = Incon.is_exhaustive(final_constraint); - let self = - is_exhaustive ? unwrapped_self : InexhaustiveMatch(unwrapped_self); - (self, m); - | None => - /* Add co-ctxs to patterns */ - let (_, m) = - map_m( - ((p, co_ctx)) => - go_pat( - ~is_synswitch=false, - ~co_ctx, - ~mode=Mode.Ana(scrut.ty), - p, - ), - List.combine(ps, e_co_ctxs), - m, - ); - (unwrapped_self, m); - }; - add'(~self, ~co_ctx=CoCtx.union([scrut.co_ctx] @ e_co_ctxs), m); - | TyAlias(typat, utyp, body) => - let m = utpat_to_info_map(~ctx, ~ancestors, typat, m) |> snd; - switch (typat.term) { - | Var(name) when !Ctx.shadows_typ(ctx, name) => - /* Currently we disallow all type shadowing */ - /* NOTE(andrew): Currently, UTyp.to_typ returns Unknown(TypeHole) - for any type variable reference not in its ctx. So any free variables - in the definition would be obliterated. But we need to check for free - variables to decide whether to make a recursive type or not. So we - tentatively add an abtract type to the ctx, representing the - speculative rec parameter. */ - let (ty_def, ctx_def, ctx_body) = { - switch (utyp.term) { - | Sum(_) when List.mem(name, Typ.free_vars(utyp)) => - /* NOTE: When debugging type system issues it may be beneficial to - use a different name than the alias for the recursive parameter */ - //let ty_rec = Typ.Rec("α", Typ.subst(Var("α"), name, ty_pre)); - let ty_rec = - Typ.Rec(TPat.Var(name) |> IdTagged.fresh, utyp) |> Typ.temp; - let ctx_def = - Ctx.extend_alias(ctx, name, TPat.rep_id(typat), ty_rec); - (ty_rec, ctx_def, ctx_def); - | _ => ( - utyp, - ctx, - Ctx.extend_alias(ctx, name, TPat.rep_id(typat), utyp), - ) - /* NOTE(yuchen): Below is an alternative implementation that attempts to - add a rec whenever type alias is present. It may cause trouble to the - runtime, so precede with caution. */ - // Typ.lookup_surface(ty_pre) - // ? { - // let ty_rec = Typ.Rec({item: ty_pre, name}); - // let ctx_def = Ctx.add_alias(ctx, name, utpat_id(typat), ty_rec); - // (ty_rec, ctx_def, ctx_def); - // } - // : { - // let ty = Term.UTyp.to_typ(ctx, utyp); - // (ty, ctx, Ctx.add_alias(ctx, name, utpat_id(typat), ty)); - // }; + add'(~self, ~co_ctx=CoCtx.union([scrut.co_ctx] @ e_co_ctxs), m); + | TyAlias(typat, utyp, body) => + let m = utpat_to_info_map(~ctx, ~ancestors, typat, m) |> snd; + switch (typat.term) { + | Var(name) when !Ctx.shadows_typ(ctx, name) => + /* Currently we disallow all type shadowing */ + /* NOTE(andrew): Currently, UTyp.to_typ returns Unknown(TypeHole) + for any type variable reference not in its ctx. So any free variables + in the definition would be obliterated. But we need to check for free + variables to decide whether to make a recursive type or not. So we + tentatively add an abtract type to the ctx, representing the + speculative rec parameter. */ + let (ty_def, ctx_def, ctx_body) = { + switch (utyp.term) { + | Sum(_) when List.mem(name, Typ.free_vars(utyp)) => + /* NOTE: When debugging type system issues it may be beneficial to + use a different name than the alias for the recursive parameter */ + //let ty_rec = Typ.Rec("α", Typ.subst(Var("α"), name, ty_pre)); + let ty_rec = + Typ.Rec(TPat.Var(name) |> IdTagged.fresh, utyp) |> Typ.temp; + let ctx_def = + Ctx.extend_alias(ctx, name, TPat.rep_id(typat), ty_rec); + (ty_rec, ctx_def, ctx_def); + | _ => ( + utyp, + ctx, + Ctx.extend_alias(ctx, name, TPat.rep_id(typat), utyp), + ) + /* NOTE(yuchen): Below is an alternative implementation that attempts to + add a rec whenever type alias is present. It may cause trouble to the + runtime, so precede with caution. */ + // Typ.lookup_surface(ty_pre) + // ? { + // let ty_rec = Typ.Rec({item: ty_pre, name}); + // let ctx_def = Ctx.add_alias(ctx, name, utpat_id(typat), ty_rec); + // (ty_rec, ctx_def, ctx_def); + // } + // : { + // let ty = Term.UTyp.to_typ(ctx, utyp); + // (ty, ctx, Ctx.add_alias(ctx, name, utpat_id(typat), ty)); + // }; + }; }; + let ctx_body = + switch (Typ.get_sum_constructors(ctx, ty_def)) { + | 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) = + go'(~ctx=ctx_body, ~mode, body, m); + /* Make sure types don't escape their scope */ + let ty_escape = Typ.subst(ty_def, typat, ty_body); + let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; + add(~self=Just(ty_escape), ~co_ctx, m); + | Var(_) + | Invalid(_) + | EmptyHole + | MultiHole(_) => + 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); }; - let ctx_body = - switch (Typ.get_sum_constructors(ctx, ty_def)) { - | 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) = - go'(~ctx=ctx_body, ~mode, body, m); - /* Make sure types don't escape their scope */ - let ty_escape = Typ.subst(ty_def, typat, ty_body); - let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; - add(~self=Just(ty_escape), ~co_ctx, m); - | Var(_) - | Invalid(_) - | EmptyHole - | MultiHole(_) => - 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); }; }; + // This is to allow lifting single values into a singleton labeled tuple when the label is not present + // TODO Think about this real hard + + switch (mode) { + | Ana(ty) => + switch (Typ.weak_head_normalize(ctx, ty).term) { + | Prod([{term: TupLabel({term: Label(l1), _}, ana_ty), _}]) => + let (e, m) = go(~mode=Mode.Syn, uexp, m); + + switch (Typ.weak_head_normalize(ctx, e.ty).term) { + | Prod([{term: TupLabel({term: Label(l2), _}, _), _}]) when l1 == l2 => + default_case() + | _ => + // TODO Deduplicate + let (e, m) = + uexp_to_info_map( + ~ctx, + ~mode=Mode.Ana(ana_ty), + ~is_in_filter, + ~ancestors, + uexp, + m, + ); + let fake_uexp = + Tuple([TupLabel(Label(l1) |> Exp.fresh, uexp) |> Exp.fresh]) + |> Exp.fresh; + let info = + Info.derived_exp( + ~uexp=fake_uexp, + ~ctx, + ~mode, + ~ancestors, + ~self=Common(Just(ty)), + ~co_ctx=e.co_ctx, + ); + + (info, add_info(fake_uexp.ids, InfoExp(info), m)); + }; + | _ => default_case() + } + | _ => default_case() + }; } and upat_to_info_map = ( @@ -694,6 +886,26 @@ and upat_to_info_map = ); (info, add_info(ids, InfoPat(info), m)); }; + let upat_to_info_map = + ( + ~is_synswitch, + ~ctx, + ~co_ctx, + ~ancestors, + ~mode, + upat: UPat.t, + m: Map.t, + ) => { + upat_to_info_map( + ~is_synswitch, + ~ctx, + ~co_ctx, + ~ancestors, + ~mode, + upat, + m: Map.t, + ); + }; let atomic = (self, constraint_) => add(~self, ~ctx, ~constraint_, m); let ancestors = [UPat.rep_id(upat)] @ ancestors; let go = upat_to_info_map(~is_synswitch, ~ancestors, ~co_ctx); @@ -732,6 +944,7 @@ and upat_to_info_map = ) | String(string) => atomic(Just(String |> Typ.temp), Constraint.String(string)) + | Label(name) => atomic(Just(Label(name) |> Typ.temp), Constraint.Truth) | ListLit(ps) => let ids = List.map(UPat.rep_id, ps); let modes = Mode.of_list_lit(ctx, List.length(ps), mode); @@ -777,8 +990,21 @@ and upat_to_info_map = ~constraint_=Constraint.Truth, m, ); + | TupLabel(label, p) => + let (labmode, mode) = Mode.of_label(ctx, mode); + let (lab, m) = go(~ctx, ~mode=labmode, label, m); + let (p, m) = go(~ctx, ~mode, p, m); + add( + ~self=Just(TupLabel(lab.ty, p.ty) |> Typ.temp), + ~ctx=p.ctx, + ~constraint_=Constraint.TupLabel(lab.constraint_, p.constraint_), + m, + ); | Tuple(ps) => - let modes = Mode.of_prod(ctx, mode, List.length(ps)); + let (ps, modes) = + Mode.of_prod(ctx, mode, ps, UPat.get_label, (name, b) => + TupLabel(Label(name) |> UPat.fresh, b) |> UPat.fresh + ); let (ctx, tys, cons, m) = ctx_fold(ctx, m, ps, modes); let rec cons_fold_tuple = cs => switch (cs) { @@ -826,7 +1052,7 @@ and utyp_to_info_map = m: Map.t, ) : (Info.typ, Map.t) => { - let add = m => { + let add = (~utyp=utyp, m) => { let info = Info.derived_typ(~utyp, ~ctx, ~ancestors, ~expects); (info, add_info(ids, InfoTyp(info), m)); }; @@ -842,6 +1068,7 @@ and utyp_to_info_map = | Float | Bool | String => add(m) + | Label(_) => add(m) | Var(_) => /* Names are resolved in Info.status_typ */ add(m) @@ -851,6 +1078,10 @@ and utyp_to_info_map = let m = go(t1, m) |> snd; let m = go(t2, m) |> snd; add(m); + | TupLabel(label, t) => + let m = go(label, m) |> snd; + let m = go(t, m) |> snd; + add(m); | Prod(ts) => let m = map_m(go, ts, m) |> snd; add(m); @@ -876,6 +1107,12 @@ and utyp_to_info_map = variants, ); add(m); + // | Dot(ty1, ty2) => + // // TODO: Fix this + // let (_, m) = + // utyp_to_info_map(~ctx, ~expects=TupleExpected, ~ancestors, ty1, m); + // let m = go(ty2, m) |> snd; + // add(m); | Forall({term: Var(name), _} as utpat, tbody) => let body_ctx = Ctx.extend_tvar(ctx, {name, id: TPat.rep_id(utpat), kind: Abstract}); diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index 0493150865..48a420d932 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -13,6 +13,8 @@ module Pat = { | Constructor | Cons | Var + | Label + | TupLabel | Tuple | Parens | Ap @@ -51,6 +53,8 @@ module Pat = { | Constructor(_) => Constructor | Cons(_) => Cons | Var(_) => Var + | Label(_) => Label + | TupLabel(_) => TupLabel | Tuple(_) => Tuple | Parens(_) => Parens | Ap(_) => Ap @@ -70,6 +74,8 @@ module Pat = { | Constructor => "Constructor" | Cons => "Cons" | Var => "Variable binding" + | Label => "Label" + | TupLabel => "Labeled Tuple Item pattern" | Tuple => "Tuple" | Parens => "Parenthesized pattern" | Ap => "Constructor application" @@ -78,6 +84,7 @@ module Pat = { let rec is_var = (pat: t) => { switch (pat.term) { | Parens(pat) + | TupLabel(_, pat) | Cast(pat, _, _) => is_var(pat) | Var(_) => true | Invalid(_) @@ -88,6 +95,7 @@ module Pat = { | Float(_) | Bool(_) | String(_) + | Label(_) | ListLit(_) | Cons(_, _) | Tuple(_) @@ -99,6 +107,7 @@ module Pat = { let rec is_fun_var = (pat: t) => { switch (pat.term) { | Parens(pat) => is_fun_var(pat) + | TupLabel(_, pat) => is_fun_var(pat) | Cast(pat, typ, _) => is_var(pat) && (UTyp.is_arrow(typ) || Typ.is_forall(typ)) | Invalid(_) @@ -109,6 +118,7 @@ module Pat = { | Float(_) | Bool(_) | String(_) + | Label(_) | ListLit(_) | Cons(_, _) | Var(_) @@ -123,6 +133,7 @@ module Pat = { || ( switch (pat.term) { | Parens(pat) => is_tuple_of_arrows(pat) + | TupLabel(_, pat) => is_tuple_of_arrows(pat) | Tuple(pats) => pats |> List.for_all(is_fun_var) | Invalid(_) | EmptyHole @@ -132,6 +143,7 @@ module Pat = { | Float(_) | Bool(_) | String(_) + | Label(_) | ListLit(_) | Cons(_, _) | Var(_) @@ -146,6 +158,7 @@ module Pat = { || ( switch (pat.term) { | Parens(pat) + | TupLabel(_, pat) | Cast(pat, _, _) => is_tuple_of_vars(pat) | Tuple(pats) => pats |> List.for_all(is_var) | Invalid(_) @@ -156,6 +169,7 @@ module Pat = { | Float(_) | Bool(_) | String(_) + | Label(_) | ListLit(_) | Cons(_, _) | Var(_) @@ -166,6 +180,7 @@ module Pat = { let rec get_var = (pat: t) => { switch (pat.term) { + | TupLabel(_, pat) | Parens(pat) => get_var(pat) | Var(x) => Some(x) | Cast(x, _, _) => get_var(x) @@ -177,6 +192,7 @@ module Pat = { | Float(_) | Bool(_) | String(_) + | Label(_) | ListLit(_) | Cons(_, _) | Tuple(_) @@ -188,6 +204,7 @@ module Pat = { let rec get_fun_var = (pat: t) => { switch (pat.term) { | Parens(pat) => get_fun_var(pat) + | TupLabel(_, pat) => get_fun_var(pat) | Cast(pat, t1, _) => if (Typ.is_arrow(t1) || UTyp.is_forall(t1)) { get_var(pat) |> Option.map(var => var); @@ -202,6 +219,7 @@ module Pat = { | Float(_) | Bool(_) | String(_) + | Label(_) | ListLit(_) | Cons(_, _) | Var(_) @@ -217,6 +235,7 @@ module Pat = { | None => switch (pat.term) { | Parens(pat) + | TupLabel(_, pat) | Cast(pat, _, _) => get_bindings(pat) | Tuple(pats) => let vars = pats |> List.map(get_var); @@ -233,6 +252,7 @@ module Pat = { | Float(_) | Bool(_) | String(_) + | Label(_) | ListLit(_) | Cons(_, _) | Var(_) @@ -247,6 +267,7 @@ module Pat = { } else { switch (pat.term) { | Parens(pat) + | TupLabel(_, pat) | Cast(pat, _, _) => get_num_of_vars(pat) | Tuple(pats) => is_tuple_of_vars(pat) ? Some(List.length(pats)) : None @@ -258,6 +279,7 @@ module Pat = { | Float(_) | Bool(_) | String(_) + | Label(_) | ListLit(_) | Cons(_, _) | Var(_) @@ -271,6 +293,18 @@ module Pat = { | Constructor(name, _) => Some(name) | _ => None }; + + let rec get_label: t => option((LabeledTuple.label, t)) = + p => + switch (p.term) { + | Parens(p) => get_label(p) + | TupLabel(plab, p') => + switch (plab.term) { + | Label(name) => Some((name, p')) + | _ => None + } + | _ => None + }; }; module Exp = { @@ -293,8 +327,11 @@ module Exp = { | ListLit | Constructor | Fun + | Label + | TupLabel | TypFun | Tuple + | Dot | Var | MetaVar | Let @@ -344,8 +381,11 @@ module Exp = { | ListLit(_) => ListLit | Constructor(_) => Constructor | Fun(_) => Fun + | Label(_) => Label + | TupLabel(_, _) => TupLabel | TypFun(_) => TypFun | Tuple(_) => Tuple + | Dot(_) => Dot | Var(_) => Var | Let(_) => Let | FixF(_) => FixF @@ -384,8 +424,11 @@ module Exp = { | ListLit => "List literal" | Constructor => "Constructor" | Fun => "Function literal" + | Label => "Label" + | TupLabel => "Labeled Tuple Item literal" | TypFun => "Type Function Literal" | Tuple => "Tuple literal" + | Dot => "Dot operator" | Var => "Variable reference" | MetaVar => "Meta variable reference" | Let => "Let expression" @@ -409,15 +452,47 @@ module Exp = { | Match => "Case expression" | Cast => "Cast expression"; + let rec get_label: t => option((LabeledTuple.label, t)) = { + e => { + switch (e.term) { + | Parens(e) => get_label(e) + | TupLabel(elab, e') => + switch (elab.term) { + | Label(name) => Some((name, e')) + | _ => None + } + // | Cast(e2, _, {term: TupLabel({term: Label(l), _}, _), _}) => + // Some((l, e2)) // TODO I would like to remove this case and stop casting in the case that we have the same labels + | Cast(e, _, _) => get_label(e) // TODO I would like to remove this case and stop casting in the case that we have the same labels + | _ => None + }; + }; + }; + // Typfun should be treated as a function here as this is only used to // determine when to allow for recursive definitions in a let binding. let rec is_fun = (e: t) => { switch (e.term) { | Parens(e) => is_fun(e) + | TupLabel(_, e) => is_fun(e) | Cast(e, _, _) => is_fun(e) | TypFun(_) - | Fun(_) + | Fun(_) => true | BuiltinFun(_) => true + | Dot(e1, e2) => + let element: option(t) = + switch (e1.term) { + | Tuple(ts) => + switch (e2.term) { + | Var(name) => LabeledTuple.find_label(get_label, ts, name) + | _ => None + } + | _ => None // TODO (Anthony): other exps + }; + switch (element) { + | Some(exp) => is_fun(exp) + | None => false + }; | Invalid(_) | EmptyHole | MultiHole(_) @@ -429,6 +504,7 @@ module Exp = { | Int(_) | Float(_) | String(_) + | Label(_) | ListLit(_) | Tuple(_) | Var(_) @@ -458,7 +534,22 @@ module Exp = { switch (e.term) { | Cast(e, _, _) | Parens(e) => is_tuple_of_functions(e) + | TupLabel(_, e) => is_tuple_of_functions(e) | Tuple(es) => es |> List.for_all(is_fun) + | Dot(e1, e2) => + let element: option(t) = + switch (e1.term) { + | Tuple(ts) => + switch (e2.term) { + | Var(name) => LabeledTuple.find_label(get_label, ts, name) + | _ => None + } + | _ => None // TODO (Anthony): other exps + }; + switch (element) { + | Some(exp) => is_tuple_of_functions(exp) + | None => false + }; | Invalid(_) | EmptyHole | MultiHole(_) @@ -470,6 +561,7 @@ module Exp = { | Int(_) | Float(_) | String(_) + | Label(_) | ListLit(_) | Fun(_) | TypFun(_) @@ -513,7 +605,9 @@ module Exp = { Some(1); } else { switch (e.term) { - | Parens(e) => get_num_of_functions(e) + | Parens(e) + | TupLabel(_, e) + | Dot(e, _) => get_num_of_functions(e) | Tuple(es) => is_tuple_of_functions(e) ? Some(List.length(es)) : None | Invalid(_) | EmptyHole @@ -530,6 +624,7 @@ module Exp = { | Int(_) | Float(_) | String(_) + | Label(_) | ListLit(_) | Fun(_) | TypFun(_) diff --git a/src/haz3lcore/statics/TermBase.re b/src/haz3lcore/statics/TermBase.re index f0585955c6..5bd1708bf6 100644 --- a/src/haz3lcore/statics/TermBase.re +++ b/src/haz3lcore/statics/TermBase.re @@ -153,7 +153,10 @@ and Exp: { option(Var.t), ) | TypFun(TPat.t, t, option(Var.t)) + | Label(string) + | TupLabel(t, t) | Tuple(list(t)) + | Dot(t, t) | Var(Var.t) | Let(Pat.t, t, t) | FixF(Pat.t, t, option(ClosureEnvironment.t)) @@ -220,7 +223,10 @@ and Exp: { option(Var.t), ) | TypFun(TPat.t, t, option(string)) + | Label(string) + | TupLabel(t, t) | Tuple(list(t)) + | Dot(t, t) | Var(Var.t) | Let(Pat.t, t, t) | FixF(Pat.t, t, [@show.opaque] option(ClosureEnvironment.t)) @@ -283,6 +289,7 @@ and Exp: { | Float(_) | Constructor(_) | String(_) + | Label(_) | Deferral(_) | Var(_) | Undefined => term @@ -293,7 +300,10 @@ and Exp: { | Fun(p, e, env, f) => Fun(pat_map_term(p), exp_map_term(e), env, f) | TypFun(tp, e, f) => TypFun(tpat_map_term(tp), exp_map_term(e), f) + | TupLabel(label, e) => + TupLabel(exp_map_term(label), exp_map_term(e)) | Tuple(xs) => Tuple(List.map(exp_map_term, xs)) + | Dot(e1, e2) => Dot(exp_map_term(e1), exp_map_term(e2)) | Let(p, e1, e2) => Let(pat_map_term(p), exp_map_term(e1), exp_map_term(e2)) | FixF(p, e, env) => FixF(pat_map_term(p), exp_map_term(e), env) @@ -351,6 +361,7 @@ and Exp: { | (Int(i1), Int(i2)) => i1 == i2 | (Float(f1), Float(f2)) => f1 == f2 | (String(s1), String(s2)) => s1 == s2 + | (Label(s1), Label(s2)) => s1 == s2 | (ListLit(xs), ListLit(ys)) => List.length(xs) == List.length(ys) && List.equal(fast_equal, xs, ys) | (Constructor(c1, ty1), Constructor(c2, ty2)) => @@ -410,6 +421,8 @@ and Exp: { ) | (Cast(e1, t1, t2), Cast(e2, t3, t4)) => fast_equal(e1, e2) && Typ.fast_equal(t1, t3) && Typ.fast_equal(t2, t4) + | (TupLabel(e1, e2), TupLabel(e3, e4)) => + fast_equal(e1, e3) && fast_equal(e2, e4) | (Invalid(_), _) | (FailedCast(_), _) | (Deferral(_), _) @@ -417,11 +430,14 @@ and Exp: { | (Int(_), _) | (Float(_), _) | (String(_), _) + | (Label(_), _) | (ListLit(_), _) | (Constructor(_), _) | (Fun(_), _) | (TypFun(_), _) | (Tuple(_), _) + | (TupLabel(_), _) + | (Dot(_), _) | (Var(_), _) | (Let(_), _) | (FixF(_), _) @@ -461,6 +477,8 @@ and Pat: { | Constructor(string, Typ.t) // Typ.t field is only meaningful in dynamic patterns | Cons(t, t) | Var(Var.t) + | Label(string) + | TupLabel(t, t) | Tuple(list(t)) | Parens(t) | Ap(t, t) @@ -495,6 +513,8 @@ and Pat: { | Constructor(string, Typ.t) | Cons(t, t) | Var(Var.t) + | Label(string) + | TupLabel(t, t) | Tuple(list(t)) | Parens(t) | Ap(t, t) @@ -529,12 +549,15 @@ and Pat: { | Float(_) | Constructor(_) | String(_) + | Label(_) | Var(_) => term | MultiHole(things) => MultiHole(List.map(any_map_term, things)) | ListLit(ts) => ListLit(List.map(pat_map_term, ts)) | Ap(e1, e2) => Ap(pat_map_term(e1), pat_map_term(e2)) | Cons(e1, e2) => Cons(pat_map_term(e1), pat_map_term(e2)) | Tuple(xs) => Tuple(List.map(pat_map_term, xs)) + | TupLabel(label, e) => + TupLabel(pat_map_term(label), pat_map_term(e)) | Parens(e) => Parens(pat_map_term(e)) | Cast(e, t1, t2) => Cast(pat_map_term(e), typ_map_term(t1), typ_map_term(t2)) @@ -545,6 +568,11 @@ and Pat: { let rec fast_equal = (p1, p2) => switch (p1 |> IdTagged.term_of, p2 |> IdTagged.term_of) { + /* TODO: Labels are a special case, but should they be?*/ + | (TupLabel(label1, d1'), TupLabel(label2, d2')) => + fast_equal(label1, label2) && fast_equal(d1', d2') + | (TupLabel(_, d1), _) => fast_equal(d1, p2) + | (_, TupLabel(_, d2)) => fast_equal(p1, d2) | (Parens(x), _) => fast_equal(x, p2) | (_, Parens(x)) => fast_equal(p1, x) | (EmptyHole, EmptyHole) => true @@ -557,6 +585,7 @@ and Pat: { | (Int(i1), Int(i2)) => i1 == i2 | (Float(f1), Float(f2)) => f1 == f2 | (String(s1), String(s2)) => s1 == s2 + | (Label(s1), Label(s2)) => s1 == s2 | (Constructor(c1, t1), Constructor(c2, t2)) => c1 == c2 && Typ.fast_equal(t1, t2) | (Var(v1), Var(v2)) => v1 == v2 @@ -577,6 +606,7 @@ and Pat: { | (Int(_), _) | (Float(_), _) | (String(_), _) + | (Label(_), _) | (ListLit(_), _) | (Constructor(_), _) | (Cons(_), _) @@ -610,11 +640,13 @@ and Typ: { | Float | Bool | String + | Label(string) | Var(string) | List(t) | Arrow(t, t) | Sum(ConstructorMap.t(t)) | Prod(list(t)) + | TupLabel(t, t) | Parens(t) | Ap(t, t) | Rec(TPat.t, t) @@ -662,11 +694,13 @@ and Typ: { | Float | Bool | String + | Label(string) | Var(string) | List(t) | Arrow(t, t) | Sum(ConstructorMap.t(t)) | Prod(list(t)) + | TupLabel(t, t) | Parens(t) | Ap(t, t) | Rec(TPat.t, t) @@ -703,12 +737,15 @@ and Typ: { | Int | Float | String + | Label(_) | Var(_) => term | List(t) => List(typ_map_term(t)) | Unknown(Hole(MultiHole(things))) => Unknown(Hole(MultiHole(List.map(any_map_term, things)))) | Ap(e1, e2) => Ap(typ_map_term(e1), typ_map_term(e2)) | Prod(xs) => Prod(List.map(typ_map_term, xs)) + | TupLabel(label, e) => + TupLabel(typ_map_term(label), typ_map_term(e)) | Parens(e) => Parens(typ_map_term(e)) | Arrow(t1, t2) => Arrow(typ_map_term(t1), typ_map_term(t2)) | Sum(variants) => @@ -738,10 +775,12 @@ and Typ: { | Float => Float |> rewrap | Bool => Bool |> rewrap | String => String |> rewrap + | Label(name) => Label(name) |> rewrap | Unknown(prov) => Unknown(prov) |> rewrap | Arrow(ty1, ty2) => Arrow(subst(s, x, ty1), subst(s, x, ty2)) |> rewrap | Prod(tys) => Prod(List.map(subst(s, x), tys)) |> rewrap + | TupLabel(label, ty) => TupLabel(label, subst(s, x, ty)) |> rewrap | Sum(sm) => Sum(ConstructorMap.map(Option.map(subst(s, x)), sm)) |> rewrap | Forall(tp2, ty) @@ -767,6 +806,10 @@ and Typ: { switch (IdTagged.term_of(t1), IdTagged.term_of(t2)) { | (Parens(t1), _) => eq_internal(n, t1, t2) | (_, Parens(t2)) => eq_internal(n, t1, t2) + | (TupLabel(label1, t1'), TupLabel(label2, t2')) => + eq_internal(n, label1, label2) && eq_internal(n, t1', t2') + | (TupLabel(_, _), _) => false // TODO Verify this + | (_, TupLabel(_, _)) => false | (Rec(x1, t1), Rec(x2, t2)) | (Forall(x1, t1), Forall(x2, t2)) => let alpha_subst = @@ -786,6 +829,8 @@ and Typ: { | (Bool, _) => false | (String, String) => true | (String, _) => false + | (Label(name1), Label(name2)) => String.equal(name1, name2) + | (Label(_), _) => false | (Ap(t1, t2), Ap(t1', t2')) => eq_internal(n, t1, t1') && eq_internal(n, t2, t2') | (Ap(_), _) => false diff --git a/src/haz3lcore/zipper/EditorUtil.re b/src/haz3lcore/zipper/EditorUtil.re index ff59e48f55..ae90b5d38d 100644 --- a/src/haz3lcore/zipper/EditorUtil.re +++ b/src/haz3lcore/zipper/EditorUtil.re @@ -12,6 +12,7 @@ let rec append_exp = (e1: Exp.t, e2: Exp.t): Exp.t => { | Int(_) | Float(_) | String(_) + | Label(_) | ListLit(_) | Constructor(_) | Closure(_) @@ -19,6 +20,8 @@ let rec append_exp = (e1: Exp.t, e2: Exp.t): Exp.t => { | TypFun(_) | FixF(_) | Tuple(_) + | TupLabel(_) + | Dot(_) | Var(_) | Ap(_) | TypAp(_) diff --git a/src/haz3lschool/SyntaxTest.re b/src/haz3lschool/SyntaxTest.re index 23dff72251..74a6f32fc0 100644 --- a/src/haz3lschool/SyntaxTest.re +++ b/src/haz3lschool/SyntaxTest.re @@ -25,8 +25,10 @@ let rec find_var_upat = (name: string, upat: Pat.t): bool => { | Float(_) | Bool(_) | String(_) + | Label(_) | Constructor(_) => false | Cons(up1, up2) => find_var_upat(name, up1) || find_var_upat(name, up2) + | TupLabel(_, up) => find_var_upat(name, up) | ListLit(l) | Tuple(l) => List.fold_left((acc, up) => {acc || find_var_upat(name, up)}, false, l) @@ -52,6 +54,8 @@ let rec find_in_let = | (_, Parens(ue)) => find_in_let(name, upat, ue, l) | (Cast(up, _, _), _) => find_in_let(name, up, def, l) | (Var(x), Fun(_)) => x == name ? [def, ...l] : l + | (TupLabel(_, up), TupLabel(_, ue)) => find_in_let(name, up, ue, l) + | (TupLabel(_, up), _) => find_in_let(name, up, def, l) | (Tuple(pl), Tuple(ul)) => if (List.length(pl) != List.length(ul)) { l; @@ -68,6 +72,7 @@ let rec find_in_let = | ( EmptyHole | Wild | Invalid(_) | MultiHole(_) | Int(_) | Float(_) | Bool(_) | String(_) | + Label(_) | ListLit(_) | Constructor(_) | Cons(_, _) | @@ -91,6 +96,7 @@ let rec find_fn = | TypFun(_, body, _) | FixF(_, body, _) | Fun(_, body, _, _) => l |> find_fn(name, body) + | TupLabel(_, u1) | TypAp(u1, _) | Parens(u1) | Cast(u1, _, _) @@ -100,6 +106,7 @@ let rec find_fn = | Closure(_, u1) | Filter(_, u1) => l |> find_fn(name, u1) | Ap(_, u1, u2) + | Dot(u1, u2) | Seq(u1, u2) | Cons(u1, u2) | ListConcat(u1, u2) @@ -126,6 +133,7 @@ let rec find_fn = | Int(_) | Float(_) | String(_) + | Label(_) | Constructor(_) | Undefined | BuiltinFun(_) @@ -147,6 +155,7 @@ let rec var_mention_upat = (name: string, upat: Pat.t): bool => { | Float(_) | Bool(_) | String(_) + | Label(_) | Constructor(_) => false | Cons(up1, up2) => var_mention_upat(name, up1) || var_mention_upat(name, up2) @@ -157,6 +166,7 @@ let rec var_mention_upat = (name: string, upat: Pat.t): bool => { false, l, ) + | TupLabel(_, up) => var_mention_upat(name, up) | Parens(up) => var_mention_upat(name, up) | Ap(up1, up2) => var_mention_upat(name, up1) || var_mention_upat(name, up2) @@ -177,6 +187,7 @@ let rec var_mention = (name: string, uexp: Exp.t): bool => { | Int(_) | Float(_) | String(_) + | Label(_) | Constructor(_) | Undefined | Deferral(_) => false @@ -194,6 +205,7 @@ let rec var_mention = (name: string, uexp: Exp.t): bool => { | Parens(u) | UnOp(_, u) | TyAlias(_, _, u) + | TupLabel(_, u) | Filter(_, u) => var_mention(name, u) | DynamicErrorHole(u, _) => var_mention(name, u) | FailedCast(u, _, _) => var_mention(name, u) @@ -203,6 +215,7 @@ let rec var_mention = (name: string, uexp: Exp.t): bool => { | BuiltinFun(_) => false | Cast(d, _, _) => var_mention(name, d) | Ap(_, u1, u2) + | Dot(u1, u2) | Seq(u1, u2) | Cons(u1, u2) | ListConcat(u1, u2) @@ -238,6 +251,7 @@ let rec var_applied = (name: string, uexp: Exp.t): bool => { | Int(_) | Float(_) | String(_) + | Label(_) | Constructor(_) | Undefined | Deferral(_) => false @@ -255,6 +269,7 @@ let rec var_applied = (name: string, uexp: Exp.t): bool => { | Parens(u) | UnOp(_, u) | TyAlias(_, _, u) + | TupLabel(_, u) | Filter(_, u) => var_applied(name, u) | TypAp(u, _) => switch (u.term) { @@ -280,6 +295,7 @@ let rec var_applied = (name: string, uexp: Exp.t): bool => { | Cons(u1, u2) | Seq(u1, u2) | ListConcat(u1, u2) + | Dot(u1, u2) | BinOp(_, u1, u2) => var_applied(name, u1) || var_applied(name, u2) | If(u1, u2, u3) => var_applied(name, u1) || var_applied(name, u2) || var_applied(name, u3) @@ -329,6 +345,7 @@ let rec tail_check = (name: string, uexp: Exp.t): bool => { | Int(_) | Float(_) | String(_) + | Label(_) | Constructor(_) | Undefined | Var(_) @@ -346,6 +363,7 @@ let rec tail_check = (name: string, uexp: Exp.t): bool => { | Test(_) => false | TyAlias(_, _, u) | Cast(u, _, _) + | TupLabel(_, u) | Filter(_, u) | Closure(_, u) | TypFun(_, u, _) @@ -358,6 +376,7 @@ let rec tail_check = (name: string, uexp: Exp.t): bool => { | Seq(u1, u2) => var_mention(name, u1) ? false : tail_check(name, u2) | Cons(u1, u2) | ListConcat(u1, u2) + | Dot(u1, u2) | BinOp(_, u1, u2) => !(var_mention(name, u1) || var_mention(name, u2)) | If(u1, u2, u3) => var_mention(name, u1) diff --git a/src/haz3lweb/Init.ml b/src/haz3lweb/Init.ml index c3d2de0aba..5c3059642b 100644 --- a/src/haz3lweb/Init.ml +++ b/src/haz3lweb/Init.ml @@ -12189,26 +12189,26 @@ let startup : PersistentData.t = # Fold projectors cover terms with abstractions. #\n\ # 1. A simple fold roles up any term, replacing #\n\ # it with ... until it is expanded again. #\n\n\ - let fold = in\n\n\ + let fold = (((((((((((()))))))))))) in\n\n\ # 2. A semantic fold covers a term with a property: #\n\ # Click to toggle inferred & synthesized types #\n\n\ - let folds: = in\n\n\ + let folds: (Int -> Bool) = in\n\n\ # Projectors on literal data are called livelits. #\n\ # Three base types literals use inline views: #\n\n\ - let guard: Bool = in\n\ - let phase: Int = in\n\ - let float: Float = in\n\n\ + let guard: Bool = true in\n\ + let phase: Int = 44 in\n\ + let float: Float = 79.00 in\n\n\ # Inline error decorations (same as for tokens) #\n\n\ - let (a:Int, f: Float) = , in\n\n\ + let (a:Int, f: Float) = true, 28 in\n\n\ # The String base type get a multiline view: #\n\n\ - let _ = in\n\ - let __ = in\n\ - let ___ = in\n\ - let ____ = in\n\ - let _____ = in\n\ - let ______ = in\n\n\ + let _ = \"\" in\n\ + let __ = \"\\n\" in\n\ + let ___ = \"a\" in\n\ + let ____ = \"shift\\n\" in\n\ + let _____ = \"\\nmalicious\" in\n\ + let ______ = \"a\\n shift\\n malicious\" in\n\n\ # Multiline error decorations #\n\n\ - let box: Int = in\n\n\ + let box: Int = \"\\nmalicious\" in\n\n\ # ERRATA: #\n\ # The bottom toggle can also be used to remove #\n\ # projectors. Currently only bidelmited terms can #\n\ @@ -12217,7 +12217,7 @@ let startup : PersistentData.t = # currently are lost on cut/copy. Both these #\n\ # restrictions will be removed in a future update. #\n\n\ # Projectors playground #\n\n\ - if && < () \n\ + if true && 23 < int_of_float(51.00) \n\ then ______ else \"its: \" ++ box"; } ); ( "Types & static errors", @@ -17555,6 +17555,1041 @@ let startup : PersistentData.t = # All output from examples: #\n\ (ex1, ex2, ex3, ex4, ex5)"; } ); + ( "Labeled Tuples", + { + zipper = + "((selection((focus Left)(content())(mode \ + Normal)))(backpack())(relatives((siblings(((Secondary((id \ + 1d22b099-baac-4811-86f4-3d4b778b8d04)(content(Comment\"# \ + Labeled Tuples #\"))))(Secondary((id \ + 029cce32-17ab-490b-b2f1-e25219197dff)(content(Whitespace\"\\n\"))))(Secondary((id \ + c3e170b1-8aeb-46f6-a78d-49cb6d86915a)(content(Whitespace\"\\n\"))))(Secondary((id \ + b1a9fa5d-4671-44c8-a303-96d7400f23d3)(content(Comment\"# \ + Tuples can have labels#\"))))(Secondary((id \ + 668efc29-986d-4f42-905e-84c7606b176b)(content(Whitespace\"\\n\"))))(Tile((id \ + 23795a9d-fa91-437f-a445-3652ac99fea5)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 0ab08c67-2641-47c5-bad2-bb0fa0b577fa)(content(Whitespace\" \ + \"))))(Tile((id \ + 374004dd-f688-48f3-9aa0-5752419d8775)(label(labeled_tuple))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 776dce9f-e223-4a19-995e-fdb5e9d5fbab)(content(Whitespace\" \ + \")))))((Secondary((id \ + aeeee415-16ca-459f-9fba-3820adc957b6)(content(Whitespace\" \ + \"))))(Tile((id \ + c73cedb9-eef3-4a02-8ea0-dc89c6b0ffce)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 08be2aff-62bb-4bb1-919f-b4d81f5b87eb)(label(a))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + ba0c2fe0-2a43-4004-b3b1-ced4b85b3449)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 4b14f8cf-7e92-4b28-8495-309f8e6bd981)(label(1))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 64acb788-0804-4a9e-b065-2235b21c3b02)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + cc891159-5869-4dfc-8f7c-0fd0116b343b)(content(Whitespace\" \ + \"))))(Tile((id \ + 577eb92e-9228-482f-a39b-bc7d25ea3a74)(label(b))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 23e7b4b7-a92a-43eb-93a2-24a4a671161a)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 0e01f92e-4201-4b0c-ab18-c02dd502075e)(label(2.0))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + b6c69ff0-709b-490b-b309-1c9cb38ac5c1)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 96b4438c-a9f8-4b92-971d-d0d4a1b19961)(content(Whitespace\" \ + \"))))(Tile((id \ + cb883be5-c6a8-47d1-8a7e-5f43b07d41cd)(label(c))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 82552269-8149-450d-b422-64c7493c13e1)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 163f4628-edf1-4911-9364-689f5f238c82)(label(true))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + d60bb231-bfe5-4b6d-8a53-46b2821680dd)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 5038abcb-455b-47da-8ce6-4d3be238998a)(content(Whitespace\"\\n\"))))(Secondary((id \ + ca401b23-4366-4cdf-957a-a6a39b861998)(content(Comment\"# \ + These labels can be projected #\"))))(Secondary((id \ + 4e035ed4-f928-4593-a7f8-491435d7137e)(content(Whitespace\"\\n\"))))(Tile((id \ + 6e28c23a-375a-4f47-80d1-11a0dbdbfd3e)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + cb2d5793-8d88-4d3a-9a4f-5ca82aefc774)(content(Whitespace\" \ + \"))))(Tile((id \ + 7bbbf7b6-ebdc-4e58-bdca-2654b0ccb9d6)(label(prj_a))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + c5b250bb-1fb9-4276-b793-0221b252c8b1)(content(Whitespace\" \ + \"))))(Tile((id \ + 2fad8b7f-6410-47e2-8786-4798001dcdb7)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 13))(sort \ + Pat))((shape(Concave 13))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + b92af63d-5b68-440d-ac0a-3cc6ae28330f)(content(Whitespace\" \ + \"))))(Tile((id \ + 09a6433d-266d-4aef-b528-7920b2650305)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + f24cff31-85a2-4d6f-ad5c-4a2284b7f17e)(content(Whitespace\" \ + \")))))((Secondary((id \ + 17dbbfc0-656a-46fd-9365-c1c2ea6dd286)(content(Whitespace\" \ + \"))))(Tile((id \ + 2effe10f-7e24-4907-a7b3-cf4b34b663e9)(label(labeled_tuple))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 6d7af305-b6c2-4a5c-bfde-edda62f126bf)(label(.))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 2))(sort \ + Exp))((shape(Concave 2))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + bdef8806-3ecc-4c67-be5c-cf7d3ed2fce9)(label(a))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Secondary((id \ + 4dc7a1ca-8770-467b-a81c-a245429d62ff)(content(Whitespace\" \ + \"))))(Secondary((id \ + 97350724-14de-4cfe-b5dc-820beca6a652)(content(Comment\"# 1 \ + #\"))))(Secondary((id \ + 6e55064c-2947-4769-b4bb-29d560f662f6)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + ca0d2c33-96ef-44c6-ac6e-f8a4d7901280)(content(Whitespace\" \ + \"))))(Secondary((id \ + 98524bad-9684-472a-a0c8-b1204357df66)(content(Whitespace\"\\n\"))))(Secondary((id \ + 38404748-91f8-4ff9-bf3e-6079ab3a3add)(content(Whitespace\"\\n\"))))(Secondary((id \ + fbc19dd7-8fdb-4932-87af-5b52f6a093bb)(content(Comment\"# \ + These can be encoded the types #\"))))(Secondary((id \ + 312fb397-2960-419d-8012-b3844228b045)(content(Whitespace\"\\n\"))))(Tile((id \ + 791f51eb-c011-424e-b6f7-c38517c3c5d3)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 1061312e-02d1-4ac2-b2b5-0432ef53c6c3)(content(Whitespace\" \ + \"))))(Tile((id \ + 1d69bc5e-76dc-4de1-96ba-f3c6e0704a2b)(label(typed_lt))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + be603a96-4fc1-4b57-8dcc-0768264c9798)(content(Whitespace\" \ + \"))))(Tile((id \ + 7eedad44-3ec3-4256-b621-ac301d91dad2)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 13))(sort \ + Pat))((shape(Concave 13))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 9671104c-9ffa-4912-9f21-f46b308d0335)(content(Whitespace\" \ + \"))))(Tile((id \ + ea52c55a-ba30-473d-8214-a685ffde4eb3)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 2d81cb0d-d4c0-4032-8fe3-b734f68d5343)(label(a))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + 1a7028bc-734d-40ce-b63b-baa31eb5966a)(label(=))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 16))(sort \ + Typ))((shape(Concave 16))(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 39fc34a0-cdd6-476f-a0c6-e15de827ad81)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + 11f70cfb-7527-4965-8e86-36cd99dd1470)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 18))(sort \ + Typ))((shape(Concave 18))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 0c00141e-9c75-45aa-bc2b-4927df8fd199)(content(Whitespace\" \ + \"))))(Tile((id \ + b3753058-016c-47ca-b53c-d4e663a9d39f)(label(b))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + c9f6de02-1793-4006-b79b-074ec663efad)(label(=))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 16))(sort \ + Typ))((shape(Concave 16))(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 295bbc9b-86d8-454c-adfb-51b9bbb37abe)(label(Float))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + c7d366ac-c0db-47b5-ba48-9d7a78be4a28)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 18))(sort \ + Typ))((shape(Concave 18))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + bd447665-f6cf-4bb9-9bfb-a9782e7125b3)(content(Whitespace\" \ + \"))))(Tile((id \ + c6c89a67-1cbb-41c0-98bf-3e5d875fb9cd)(label(c))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + f626e35e-b6af-4e72-b758-df9c9ce90493)(label(=))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 16))(sort \ + Typ))((shape(Concave 16))(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 2041fea5-1d59-4998-9f2e-3d7d20e8f519)(label(Bool))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 7c74d480-0097-4740-a918-7b5345a875eb)(content(Whitespace\" \ + \")))))((Secondary((id \ + 058c6341-431b-4045-98f3-1227ac57bca1)(content(Whitespace\" \ + \"))))(Tile((id \ + cbcebeee-2946-41d7-af56-10acfc3ee98b)(label(labeled_tuple))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Secondary((id \ + 95cf3af0-a1f4-4639-802b-8e6a68b821aa)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 7df90b9b-fc87-4093-8a73-f1dd5f9b4e7b)(content(Whitespace\"\\n\"))))(Secondary((id \ + 87181a2a-7168-4fcb-922c-03c6f08cb29a)(content(Whitespace\"\\n\"))))(Secondary((id \ + 2d1cd3ec-0347-4ad3-8d1d-f90b8ee226bc)(content(Comment\"# \ + Labels are optional and can be interspersed throughout a \ + label #\"))))(Secondary((id \ + 6304d9bb-70f1-4711-af0a-3ceca5abf350)(content(Whitespace\"\\n\"))))(Tile((id \ + c03a5bf0-5b40-4db5-833d-aa7ccc5f1de9)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 8ce73b84-f462-45d0-b8f9-c5b1ec532ece)(content(Whitespace\" \ + \"))))(Tile((id \ + a16b7bdb-34bc-481b-99a2-d9b3fe4c43e9)(label(mixed_labels))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 88c2b5e3-4624-4004-956c-e2c4e56ada6c)(content(Whitespace\" \ + \"))))(Tile((id \ + e1b247ba-d61f-4616-88df-064c2b7fd3a6)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 13))(sort \ + Pat))((shape(Concave 13))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + e47e4eee-8023-46a0-9f3e-cbd22343c821)(content(Whitespace\" \ + \"))))(Tile((id \ + b1d12b65-0bde-4897-be50-9382a322d257)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 085dbae6-4130-4b47-92ca-5292fe150994)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + e55ee8c2-9a8a-4139-9ea1-682d2d310402)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 18))(sort \ + Typ))((shape(Concave 18))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 9d5cfb64-78af-4a52-9833-6431217e882c)(content(Whitespace\" \ + \"))))(Tile((id \ + 3b1add0f-323b-4023-a55c-a42fd1032b4d)(label(a))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + 977eb5ad-75f9-4480-baa0-50c6e374f0ba)(label(=))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 16))(sort \ + Typ))((shape(Concave 16))(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 19b644d1-a6a0-41ba-8624-61eeaad5e300)(label(String))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + e54ed288-ac41-4a9f-841d-5243dc7376c1)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 18))(sort \ + Typ))((shape(Concave 18))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 513ff80c-bf03-4deb-b410-29faeac69a2d)(content(Whitespace\" \ + \"))))(Tile((id \ + 2a77c478-08ea-4569-81ef-c3b7cc56d0e1)(label(Float))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + ab9239e3-4316-44cb-9899-9aa69c755279)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 18))(sort \ + Typ))((shape(Concave 18))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + c548f75f-47a0-4ab4-86e8-69e634a4cca6)(content(Whitespace\" \ + \"))))(Tile((id \ + 3c55d843-a871-418c-9eff-da75446c297e)(label(flag))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + d1ed7227-a849-44ab-9890-8d264b5f1945)(label(=))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 16))(sort \ + Typ))((shape(Concave 16))(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 020058df-9514-49a0-9645-677851c38bb2)(label(Bool))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 40c93475-ca3b-41e8-8b21-1051f0fa687f)(content(Whitespace\" \ + \")))))((Secondary((id \ + e6102414-8e6a-49d8-8a4b-c30d478ff2c4)(content(Whitespace\" \ + \"))))(Tile((id \ + b28ba9ca-6b59-4d5c-9fcf-6ae44e1e204f)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 88d1e44a-ec5a-4157-ae30-75bf01cad38c)(label(1))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 21c197df-d99d-4d9d-a358-a67c10d5cccc)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + cb832565-6203-49ff-b53e-64fd5b3c6e49)(content(Whitespace\" \ + \"))))(Tile((id \ + cce72259-be1e-4bc7-8500-1ba2bf15c674)(label(a))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 4a61fc13-383b-47a7-972b-d6faa7503456)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 3a55f509-fd99-44fa-8ee1-3d41554353bf)(label(\"\\\"String \ + Value\\\"\"))(mold((out Exp)(in_())(nibs(((shape Convex)(sort \ + Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 51c1a82b-60b3-4c5a-8626-08a974105ae1)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 5eb818c5-d046-4862-b6e4-03e135fc56cf)(content(Whitespace\" \ + \"))))(Tile((id \ + 65876d7a-f0ab-4fba-a53a-00bd9b55dcfc)(label(2.5))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + ab3377df-c4ba-45ff-a280-888d3a4c0ae7)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 333f4c49-4a0d-4ea9-841b-e8b6f43a8765)(content(Whitespace\" \ + \"))))(Tile((id \ + 0e51bceb-1bf0-40b1-b825-225d9c42c415)(label(flag))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + d67f063a-acd8-4bb0-86e6-87b8a6314bba)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 3b3683bc-a873-49ff-9aab-9f5d2ff8a384)(label(true))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + b0a7bb24-0bdd-4ff7-8792-c404acc07832)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 006326dd-00d8-4ffd-99e0-f9e14310393f)(content(Whitespace\"\\n\"))))(Secondary((id \ + 9cee0316-ff16-45fc-8222-5a8004de1f1b)(content(Whitespace\"\\n\"))))(Tile((id \ + ca249965-e64a-4466-9054-2f8b8087e172)(label(type = \ + in))(mold((out Exp)(in_(TPat Typ))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + ce8336b7-fd8f-4766-9bc2-85e041f76ea2)(content(Whitespace\" \ + \"))))(Tile((id \ + dffcb8bd-d722-48ab-93b8-d096a011b106)(label(Person))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 6c2dfa03-96af-4244-9ad1-5aca79846f59)(content(Whitespace\" \ + \")))))((Secondary((id \ + 28b30431-f967-4a84-b719-3ee6dd323971)(content(Whitespace\" \ + \"))))(Tile((id \ + d46306e3-6845-4d24-9e26-b4b0292ec03b)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 71962028-dd1f-4b58-8881-6e72e881deb7)(label(String))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + c087cb02-0d08-4b91-8e34-99a0f2369e1a)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 18))(sort \ + Typ))((shape(Concave 18))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + a3cc0163-1461-4774-b351-3be27ddb56ec)(content(Whitespace\" \ + \"))))(Tile((id \ + b1c7750d-d878-4561-bfd5-c8583121858b)(label(age))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + 03ce37fb-27dc-4b48-a329-d0538384b590)(label(=))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 16))(sort \ + Typ))((shape(Concave 16))(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 083755c0-e2a7-465e-9fb8-b1fb5d73725c)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + 745a5f93-acf5-4e56-9ef8-6d9c9e9df676)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 18))(sort \ + Typ))((shape(Concave 18))(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 67a5db8b-7000-45f6-ae8f-86027d382414)(label(favorite_color))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + 10cf3666-399c-4136-be8f-60a561558bbe)(label(=))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 16))(sort \ + Typ))((shape(Concave 16))(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + f095c3a4-97e2-4433-aa7d-33ffa6775118)(label(String))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 0254047f-2d49-49da-a292-8ae1c8bd9315)(content(Whitespace\" \ + \"))))))))))((Secondary((id \ + 30456699-1693-415d-a38e-b103a1d4f4ca)(content(Whitespace\"\\n\"))))(Secondary((id \ + 4a35bd2e-ceac-4010-9b5e-b96baa3abef7)(content(Comment\"# \ + These labels can be automatically applied based on the type \ + expectation #\"))))(Secondary((id \ + e9813292-9c79-4183-9279-a341eacd3539)(content(Whitespace\"\\n\"))))(Tile((id \ + 0dfaf809-1beb-41e2-827a-bb9892dc0dbe)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 4911aaae-dcab-49b2-b114-dc86b6af73b8)(content(Whitespace\" \ + \"))))(Tile((id \ + 8b2a6afc-1c96-4e7e-b272-d516fb60c351)(label(alice))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 83a57212-492f-4c9e-b2d4-c5633c00492f)(content(Whitespace\" \ + \"))))(Tile((id \ + 0b4b1269-4a3b-4d77-8573-a57eaa2c2ff2)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 13))(sort \ + Pat))((shape(Concave 13))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 97236a27-c11a-4f08-a6dc-f2095a2ad44d)(content(Whitespace\" \ + \"))))(Tile((id \ + 221deda5-eb21-40a7-83b8-a4d3f0c72747)(label(Person))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 8c693b47-51a0-4394-a36d-0c55ed746ba2)(content(Whitespace\" \ + \")))))((Secondary((id \ + d84f659d-563b-4065-8352-0b48a0dbbc15)(content(Whitespace\" \ + \"))))(Tile((id \ + 3fce66bd-c247-471c-92b2-baabe04684aa)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + c3e4496d-c777-49da-b359-e87e57f500d8)(label(\"\\\"Alice\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 48ba350a-53b5-4afa-905a-8b113add1293)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 3f69e5d2-93c3-4464-9929-7684a8b4cce8)(content(Whitespace\" \ + \"))))(Tile((id \ + ead66a1a-2749-4c00-8c72-a1be1dbd9138)(label(22))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 8d300e9e-01fb-4ca7-98f9-d0e6761eee55)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 4f18f100-b7fa-4a75-9c20-bc59f55991b1)(content(Whitespace\" \ + \"))))(Tile((id \ + 8658b876-0dbe-41d2-8012-42a1d9eeedbd)(label(\"\\\"Blue\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + c3ebb086-566a-44a9-a3f1-02778e67cd50)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 87947367-9bf5-458f-a957-fd401c6fe62d)(content(Whitespace\"\\n\"))))(Secondary((id \ + 6ee9768e-9165-4e4b-9edc-0f5b431f3b4e)(content(Comment\"# \ + Explicitly Labeled elements are automatically \ + reordered#\"))))(Secondary((id \ + 160bfc3e-2922-46da-8880-6a55ec4e8f08)(content(Whitespace\"\\n\"))))(Tile((id \ + 9fb5dc17-bf6f-42a1-bad6-a7141ab485ff)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 44556e11-4a18-4808-8e3b-96a449991571)(content(Whitespace\" \ + \"))))(Tile((id \ + 1915e41b-fe9e-4d75-8147-05a8de710213)(label(bob))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 936f49f0-7701-46d3-9106-c5a513d9bcd8)(content(Whitespace\" \ + \"))))(Tile((id \ + ea62f713-8e6c-43ee-ad43-7960aa751f42)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 13))(sort \ + Pat))((shape(Concave 13))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + cd474fd5-2959-4f9c-a1b4-5fdf2dd5a8bd)(content(Whitespace\" \ + \"))))(Tile((id \ + fd2b6d83-7e76-4bc5-9ee9-acf808142cb2)(label(Person))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 5fc66ce9-3fab-4aef-85a9-4bef5b776355)(content(Whitespace\" \ + \")))))((Secondary((id \ + 6f0cfe1c-1274-4ca6-9230-a41ac4afd6ea)(content(Whitespace\" \ + \"))))(Tile((id \ + d5fcc42c-8f5e-429b-bca3-e0316b162a7a)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + b4672fe9-7b7f-486c-9fd7-31caa7a850dd)(label(age))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + f0bac892-177e-4d96-88de-e4d17dc891c0)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 1c4d0130-d17f-432b-8692-f87ab2c096a8)(label(25))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 05e7f039-2de3-4e31-91eb-a99c4566d90b)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 21495a10-72b3-4ced-9292-fc8c8415cd4b)(content(Whitespace\" \ + \"))))(Tile((id \ + 79158e46-09bb-4bdd-9e94-d43513f0a6cc)(label(favorite_color))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 90a05943-35bb-4045-84d5-1a9d9f4f9933)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 46b0779f-2d9e-4171-abab-3a5e49ee6f57)(label(\"\\\"Red\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 2fa915a0-88fb-45f9-ba3b-d05260c06e4e)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + a08417ac-4577-411a-854a-eda4acf4964b)(content(Whitespace\" \ + \"))))(Tile((id \ + 3a8e7e83-74ec-444a-a7df-06d68f289bc3)(label(\"\\\"Bob\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + db14a17f-90ca-498b-af9e-8690c183c312)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 55d9fe07-3edd-4db1-98c4-881a873ecaa2)(content(Whitespace\" \ + \"))))(Secondary((id \ + 3aeb958c-78e8-41ca-8bd8-e4fe58ab1279)(content(Comment\"# \ + equals (\\\"Bob\\\", age=25, \ + favorite_color=\\\"Red\\\")#\"))))(Secondary((id \ + 3dc6447b-da88-4cc0-8d41-fa06812d2f2b)(content(Whitespace\"\\n\"))))(Secondary((id \ + 105ece24-a726-45da-87f3-6888e1cdedbe)(content(Whitespace\"\\n\"))))(Secondary((id \ + 0a3fa6fe-890f-434b-b9f9-fb84b56a81fb)(content(Comment\"# \ + Destructuring #\"))))(Secondary((id \ + dfcae445-0ba1-4676-91e0-3273c23f9766)(content(Whitespace\"\\n\"))))(Tile((id \ + e91a3973-b16d-49a4-a59d-380a2979c970)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 892a74b8-31ca-477d-abd8-386d58d88f28)(content(Whitespace\" \ + \"))))(Tile((id \ + 88159ab5-30b8-46d7-9f90-475b8d94c1f4)(label(\"(\"\")\"))(mold((out \ + Pat)(in_(Pat))(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0 1))(children(((Tile((id \ + 60d7049c-eb88-4791-9809-6b99b6678e38)(label(bobs_name))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ + f6bff178-21db-4571-99d6-620d4d3d3bcb)(label(,))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 18))(sort \ + Pat))((shape(Concave 18))(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 1fd05df6-54a0-4a88-b9ea-a3c9d4081260)(content(Whitespace\" \ + \"))))(Tile((id \ + 937f5455-014e-49ee-9582-b8b2d41115b0)(label(age))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ + 060f122d-3e7b-4bc1-bf84-9642626f1555)(label(=))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 16))(sort \ + Pat))((shape(Concave 16))(sort \ + Pat))))))(shards(0))(children())))(Tile((id \ + 3206215b-978a-4d6b-8ae9-1b9210b0d49b)(label(bobs_age))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ + 965a3191-2574-4447-b05b-0d40f9d83946)(label(,))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 18))(sort \ + Pat))((shape(Concave 18))(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 38246b0f-0bee-46e7-b01b-0d8afc2fbd0d)(content(Whitespace\" \ + \"))))(Tile((id \ + 407f97ee-e857-4ce8-83fe-634df9404c38)(label(favorite_color))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ + 34a291de-b553-482e-92fb-b0ec3a2c6e0a)(label(=))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 16))(sort \ + Pat))((shape(Concave 16))(sort \ + Pat))))))(shards(0))(children())))(Tile((id \ + 30328d7c-b472-4dae-b050-6d959fe7be32)(label(bobs_favorite_color))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children()))))))))(Secondary((id \ + 2d1138cf-7b53-4891-bbe7-9443bc061639)(content(Whitespace\" \ + \")))))((Secondary((id \ + 90bf31c2-7807-4d05-af22-bfb0803990a2)(content(Whitespace\" \ + \"))))(Tile((id \ + 3d677f5a-b880-49e5-9171-ed5a21307452)(label(bob))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Secondary((id \ + 99c467af-0605-4a51-814b-6fe35edb5b59)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 1672c094-ce77-4a2c-a610-f352d9c00f7f)(content(Whitespace\"\\n\"))))(Secondary((id \ + 183b912f-dde9-4f06-8047-2b73d3e7ac89)(content(Whitespace\"\\n\"))))(Secondary((id \ + 0bc5c1e3-46a7-4e8d-9cb6-6aadf34388ac)(content(Comment\"# As \ + Labeled Function Arguments#\"))))(Secondary((id \ + 5e62d069-586f-4b4a-bebd-1d85c911942e)(content(Whitespace\"\\n\"))))(Tile((id \ + 5fa063ff-949a-4aae-999a-41a6c69d6c56)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + fb4e903c-38ba-4ea6-8b32-317b1285f772)(content(Whitespace\" \ + \"))))(Tile((id \ + ec1af2af-1ed0-48ee-b453-7212541060db)(label(make_person))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + ccb12ba8-9f10-4b75-994e-5305f899a2f6)(content(Whitespace\" \ + \")))))((Secondary((id \ + cd12b638-f5e5-4404-9258-b52dcf650df7)(content(Whitespace\" \ + \"))))(Tile((id \ + 75548ddc-6a1b-40ba-9657-fd01f72ed587)(label(fun \ + ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 15))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id \ + b79f71ec-30f8-4195-9354-0438e6141369)(content(Whitespace\" \ + \"))))(Tile((id \ + 76c41ade-16f9-4118-8b93-19ee95712e29)(label(name))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ + 12499cf9-95f4-4b6c-b3e8-caeed4c8ac7f)(label(=))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 16))(sort \ + Pat))((shape(Concave 16))(sort \ + Pat))))))(shards(0))(children())))(Tile((id \ + 6a914505-51dc-4704-b3e6-c28c64ee2192)(label(name))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ + 2720ae7a-5bd6-4cce-b71d-d14996d9a6ae)(label(,))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 18))(sort \ + Pat))((shape(Concave 18))(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 592cf330-b2d5-4cab-876d-74ad562b281b)(content(Whitespace\" \ + \"))))(Tile((id \ + 9a3fa4ed-eb24-49e6-97b6-2060a725b792)(label(age))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ + 83ea2c01-eaa9-41dc-b613-9f8b5f28bc2a)(label(=))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 16))(sort \ + Pat))((shape(Concave 16))(sort \ + Pat))))))(shards(0))(children())))(Tile((id \ + 003dc40d-5777-4d85-826e-4bc2821ed79a)(label(age))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 20ddd665-117f-48fd-9d81-cfd0be30c3f6)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 468a44b1-08e5-4630-b83e-530908e27910)(content(Whitespace\" \ + \"))))(Tile((id \ + 87515d1a-6137-4329-adef-3447763bfeec)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 7e52e359-8f40-4fe8-a17e-5f3f7d2ac33e)(label(name))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 29619540-cc0d-4cc0-9981-c83c069dca20)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + c80ac6ac-d08a-4409-973e-5f3e18ba51b0)(content(Whitespace\" \ + \"))))(Tile((id \ + e02e1487-d3d4-4676-b336-162501ed79a6)(label(age))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 2039c996-dd01-4836-adeb-4e172e7a6fe9)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 5e71d9fa-5efd-4e8e-9382-22a5ae2adfb4)(content(Whitespace\" \ + \"))))(Tile((id \ + a8d4584e-fbcb-43cf-b59f-48f6db174fd4)(label(favorite_color))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + a1fc6211-064f-456a-8db6-c8853f11f3a1)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 6ed737e9-6dfa-49f0-b3c0-0fb5e3586ca2)(label(\"\\\"red\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + 3e83623e-f633-4186-a3b5-d8b9524a4a86)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + e8f3f82e-5611-4b88-863b-9a2ae9d1c21d)(content(Whitespace\"\\n\"))))(Tile((id \ + bf3c8af3-ae3a-48c6-93b4-04ac67772b08)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 619b044c-b0e4-4e02-b5db-d15570566791)(content(Whitespace\" \ + \"))))(Tile((id \ + f934d33c-4593-4026-8ec0-5ead64be5882)(label(inconsistent_function_arg))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 9e666317-40ce-4c94-91cc-ad967e7eb9c4)(content(Whitespace\" \ + \")))))((Secondary((id \ + 6e84d392-0a09-4e6b-b0c5-276e43ab0f4a)(content(Whitespace\" \ + \"))))(Tile((id \ + 6d4f698b-0886-4488-a1d9-559d1f453cd2)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + ab35f30b-6f45-48c8-839b-1ef89002c759)(label(\"\\\"Invalid\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 91e66749-d8b1-4e70-92d1-cd07b4bf0384)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 37c22349-8aa6-41c7-b125-c62afe63d0eb)(content(Whitespace\" \ + \"))))(Tile((id \ + 03cfd730-4fa8-4735-b189-b606425881af)(label(-))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 4))(sort Exp))))))(shards(0))(children())))(Tile((id \ + 12d2af65-b5c1-45f0-b3f9-6e4931addb73)(label(1))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + 0af9bc1c-fdfc-4a69-b7d6-27bd571dcfd8)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 71ab2007-0a3a-4c9e-a3ce-569eff4c9d0d)(content(Whitespace\"\\n\"))))(Tile((id \ + 6772cdf5-3409-4b9c-8637-a24516a5c967)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 9de2ec9f-c185-4c6d-a715-1a98df8558aa)(content(Whitespace\" \ + \"))))(Tile((id \ + 1bbb9c86-d902-4829-98d1-555dd346ef33)(label(consistent_function_arg))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + d400dbe1-4dc2-4df0-8996-86ae6b0f9c4c)(content(Whitespace\" \ + \")))))((Secondary((id \ + 16f13179-43e2-4bca-b532-62bb500c7855)(content(Whitespace\" \ + \"))))(Tile((id \ + 5142d9b7-f548-4acf-8901-2c6a902ab1eb)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 30f541b4-e181-44e2-887a-8db7636c3420)(label(name))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 622ecc74-32c1-4028-b39c-d8a61e1e204a)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 371d1add-d34b-4e00-b9ec-bda86d5c8009)(label(\"\\\"Valid\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 35d0418b-5000-42c5-8789-e69e0b8d602a)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + e04fa0dd-087b-439c-bbe3-0580927ee180)(content(Whitespace\" \ + \"))))(Tile((id \ + 27c6d19b-7e30-4502-823f-b766f0939ea4)(label(age))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 3311b98f-1230-4d42-a39c-2dd23582a839)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + cae073b2-d9e2-4e6e-bdb9-a6506415fe25)(label(1))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + d12a2a58-1e0f-4924-b1c4-9260ab60fd8d)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + fae1053e-ed09-4559-ac80-c03838ddc7d8)(content(Whitespace\"\\n\"))))(Tile((id \ + 04747bb7-9e2f-4ebc-8ce0-7b198b5600ea)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + cf41c843-ee1e-462b-bf32-8d507355ca8f)(content(Whitespace\" \ + \"))))(Tile((id \ + 7c40a1e7-7010-494e-a909-8845d0c9326a)(label(more_people))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + fb482afa-0658-483f-9adf-70fd761b6290)(content(Whitespace\" \ + \"))))(Tile((id \ + 0c29ee28-0626-45b1-aac3-e4a78f11dcff)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 13))(sort \ + Pat))((shape(Concave 13))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 49e417e5-fe4b-453a-b01a-1d293bdb25ad)(content(Whitespace\" \ + \"))))(Tile((id 5a14afa0-4406-4d67-85d8-9cfa118caf38)(label([ \ + ]))(mold((out Typ)(in_(Typ))(nibs(((shape Convex)(sort \ + Typ))((shape Convex)(sort Typ))))))(shards(0 \ + 1))(children(((Tile((id \ + b93d434d-96ca-4604-847d-b0205aeb99ed)(label(Person))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 5896c5a9-156b-46ca-8e72-30f57076188f)(content(Whitespace\" \ + \")))))((Secondary((id \ + 1ade8ad4-18e3-455c-9ec2-32d45710df5e)(content(Whitespace\" \ + \"))))(Tile((id 372c347d-d19d-4e90-a425-809765a77865)(label([ \ + ]))(mold((out Exp)(in_(Exp))(nibs(((shape Convex)(sort \ + Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id \ + f383ce0c-2993-4d70-bd1e-071d4b8088a3)(content(Whitespace\"\\n\"))))(Tile((id \ + e2fc05f3-ccb2-4508-bb28-1df2197fcc07)(label(make_person))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + de83e03a-1b73-4386-9af3-b74e69527830)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 3))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + ca2fb28d-f718-4d00-a3a6-67f0b08fd3f4)(label(\"\\\"Bob\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + dbe464e2-a48d-421a-b32a-d555ecb3a6a3)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 5be01cd9-5138-4127-afad-6aa13115a9b0)(content(Whitespace\" \ + \"))))(Tile((id \ + 6cec742d-95b7-4cb2-9662-2761546bd130)(label(25))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children()))))))))(Tile((id \ + 86f01c66-3a10-4436-a265-ed32edc4110e)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 98be2652-07fc-4b72-8306-782c815b289e)(content(Whitespace\" \ + \"))))(Secondary((id \ + 3de82faf-6b7b-463c-996d-6c80e53ea84c)(content(Comment\"# \ + Labels Elided #\"))))(Secondary((id \ + f117280d-d441-4e2e-8838-9d60abeef621)(content(Whitespace\"\\n\"))))(Tile((id \ + 65e63a67-4573-4a72-8520-4f6c92520c85)(label(make_person))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 33c997e0-df65-4c1d-96cb-d80ef2677af5)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 3))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + b77a8e85-4ff3-413a-8a3e-a53b3724b247)(label(name))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 88107447-620c-4af0-a5ae-456a20ccc1c9)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + ab0c2887-7351-4627-b46d-a19631eed2bb)(label(\"\\\"Alice\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 3bfe6938-5e24-4b48-99a3-b9241d8801c5)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 26d948f4-1b53-407f-82e7-ce22a2ef78ae)(label(age))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 614d4f6c-a75d-4a62-ac88-a1ea39d77474)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + b1f9b854-9e65-49c1-96e4-4d501e573920)(label(22))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children()))))))))(Tile((id \ + f7ea71cf-5d03-44ae-b4f7-efb79c1b0a80)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 23ccd115-dd96-415a-b141-18a2f9c2928c)(content(Whitespace\" \ + \"))))(Secondary((id \ + 4776654a-cdec-44cf-81c0-b8246aaba138)(content(Comment\"# \ + Labels Present #\"))))(Secondary((id \ + 0b72bd36-b3ed-4b5a-877d-39863dce9106)(content(Whitespace\"\\n\"))))(Tile((id \ + 1953b9bc-fe9d-4c1f-b000-a2bf7a9a53e4)(label(make_person))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 732bdb11-adfc-48bf-a140-1eb7cd7e6c9c)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 3))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 1b0e2070-acec-473d-a277-c7672c903619)(label(age))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 01c9c18d-dbe1-4806-a8a6-65130c91a89a)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + b04bb7ea-7efd-453f-a197-4ab510dd0ecf)(label(23))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + df81e118-f9d0-4bc1-9019-be2b08b570bd)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + a0408131-c052-46c9-8416-c47aed162ded)(content(Whitespace\" \ + \"))))(Tile((id \ + a7730441-3dae-4dd8-9fbd-7b6f9a6041bf)(label(\"\\\"Mallory\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children()))))))))(Tile((id \ + f04e07bb-b99c-4d60-b21a-d14c84ea222b)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 82d777da-78dc-4090-8467-8fef0264b422)(content(Whitespace\" \ + \"))))(Secondary((id \ + 4468b1fa-3064-49f6-94ca-58e15e65db17)(content(Comment\"# \ + Labels Rearranging #\"))))(Secondary((id \ + 0a3e4609-541c-47ff-bf58-ee707e6fe045)(content(Whitespace\"\\n\"))))(Tile((id \ + 65153718-6c17-4581-9a16-00b9780bd520)(label(make_person))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 21b03f5b-15dc-49da-814b-0fce4ec86966)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 3))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + aa9bac65-bcdc-43b3-8afa-4c77a7981213)(label(inconsistent_function_arg))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children()))))))))(Tile((id \ + a8f6f87f-a708-401e-8151-bb9752e92503)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 281dc9b8-8acf-4d09-b6c9-206958fd8761)(content(Whitespace\" \ + \"))))(Secondary((id \ + 6d84d30b-e4e5-49cc-ac1c-02ded4f46aba)(content(Comment\"# \ + Rearranging and label addition only happens for \ + literals#\"))))(Secondary((id \ + 7fd3a911-046b-4a06-a949-a753d4f06116)(content(Whitespace\"\\n\"))))(Tile((id \ + 61983531-9deb-4439-b41d-be9ec0ffce1a)(label(make_person))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 373f7dbf-5e4c-4f95-907a-d27240ba731b)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 3))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 5cde39ac-556b-4891-9983-774d9c28bf97)(label(consistent_function_arg))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + 0efb970f-68ad-4381-81c3-9fc505b74e25)(content(Whitespace\" \ + \"))))(Secondary((id \ + 2c336ab6-7ae3-45ca-9878-92ae35539fd3)(content(Comment\"# \ + Unlabeled Tuple won't be allowed#\"))))(Secondary((id \ + 5213fdf4-7566-4b50-952b-69ed2727c40a)(content(Whitespace\"\\n\")))))))))(Secondary((id \ + fae77a96-5f1b-495d-9287-f067c380eb4c)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 63c5cf47-23a5-4ad2-b4fd-70ec5cbc26e2)(content(Whitespace\" \ + \"))))(Secondary((id \ + 16bbdb76-de5c-483d-ac2a-f6e9e3da33a4)(content(Whitespace\"\\n\"))))(Secondary((id \ + f0beefad-82fb-45a3-946c-981902b26ec5)(content(Whitespace\"\\n\"))))(Secondary((id \ + ecbf23ce-4a66-4b2b-b3d2-157af8872f02)(content(Whitespace\"\\n\"))))(Tile((id \ + aaced2aa-2d0a-461d-976f-9dec83c795cd)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 18))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 7d1e8e23-dcd9-4b1e-b822-5f842cb6bd44)(content(Whitespace\" \ + \"))))(Tile((id \ + 774d1844-2b95-4fcf-8ee8-878cf7c84151)(label(singleton_function))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 1a9c907e-f571-4d67-81ef-4ecc4851f548)(content(Whitespace\" \ + \")))))((Secondary((id \ + f4534e76-0158-416a-b61d-c2db539c772c)(content(Whitespace\" \ + \"))))(Tile((id \ + edd442bd-46fd-4794-bb9c-5af613263d68)(label(fun \ + ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 15))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id \ + 4386d151-96f7-4f04-9f11-64c7e6b993ad)(content(Whitespace\" \ + \"))))(Tile((id \ + 9cdc3202-4783-4f18-a28a-170cf9dcb31b)(label(arg))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ + 560eb91c-1ae0-4403-95be-acad1d929786)(label(=))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 16))(sort \ + Pat))((shape(Concave 16))(sort \ + Pat))))))(shards(0))(children())))(Tile((id \ + d747f9b6-5a31-403b-9d2e-d020d7eab3ec)(label(a))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 4a40c3d1-4a54-44a4-ba42-0adaf192746c)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 1c961485-84a2-4344-b8ac-80e5dfb502cb)(content(Whitespace\" \ + \"))))(Tile((id \ + 205b25cf-a5e3-425c-9543-14fa3236c695)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 1c0b9b7b-a060-4823-ae2d-f550638e0152)(label(a))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + e3b044ee-b11c-4853-804f-3aaf9ae93f05)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + f4118116-399b-4d85-98e8-803013328598)(content(Whitespace\" \ + \"))))(Tile((id \ + ead750da-7f4a-485a-a026-a7a4453e2f46)(label(a))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + db57dda3-640d-4413-852c-d3425de4192e)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 2065f441-6fa2-4bcf-ac9b-033463ad1d03)(content(Whitespace\"\\n\"))))(Tile((id \ + 75c4ccaf-dfa7-43b0-8715-707079b8ba58)(label([ ]))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + bb9f8ac1-4fbd-46f6-8526-85d4dcb25dea)(label(singleton_function))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 48931dc4-c220-4d0f-808c-2bd7972ff57e)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 3))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 87bc964a-591e-4db8-9be5-0df341bc50fb)(label(1))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children()))))))))(Tile((id \ + 70479ac6-4712-4591-b99e-d0cd8377f170)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 18))(sort \ + Exp))((shape(Concave 18))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + cea4761f-b845-4944-85c4-af502a792bc7)(label(singleton_function))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 209793a6-3fbc-4b27-81bd-b2800716af95)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 3))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 5d711ea8-0d2d-4afc-a3d3-f6e00203ff15)(label(arg))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 9ba1426c-958a-4cfe-b6b1-e14766cabcae)(label(=))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 16))(sort \ + Exp))((shape(Concave 16))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + cbe7def1-4267-4549-b8e6-f622fd80f3ec)(label(1))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))))))))))(ancestors())))(caret \ + Outer))"; + backup_text = + "# Labeled Tuples #\n\n\ + # Tuples can have labels#\n\ + let labeled_tuple = (a=1, b=2.0, c=true) in\n\ + # These labels can be projected #\n\ + let prj_a : Int = labeled_tuple.a # 1 # in \n\n\ + # These can be encoded the types #\n\ + let typed_lt : (a=Int, b=Float, c=Bool) = labeled_tuple in\n\n\ + # Labels are optional and can be interspersed throughout a \ + label #\n\ + let mixed_labels : (Int, a=String, Float, flag=Bool) = (1, \ + a=\"String Value\", 2.5, flag=true) in\n\n\ + type Person = (String, age=Int,favorite_color=String) in\n\ + # These labels can be automatically applied based on the type \ + expectation #\n\ + let alice : Person = (\"Alice\", 22, \"Blue\") in\n\ + # Explicitly Labeled elements are automatically reordered#\n\ + let bob : Person = (age=25, favorite_color=\"Red\", \"Bob\") \ + in # equals (\"Bob\", age=25, favorite_color=\"Red\")#\n\n\ + # Destructuring #\n\ + let (bobs_name, age=bobs_age, \ + favorite_color=bobs_favorite_color) = bob in\n\n\ + # As Labeled Function Arguments#\n\ + let make_person = fun name=name, age=age -> (name, age, \ + favorite_color=\"red\") in\n\ + let inconsistent_function_arg = (\"Invalid\", -1) in\n\ + let consistent_function_arg = (name=\"Valid\", age=1) in\n\ + let more_people : [Person] = [\n\ + make_person(\"Bob\", 25), # Labels Elided #\n\ + make_person(name=\"Alice\",age=22), # Labels Present #\n\ + make_person(age=23, \"Mallory\"), # Labels Rearranging #\n\ + make_person(inconsistent_function_arg), # Rearranging and \ + label addition only happens for literals#\n\ + make_person(consistent_function_arg) # Unlabeled Tuple won't \ + be allowed#\n\ + ] in \n\n\n\ + let singleton_function = fun arg=a -> (a, a) in\n\ + [singleton_function(1),singleton_function(arg=1)]"; + } ); ( "Expressive Programming", { zipper = @@ -17657,6 +18692,7 @@ let startup : PersistentData.t = ("scratch_Computing Equationally", Evaluation); ("scratch_Conditional Expressions", Evaluation); ("scratch_Functions", Evaluation); + ("scratch_Labeled Tuples", Evaluation); ("scratch_Polymorphism", Evaluation); ("scratch_Programming Expressively", Evaluation); ("scratch_Projectors", Evaluation); diff --git a/src/haz3lweb/explainthis/Example.re b/src/haz3lweb/explainthis/Example.re index 9408167cf6..460c8e4c0a 100644 --- a/src/haz3lweb/explainthis/Example.re +++ b/src/haz3lweb/explainthis/Example.re @@ -103,6 +103,11 @@ let comma_exp = () => mk_monotile(Form.get("comma_exp")); let comma_pat = () => mk_monotile(Form.get("comma_pat")); let comma_typ = () => mk_monotile(Form.get("comma_typ")); let pipeline = () => mk_monotile(Form.get("pipeline")); +let labeled_exp = () => mk_monotile(Form.get("tuple_labeled_exp")); +let labeled_pat = () => mk_monotile(Form.get("tuple_labeled_pat")); +let labeled_typ = () => mk_monotile(Form.get("tuple_labeled_typ")); +let dot_exp = () => mk_monotile(Form.get("dot_exp")); +let dot_typ = () => mk_monotile(Form.get("dot_typ")); let nil = () => exp("[]"); let deferral = () => exp("_"); let typeann = () => mk_monotile(Form.get("typeann")); diff --git a/src/haz3lweb/explainthis/ExplainThisForm.re b/src/haz3lweb/explainthis/ExplainThisForm.re index a2291253e5..8acdb21e15 100644 --- a/src/haz3lweb/explainthis/ExplainThisForm.re +++ b/src/haz3lweb/explainthis/ExplainThisForm.re @@ -34,6 +34,7 @@ type fun_examples = | ConsSnd | VarIncr | VarAnd + | TupLabel | Tuple2 | Tuple3 | Ctr @@ -53,6 +54,7 @@ type let_examples = | ConsHd | ConsSnd | Var + | TupLabel | Tuple2 | Tuple3 | Ctr @@ -85,6 +87,11 @@ type example_id = | List(list_examples) | TypFun(typfun_examples) | Fun(fun_examples) + | Label1 + | Label2 + | Dot1 + | Dot2 + | DotTyp | Fix1 | Fix2 | Tuple1 @@ -139,11 +146,13 @@ type pat_sub_form_id = | Float | Bool | String + | Label | Triv | ListNil | ListLit | ListCons | Var + | TupLabel | Tuple | Tuple2 | Tuple3 @@ -168,6 +177,8 @@ type form_id = | ListConcatExp | TypFunctionExp | FunctionExp(pat_sub_form_id) + | LabeledExp + | DotExp | TupleExp | Tuple2Exp | Tuple3Exp @@ -198,6 +209,7 @@ type form_id = | ListNilPat | ConsPat | Cons2Pat + | LabeledPat | TuplePat | Tuple2Pat | Tuple3Pat @@ -215,10 +227,12 @@ type form_id = | RecTyp | ArrowTyp | Arrow3Typ + | LabeledTyp | TupleTyp | Tuple0Typ | Tuple2Typ | Tuple3Typ + | DotTyp | LabelledSumTyp | SumTypUnaryConstructorDef | SumTypNullaryConstructorDef @@ -226,6 +240,7 @@ type form_id = | MultiHoleTPat | VarTPat | PipelineExp + | Label | FilterPause | FilterEval | FilterDebug @@ -261,6 +276,8 @@ type group_id = | ListConcatExp | TypFunctionExp | FunctionExp(pat_sub_form_id) + | LabeledExp + | DotExp | TupleExp | Tuple2Exp | Tuple3Exp @@ -292,6 +309,7 @@ type group_id = | ListNilPat | ConsPat | Cons2Pat + | LabeledPat | TuplePat | Tuple2Pat | Tuple3Pat @@ -309,16 +327,19 @@ type group_id = | RecTyp | ArrowTyp | Arrow3Typ + | LabeledTyp | TupleTyp | Tuple0Typ | Tuple2Typ | Tuple3Typ + | DotTyp | LabelledSumTyp | SumTypUnaryConstructorDef | SumTypNullaryConstructorDef | EmptyHoleTPat | MultiHoleTPat | VarTPat + | Label | FilterPause | FilterEval | FilterDebug diff --git a/src/haz3lweb/explainthis/data/DotExp.re b/src/haz3lweb/explainthis/data/DotExp.re new file mode 100644 index 0000000000..bacafdfb7a --- /dev/null +++ b/src/haz3lweb/explainthis/data/DotExp.re @@ -0,0 +1,27 @@ +// open Haz3lcore; +open ExplainThisForm; +open Example; + +let dot_example_1 = { + sub_id: Dot1, + term: mk_example("(x=1, y=2).x"), + message: "Retrieves the element in the tuple associated with the label 'x', which in this example is 1.", +}; +let dot_exp: form = { + let explanation = "Dot Operator explanation"; + { + id: DotExp, + syntactic_form: [exp("(x=e)"), dot_exp(), pat("x")], + expandable_id: None, + explanation, + examples: [dot_example_1], + }; +}; +// let _exp1 = exp("e1"); +// let _exp2 = exp("e2"); +// let tuple_exp_size2_coloring_ids = +// (~exp1_id: Id.t, ~exp2_id: Id.t): list((Id.t, Id.t)) => { +// [(Piece.id(_exp1), exp1_id), (Piece.id(_exp2), exp2_id)]; +// } + +let dot_exp: group = {id: DotExp, forms: [dot_exp]}; diff --git a/src/haz3lweb/explainthis/data/DotTyp.re b/src/haz3lweb/explainthis/data/DotTyp.re new file mode 100644 index 0000000000..22412390ba --- /dev/null +++ b/src/haz3lweb/explainthis/data/DotTyp.re @@ -0,0 +1,20 @@ +// // open Haz3lcore; + // open ExplainThisForm; + // open Example; + // let dot_typ: form = { + // let explanation = "Dot Operator Typ explanation"; + // { + // id: DotTyp, + // syntactic_form: [exp("(x=t)"), dot_typ(), pat("x")], + // expandable_id: None, + // explanation, + // examples: [], + // }; + // }; + // // let _exp1 = exp("e1"); + // // let _exp2 = exp("e2"); + // // let tuple_exp_size2_coloring_ids = + // // (~exp1_id: Id.t, ~exp2_id: Id.t): list((Id.t, Id.t)) => { + // // [(Piece.id(_exp1), exp1_id), (Piece.id(_exp2), exp2_id)]; + // // } + // let dot_typ: group = {id: DotTyp, forms: [dot_typ]}; diff --git a/src/haz3lweb/explainthis/data/FunctionExp.re b/src/haz3lweb/explainthis/data/FunctionExp.re index 895f9d7db6..ea6f454ebe 100644 --- a/src/haz3lweb/explainthis/data/FunctionExp.re +++ b/src/haz3lweb/explainthis/data/FunctionExp.re @@ -77,6 +77,11 @@ let tuple3_fun_ex = { term: mk_example("fun (a, b, c) ->\na && b && c"), message: "When given a 3-tuple of booleans, the function evaluates to the logical-and of the three booleans.", }; +let tuplabel_fun_ex = { + sub_id: Fun(TupLabel), + term: mk_example("fun x=y, y=z ->\ny"), + message: "When given a 2-tuple of elements, the function evaluates to the first element (not the second).", +}; let ctr_fun_ex = { sub_id: Fun(Ctr), term: mk_example("fun None -> 1"), @@ -219,6 +224,22 @@ let function_strlit_exp: form = { examples: [strlit_fun_ex], }; }; +let _pat = pat("Label"); +let _exp = exp("e"); +let function_label_coloring_ids = + _pat_body_function_exp_coloring_ids(Piece.id(_pat), Piece.id(_exp)); +let function_label: form = { + let explanation = "[TODO: Label docs] %s"; + + let form = [mk_fun([[space(), _pat, space()]]), space(), _exp]; + { + id: FunctionExp(Label), + syntactic_form: form, + expandable_id: Some((Piece.id(_pat), [pat("Label")])), + explanation, + examples: [], + }; +}; let _pat = pat("()"); let _exp = exp("e"); let function_triv_exp_coloring_ids = @@ -311,6 +332,30 @@ let function_var_exp: form = { examples: [basic_fun_ex, var_incr_fun_ex, var_and_fun_ex], }; }; + +let _labeled_pat = labeled_pat(); +let _exp = exp("e"); +let function_labeled_exp_coloring_ids = + _pat_body_function_exp_coloring_ids( + Piece.id(_labeled_pat), + Piece.id(_exp), + ); +let function_labeled_exp: form = { + let explanation = "Any unlabeled value matches with the [*argument*]. Only labeled elements that match the [*name*](%s) 'x' are accepted, and evaluate using the [*value*](%s) 'y' to the function [*body*](%s)."; + let form = [ + mk_fun([[space(), pat("x"), _labeled_pat, pat("y"), space()]]), + space(), + _exp, + ]; + { + id: FunctionExp(TupLabel), + syntactic_form: form, + expandable_id: + Some((Piece.id(_labeled_pat), [pat("x"), labeled_pat(), pat("y")])), + explanation, + examples: [tuplabel_fun_ex], + }; +}; let _comma = comma_pat(); let _exp = exp("e"); let function_tuple_exp_coloring_ids = @@ -476,6 +521,11 @@ let functions_str = { forms: [function_strlit_exp, function_exp], }; +let functions_label = { + id: FunctionExp(Label), + forms: [function_label, function_exp], +}; + let functions_triv = { id: FunctionExp(Triv), forms: [function_triv_exp, function_exp], @@ -501,6 +551,11 @@ let functions_var = { forms: [function_var_exp, function_exp], }; +let functions_tuplabel = { + id: FunctionExp(TupLabel), + forms: [function_labeled_exp, function_exp], +}; + let functions_tuple = { id: FunctionExp(Tuple), forms: [function_tuple_exp, function_exp], diff --git a/src/haz3lweb/explainthis/data/LabelTerm.re b/src/haz3lweb/explainthis/data/LabelTerm.re new file mode 100644 index 0000000000..bab179c553 --- /dev/null +++ b/src/haz3lweb/explainthis/data/LabelTerm.re @@ -0,0 +1,14 @@ +open ExplainThisForm; +open Example; + +let label = (n: string): form => { + let explanation = "`%s` is a label (or name) for an item within a tuple."; + { + id: Label, + syntactic_form: [n |> abbreviate |> tpat], // TODO: Fix this + expandable_id: None, + explanation, + examples: [], + }; +}; +let labels = (n: string): group => {id: Label, forms: [label(n)]}; diff --git a/src/haz3lweb/explainthis/data/LabeledExp.re b/src/haz3lweb/explainthis/data/LabeledExp.re new file mode 100644 index 0000000000..707e553f0f --- /dev/null +++ b/src/haz3lweb/explainthis/data/LabeledExp.re @@ -0,0 +1,32 @@ +// open Haz3lcore; +open ExplainThisForm; +open Example; + +let labeled_example_1 = { + sub_id: Label1, + term: mk_example("(x=1)"), + message: "A labeled expression within a singleton tuple, where the element 1 is assigned the label 'x'.", +}; +let labeled_example_2 = { + sub_id: Label2, + term: mk_example("(1, 2, y=3)"), + message: "A tuple with first element 1, second element 2, and third element 3 with the label 'y'.", +}; +let labeled_exp: form = { + let explanation = "Assigns a label (name) to an expression within a tuple. Labeled expressions cannot exist outside of a tuple; by default, labeled expressions that are not contained within a tuple are implied to be in a singleton tuple."; + { + id: LabeledExp, + syntactic_form: [exp("x"), labeled_exp(), exp("e")], + expandable_id: None, + explanation, + examples: [labeled_example_1, labeled_example_2], + }; +}; +// let _exp1 = exp("e1"); +// let _exp2 = exp("e2"); +// let tuple_exp_size2_coloring_ids = +// (~exp1_id: Id.t, ~exp2_id: Id.t): list((Id.t, Id.t)) => { +// [(Piece.id(_exp1), exp1_id), (Piece.id(_exp2), exp2_id)]; +// } + +let labeled_exps: group = {id: LabeledExp, forms: [labeled_exp]}; diff --git a/src/haz3lweb/explainthis/data/LabeledPat.re b/src/haz3lweb/explainthis/data/LabeledPat.re new file mode 100644 index 0000000000..de8150f26d --- /dev/null +++ b/src/haz3lweb/explainthis/data/LabeledPat.re @@ -0,0 +1,22 @@ +// open Haz3lcore; +open Example; +open ExplainThisForm; +// let _pat = pat("p"); +// let _typ = typ("ty"); +// let labeled_pat_coloring_ids = +// (~pat_id: Id.t, ~typ_id: Id.t): list((Id.t, Id.t)) => [ +// (Piece.id(_pat), pat_id), +// (Piece.id(_typ), typ_id), +// ]; +let labeled_pat: form = { + let explanation = "Assigns a label (name) to a pattern within a tuple. Labeled patterns cannot exist outside of a tuple; by default, labeled pattens that are not contained within a tuple are implied to be in a singleton tuple."; + { + id: LabeledPat, + syntactic_form: [pat("x"), labeled_pat(), pat("p")], + expandable_id: None, + explanation, + examples: [], + }; +}; + +let labeled_pats: group = {id: LabeledPat, forms: [labeled_pat]}; diff --git a/src/haz3lweb/explainthis/data/LabeledTyp.re b/src/haz3lweb/explainthis/data/LabeledTyp.re new file mode 100644 index 0000000000..7bfaac386d --- /dev/null +++ b/src/haz3lweb/explainthis/data/LabeledTyp.re @@ -0,0 +1,16 @@ +open Example; +open ExplainThisForm; +// open Haz3lcore; + +let labeled_typ: form = { + let explanation = "Assigns a label (name) to a type within a tuple. Labeled types cannot exist outside of a tuple; by default, labeled pattens that are not contained within a tuple are implied to be in a singleton tuple."; + { + id: LabeledTyp, + syntactic_form: [pat("x"), labeled_typ(), typ("t")], + expandable_id: None, + explanation, + examples: [], + }; +}; + +let labeled_typs: group = {id: LabeledTyp, forms: [labeled_typ]}; diff --git a/src/haz3lweb/explainthis/data/LetExp.re b/src/haz3lweb/explainthis/data/LetExp.re index 59b6d41d98..e997765ab7 100644 --- a/src/haz3lweb/explainthis/data/LetExp.re +++ b/src/haz3lweb/explainthis/data/LetExp.re @@ -62,6 +62,11 @@ let let_var_ex = { term: mk_example("let x = 1 in \nx + 2"), message: "The variable x is bound to 1, so the expression evaluates to 1 + 2, which is 3.", }; +let let_labeled_ex = { + sub_id: Let(TupLabel), + term: mk_example("let (a=x, b=y) = (1, a=2) in \nx + 2"), + message: "The variable x is bound to 2 and the y is bound to 2, so the expression evaluates to 2 + 2, which is 4.", +}; let let_tuple2_ex = { sub_id: Let(Tuple2), term: mk_example("let (x, y) = (1, 2) in \nx + y"), @@ -277,6 +282,30 @@ let let_str_exp: form = { examples: [let_str_ex], }; }; +let _pat = pat("Label"); +let _exp_def = exp("e_def"); +let _exp_body = exp("e_body"); +let let_label_coloring_ids = + _pat_def_body_let_exp_coloring_ids( + Piece.id(_pat), + Piece.id(_exp_def), + Piece.id(_exp_body), + ); +let let_label: form = { + let explanation = "[TODO: Label docs] %s"; + let form = [ + mk_let([[space(), _pat, space()], [space(), _exp_def, space()]]), + linebreak(), + _exp_body, + ]; + { + id: LetExp(Label), + syntactic_form: form, + expandable_id: Some((Piece.id(_pat), [pat("Label")])), + explanation, + examples: [], + }; +}; let _pat = pat("()"); let _exp_def = exp("e_def"); let _exp_body = exp("e_body"); @@ -399,6 +428,34 @@ let let_var_exp: form = { // TODO Does this example being slightly different actually add anything? }; }; +let _labeled_pat = labeled_pat(); +let _exp_def = exp("e_def"); +let _exp_body = exp("e_body"); +let let_labeled_exp_coloring_ids = + _pat_def_body_let_exp_coloring_ids( + Piece.id(_labeled_pat), + Piece.id(_exp_def), + Piece.id(_exp_body), + ); +let let_labeled_exp: form = { + let explanation = "TODO: label explanation %s%s%s%s%s"; + let form = [ + mk_let([ + [space(), pat("x"), _labeled_pat, pat("a"), space()], + [space(), _exp_def, space()], + ]), + linebreak(), + _exp_body, + ]; + { + id: LetExp(TupLabel), + syntactic_form: form, + expandable_id: + Some((Piece.id(_labeled_pat), [pat("x"), labeled_pat(), pat("e")])), + explanation, + examples: [let_labeled_ex], + }; +}; let _comma = comma_pat(); let _exp_def = exp("e_def"); let let_tuple_exp_coloring_ids = @@ -582,6 +639,11 @@ let lets_str: group = { forms: [let_str_exp, let_base_exp], }; +let lets_label: group = { + id: LetExp(Label), + forms: [let_label, let_base_exp], +}; + let lets_triv: group = { id: LetExp(Triv), forms: [let_triv_exp, let_base_exp], @@ -604,6 +666,11 @@ let lets_cons: group = { let lets_var: group = {id: LetExp(Var), forms: [let_var_exp, let_base_exp]}; +let lets_tuplabel: group = { + id: LetExp(TupLabel), + forms: [let_labeled_exp, let_base_exp], +}; + let lets_tuple: group = { id: LetExp(Tuple), forms: [let_tuple_exp, let_base_exp], diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 879b355999..be3d3110e5 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -170,6 +170,7 @@ let typ_err_view = (ok: Info.error_typ) => | WantConstructorFoundAp | WantConstructorFoundType(_) => [text("Expected a constructor")] | WantTypeFoundAp => [text("Must be part of a sum type")] + | WantTuple => [text("Expect a valid tuple")] | DuplicateConstructor(name) => [ Type.view(Var(name) |> Typ.fresh), text("already used in this sum"), diff --git a/src/haz3lweb/view/ExplainThis.re b/src/haz3lweb/view/ExplainThis.re index cbfdf4df9f..774bf500df 100644 --- a/src/haz3lweb/view/ExplainThis.re +++ b/src/haz3lweb/view/ExplainThis.re @@ -623,6 +623,7 @@ let get_doc = let pat_id = List.nth(pat.ids, 0); let body_id = List.nth(body.ids, 0); switch (pat.term) { + // TODO (Anthony): put in a real message | EmptyHole => if (FunctionExp.function_empty_hole_exp.id == get_specificity_level(FunctionExp.functions_empty_hole)) { @@ -789,6 +790,25 @@ let get_doc = } else { basic(FunctionExp.functions_str); } + | Label(name) => + if (FunctionExp.function_label.id + == get_specificity_level(FunctionExp.functions_label)) { + get_message( + ~colorings= + FunctionExp.function_label_coloring_ids(~pat_id, ~body_id), + ~format= + Some( + msg => + Printf.sprintf( + Scanf.format_from_string(msg, "%s"), + name, + ), + ), + FunctionExp.functions_label, + ); + } else { + basic(FunctionExp.functions_label); + } | Tuple([]) => if (FunctionExp.function_triv_exp.id == get_specificity_level(FunctionExp.functions_triv)) { @@ -909,6 +929,31 @@ let get_doc = } else { basic(FunctionExp.functions_var); } + | TupLabel(_, p) => + if (FunctionExp.function_labeled_exp.id + == get_specificity_level(FunctionExp.functions_tuplabel)) { + let p_id = List.nth(p.ids, 0); + get_message( + ~colorings= + FunctionExp.function_labeled_exp_coloring_ids( + ~pat_id, + ~body_id, + ), + ~format= + Some( + msg => + Printf.sprintf( + Scanf.format_from_string(msg, "%s%s%s"), + Id.to_string(pat_id), + Id.to_string(p_id), + Id.to_string(body_id), + ), + ), + FunctionExp.functions_tuplabel, + ); + } else { + basic(FunctionExp.functions_tuplabel); + } | Tuple(elements) => let pat_id = List.nth(pat.ids, 0); let body_id = List.nth(body.ids, 0); @@ -1059,6 +1104,17 @@ let get_doc = | Parens(_) => default // Shouldn't get hit? | Cast(_) => default // Shouldn't get hit? }; + | Label(name) => + get_message( + ~format= + Some( + msg => + Printf.sprintf(Scanf.format_from_string(msg, "%s"), name), + ), + LabelTerm.labels(name), + ) + | TupLabel(_, _) => get_message(LabeledExp.labeled_exps) + | Dot(_, _) => get_message(DotExp.dot_exp) | Tuple(terms) => let basic = group_id => get_message( @@ -1312,6 +1368,27 @@ let get_doc = LetExp.lets_str, ); } + | Label(name) => + if (LetExp.let_label.id == get_specificity_level(LetExp.lets_label)) { + get_message( + ~colorings= + LetExp.let_label_coloring_ids(~pat_id, ~def_id, ~body_id), + ~format= + Some( + msg => + Printf.sprintf( + Scanf.format_from_string(msg, "%s"), + name, + ), + ), + LetExp.lets_label, + ); + } else { + /* TODO The coloring for the syntactic form is sometimes wrong here... */ + basic( + LetExp.lets_label, + ); + } | Tuple([]) => if (LetExp.let_triv_exp.id == get_specificity_level(LetExp.lets_triv)) { @@ -1428,6 +1505,34 @@ let get_doc = } else { basic(LetExp.lets_var); } + | TupLabel(_, p) => + if (LetExp.let_labeled_exp.id + == get_specificity_level(LetExp.lets_tuplabel)) { + let p_id = List.nth(p.ids, 0); + get_message( + ~colorings= + LetExp.let_labeled_exp_coloring_ids( + ~pat_id, + ~def_id, + ~body_id, + ), + ~format= + Some( + msg => + Printf.sprintf( + Scanf.format_from_string(msg, "%s%s%s%s%s"), + Id.to_string(def_id), + Id.to_string(pat_id), + "[label placeholder]", + Id.to_string(body_id), + Id.to_string(p_id), + ), + ), + LetExp.lets_tuplabel, + ); + } else { + basic(LetExp.lets_tuplabel); + } | Tuple(elements) => let basic_tuple = group_id => { get_message( @@ -2016,6 +2121,15 @@ let get_doc = ), TerminalPat.var(v), ) + | Label(name) => + get_message( + ~format= + Some( + msg => Printf.sprintf(Scanf.format_from_string(msg, "%s"), name), + ), + LabelTerm.labels(name), + ) + | TupLabel(_, _) => get_message(LabeledPat.labeled_pats) | Tuple(elements) => let basic = group => get_message( @@ -2229,6 +2343,16 @@ let get_doc = } | _ => basic(ArrowTyp.arrow) }; + | Label(name) => + get_message( + ~format= + Some( + msg => Printf.sprintf(Scanf.format_from_string(msg, "%s"), name), + ), + LabelTerm.labels(name), + ) + | TupLabel(_, _) => get_message(LabeledTyp.labeled_typs) + // | Dot(_, _) => get_message(DotTyp.dot_typ) | Prod(elements) => let basic = group => get_message( diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 622dcf766e..bc9075f701 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -29,8 +29,15 @@ let rec view_ty = (~strip_outer_parens=false, ty: Haz3lcore.Typ.t): Node.t => | Int => ty_view("Int", "Int") | Float => ty_view("Float", "Float") | String => ty_view("String", "String") + | Label(name) => ty_view("Label", name) | Bool => ty_view("Bool", "Bool") | Var(name) => ty_view("Var", name) + | TupLabel({term: Label(l), _}, ty) => + div( + ~attrs=[clss(["typ-view", "TupLabel"])], + [text(l ++ "="), view_ty(ty)], + ) + | TupLabel(_, ty) => view_ty(ty) // This should be impossible | Rec(name, t) => div( ~attrs=[clss(["typ-view", "Rec"])], @@ -52,8 +59,6 @@ let rec view_ty = (~strip_outer_parens=false, ty: Haz3lcore.Typ.t): Node.t => paren_view(t1) @ [text(" -> "), view_ty(t2)], ) | Prod([]) => div(~attrs=[clss(["typ-view", "Prod"])], [text("()")]) - | Prod([_]) => - div(~attrs=[clss(["typ-view", "Prod"])], [text("Singleton Product")]) | Prod([t0, ...ts]) => div( ~attrs=[clss(["typ-view", "atom", "Prod"])], diff --git a/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re b/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re index ffb0eed0c5..a2d9689f53 100644 --- a/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re +++ b/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re @@ -53,6 +53,7 @@ let rec precedence = (~show_function_bodies, ~show_casts: bool, d: DHExp.t) => { | Test(_) | Float(_) | String(_) + | Label(_) | ListLit(_) | EmptyHole | Constructor(_) @@ -71,7 +72,10 @@ let rec precedence = (~show_function_bodies, ~show_casts: bool, d: DHExp.t) => { | TypAp(_) => DHDoc_common.precedence_Ap | Cons(_) => DHDoc_common.precedence_Cons | ListConcat(_) => DHDoc_common.precedence_Plus + // TODO (Anthony): what should this be? + | TupLabel(_) => DHDoc_common.precedence_Comma | Tuple(_) => DHDoc_common.precedence_Comma + | Dot(_) => DHDoc_common.precedence_Dot | TypFun(_) | Fun(_) when !show_function_bodies => DHDoc_common.precedence_const | TypFun(_) @@ -164,6 +168,7 @@ let mk = | (BinIntOp(_), _) | (BinFloatOp(_), _) | (BinStringOp(_), _) + | (Dot, _) | (Projection, _) | (ListCons, _) | (ListConcat, _) @@ -319,6 +324,7 @@ let mk = | Int(n) => DHDoc_common.mk_IntLit(n) | Float(f) => DHDoc_common.mk_FloatLit(f) | String(s) => DHDoc_common.mk_StringLit(s) + | Label(name) => DHDoc_common.mk_Label(name) | Undefined => DHDoc_common.mk_Undefined() | Test(d) => DHDoc_common.mk_Test(go'(d)) | Deferral(_) => text("_") @@ -398,6 +404,13 @@ let mk = let (doc1, doc2) = mk_right_associative_operands(precedence_bin_bool_op(op), d1, d2); hseps([doc1, mk_bin_bool_op(op), doc2]); + // TODO(Anthony): what to do here? + | TupLabel(l, d) => + Doc.hcats([go'(l), DHDoc_common.Delim.mk("="), go'(d)]) + | Dot(d1, d2) => + let doc1 = go'(d1); + let doc2 = go'(d2); + DHDoc_common.mk_Dot(doc1, doc2); | Tuple([]) => DHDoc_common.Delim.triv | Tuple(ds) => DHDoc_common.mk_Tuple(ds |> List.map(d => go'(d))) | Match(dscrut, drs) => go_case(dscrut, drs) diff --git a/src/haz3lweb/view/dhcode/layout/DHDoc_Pat.re b/src/haz3lweb/view/dhcode/layout/DHDoc_Pat.re index 8996bd4b03..0ee93679fc 100644 --- a/src/haz3lweb/view/dhcode/layout/DHDoc_Pat.re +++ b/src/haz3lweb/view/dhcode/layout/DHDoc_Pat.re @@ -12,8 +12,10 @@ let precedence = (dp: Pat.t) => | Float(_) | Bool(_) | String(_) + | Label(_) | ListLit(_) | Constructor(_) => DHDoc_common.precedence_const + | TupLabel(_, _) => DHDoc_common.precedence_Comma | Tuple(_) => DHDoc_common.precedence_Comma | Cons(_) => DHDoc_common.precedence_Cons | Ap(_) => DHDoc_common.precedence_Ap @@ -51,6 +53,7 @@ let rec mk = | Float(f) => DHDoc_common.mk_FloatLit(f) | Bool(b) => DHDoc_common.mk_BoolLit(b) | String(s) => DHDoc_common.mk_StringLit(s) + | Label(name) => DHDoc_common.mk_Label(name) | ListLit(d_list) => let ol = List.map(mk', d_list); DHDoc_common.mk_ListLit(ol); @@ -58,6 +61,9 @@ let rec mk = let (doc1, doc2) = mk_right_associative_operands(DHDoc_common.precedence_Cons, dp1, dp2); DHDoc_common.mk_Cons(doc1, doc2); + // TODO (Anthony): What to do for Tuplabel? + | TupLabel(l, d) => + Doc.hcats([mk'(l), DHDoc_common.Delim.mk("="), mk'(d)]) | Tuple([]) => DHDoc_common.Delim.triv | Tuple(ds) => DHDoc_common.mk_Tuple(List.map(mk', ds)) // TODO: Print type annotations diff --git a/src/haz3lweb/view/dhcode/layout/DHDoc_common.re b/src/haz3lweb/view/dhcode/layout/DHDoc_common.re index 2f35d5f0ab..80e1525a67 100644 --- a/src/haz3lweb/view/dhcode/layout/DHDoc_common.re +++ b/src/haz3lweb/view/dhcode/layout/DHDoc_common.re @@ -20,6 +20,7 @@ let precedence_GreaterThan = P.eqs; let precedence_And = P.and_; let precedence_Or = P.or_; let precedence_Comma = P.comma; +let precedence_Dot = P.dot; let precedence_max = P.min; let pad_child = @@ -98,6 +99,8 @@ let mk_IntLit = n => Doc.text(string_of_int(n)); let mk_StringLit = s => Doc.text(Form.string_quote(s)); +let mk_Label = name => Doc.text(name); + let mk_Test = t => Doc.(hcats([text("Test"), t, text("End")])); let mk_FloatLit = (f: float) => @@ -138,4 +141,6 @@ let mk_Ap = (doc1, doc2) => let mk_rev_Ap = (doc1, doc2) => Doc.(hcats([doc1, text(" |> "), doc2])); +let mk_Dot = (doc1, doc2) => Doc.(hcats([doc1, text("."), doc2])); + let mk_Undefined = () => Doc.text("undefined"); diff --git a/src/haz3lweb/view/dhcode/layout/DHDoc_common.rei b/src/haz3lweb/view/dhcode/layout/DHDoc_common.rei index aec422a020..7dcfc5678e 100644 --- a/src/haz3lweb/view/dhcode/layout/DHDoc_common.rei +++ b/src/haz3lweb/view/dhcode/layout/DHDoc_common.rei @@ -17,6 +17,7 @@ let precedence_GreaterThan: int; let precedence_And: int; let precedence_Or: int; let precedence_Comma: int; +let precedence_Dot: int; let precedence_max: int; let pad_child: @@ -82,6 +83,8 @@ let mk_ConstructorLit: string => Pretty.Doc.t('a); let mk_StringLit: string => Pretty.Doc.t('a); +let mk_Label: string => Pretty.Doc.t('a); + let mk_Cons: (Pretty.Doc.t('a), Pretty.Doc.t('a)) => Pretty.Doc.t('a); let mk_ListConcat: (Pretty.Doc.t('a), Pretty.Doc.t('a)) => Pretty.Doc.t('a); @@ -96,4 +99,6 @@ let mk_Ap: (Pretty.Doc.t('a), Pretty.Doc.t('a)) => Pretty.Doc.t('a); let mk_rev_Ap: (Pretty.Doc.t('a), Pretty.Doc.t('a)) => Pretty.Doc.t('a); +let mk_Dot: (Pretty.Doc.t('a), Pretty.Doc.t('a)) => Pretty.Doc.t('a); + let mk_Undefined: unit => Pretty.Doc.t('a); diff --git a/src/haz3lweb/view/dhcode/layout/HTypDoc.re b/src/haz3lweb/view/dhcode/layout/HTypDoc.re index 996d01f607..1dc5aea761 100644 --- a/src/haz3lweb/view/dhcode/layout/HTypDoc.re +++ b/src/haz3lweb/view/dhcode/layout/HTypDoc.re @@ -18,10 +18,12 @@ let precedence = (ty: Typ.t): int => | Float | Bool | String + | Label(_) | Unknown(_) | Var(_) | Forall(_) | Rec(_) + | TupLabel(_) | Sum(_) => precedence_Sum | List(_) => precedence_Const | Prod(_) => precedence_Prod @@ -75,7 +77,12 @@ let rec mk = (~parenthesize=false, ~enforce_inline: bool, ty: Typ.t): t => { | Float => (text("Float"), parenthesize) | Bool => (text("Bool"), parenthesize) | String => (text("String"), parenthesize) + | Label(name) => (text(name), parenthesize) | Var(name) => (text(name), parenthesize) + | TupLabel(label, ty) => ( + hcats([mk'(label), text("="), mk'(ty)]), + parenthesize, + ) // TODO (Anthony): What to do here? | List(ty) => ( hcats([ mk_delim("["), diff --git a/test/Test_Elaboration.re b/test/Test_Elaboration.re index 2516f25227..6bdb5cfea9 100644 --- a/test/Test_Elaboration.re +++ b/test/Test_Elaboration.re @@ -10,6 +10,8 @@ let id_at = x => x |> List.nth(ids); let mk_map = Statics.mk(CoreSettings.on, Builtins.ctx_init); let dhexp_of_uexp = u => Elaborator.elaborate(mk_map(u), u) |> fst; let alco_check = dhexp_typ |> Alcotest.check; +let parse_exp = (s: string) => + MakeTerm.from_zip_for_sem(Option.get(Printer.zipper_of_string(s))).term; let u1: Exp.t = {ids: [id_at(0)], term: Int(8), copied: false}; let single_integer = () => @@ -181,6 +183,7 @@ let deferral = () => alco_check( "string_sub(\"hello\", 1, _)", dhexp_of_uexp( + // This test seems broken DeferredAp( Var("string_sub") |> Exp.fresh, [ @@ -204,6 +207,178 @@ let deferral = () => ), ); +/* + Label Elaboration test + ```hazel + let add : (street=String, city=String, state=String, zipcode=Int)= ("123 Maple St", + "Ann Arbor", + "MI", + 48103) in add ``` + elaborates to + (street="123 Maple St", city="Ann Arbor", state="MI", zipcode=48103) + */ +let full_labeled_tuple_program: Exp.t = + Let( + Cast( + Var("add") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("street") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + TupLabel(Label("city") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + TupLabel(Label("state") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + TupLabel(Label("zipcode") |> Typ.fresh, Int |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + Parens( + Tuple([ + String("123 Maple St") |> Exp.fresh, + String("Ann Arbor") |> Exp.fresh, + String("MI") |> Exp.fresh, + Int(48103) |> Exp.fresh, + ]) + |> Exp.fresh, + ) + |> Exp.fresh, + Var("add") |> Exp.fresh, + ) + |> Exp.fresh; +let elaborated_labeled_tuple = () => + alco_check( + "Labeled Tuple label introduction", + Let( + Var("add") |> Pat.fresh, + Tuple([ + TupLabel( + Label("street") |> Exp.fresh, + String("123 Maple St") |> Exp.fresh, + ) + |> Exp.fresh, + TupLabel( + Label("city") |> Exp.fresh, + String("Ann Arbor") |> Exp.fresh, + ) + |> Exp.fresh, + TupLabel(Label("state") |> Exp.fresh, String("MI") |> Exp.fresh) + |> Exp.fresh, + TupLabel(Label("zipcode") |> Exp.fresh, Int(48103) |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + Var("add") |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp(full_labeled_tuple_program), + ); + +let singleton_labeled_tuple = () => + alco_check( + "Singleton Labeled Tuple", + Tuple([ + TupLabel( + Label("label") |> Exp.fresh, + String("a string value") |> Exp.fresh, + ) + |> Exp.fresh, + ]) + |> Exp.fresh, + dhexp_of_uexp( + Tuple([ + TupLabel( + Label("label") |> Exp.fresh, + String("a string value") |> Exp.fresh, + ) + |> Exp.fresh, + ]) + |> Exp.fresh, + ), + ); + +let singleton_labeled_tuple_elaborates_labels = () => + alco_check( + "let x : (l=String) = \"a\" in x", + Let( + Var("x") |> Pat.fresh, + Tuple([ + TupLabel(Label("l") |> Exp.fresh, String("a") |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + Var("x") |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp(parse_exp("let x : (l=String) = \"a\" in x")), + ); + +/* Labeled Tuple Rearranging + ```hazel + let val : (a=Int, b=String, Float, c=Bool)= (1, + 1.0, + c=true, + b="a") in val ``` + elaborates to + (a=1, b="a", 1.0, c=true) + */ +let rearranged_labeled_tuple_program: Exp.t = + Let( + Cast( + Var("val") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("a") |> Typ.fresh, Int |> Typ.fresh) |> Typ.fresh, + TupLabel(Label("b") |> Typ.fresh, String |> Typ.fresh) |> Typ.fresh, + Float |> Typ.fresh, + TupLabel(Label("c") |> Typ.fresh, Bool |> Typ.fresh) |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + Parens( + Tuple([ + Int(1) |> Exp.fresh, + Float(1.0) |> Exp.fresh, + TupLabel(Label("c") |> Exp.fresh, Bool(true) |> Exp.fresh) + |> Exp.fresh, + TupLabel(Label("b") |> Exp.fresh, String("a") |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + ) + |> Exp.fresh, + Var("val") |> Exp.fresh, + ) + |> Exp.fresh; +let rearranged_labeled_tuple = () => + alco_check( + "Labeled Tuple rearrangement", + Let( + Var("val") |> Pat.fresh, + Tuple([ + TupLabel(Label("a") |> Exp.fresh, Int(1) |> Exp.fresh) |> Exp.fresh, + TupLabel(Label("b") |> Exp.fresh, String("a") |> Exp.fresh) + |> Exp.fresh, + Float(1.0) |> Exp.fresh, + TupLabel(Label("c") |> Exp.fresh, Bool(true) |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + Var("val") |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp(rearranged_labeled_tuple_program), + ); + let elaboration_tests = [ test_case("Single integer", `Quick, single_integer), test_case("Empty hole", `Quick, empty_hole), @@ -220,4 +395,246 @@ let elaboration_tests = [ `Quick, deferral, ), + test_case("Labeled tuple elaboration", `Quick, elaborated_labeled_tuple), + test_case("Rearranged labeled tuple", `Quick, rearranged_labeled_tuple), + test_case( + // TODO Not sure if we want this case + "Singleton labeled tuple adds labels", + `Quick, + singleton_labeled_tuple_elaborates_labels, + ), + test_case("Singleton labeled tuple", `Quick, singleton_labeled_tuple), // TODO Make consistent with make term + // TODO Add singleton labeled function application + test_case("Singleton labeld tuple analysis adds label", `Quick, () => + alco_check( + "Singleton labeld tuple analysis adds label", + Let( + Var("x") |> Pat.fresh, + Tuple([ + TupLabel(Label("l") |> Exp.fresh, String("a") |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + Var("x") |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp( + Let( + Cast( + Var("x") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("l") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + Parens(String("a") |> Exp.fresh) |> Exp.fresh, + Var("x") |> Exp.fresh, + ) + |> Exp.fresh, + ), + ) + ), + test_case( + "Singleton labeld tuple analysis adds label with type alias", `Quick, () => + alco_check( + {|type T = (a=String) in + let x : T = "hello" in x|}, + Let( + Var("x") |> Pat.fresh, + Tuple([ + TupLabel(Label("a") |> Exp.fresh, String("hello") |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + Var("x") |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp( + parse_exp({|type T = (a=String) in let x : T = "hello" in x|}), + ), + ) + ), + test_case( + "Singleton labeld tuple analysis adds label with type alias", `Quick, () => + alco_check( + {|let zip_only : (zip=Int) = (zip=12345) in zip_only|}, + Let( + Var("zip_only") |> Pat.fresh, + Tuple([ + TupLabel(Label("zip") |> Exp.fresh, Int(12345) |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + Var("zip_only") |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp( + parse_exp({|let zip_only : (zip=Int) = (zip=12345) in zip_only|}), + ), + ) + ), + test_case( + "Singleton labeled argument function application with known type", + `Quick, + () => + alco_check( + {|(fun a=x->x)(a=1)|}, + Ap( + Forward, + Fun( + Tuple([ + TupLabel(Label("a") |> Pat.fresh, Var("x") |> Pat.fresh) + |> Pat.fresh, + ]) + |> Pat.fresh, + Var("x") |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + Tuple([ + TupLabel(Label("a") |> Exp.fresh, Int(1) |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp(parse_exp({|(fun a=(x:Int) -> x)(a=1)|})), + ) + ), + test_case( + "Singleton labeled argument function application with no label in ap", + `Quick, + () => + alco_check( + {|(fun a=x->x)(a=1)|}, + Ap( + Forward, + Fun( + Tuple([ + TupLabel(Label("a") |> Pat.fresh, Var("x") |> Pat.fresh) + |> Pat.fresh, + ]) + |> Pat.fresh, + Var("x") |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + Tuple([ + TupLabel(Label("a") |> Exp.fresh, Int(1) |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp(parse_exp({|(fun a=(x:Int) -> x)(1)|})), + ) + ), + test_case("Failed cast inside labeled tuple", `Quick, () => + alco_check( + {|let x : (c=String) = c=1 in x|}, // TODO Things go wrong if this is unknown rather than String + Let( + Var("x") |> Pat.fresh, + Tuple([ + TupLabel( + Label("c") |> Exp.fresh, + FailedCast( + Int(1) |> Exp.fresh, + Int |> Typ.fresh, + String |> Typ.fresh, + ) + |> Exp.fresh, + ) + |> Exp.fresh, + ]) + |> Exp.fresh, + Var("x") |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp(parse_exp({|let x : (c=String) = c=1 in x|})), + ) + ), + test_case("nested different singleton labeled arguments", `Quick, () => + alco_check( + {|let x : (b=c=String) = b="" in x|}, + Let( + Var("x") |> Pat.fresh, + Tuple([ + TupLabel( + Label("b") |> Exp.fresh, + Tuple([ + TupLabel( + Label("c") |> Exp.fresh, + FailedCast( + Int(1) |> Exp.fresh, + Int |> Typ.fresh, + String |> Typ.fresh, + ) + |> Exp.fresh, + ) + |> Exp.fresh, + ]) + |> Exp.fresh, + ) + |> Exp.fresh, + ]) + |> Exp.fresh, + Var("x") |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp(parse_exp({|let x : (b=c=String) = b="" in x|})), + ) + ), + test_case("Singleton labeled argument let with unknown type", `Quick, () => + alco_check( + {|let x : (a=?) = (a=1) in x|}, + Let( + Var("x") |> Pat.fresh, + Tuple([ + TupLabel(Label("a") |> Exp.fresh, Int(1) |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + Var("x") |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp(parse_exp({|let x : (a=?) = (a=1) in x|})), + ) + ), + test_case( + "Singleton labeled argument function application with unknown type", + `Quick, + () => + alco_check( + {|(fun a=x->x)(a=1)|}, + Ap( + Forward, + Fun( + Tuple([ + TupLabel(Label("a") |> Pat.fresh, Var("x") |> Pat.fresh) + |> Pat.fresh, + ]) + |> Pat.fresh, + Var("x") |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + Tuple([ + TupLabel(Label("a") |> Exp.fresh, Int(1) |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + ) + |> Exp.fresh, + dhexp_of_uexp(parse_exp({|(fun a=x->x)(a=1)|})), + ) + ), ]; diff --git a/test/Test_Evaluator.re b/test/Test_Evaluator.re index fc159425b2..366c7fc1f0 100644 --- a/test/Test_Evaluator.re +++ b/test/Test_Evaluator.re @@ -38,7 +38,29 @@ let test_sum = () => BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) |> Exp.fresh, ); +let test_labeled_tuple_projection = () => + evaluation_test( + "(a=1, b=2, c=?).a", + Int(1) |> Exp.fresh, + Dot( + Tuple([ + TupLabel(Label("a") |> Exp.fresh, Int(1) |> Exp.fresh) |> Exp.fresh, + TupLabel(Label("b") |> Exp.fresh, Int(2) |> Exp.fresh) |> Exp.fresh, + TupLabel(Label("c") |> Exp.fresh, EmptyHole |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + Var("a") |> Exp.fresh // This is a var now for parsing reasons + ) + |> Exp.fresh, + ); + let tests = [ test_case("Integer literal", `Quick, test_int), test_case("Integer sum", `Quick, test_sum), + test_case( + "Labeled tuple projection", + `Quick, + test_labeled_tuple_projection, + ), ]; diff --git a/test/Test_LabeledTuple.re b/test/Test_LabeledTuple.re new file mode 100644 index 0000000000..e1715207aa --- /dev/null +++ b/test/Test_LabeledTuple.re @@ -0,0 +1,98 @@ +open Alcotest; +open Haz3lcore; + +let test_rearrange = (name, analyzed_types, actual_values, expected_values) => + test_case( + name, + `Quick, + () => { + let actual = + LabeledTuple.rearrange_base( + ~show_b=[%derive.show: int], + analyzed_types, + actual_values, + ); + check( + list(pair(option(string), int)), + name, + expected_values, + actual, + ); + (); + }, + ); +// Create a property test +let tests: list(test_case(return)) = [ + test_rearrange( + "Singleton unlabeled", + [None], + [(None, 1)], + [(None, 1)], + ), + test_rearrange( + "Singleton labeled", + [Some("a")], + [(Some("a"), 1)], + [(Some("a"), 1)], + ), + test_rearrange( + "unlabeled remains same order", + [None, None, None], + [(None, 1), (None, 2), (None, 3)], + [(None, 1), (None, 2), (None, 3)], + ), + test_rearrange( + "fully labeled retains ordering", + [Some("a"), Some("b"), Some("c")], + [(Some("a"), 1), (Some("b"), 2), (Some("c"), 3)], + [(Some("a"), 1), (Some("b"), 2), (Some("c"), 3)], + ), + test_rearrange( + "Missing labels get added", + [Some("a"), Some("b"), Some("c")], + [(None, 1), (None, 2), (None, 3)], + [(Some("a"), 1), (Some("b"), 2), (Some("c"), 3)], + ), + test_rearrange( + "Present labels get reordered", + [Some("a"), Some("b"), Some("c")], + [(Some("b"), 1), (Some("a"), 2), (Some("c"), 3)], + [(Some("a"), 2), (Some("b"), 1), (Some("c"), 3)], + ), + test_rearrange( + "Partial labels get reordered", + [Some("a"), Some("b"), Some("c")], + [(Some("b"), 1), (None, 2), (None, 3)], + [(Some("a"), 2), (Some("b"), 1), (Some("c"), 3)], + ), + test_rearrange( + "Extra labels get reordered", + [Some("a"), Some("b"), Some("c")], + [(Some("d"), 4), (Some("b"), 1), (Some("a"), 2), (Some("c"), 3)], + [(Some("a"), 2), (Some("b"), 1), (Some("c"), 3), (Some("d"), 4)], + ), + test_rearrange( + "pair labeled, unlabled", + [Some("a"), None], + [(Some("a"), 1), (None, 2)], + [(Some("a"), 1), (None, 2)], + ), + test_rearrange( + "Independent label sets with some overlap", + [Some("a"), Some("b"), None, Some("c"), None], + [ + (Some("d"), 4), + (Some("c"), 1), + (Some("e"), 5), + (Some("b"), 3), + (None, 2), + ], + [ + (Some("a"), 4), + (Some("b"), 3), + (None, 5), + (Some("c"), 1), + (None, 2), + ], + ), +]; diff --git a/test/Test_MakeTerm.re b/test/Test_MakeTerm.re new file mode 100644 index 0000000000..d5e8bc9a7d --- /dev/null +++ b/test/Test_MakeTerm.re @@ -0,0 +1,110 @@ +/** + * This file contains tests to validate the `MakeTerm` module's ability to convert + * zippers into expressions. + */ +open Alcotest; +open Haz3lcore; + +let exp_typ = testable(Fmt.using(Exp.show, Fmt.string), Exp.fast_equal); + +// TODO Assertion if it doesn't parse +let parse_exp = (s: string) => + MakeTerm.from_zip_for_sem(Option.get(Printer.zipper_of_string(s))).term; +let exp_check = (expected, actual) => + check(exp_typ, actual, expected, parse_exp(actual)); + +let tests = [ + test_case("Singleton Labled Tuple ascription in let", `Quick, () => { + exp_check( + Let( + Cast( + Var("x") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("l") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + Parens(String("a") |> Exp.fresh) |> Exp.fresh, + Var("x") |> Exp.fresh, + ) + |> Exp.fresh, + "let x : (l=String) = (\"a\") in x", + ) + }), + test_case("Assigning labeled tuple to variable", `Quick, () => { + exp_check( + Let( + Var("x") |> Pat.fresh, + Parens( + Tuple([ + TupLabel(Label("l") |> Exp.fresh, Int(32) |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + ) + |> Exp.fresh, + Let( + Cast( + Var("y") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("l") |> Typ.fresh, Int |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + Var("x") |> Exp.fresh, + Var("y") |> Exp.fresh, + ) + |> Exp.fresh, + ) + |> Exp.fresh, + "let x = (l=32) in + let y : (l=Int) = x in y", + ) + }), + test_case("Multiple labels in tuple", `Quick, () => { + exp_check( + Let( + Cast( + Var("x") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("l") |> Typ.fresh, Int |> Typ.fresh) + |> Typ.fresh, + TupLabel(Label("l2") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + Parens( + Tuple([ + TupLabel(Label("l") |> Exp.fresh, Int(32) |> Exp.fresh) + |> Exp.fresh, + TupLabel(Label("l2") |> Exp.fresh, String("") |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, + ) + |> Exp.fresh, + Var("x") |> Exp.fresh, + ) + |> Exp.fresh, + {|let x : (l=Int, l2=String) = (l=32, l2="") in x|}, + ) + }), +]; diff --git a/test/Test_Statics.re b/test/Test_Statics.re index 71fdafc8ba..928749f499 100644 --- a/test/Test_Statics.re +++ b/test/Test_Statics.re @@ -2,28 +2,217 @@ open Alcotest; open Haz3lcore; let testable_typ = testable(Fmt.using(Typ.show, Fmt.string), Typ.fast_equal); +let testable_status_exp = + testable( + Fmt.using(Info.show_status_exp, Fmt.string), + // TODO: Fix this + (a, b) => { + switch (a, b) { + | ( + InHole(Common(Inconsistent(Expectation({ana: a1, syn: a2})))), + InHole(Common(Inconsistent(Expectation({ana: b1, syn: b2})))), + ) => + Typ.fast_equal(a1, b1) && Typ.fast_equal(a2, b2) + | _ => false + } + }); + +let status_exp: testable(Info.status_exp) = + testable(Fmt.using(Info.show_status_exp, Fmt.string), (==)); module FreshId = { let arrow = (a, b) => Arrow(a, b) |> Typ.fresh; let unknown = a => Unknown(a) |> Typ.fresh; let int = Typ.fresh(Int); let float = Typ.fresh(Float); let prod = a => Prod(a) |> Typ.fresh; + let label = a => Label(a) |> Typ.fresh; + let tup_label = (a, b) => TupLabel(a, b) |> Typ.fresh; let string = Typ.fresh(String); }; let ids = List.init(12, _ => Id.mk()); let id_at = x => x |> List.nth(ids); let statics = Statics.mk(CoreSettings.on, Builtins.ctx_init); let alco_check = Alcotest.option(testable_typ) |> Alcotest.check; +let parse_exp = (s: string) => + MakeTerm.from_zip_for_sem(Option.get(Printer.zipper_of_string(s))).term; -// Get the type from the statics -let type_of = f => { - let s = statics(f); - switch (Id.Map.find(IdTagged.rep_id(f), s)) { - | InfoExp({ty, _}) => Some(ty) +let info_of_id = (~statics_map=?, f: UExp.t, id: Id.t) => { + // print_endline( + // "Map: " ++ [%derive.show: option(Statics.Map.t)](statics_map), + // ); + let s = + switch (statics_map) { + | Some(s) => s + | None => statics(f) + }; + switch (Id.Map.find(id, s)) { + | InfoExp(ie) => Some(ie) | _ => None }; }; +// Get the type from the statics +let type_of = (~statics_map=?, f) => { + Option.map( + (ie: Info.exp) => ie.ty, + info_of_id(~statics_map?, f, IdTagged.rep_id(f)), + ); +}; + +let inconsistent_typecheck = (name, _serialized, exp) => { + test_case( + name, + `Quick, + () => { + let s = statics(exp); + let errors = + List.map( + (id: Id.t) => { + let info = Id.Map.find(id, s); + switch (info) { + | InfoExp(ie) => ie.status + | _ => fail("Expected InfoExp") + }; + }, + Statics.Map.error_ids(s), + ); + if (errors == []) { + fail("Expected errors"); + }; + print_endline( + "Errors: " ++ [%derive.show: list(Info.status_exp)](errors), + ); + }, + ); +}; +let fully_consistent_typecheck = (name, serialized, expected, exp) => { + test_case( + name, + `Quick, + () => { + let s = statics(exp); + let errors = + List.map( + (id: Id.t) => { + let info = Id.Map.find(id, s); + switch (info) { + | InfoExp(ie) => ie.status + | _ => fail("Expected InfoExp") + }; + }, + Statics.Map.error_ids(s), + ); + Alcotest.check(list(status_exp), "Static Errors", [], errors); + alco_check(serialized, expected, type_of(~statics_map=s, exp)); + }, + ); +}; + +let reusable_id = Id.mk(); +let unlabeled_tuple_to_labeled_fails = + test_case( + "Typechecking fails for unlabeled variable being assigned to labeled tuple", + `Quick, + () => + Alcotest.check( + Alcotest.option(testable_status_exp), + "let x = (1, 2) in let y : (a=Int, b=Int) = x in y", + Some( + InHole( + Common( + Inconsistent( + Expectation({ + ana: + Parens( + Prod([ + TupLabel(Label("a") |> Typ.fresh, Int |> Typ.fresh) + |> Typ.fresh, + TupLabel(Label("b") |> Typ.fresh, Int |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + syn: Prod([Int |> Typ.fresh, Int |> Typ.fresh]) |> Typ.fresh, + }), + ), + ), + ), + ), + Option.map( + (ie: Info.exp) => ie.status, + info_of_id( + Let( + Var("x") |> Pat.fresh, + Parens( + Tuple([Int(1) |> Exp.fresh, Int(2) |> Exp.fresh]) |> Exp.fresh, + ) + |> Exp.fresh, + Let( + Cast( + Var("y") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("a") |> Typ.fresh, Int |> Typ.fresh) + |> Typ.fresh, + TupLabel(Label("b") |> Typ.fresh, Int |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + {ids: [reusable_id], term: Var("x"), copied: false}, + Var("y") |> Exp.fresh, + ) + |> Exp.fresh, + ) + |> Exp.fresh, + reusable_id, + ), + ), + ) + ); + +let simple_inconsistency = + test_case( + "Typechecking fails for unlabeled variable being assigned to labeled tuple", + `Quick, + () => + Alcotest.check( + Alcotest.option(testable_status_exp), + "let y : String = true", + Some( + InHole( + Common( + Inconsistent( + Expectation({ana: String |> Typ.fresh, syn: Bool |> Typ.fresh}), + ), + ), + ), + ), + Option.map( + (ie: Info.exp) => ie.status, + info_of_id( + Let( + Cast( + Var("y") |> Pat.fresh, + String |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + {ids: [reusable_id], term: Bool(true), copied: false}, + Var("y") |> Exp.fresh, + ) + |> Exp.fresh, + reusable_id, + ), + ), + ) + ); + let unapplied_function = () => alco_check( "Unknown param", @@ -42,85 +231,400 @@ let unapplied_function = () => let tests = FreshId.[ - test_case("Function with unknown param", `Quick, () => - alco_check( - "x => 4 + 5", - Some(arrow(unknown(Internal), int)), - type_of( - Fun( - Var("x") |> Pat.fresh, - BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) + fully_consistent_typecheck( + "Function with unknown param", + "x => 4 + 5", + Some(arrow(unknown(Internal), int)), + Fun( + Var("x") |> Pat.fresh, + BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) + |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + ), + fully_consistent_typecheck( + "Function with known param", + "x : Int => 4 + 5", + Some(arrow(int, int)), + Fun( + Cast(Var("x") |> Pat.fresh, int, unknown(Internal)) |> Pat.fresh, + BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) + |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + ), + fully_consistent_typecheck( + "Function with labeled param", + "fun (a=x) -> 4", + Some(arrow(prod([tup_label(label("a"), unknown(Internal))]), int)), + Fun( + Parens( + Tuple([ + TupLabel(Label("a") |> Pat.fresh, Var("x") |> Pat.fresh) + |> Pat.fresh, + ]) + |> Pat.fresh, + ) + |> Pat.fresh, + Int(4) |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + ), + fully_consistent_typecheck( + "bifunction", + "x : Int, y: Int => x + y", + Some(arrow(prod([int, int]), int)), + Fun( + Tuple([ + Cast(Var("x") |> Pat.fresh, int, unknown(Internal)) |> Pat.fresh, + Cast(Var("y") |> Pat.fresh, int, unknown(Internal)) |> Pat.fresh, + ]) + |> Pat.fresh, + BinOp(Int(Plus), Var("x") |> Exp.fresh, Var("y") |> Exp.fresh) + |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + ), + fully_consistent_typecheck( + "bifunction", + "x : Int, y: Int => x + y", + Some(arrow(prod([int, int]), int)), + Fun( + Tuple([ + Cast(Var("x") |> Pat.fresh, int, unknown(Internal)) |> Pat.fresh, + Cast(Var("y") |> Pat.fresh, int, unknown(Internal)) |> Pat.fresh, + ]) + |> Pat.fresh, + BinOp(Int(Plus), Var("x") |> Exp.fresh, Var("y") |> Exp.fresh) + |> Exp.fresh, + None, + None, + ) + |> Exp.fresh, + ), + // fully_consistent_typecheck( + // "function application", + // "float_of_int(1)", + // Some(float), + // Ap(Forward, Var("float_of_int") |> Exp.fresh, Int(1) |> Exp.fresh) + // |> Exp.fresh, + // ), + // fully_consistent_typecheck( + // "function deferral", + // "string_sub(\"hello\", 1, _)", + // Some(arrow(int, string)), + // DeferredAp( + // Var("string_sub") |> Exp.fresh, + // [ + // String("hello") |> Exp.fresh, + // Int(1) |> Exp.fresh, + // Deferral(InAp) |> Exp.fresh, + // ], + // ) + // |> Exp.fresh, + // ), + unlabeled_tuple_to_labeled_fails, + simple_inconsistency, + fully_consistent_typecheck( + "Assigning labeled tuple to variable", + "let x = (l=32) in let y : (l=Int) = x in y", + Some( + Prod([ + TupLabel(Label("l") |> Typ.fresh, Int |> Typ.fresh) |> Typ.fresh, + ]) + |> Typ.fresh, + ), + Let( + Var("x") |> Pat.fresh, + Parens( + Tuple([ + TupLabel(Label("l") |> Exp.fresh, Int(32) |> Exp.fresh) |> Exp.fresh, - None, - None, - ) + ]) |> Exp.fresh, - ), + ) + |> Exp.fresh, + Let( + Cast( + Var("y") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("l") |> Typ.fresh, Int |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + Var("x") |> Exp.fresh, + Var("y") |> Exp.fresh, + ) + |> Exp.fresh, ) + |> Exp.fresh, ), - test_case("Function with known param", `Quick, () => - alco_check( - "x : Int => 4 + 5", - Some(arrow(int, int)), - type_of( - Fun( - Cast(Var("x") |> Pat.fresh, int, unknown(Internal)) |> Pat.fresh, - BinOp(Int(Plus), Int(4) |> Exp.fresh, Int(5) |> Exp.fresh) - |> Exp.fresh, - None, - None, + fully_consistent_typecheck( + "Singleton Labled Tuple ascription in let", + "let x : (l=String) = (\"a\") in x", + Some( + Prod([ + TupLabel(Label("l") |> Typ.fresh, String |> Typ.fresh) |> Typ.fresh, + ]) + |> Typ.fresh, + ), + Let( + Cast( + Var("x") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("l") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, ) - |> Exp.fresh, - ), + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + Parens(String("a") |> Exp.fresh) |> Exp.fresh, // TODO Need to assert there's no inconsistency in this branch + Var("x") |> Exp.fresh, ) + |> Exp.fresh, ), - test_case("bifunction", `Quick, () => - alco_check( - "x : Int, y: Int => x + y", - Some(arrow(prod([int, int]), int)), - type_of( - Fun( - Tuple([ - Cast(Var("x") |> Pat.fresh, int, unknown(Internal)) - |> Pat.fresh, - Cast(Var("y") |> Pat.fresh, int, unknown(Internal)) - |> Pat.fresh, + inconsistent_typecheck( + "Singleton Labled Tuple ascription in let with wrong type should fail", + "let x : (l=String) = 1 in x", + Let( + Cast( + Var("x") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("l") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, ]) - |> Pat.fresh, - BinOp(Int(Plus), Var("x") |> Exp.fresh, Var("y") |> Exp.fresh) - |> Exp.fresh, - None, - None, + |> Typ.fresh, ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + Int(1) |> Exp.fresh, // TODO Need to assert there's no inconsistency in this branch + Var("x") |> Exp.fresh, + ) + |> Exp.fresh, + ), + fully_consistent_typecheck( + "Singleton Labled Tuple with specified label", + "let x : (l=String) = (l=\"a\") in x", + Some( + Prod([ + TupLabel(Label("l") |> Typ.fresh, String |> Typ.fresh) |> Typ.fresh, + ]) + |> Typ.fresh, + ), + Let( + Cast( + Var("x") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("l") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + Parens( + Tuple([ + TupLabel(Label("l") |> Exp.fresh, String("a") |> Exp.fresh) + |> Exp.fresh, + ]) |> Exp.fresh, - ), + ) + |> Exp.fresh, // TODO Need to assert there's no inconsistency in this branch + Var("x") |> Exp.fresh, ) + |> Exp.fresh, ), - test_case("function application", `Quick, () => - alco_check( - "float_of_int(1)", - Some(float), - type_of( - Ap(Forward, Var("float_of_int") |> Exp.fresh, Int(1) |> Exp.fresh) + fully_consistent_typecheck( + "Labeled tuple with multiple labels", + {|(l=32, l2="")|}, + Some( + Prod([ + TupLabel(Label("l") |> Typ.fresh, Int |> Typ.fresh) |> Typ.fresh, + TupLabel(Label("l2") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ), + Parens( + Tuple([ + TupLabel(Label("l") |> Exp.fresh, Int(32) |> Exp.fresh) |> Exp.fresh, - ), + TupLabel(Label("l2") |> Exp.fresh, String("") |> Exp.fresh) + |> Exp.fresh, + ]) + |> Exp.fresh, ) + |> Exp.fresh, ), - test_case("function deferral", `Quick, () => - alco_check( - "string_sub(\"hello\", 1, _)", - Some(arrow(int, string)), - type_of( - DeferredAp( - Var("string_sub") |> Exp.fresh, - [ - String("hello") |> Exp.fresh, - Int(1) |> Exp.fresh, - Deferral(InAp) |> Exp.fresh, - ], + fully_consistent_typecheck( + "Let statement that adds labels during elaboration", + {|let x : (name=String, age=Int)= ("Bob", 20) |}, + Some( + Prod([ + TupLabel(Label("name") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + TupLabel(Label("age") |> Typ.fresh, Int |> Typ.fresh) |> Typ.fresh, + ]) + |> Typ.fresh, + ), + Let( + Cast( + Var("x") |> Pat.fresh, + Parens( + Prod([ + TupLabel(Label("name") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + TupLabel(Label("age") |> Typ.fresh, Int |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + Parens( + Tuple([String("Bob") |> Exp.fresh, Int(20) |> Exp.fresh]) |> Exp.fresh, - ), + ) + |> Exp.fresh, + Var("x") |> Exp.fresh, + ) + |> Exp.fresh, + ), + fully_consistent_typecheck( + "Duplicate singleton labels", + {|let y : (l=(l=Int)) = (l=1) in y|}, + Some( + Prod([ + TupLabel( + Label("l") |> Typ.fresh, + Parens( + Prod([ + TupLabel(Label("l") |> Typ.fresh, Int |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + ) + |> Typ.fresh, + ]) + |> Typ.fresh, + ), + parse_exp({|let y : (l=(l=Int)) = (l=1) in y|}), + ), + fully_consistent_typecheck( + "Reconstructed labeled tuple without values", + {|let x : (l=|}, + Some(Unknown(Internal) |> Typ.fresh), + Let( + Cast( + Var("x") |> Pat.fresh, + Parens( + Prod([ + TupLabel( + Label("l") |> Typ.fresh, + Unknown(Hole(EmptyHole)) |> Typ.fresh, + ) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Pat.fresh, + EmptyHole |> Exp.fresh, + EmptyHole |> Exp.fresh, ) + |> Exp.fresh, + ), + fully_consistent_typecheck( + "Singleton labeled argument let with unknown type", + {|let x : (a=?) = (a=1) in x|}, + Some( + Prod([ + TupLabel( + Label("a") |> Typ.fresh, + Unknown(Hole(EmptyHole)) |> Typ.fresh, + ) + |> Typ.fresh, + ]) + |> Typ.fresh, + ), + parse_exp({|let x : (a=?) = (a=1) in x|}), + ), + fully_consistent_typecheck( + "nested different singleton labeled arguments", + {|let x : (b=c=String) = b="" in x|}, + Some( + Prod([ + TupLabel( + Label("b") |> Typ.fresh, + Prod([ + TupLabel(Label("c") |> Typ.fresh, String |> Typ.fresh) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + ]) + |> Typ.fresh, + ), + parse_exp({|let x : (b=c=String) = b="" in x|}), + ), + fully_consistent_typecheck( + "nested different singleton labeled arguments", + {|let x : (a=b=c=?) = b=? in x|}, + Some( + Prod([ + TupLabel( + Label("a") |> Typ.fresh, + Prod([ + TupLabel( + Label("b") |> Typ.fresh, + Prod([ + TupLabel( + Label("c") |> Typ.fresh, + Unknown(Hole(EmptyHole)) |> Typ.fresh, + ) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + ]) + |> Typ.fresh, + ) + |> Typ.fresh, + ]) + |> Typ.fresh, + ), + parse_exp({|let x : (a=b=c=?) = b=? in x|}), ), ]; diff --git a/test/dune b/test/dune index 832c9689f2..12c177c749 100644 --- a/test/dune +++ b/test/dune @@ -5,4 +5,4 @@ (libraries haz3lcore alcotest junit junit_alcotest) (modes js) (preprocess - (pps js_of_ocaml-ppx))) + (pps js_of_ocaml-ppx ppx_deriving.show))) diff --git a/test/haz3ltest.re b/test/haz3ltest.re index 3e13ae44b7..83ac064967 100644 --- a/test/haz3ltest.re +++ b/test/haz3ltest.re @@ -6,8 +6,10 @@ let (suite, _) = "Dynamics", [ ("Elaboration", Test_Elaboration.elaboration_tests), + ("LabeledTuple", Test_LabeledTuple.tests), ("Statics", Test_Statics.tests), ("Evaluator", Test_Evaluator.tests), + ("MakeTerm", Test_MakeTerm.tests), ], ); Junit.to_file(Junit.make([suite]), "junit_tests.xml");