diff --git a/Makefile b/Makefile index 5eef59a1d4..5289cf7b6c 100644 --- a/Makefile +++ b/Makefile @@ -64,7 +64,7 @@ test: node $(TEST_DIR)/haz3ltest.bc.js watch-test: - dune build @ocaml-index @fmt @runtest --auto-promote --watch + dune build @ocaml-index @fmt @runtest @default --profile dev --auto-promote --watch coverage: dune build @src/fmt @test/fmt --auto-promote src test --profile dev diff --git a/hazel.opam b/hazel.opam index 09ee887ab3..6f43cbbd17 100644 --- a/hazel.opam +++ b/hazel.opam @@ -14,6 +14,7 @@ depends: [ "reason" {>= "3.12.0"} "ppx_yojson_conv_lib" "ppx_yojson_conv" + "incr_dom" "bisect_ppx" "omd" {>= "2.0.0~alpha4"} "ezjs_idb" diff --git a/src/haz3lcore/LabeledTuple.re b/src/haz3lcore/LabeledTuple.re new file mode 100644 index 0000000000..9c9b150b89 --- /dev/null +++ b/src/haz3lcore/LabeledTuple.re @@ -0,0 +1,322 @@ +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 + }; + }; + +// This function should only be used for type checking labels +let match_labels: (label, label) => bool = + (label1, label2) => { + switch (label1, label2) { + // Empty label is a placeholder for checking any label + | ("", _) + | (_, "") => true + | (_, _) => label1 == label2 + }; + }; + +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; + }; + +// 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); +}; + +// TODO: can just use get_duplicate_labels and check if empty. +// Takes a list of strings and returns true if there are no duplicates. +let rec is_uniquely_labeled_base: list(label) => bool = + labels => { + let contains_duplicates = + switch (labels) { + | [] => false + | [hd, ...tl] => + List.exists(l => hd == l, tl) || is_uniquely_labeled_base(tl) + }; + !contains_duplicates; + }; + +// TODO: Performance +// Takes a list of strings and returns a list of duplicates and list of uniques. +// Can also be modified to get unique labels. +let get_duplicate_and_unique_labels_base: + list(label) => (list(label), list(label)) = + labels => { + let (duplicates, uniques) = + List.fold_left( + (acc, label) => { + let (dupes, uniqs) = acc; + List.exists(l => label == l, uniqs) + ? List.exists(l => label == l, dupes) + ? (dupes, uniqs) : (dupes @ [label], uniqs) + : (dupes, uniqs @ [label]); + }, + ([], []), + labels, + ); + (duplicates, uniques); + }; + +// Takes in a get_label function and a list of elements and applys is_uniquely_labeled_base +let is_uniquely_labeled: 'a. ('a => option((label, 'a)), list('a)) => bool = + (get_label, es) => { + let labels = fst(separate_and_keep_labels(get_label, es)); + let labels = + labels + |> List.filter(x => Option.is_some(x)) + |> OptUtil.sequence + |> OptUtil.get(() => []); + is_uniquely_labeled_base(labels); + }; + +let get_duplicate_and_unique_labels: + 'a. + ('a => option((label, 'a)), list('a)) => (list(label), list(label)) + = + (get_label, es) => { + let labels = fst(separate_and_keep_labels(get_label, es)); + let labels = + labels + |> List.filter(x => Option.is_some(x)) + |> OptUtil.sequence + |> OptUtil.get(() => []); + get_duplicate_and_unique_labels_base(labels); + }; + +// 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 a69f560dd5..6caa3474ae 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 27ec1ef5b3..49fc086959 100644 --- a/src/haz3lcore/dynamics/Elaborator.re +++ b/src/haz3lcore/dynamics/Elaborator.re @@ -47,14 +47,16 @@ let fresh_pat_cast = (p: DHPat.t, t1: Typ.t, t2: Typ.t): DHPat.t => { }; }; -let elaborated_type = (m: Statics.Map.t, uexp: UExp.t): (Typ.t, Ctx.t, 'a) => { - let (mode, self_ty, ctx, co_ctx) = +let elaborated_type = + (m: Statics.Map.t, uexp: UExp.t): (Typ.t, Ctx.t, 'a, UExp.t) => { + let (mode, self_ty, ctx, co_ctx, term) = switch (Id.Map.find_opt(Exp.rep_id(uexp), m)) { - | Some(Info.InfoExp({mode, ty, ctx, co_ctx, _})) => ( + | Some(Info.InfoExp({mode, ty, ctx, co_ctx, term, _})) => ( mode, ty, ctx, co_ctx, + term, ) | _ => raise(MissingTypeInfo) }; @@ -71,17 +73,19 @@ let elaborated_type = (m: Statics.Map.t, uexp: UExp.t): (Typ.t, Ctx.t, 'a) => { // We need to remove the synswitches from this type. | Ana(ana_ty) => Typ.match_synswitch(ana_ty, self_ty) }; - (elab_ty |> Typ.normalize(ctx), ctx, co_ctx); + (elab_ty |> Typ.normalize(ctx), ctx, co_ctx, term); }; -let elaborated_pat_type = (m: Statics.Map.t, upat: UPat.t): (Typ.t, Ctx.t) => { - let (mode, self_ty, ctx, prev_synswitch) = +let elaborated_pat_type = + (m: Statics.Map.t, upat: UPat.t): (Typ.t, Ctx.t, Pat.t) => { + let (mode, self_ty, ctx, prev_synswitch, term) = switch (Id.Map.find_opt(UPat.rep_id(upat), m)) { - | Some(Info.InfoPat({mode, ty, ctx, prev_synswitch, _})) => ( + | Some(Info.InfoPat({mode, ty, ctx, prev_synswitch, term, _})) => ( mode, ty, ctx, prev_synswitch, + term, ) | _ => raise(MissingTypeInfo) }; @@ -101,12 +105,16 @@ let elaborated_pat_type = (m: Statics.Map.t, upat: UPat.t): (Typ.t, Ctx.t) => { | Some(syn_ty) => Typ.match_synswitch(syn_ty, ana_ty) } }; - (elab_ty |> Typ.normalize(ctx), ctx); + (elab_ty |> Typ.normalize(ctx), ctx, term); }; let rec elaborate_pattern = - (m: Statics.Map.t, upat: UPat.t): (DHPat.t, Typ.t) => { - let (elaborated_type, ctx) = elaborated_pat_type(m, upat); + (m: Statics.Map.t, upat: UPat.t, in_container: bool) + : (DHPat.t, Typ.t) => { + // Pulling upat back out of the statics map for statics level elaboration + let (elaborated_type, ctx, upat) = 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 +123,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 = @@ -137,8 +146,60 @@ let rec elaborate_pattern = let p1'' = fresh_pat_cast(p1', ty1, ty_inner); let p2'' = fresh_pat_cast(p2', ty2, List(ty_inner) |> Typ.temp); 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) { + TupLabel(plab, p') + |> rewrap + |> cast_from(TupLabel(labty, pty) |> Typ.temp); + } else { + Tuple([TupLabel(plab, p') |> rewrap]) + |> DHPat.fresh + |> cast_from(Prod([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) => + TupLabel(Label(name) |> DHPat.fresh, p) |> DHPat.fresh, + (name, t) => TupLabel(Label(name) |> Typ.temp, t) |> Typ.temp, + ); Tuple(ps') |> rewrap |> cast_from(Prod(tys) |> Typ.temp); | Ap(p1, p2) => let (p1', ty1) = elaborate_pattern(m, p1); @@ -202,9 +263,16 @@ let rec elaborate_pattern = want to remove one, I'd ask you instead comment it out and leave 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); + // In the case of singleton labeled tuples we update the syntax in Statics. + // We store this syntax with the same ID as the original expression and store it on the Info.exp in the Statics.map + // We are then pulling this out and using it in place of the actual expression. + let (elaborated_type, ctx, co_ctx, statics_pseudo_elaborated) = + elaborated_type(m, uexp); + let cast_from = (ty, exp) => fresh_cast(exp, ty, elaborated_type); - let (term, rewrap) = UExp.unwrap(uexp); + let (_, rewrap) = UExp.unwrap(uexp); + let uexp = rewrap(statics_pseudo_elaborated.term); + let term = statics_pseudo_elaborated.term; let dhexp = switch (term) { | Invalid(_) @@ -213,7 +281,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) @@ -238,6 +306,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 = @@ -260,7 +329,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); Fun(p', e', env, n) |> rewrap @@ -270,9 +339,77 @@ let rec elaborate = (m: Statics.Map.t, uexp: UExp.t): (DHExp.t, Typ.t) => { TypFun(tpat, e', name) |> rewrap |> cast_from(Forall(tpat, tye) |> Typ.temp); + | TupLabel(label, e) => + let (label', labty) = elaborate(m, label); + let (e', ety) = elaborate(m, e); + TupLabel(label', e') + |> rewrap + |> cast_from(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) => { + TupLabel(Label(name) |> DHExp.fresh, e) |> DHExp.fresh + }, + (name, t) => TupLabel(Label(name) |> Typ.temp, t) |> Typ.temp, + ); Tuple(ds) |> rewrap |> cast_from(Prod(tys) |> Typ.temp); + + | Dot(e1, e2) => + let (e1, ty1) = elaborate(m, e1); + // Don't elaborate labels + // let (e2, ty2) = elaborate(m, e2); + let rec elab_dot = (ty1: Typ.t, e2: DHExp.t) => + switch (ty1.term, e2.term) { + | (Parens(ty1), _) => elab_dot(ty1, e2) + | (Prod(tys), Label(name)) => + let element = LabeledTuple.find_label(Typ.get_label, tys, name); + switch (element) { + | Some({term: TupLabel(_, ty), _}) => ty + | _ => Unknown(Internal) |> Typ.temp + }; + | (TupLabel(_, ty), Label(name)) + when LabeledTuple.equal(Typ.get_label(ty1), Some((name, e2))) => ty + | _ => Unknown(Internal) |> Typ.temp + }; + let ty = elab_dot(ty1, e2); + // Freshcast this, if necessary? + Dot(e1, e2) |> rewrap |> cast_from(ty); + | Var(v) => uexp |> cast_from( @@ -291,7 +428,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) @@ -301,18 +452,38 @@ 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); - Let(p, fresh_cast(def, ty2, ty1), body) |> rewrap |> cast_from(ty); + 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 { // TODO: Add names to mutually recursive functions // TODO: Don't add fixpoint if there already is one 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? 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); FixF(p', fresh_cast(e', tye, typ), env) |> rewrap |> cast_from(typ); | TyAlias(_, _, e) => @@ -329,7 +500,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', @@ -531,7 +705,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=Unknown(Internal) |> Typ.temp, ctx, ptys) |> Option.value(~default=Typ.temp(Unknown(Internal))); diff --git a/src/haz3lcore/dynamics/EvalCtx.re b/src/haz3lcore/dynamics/EvalCtx.re index 1f60bfa70a..fb238fbcc8 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))) @@ -109,6 +112,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 0882fa223f..ab5a43021f 100644 --- a/src/haz3lcore/dynamics/EvaluatorStep.re +++ b/src/haz3lcore/dynamics/EvaluatorStep.re @@ -332,6 +332,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 61fd72f1bd..113653282c 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..fd02b443af 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,13 @@ 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); + LabeledTuple.match_labels(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 +60,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 5c936426b9..a9ab026182 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 @@ -162,6 +163,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) { @@ -346,6 +348,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, @@ -454,6 +505,7 @@ module Transition = (EV: EV_MODE) => { | Int(_) | Float(_) | String(_) + | Label(_) | Constructor(_) | BuiltinFun(_) => let. _ = otherwise(env, d); @@ -650,6 +702,81 @@ 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? + // TODO: Get rid of all these casts + switch (DHExp.term_of(d1'), DHExp.term_of(d2')) { + | (Tuple(ds), Label(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, + }) + | (TupLabel(_, d), Label(name)) => + Step({ + expr: + LabeledTuple.equal(Exp.get_label(d1'), Some((name, d))) + ? d : 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), Label(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 + // | _ => Unknown(Internal) |> Typ.temp + // }; + // let ty' = + // switch (LabeledTuple.find_label(Typ.get_label, ts', name)) { + // | Some({term: TupLabel(_, ty), _}) => ty + // | _ => Unknown(Internal) |> Typ.temp + // }; + // Step({ + // expr: Cast(Dot(d3', d2) |> fresh, ty, ty') |> fresh, + // state_update, + // kind: CastAp, + // is_value: false, + // }); + | _ => Indet + }; + | 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. _ = @@ -798,6 +925,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 59b58aa56f..aeedf5634d 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(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(TupLabel(tlab, ty) |> Typ.temp); + | Dot(d1, d2) => + switch (d1.term, d2.term) { + | (Tuple(ds), Label(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), Label(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 c9a6f0c204..9528a611cd 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(_) @@ -150,13 +160,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) @@ -164,6 +186,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) @@ -223,6 +246,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' = @@ -257,15 +289,30 @@ let rec join = (~resolve=false, ~fix, ctx: Ctx.t, ty1: t, ty2: t): option(t) => | (Bool, _) => None | (String, String) => Some(ty1) | (String, _) => None + | (Label(_), Label("")) => Some(ty1) + | (Label(""), Label(_)) => Some(ty2) + | (Label(name1), Label(name2)) + when LabeledTuple.match_labels(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); @@ -292,6 +339,7 @@ let rec match_synswitch = (t1: t, t2: t) => { | (Float, _) | (Bool, _) | (String, _) + | (Label(_), _) | (Var(_), _) | (Ap(_), _) | (Rec(_), _) @@ -303,9 +351,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; @@ -348,13 +405,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) => @@ -394,18 +454,76 @@ 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) + | _ => (Label("") |> temp, ty) // Empty label is a placeholder for checking any label + } + | Unknown(SynSwitch) => (Label("") |> temp, Unknown(SynSwitch) |> temp) + | _ => (Label("") |> 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))) { @@ -464,6 +582,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 @@ -478,7 +597,9 @@ let rec needs_parens = (ty: t): bool => | Int | Float | String + | Label(_) | Bool + | TupLabel(_, _) | Var(_) => false | Rec(_, _) | Forall(_, _) => true @@ -506,6 +627,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) @@ -529,6 +651,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..593c1550f4 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -51,7 +51,10 @@ type error_no_type = /* Empty application of function with inconsistent type */ | BadTrivAp(Typ.t) /* Sum constructor neiter bound nor in ana type */ - | FreeConstructor(Constructor.t); + | FreeConstructor(Constructor.t) + /* Dot Operator is ill-formed */ + | WantTuple + | LabelNotFound; /* Errors which can apply to either expression or patterns */ [@deriving (show({with_path: false}), sexp, yojson)] @@ -59,7 +62,11 @@ type error_common = /* Underdetermined: No type can be assigned */ | NoType(error_no_type) /* Overdetermined: Conflicting type expectations */ - | Inconsistent(error_inconsistent); + | Inconsistent(error_inconsistent) + /* Duplicate labels in labeled tuple */ + | DuplicateLabels(Typ.t) + /* Duplicate item, used for duplicated labels*/ + | Duplicate(Typ.t); [@deriving (show({with_path: false}), sexp, yojson)] type error_exp = @@ -132,6 +139,8 @@ type status_variant = [@deriving (show({with_path: false}), sexp, yojson)] type typ_expects = | TypeExpected + | TupleExpected(status_variant) + | LabelExpected(status_variant, list(string)) // list of duplicate labels expected to NOT be | ConstructorExpected(status_variant, Typ.t) | VariantExpected(status_variant, Typ.t); @@ -144,7 +153,11 @@ type error_typ = | BadToken(Token.t) /* Invalid token, treated as type hole */ | FreeTypeVariable(string) /* Free type variable */ | DuplicateConstructor(Constructor.t) /* Duplicate ctr in same sum */ + | DuplicateLabels(Typ.t) + | Duplicate(Typ.t) | WantTypeFoundAp + | WantTuple + | WantLabel | WantConstructorFoundType(Typ.t) | WantConstructorFoundAp; @@ -190,6 +203,10 @@ type status_tpat = | NotInHole(ok_tpat) | InHole(error_tpat); +[@deriving (show({with_path: false}), sexp, yojson)] +type sugar = + | AutoLabel(LabeledTuple.label); + [@deriving (show({with_path: false}), sexp, yojson)] type exp = { term: UExp.t, /* The term under consideration */ @@ -200,7 +217,9 @@ type exp = { co_ctx: CoCtx.t, /* Locally free variables */ cls: Cls.t, /* DERIVED: Syntax class (i.e. form name) */ status: status_exp, /* DERIVED: Ok/Error statuses for display */ - ty: Typ.t /* DERIVED: Type after nonempty hole fixing */ + ty: Typ.t, /* DERIVED: Type after nonempty hole fixing */ + unelaborated_info: option(exp), /* The info of the pre-sugar term */ + sugar_info: option(sugar), }; [@deriving (show({with_path: false}), sexp, yojson)] @@ -216,6 +235,7 @@ type pat = { status: status_pat, ty: Typ.t, constraint_: Constraint.t, + elaboration_provenance: option((pat, sugar)), }; [@deriving (show({with_path: false}), sexp, yojson)] @@ -370,6 +390,11 @@ let rec status_common = } | (BadToken(name), _) => InHole(NoType(BadToken(name))) | (BadTrivAp(ty), _) => InHole(NoType(BadTrivAp(ty))) + | (Duplicate_Labels(Just(ty)), _) => InHole(DuplicateLabels(ty)) + | (Duplicate(Just(ty)), _) => InHole(Duplicate(ty)) + | (Duplicate_Labels(_), _) => + InHole(DuplicateLabels(Unknown(Internal) |> Typ.temp)) + | (Duplicate(_), _) => InHole(Duplicate(Unknown(Internal) |> Typ.temp)) | (IsMulti, _) => NotInHole(Syn(Unknown(Internal) |> Typ.temp)) | (NoJoin(wrap, tys), Ana(ana)) => let syn: Typ.t = Self.join_of(wrap, Unknown(Internal) |> Typ.temp); @@ -382,6 +407,8 @@ let rec status_common = }; | (NoJoin(_, tys), Syn | SynFun | SynTypFun) => InHole(Inconsistent(Internal(Typ.of_source(tys)))) + | (WantTuple, _) => InHole(NoType(WantTuple)) + | (LabelNotFound, _) => InHole(NoType(LabelNotFound)) }; let rec status_pat = (ctx: Ctx.t, mode: Mode.t, self: Self.pat): status_pat => @@ -392,6 +419,8 @@ let rec status_pat = (ctx: Ctx.t, mode: Mode.t, self: Self.pat): status_pat => | InHole(Common(Inconsistent(Internal(_) | Expectation(_))) as err) | InHole(Common(NoType(_)) as err) => Some(err) | NotInHole(_) => None + | InHole(Common(DuplicateLabels(_))) // Is this right? + | InHole(Common(Duplicate(_))) | InHole(Common(Inconsistent(WithArrow(_)))) | InHole(ExpectedConstructor | Redundant(_)) => // ExpectedConstructor cannot be a reason to hole-wrap the entire pattern @@ -428,6 +457,8 @@ let rec status_exp = (ctx: Ctx.t, mode: Mode.t, self: Self.exp): status_exp => | NotInHole(_) | InHole(Common(Inconsistent(Expectation(_) | WithArrow(_)))) => None /* Type checking should fail and these errors would be nullified */ | InHole(Common(NoType(_))) + | InHole(Common(DuplicateLabels(_))) // Is this right? + | InHole(Common(Duplicate(_))) | InHole( FreeVariable(_) | InexhaustiveMatch(_) | UnusedDeferral | BadPartialAp(_), @@ -464,6 +495,18 @@ 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) + } + | LabelExpected(_) => + switch (Ctx.lookup_alias(ctx, name)) { + | Some({term: Label(_), _}) => + NotInHole(TypeAlias(name, Typ.weak_head_normalize(ctx, ty))) + | _ => InHole(WantLabel) + } | TypeExpected => switch (Ctx.is_alias(ctx, name)) { | false => @@ -484,11 +527,47 @@ 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) + | LabelExpected(_) => InHole(WantLabel) | TypeExpected => InHole(WantTypeFoundAp) } + // | Dot(t1, _) => + // switch (expects, ty) { + // | (TupleExpected, _) => + // switch (t1.term) { + // | Tuple(_) => NotInHole(Type(ty)) + // | _ => InHole(WantTuple) + // } + // | _ => NotInHole(Type(ty)) + // } + | Label(name) => + switch (expects) { + | TypeExpected => NotInHole(Type(ty)) + | TupleExpected(_) => InHole(WantTuple) + | LabelExpected(Unique, _) => NotInHole(Type(ty)) + | LabelExpected(Duplicate, dupes) => + List.exists(l => name == l, dupes) + ? InHole(Duplicate(ty)) : InHole(WantLabel) + | ConstructorExpected(_) + | VariantExpected(_) => InHole(WantConstructorFoundType(ty)) + } + | Prod(_) => + switch (expects) { + | TypeExpected => NotInHole(Type(ty)) + | TupleExpected(status) => + switch (status) { + | Duplicate => InHole(DuplicateLabels(ty)) + | _ => InHole(WantTuple) // shouldn't happen + } + | LabelExpected(_) => InHole(WantLabel) + | ConstructorExpected(_) + | VariantExpected(_) => InHole(WantConstructorFoundType(ty)) + } | _ => switch (expects) { | TypeExpected => NotInHole(Type(ty)) + | TupleExpected(_) => InHole(WantTuple) + | LabelExpected(_) => InHole(WantLabel) | ConstructorExpected(_) | VariantExpected(_) => InHole(WantConstructorFoundType(ty)) } @@ -514,8 +593,9 @@ let status_tpat = (ctx: Ctx.t, utpat: TPat.t): status_tpat => /* Determines whether any term is in an error hole. */ let is_error = (ci: t): bool => { switch (ci) { - | InfoExp({mode, self, ctx, _}) => - switch (status_exp(ctx, mode, self)) { + | InfoExp({status, _}) => + // TODO Confirm with disconcision that we can use the derived status + switch (status) { | InHole(_) => true | NotInHole(_) => false } @@ -550,6 +630,8 @@ let fixed_typ_ok: ok_pat => Typ.t = let fixed_typ_err_common: error_common => Typ.t = fun | NoType(_) => Unknown(Internal) |> Typ.temp + | DuplicateLabels(typ) => typ + | Duplicate(typ) => typ | Inconsistent(Expectation({ana, _})) => ana | Inconsistent(Internal(_)) => Unknown(Internal) |> Typ.temp // Should this be some sort of meet? | Inconsistent(WithArrow(_)) => @@ -610,11 +692,33 @@ let fixed_typ_exp = (ctx, mode: Mode.t, self: Self.exp): Typ.t => /* Add derivable attributes for expression terms */ let derived_exp = - (~uexp: UExp.t, ~ctx, ~mode, ~ancestors, ~self, ~co_ctx): exp => { + ( + ~uexp: UExp.t, + ~ctx, + ~mode, + ~ancestors, + ~self, + ~co_ctx, + ~unelaborated_info: option(exp), + ~sugar_info: option(sugar), + ) + : exp => { let cls = Cls.Exp(UExp.cls_of_term(uexp.term)); let status = status_exp(ctx, mode, self); let ty = fixed_typ_exp(ctx, mode, self); - {cls, self, ty, mode, status, ctx, co_ctx, ancestors, term: uexp}; + { + cls, + self, + ty, + mode, + status, + ctx, + co_ctx, + ancestors, + term: uexp, + unelaborated_info, + sugar_info, + }; }; /* Add derivable attributes for pattern terms */ @@ -628,6 +732,7 @@ let derived_pat = ~ancestors, ~self, ~constraint_, + ~elaboration_provenance: option((pat, sugar)), ) : pat => { let cls = Cls.Pat(UPat.cls_of_term(upat.term)); @@ -646,6 +751,7 @@ let derived_pat = ancestors, term: upat, constraint_, + elaboration_provenance, }; }; diff --git a/src/haz3lcore/statics/MakeTerm.re b/src/haz3lcore/statics/MakeTerm.re index d1edb9d16a..ed6b7dc842 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,30 @@ 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) + // Currently not allowing Strings to prevent empty Labels + | Var(name) => + Tuple([ + TupLabel( + {ids: l.ids, copied: l.copied, term: Label(name)}, + r, + ) + |> Exp.fresh, + ]) + | _ => TupLabel(l, r) + } + | (["."], []) => + // TODO (Anthony): Other cases to convert to string + switch (r.term) { + // | String(name) + // Currently not allowing Strings to prevent empty Labels + | Var(name) => + Dot(l, {ids: r.ids, copied: r.copied, term: Label(name)}) + | _ => Dot(l, r) + } | (["|>"], []) => Ap(Reverse, r, l) | (["@"], []) => ListConcat(l, r) | _ => hole(tm) @@ -378,9 +415,33 @@ 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) + // Currently not allowing Strings to prevent empty Labels + | 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 +514,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 2415399627..d336a76c4a 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -60,12 +60,33 @@ let of_forall = (ctx: Ctx.t, name_opt: option(string), mode: t): t => }; }; -let of_prod = (ctx: Ctx.t, mode: t, length): list(t) => +// Empty label is a placeholder for checking any label +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 => (Ana(Label("") |> Typ.temp), 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/Self.re b/src/haz3lcore/statics/Self.re index cece7d2b0b..5c278d8afa 100644 --- a/src/haz3lcore/statics/Self.re +++ b/src/haz3lcore/statics/Self.re @@ -29,13 +29,17 @@ type join_type = type t = | Just(Typ.t) /* Just a regular type */ | NoJoin(join_type, list(Typ.source)) /* Inconsistent types for e.g match, listlits */ - | BadToken(Token.t) /* Invalid expression token, treated as hole */ + | Duplicate_Labels(t) /* Duplicate labels in a labeled tuple, treated as regular type (?) */ + | Duplicate(t) /* Duplicate label, marked as duplicate */ + | BadToken(Token.t) /* Invalid expression token, continues with undefined behavior */ | BadTrivAp(Typ.t) /* Trivial (nullary) ap on function that doesn't take triv */ | IsMulti /* Multihole, treated as hole */ | IsConstructor({ name: Constructor.t, syn_ty: option(Typ.t), - }); /* Constructors have special ana logic */ + }) /* Constructors have special ana logic */ + | WantTuple /* Want a Tuple, found not-tuple */ + | LabelNotFound; /* Currently used by the dot operator for a label not found */ [@deriving (show({with_path: false}), sexp, yojson)] type error_partial_ap = @@ -71,11 +75,17 @@ let join_of = (j: join_type, ty: Typ.t): Typ.t => let typ_of: (Ctx.t, t) => option(Typ.t) = _ctx => fun - | Just(typ) => Some(typ) + | Just(typ) + | Duplicate_Labels(Just(typ)) + | Duplicate(Just(typ)) => Some(typ) | IsConstructor({syn_ty, _}) => syn_ty | BadToken(_) | BadTrivAp(_) | IsMulti + | Duplicate_Labels(_) + | Duplicate(_) + | WantTuple + | LabelNotFound | NoJoin(_) => None; let typ_of_exp: (Ctx.t, exp) => option(Typ.t) = diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 443c94155b..18aacc8b46 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -131,7 +131,7 @@ let rec any_to_info_map = switch (any) { | Exp(e) => let ({co_ctx, _}: Info.exp, m) = - uexp_to_info_map(~ctx, ~ancestors, e, m); + uexp_to_info_map(~ctx, ~ancestors, ~duplicates=[], e, m); (co_ctx, m); | Pat(p) => let m = @@ -139,6 +139,7 @@ let rec any_to_info_map = ~is_synswitch=false, ~co_ctx=CoCtx.empty, ~ancestors, + ~duplicates=[], ~ctx, p, m, @@ -172,6 +173,7 @@ and uexp_to_info_map = ~mode=Mode.Syn, ~is_in_filter=false, ~ancestors, + ~duplicates: list(string), {ids, copied: _, term} as uexp: UExp.t, m: Map.t, ) @@ -182,12 +184,37 @@ and uexp_to_info_map = | Ana({term: Unknown(SynSwitch), _}) => Mode.Syn | _ => mode }; - let add' = (~self, ~co_ctx, m) => { + let add' = (~unelaborated_info=?, ~sugar_info=?, ~self, ~co_ctx, m) => { let info = - Info.derived_exp(~uexp, ~ctx, ~mode, ~ancestors, ~self, ~co_ctx); + Info.derived_exp( + ~uexp, + ~ctx, + ~mode, + ~ancestors, + ~self, + ~co_ctx, + ~unelaborated_info, + ~sugar_info, + ); + (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 = ( @@ -195,471 +222,641 @@ and uexp_to_info_map = ~mode=Mode.Syn, ~is_in_filter=is_in_filter, ~ancestors=ancestors, + ~duplicates=[], uexp: UExp.t, m: Map.t, ) => { - uexp_to_info_map(~ctx, ~mode, ~is_in_filter, ~ancestors, uexp, m); + uexp_to_info_map( + ~ctx, + ~mode, + ~is_in_filter, + ~ancestors, + ~duplicates, + uexp, + m, + ); }; let go' = uexp_to_info_map(~ancestors); let go = go'(~ctx); - let map_m_go = m => + let map_m_go = (m, ~duplicates=[]) => List.fold_left2( ((es, m), mode, e) => - go(~mode, e, m) |> (((e, m)) => (es @ [e], m)), + go(~mode, ~duplicates, e, m) |> (((e, m)) => (es @ [e], m)), ([], 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") => Constructor("$e", Unknown(Internal) |> Typ.temp) - | Var("v") => Constructor("$v", Unknown(Internal) |> Typ.temp) - | _ => e.term - }, - }; - let ty_in = Var("$Meta") |> Typ.temp; - let ty_out = 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. */ + // TODO: Confirm if duplicates should or not be default [] + let go_pat = upat_to_info_map(~ctx, ~ancestors, ~duplicates); + let elaborate_singleton_tuple = (uexp: Exp.t, inner_ty, l, m) => { + let (term, rewrap) = UExp.unwrap(uexp); + let original_expression = Exp.fresh(term); + let (original_info, m) = + uexp_to_info_map( + ~ctx, + ~mode=Mode.Ana(inner_ty), + ~is_in_filter, + ~ancestors, + original_expression, + m, + ); + let elaborated_exp = + rewrap( + Tuple([ + TupLabel(Label(l) |> Exp.fresh, original_expression) |> Exp.fresh, + ]), + ); + // We need to reanalyze the elaborated expression to get the statics in the map for the label and tuple + let (info, m) = + uexp_to_info_map(~ctx, ~mode, ~ancestors, elaborated_exp, m); + + // We need to keep the original status of the expression to get error messages on the unelaborated expression + let info = { + ...info, + status: original_info.status, + unelaborated_info: Some(original_info), + sugar_info: Some(AutoLabel(l)), }; - | 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) == Unknown(SynSwitch) && !Typ.eq(ty_fn1, ty_fn2) - ? ty_fn1 : ty_p; + + (info, add_info(elaborated_exp.ids, InfoExp(info), m)); + }; + 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) => + let self = Self.Just(Label(name) |> Typ.temp); + List.exists(l => name == l, duplicates) + ? atomic(Duplicate(self)) : atomic(self); + | 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") => Constructor("$e", Unknown(Internal) |> Typ.temp) + | Var("v") => Constructor("$v", Unknown(Internal) |> Typ.temp) + | _ => e.term + }, + }; + let ty_in = Var("$Meta") |> Typ.temp; + let ty_out = 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, ~duplicates, 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 (duplicate_labels, _) = + LabeledTuple.get_duplicate_and_unique_labels(Exp.get_label, es); + let (es', m) = map_m_go(~duplicates=duplicate_labels, m, modes, es); + let ty_list = List.map(Info.exp_ty, es'); + let self = Self.Just(Prod(ty_list) |> Typ.temp); + let self = + List.is_empty(duplicate_labels) ? self : Self.Duplicate_Labels(self); + add(~self, ~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 (info_e2, m) = go(~mode=Ana(Label("") |> Typ.temp), e2, m); + let (ty, m) = { + switch (info_e1.ty.term, info_e2.ty.term) { + | (Unknown(_), Label(name)) => + // This is so that the statics will result in Unknown(Internal) + let ty = + 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); - Prod(tys) |> Typ.temp; - | ((_, _), _) => ana_ty_fn((def_base.ty, def_base2.ty), p_syn.ty) + }; + switch (ty.term) { + | Prod(ts) => + switch (e2.term) { + | Label(name) => + let element: option(Typ.t) = + LabeledTuple.find_label(Typ.get_label, ts, name); + switch (element) { + | Some({term: TupLabel(_, typ), _}) + | Some(typ) => add(~self=Just(typ), ~co_ctx=info_e2.co_ctx, m) + | None => add(~self=LabelNotFound, ~co_ctx=info_e2.co_ctx, m) }; - let (def, m) = go'(~ctx=def_ctx, ~mode=Ana(ana), def, m); - (def, def_ctx, m, ty_p_ana); + | _ => add(~self=LabelNotFound, ~co_ctx=info_e2.co_ctx, m) + } + | _ => add(~self=WantTuple, ~co_ctx=info_e2.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: Tuple(es'), + ids: arg.ids, + copied: arg.copied, + }; + arg; + // Now doing the singleton label elaboration below. I'll discuss with Anthony before removing these + // | (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, + ); + | 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_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(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) == 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); + 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, ); - 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) => { + | 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, + ~elaboration_provenance=None, + ); + ( + // 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 = - Rec((Var(name): TPat.term) |> 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 = Rec(Var(name) |> TPat.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 + switch (mode) { + | Ana(ty) => + switch (Typ.weak_head_normalize(ctx, ty).term) { + | Prod([{term: TupLabel({term: Label(l1), _}, ana_ty), _}]) => + // We can flatten this by pulling it up on the case match but since OCaml is strict it'll be evaluated. + // So for performance reasons we'll just do it here. + 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() + | _ => elaborate_singleton_tuple(uexp, ana_ty, l1, m) + }; + | _ => default_case() + } + | _ => default_case() + }; } and upat_to_info_map = ( @@ -667,12 +864,14 @@ and upat_to_info_map = ~ctx, ~co_ctx, ~ancestors: Info.ancestors, + ~duplicates: list(string), ~mode: Mode.t=Mode.Syn, + ~under_ascription: bool=false, {ids, term, _} as upat: UPat.t, m: Map.t, ) : (Info.pat, Map.t) => { - let add = (~self, ~ctx, ~constraint_, m) => { + let add = (~self, ~ctx, ~constraint_, ~elaboration_provenance=?, m) => { let prev_synswitch = switch (Id.Map.find_opt(Pat.rep_id(upat), m)) { | Some(Info.InfoPat({mode: Syn | SynFun, ty, _})) => Some(ty) @@ -690,17 +889,43 @@ and upat_to_info_map = ~ancestors, ~self=Common(self), ~constraint_, + ~elaboration_provenance, ); (info, add_info(ids, InfoPat(info), m)); }; + let upat_to_info_map = + ( + ~is_synswitch, + ~ctx, + ~co_ctx, + ~ancestors, + ~duplicates=[], + ~mode, + ~under_ascription=false, + upat: UPat.t, + m: Map.t, + ) => { + upat_to_info_map( + ~is_synswitch, + ~ctx, + ~co_ctx, + ~ancestors, + ~duplicates, + ~mode, + ~under_ascription, + 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); + let go = (~under_ascription=false) => + upat_to_info_map(~under_ascription, ~is_synswitch, ~ancestors, ~co_ctx); let unknown = Unknown(is_synswitch ? SynSwitch : Internal) |> Typ.temp; - let ctx_fold = (ctx: Ctx.t, m) => + let ctx_fold = (ctx: Ctx.t, m, ~duplicates=[]) => List.fold_left2( ((ctx, tys, cons, m), e, mode) => - go(~ctx, ~mode, e, m) + go(~ctx, ~mode, ~duplicates, e, m) |> ( ((info, m)) => ( info.ctx, @@ -712,108 +937,196 @@ and upat_to_info_map = (ctx, [], [], m), ); let hole = self => atomic(self, Constraint.Hole); - switch (term) { - | MultiHole(tms) => - let (_, m) = multi(~ctx, ~ancestors, m, tms); - add(~self=IsMulti, ~ctx, ~constraint_=Constraint.Hole, m); - | Invalid(token) => hole(BadToken(token)) - | EmptyHole => hole(Just(unknown)) - | Int(int) => atomic(Just(Int |> Typ.temp), Constraint.Int(int)) - | Float(float) => - atomic(Just(Float |> Typ.temp), Constraint.Float(float)) - | Tuple([]) => atomic(Just(Prod([]) |> Typ.temp), Constraint.Truth) - | Bool(bool) => - atomic( - Just(Bool |> Typ.temp), - bool - ? Constraint.InjL(Constraint.Truth) - : Constraint.InjR(Constraint.Truth), - ) - | String(string) => - atomic(Just(String |> Typ.temp), Constraint.String(string)) - | ListLit(ps) => - let ids = List.map(UPat.rep_id, ps); - let modes = Mode.of_list_lit(ctx, List.length(ps), mode); - let (ctx, tys, cons, m) = ctx_fold(ctx, m, ps, modes); - let rec cons_fold_list = cs => - switch (cs) { - | [] => Constraint.InjL(Constraint.Truth) // Left = nil, Right = cons - | [hd, ...tl] => - Constraint.InjR(Constraint.Pair(hd, cons_fold_list(tl))) - }; - add( - ~self=Self.listlit(~empty=unknown, ctx, tys, ids), - ~ctx, - ~constraint_=cons_fold_list(cons), - m, - ); - | Cons(hd, tl) => - let (hd, m) = go(~ctx, ~mode=Mode.of_cons_hd(ctx, mode), hd, m); - let (tl, m) = - go(~ctx=hd.ctx, ~mode=Mode.of_cons_tl(ctx, mode, hd.ty), tl, m); - add( - ~self=Just(List(hd.ty) |> Typ.temp), - ~ctx=tl.ctx, - ~constraint_= - Constraint.InjR(Constraint.Pair(hd.constraint_, tl.constraint_)), - m, - ); - | Wild => atomic(Just(unknown), Constraint.Truth) - | Var(name) => - /* NOTE: The self type assigned to pattern variables (Unknown) - may be SynSwitch, but SynSwitch is never added to the context; - Unknown(Internal) is used in this case */ - let ctx_typ = - Info.fixed_typ_pat( - ctx, - mode, - Common(Just(Unknown(Internal) |> Typ.temp)), + + let elaborate_singleton_tuple = (upat: Pat.t, inner_ty, l, m) => { + print_endline("elaborating singleton tuple: " ++ Pat.show(upat)); + let (term, rewrap) = UPat.unwrap(upat); + let original_expression = Pat.fresh(term); + let (original_info, m) = + upat_to_info_map( + ~ctx, + ~co_ctx, + ~is_synswitch, + ~ancestors, + ~mode=Mode.Ana(inner_ty), + original_expression, + m, ); - let entry = Ctx.VarEntry({name, id: UPat.rep_id(upat), typ: ctx_typ}); - add( - ~self=Just(unknown), - ~ctx=Ctx.extend(ctx, entry), - ~constraint_=Constraint.Truth, - m, - ); - | Tuple(ps) => - let modes = Mode.of_prod(ctx, mode, List.length(ps)); - let (ctx, tys, cons, m) = ctx_fold(ctx, m, ps, modes); - let rec cons_fold_tuple = cs => - switch (cs) { - | [] => Constraint.Truth - | [elt] => elt - | [hd, ...tl] => Constraint.Pair(hd, cons_fold_tuple(tl)) - }; - add( - ~self=Just(Prod(tys) |> Typ.temp), - ~ctx, - ~constraint_=cons_fold_tuple(cons), - m, - ); - | Parens(p) => - let (p, m) = go(~ctx, ~mode, p, m); - add(~self=Just(p.ty), ~ctx=p.ctx, ~constraint_=p.constraint_, m); - | Constructor(ctr, _) => - let self = Self.of_ctr(ctx, ctr); - atomic(self, Constraint.of_ctr(ctx, mode, ctr, self)); - | Ap(fn, arg) => - let ctr = UPat.ctr_name(fn); - let fn_mode = Mode.of_ap(ctx, mode, ctr); - let (fn, m) = go(~ctx, ~mode=fn_mode, fn, m); - let (ty_in, ty_out) = Typ.matched_arrow(ctx, fn.ty); - let (arg, m) = go(~ctx, ~mode=Ana(ty_in), arg, m); - add( - ~self=Just(ty_out), - ~ctx=arg.ctx, - ~constraint_= - Constraint.of_ap(ctx, mode, ctr, arg.constraint_, Some(ty_out)), - m, - ); - | Cast(p, ann, _) => - let (ann, m) = utyp_to_info_map(~ctx, ~ancestors, ann, m); - let (p, m) = go(~ctx, ~mode=Ana(ann.term), p, m); - add(~self=Just(ann.term), ~ctx=p.ctx, ~constraint_=p.constraint_, m); + let elaborated_pat = + rewrap( + Tuple([ + TupLabel(Label(l) |> Pat.fresh, original_expression) |> Pat.fresh, + ]), + ); + let (info, m) = + upat_to_info_map( + ~ctx, + ~co_ctx, + ~is_synswitch, + ~ancestors, + ~mode, + elaborated_pat, + m, + ); + + // We need to keep the original status of the expression to get error messages on the unelaborated expression + let info = { + ...info, + status: original_info.status, + elaboration_provenance: Some((original_info, AutoLabel(l))), + }; + + (info, add_info(elaborated_pat.ids, InfoPat(info), m)); + }; + + let default_case = () => + switch (term) { + | MultiHole(tms) => + let (_, m) = multi(~ctx, ~ancestors, m, tms); + add(~self=IsMulti, ~ctx, ~constraint_=Constraint.Hole, m); + | Invalid(token) => hole(BadToken(token)) + | EmptyHole => hole(Just(unknown)) + | Int(int) => atomic(Just(Int |> Typ.temp), Constraint.Int(int)) + | Float(float) => + atomic(Just(Float |> Typ.temp), Constraint.Float(float)) + | Tuple([]) => atomic(Just(Prod([]) |> Typ.temp), Constraint.Truth) + | Bool(bool) => + atomic( + Just(Bool |> Typ.temp), + bool + ? Constraint.InjL(Constraint.Truth) + : Constraint.InjR(Constraint.Truth), + ) + | String(string) => + atomic(Just(String |> Typ.temp), Constraint.String(string)) + | Label(name) => + // TODO: Constraint? + let self = Self.Just(Label(name) |> Typ.temp); + List.exists(l => name == l, duplicates) + ? atomic(Duplicate(self), Constraint.Truth) + : atomic(self, Constraint.Truth); + | ListLit(ps) => + let ids = List.map(UPat.rep_id, ps); + let modes = Mode.of_list_lit(ctx, List.length(ps), mode); + let (ctx, tys, cons, m) = ctx_fold(ctx, m, ps, modes); + let rec cons_fold_list = cs => + switch (cs) { + | [] => Constraint.InjL(Constraint.Truth) // Left = nil, Right = cons + | [hd, ...tl] => + Constraint.InjR(Constraint.Pair(hd, cons_fold_list(tl))) + }; + add( + ~self=Self.listlit(~empty=unknown, ctx, tys, ids), + ~ctx, + ~constraint_=cons_fold_list(cons), + m, + ); + | Cons(hd, tl) => + let (hd, m) = go(~ctx, ~mode=Mode.of_cons_hd(ctx, mode), hd, m); + let (tl, m) = + go(~ctx=hd.ctx, ~mode=Mode.of_cons_tl(ctx, mode, hd.ty), tl, m); + add( + ~self=Just(List(hd.ty) |> Typ.temp), + ~ctx=tl.ctx, + ~constraint_= + Constraint.InjR(Constraint.Pair(hd.constraint_, tl.constraint_)), + m, + ); + | Wild => atomic(Just(unknown), Constraint.Truth) + | Var(name) => + /* NOTE: The self type assigned to pattern variables (Unknown) + may be SynSwitch, but SynSwitch is never added to the context; + Unknown(Internal) is used in this case */ + let ctx_typ = + Info.fixed_typ_pat( + ctx, + mode, + Common(Just(Unknown(Internal) |> Typ.temp)), + ); + let entry = Ctx.VarEntry({name, id: UPat.rep_id(upat), typ: ctx_typ}); + add( + ~self=Just(unknown), + ~ctx=Ctx.extend(ctx, entry), + ~constraint_=Constraint.Truth, + m, + ); + | TupLabel(label, p) => + let (labmode, mode) = Mode.of_label(ctx, mode); + let (lab, m) = go(~ctx, ~mode=labmode, ~duplicates, 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 (ps, modes) = + Mode.of_prod(ctx, mode, ps, UPat.get_label, (name, b) => + TupLabel(Label(name) |> UPat.fresh, b) |> UPat.fresh + ); + let rec cons_fold_tuple = cs => + switch (cs) { + | [] => Constraint.Truth + | [elt] => elt + | [hd, ...tl] => Constraint.Pair(hd, cons_fold_tuple(tl)) + }; + let (duplicate_labels, _) = + LabeledTuple.get_duplicate_and_unique_labels(Pat.get_label, ps); + let (ctx, tys, cons, m) = + ctx_fold(ctx, m, ~duplicates=duplicate_labels, ps, modes); + let self = Self.Just(Prod(tys) |> Typ.temp); + let self = + List.is_empty(duplicate_labels) ? self : Self.Duplicate_Labels(self); + add(~self, ~ctx, ~constraint_=cons_fold_tuple(cons), m); + | Parens(p) => + let (p, m) = go(~ctx, ~mode, p, m); + add(~self=Just(p.ty), ~ctx=p.ctx, ~constraint_=p.constraint_, m); + | Constructor(ctr, _) => + let self = Self.of_ctr(ctx, ctr); + atomic(self, Constraint.of_ctr(ctx, mode, ctr, self)); + | Ap(fn, arg) => + let ctr = UPat.ctr_name(fn); + let fn_mode = Mode.of_ap(ctx, mode, ctr); + let (fn, m) = go(~ctx, ~mode=fn_mode, fn, m); + let (ty_in, ty_out) = Typ.matched_arrow(ctx, fn.ty); + let (arg, m) = go(~ctx, ~mode=Ana(ty_in), arg, m); + add( + ~self=Just(ty_out), + ~ctx=arg.ctx, + ~constraint_= + Constraint.of_ap(ctx, mode, ctr, arg.constraint_, Some(ty_out)), + m, + ); + | Cast(p, ann, _) => + let (ann, m) = utyp_to_info_map(~ctx, ~ancestors, ann, m); + let (p, m) = + go(~ctx, ~under_ascription=true, ~mode=Ana(ann.term), p, m); + add(~self=Just(ann.term), ~ctx=p.ctx, ~constraint_=p.constraint_, m); + }; + + // This is to allow lifting single values into a singleton labeled tuple when the label is not present + if (under_ascription) { + default_case(); + } else { + switch (mode) { + | Ana(ty) => + switch (Typ.weak_head_normalize(ctx, ty).term) { + | Prod([{term: TupLabel({term: Label(l1), _}, ana_ty), _}]) => + // We can flatten this by pulling it up on the case match but since OCaml is strict it'll be evaluated. + // So for performance reasons we'll just do it here. + let (e, m) = go(~mode=Mode.Syn, ~ctx, upat, m); + + switch (Typ.weak_head_normalize(ctx, e.ty).term) { + | Prod([{term: TupLabel({term: Label(l2), _}, _), _}]) + when l1 == l2 => + default_case() + | _ => elaborate_singleton_tuple(upat, ana_ty, l1, m) + }; + | _ => default_case() + } + | _ => default_case() + }; }; } and utyp_to_info_map = @@ -825,10 +1138,11 @@ and utyp_to_info_map = m: Map.t, ) : (Info.typ, Map.t) => { - let add = m => { + let add' = (~expects=expects, ~utyp=utyp, m) => { let info = Info.derived_typ(~utyp, ~ctx, ~ancestors, ~expects); (info, add_info(ids, InfoTyp(info), m)); }; + let add = (~utyp=utyp, m) => add'(~utyp, m); let ancestors = [UTyp.rep_id(utyp)] @ ancestors; let go' = utyp_to_info_map(~ctx, ~ancestors); let go = go'(~expects=TypeExpected); @@ -841,6 +1155,7 @@ and utyp_to_info_map = | Float | Bool | String => add(m) + | Label(_) => add(m) | Var(_) => /* Names are resolved in Info.status_typ */ add(m) @@ -850,9 +1165,34 @@ and utyp_to_info_map = let m = go(t1, m) |> snd; let m = go(t2, m) |> snd; add(m); + | TupLabel(label, t) => + let expects_label = + switch (expects) { + | LabelExpected(_) => expects + | _ => LabelExpected(Unique, []) + }; + let m = go'(~expects=expects_label, label, m) |> snd; + let m = go(t, m) |> snd; + add'(~expects=TypeExpected, m); | Prod(ts) => - let m = map_m(go, ts, m) |> snd; - add(m); + // let m = map_m(go, ts, m) |> snd; + // add(m); + let (duplicate_labels, _) = + LabeledTuple.get_duplicate_and_unique_labels(Typ.get_label, ts); + let (expects, m) = + List.is_empty(duplicate_labels) + ? (expects, map_m(go, ts, m) |> snd) + : ( + TupleExpected(Duplicate), + map_m( + go'(~expects=LabelExpected(Duplicate, duplicate_labels)), + ts, + m, + ) + |> snd, + ); + let info = Info.derived_typ(~utyp, ~ctx, ~ancestors, ~expects); + (info, add_info(ids, InfoTyp(info), m)); | Ap(t1, t2) => let t1_mode: Info.typ_expects = switch (expects) { @@ -875,6 +1215,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}); @@ -969,7 +1315,8 @@ and variant_to_info_map = let mk = Core.Memo.general(~cache_size_bound=1000, (ctx, e) => { - uexp_to_info_map(~ctx, ~ancestors=[], e, Id.Map.empty) |> snd + uexp_to_info_map(~ctx, ~ancestors=[], ~duplicates=[], e, Id.Map.empty) + |> snd }); let mk = (core: CoreSettings.t, ctx, exp) => diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index 92eef8161e..95f511473e 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) { + | Label(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) { + | Label(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 02bd8400d4..d3dcc199ac 100644 --- a/src/haz3lcore/statics/TermBase.re +++ b/src/haz3lcore/statics/TermBase.re @@ -100,6 +100,9 @@ and exp_term = two consistent types. Both types should be normalized in dynamics for the cast calculus to work right. */ | Cast(exp_t, typ_t, typ_t) + | Label(string) + | TupLabel(exp_t, exp_t) + | Dot(exp_t, exp_t) and exp_t = IdTagged.t(exp_term) and pat_term = | Invalid(string) @@ -118,6 +121,8 @@ and pat_term = | Parens(pat_t) | Ap(pat_t, pat_t) | Cast(pat_t, typ_t, typ_t) + | Label(string) + | TupLabel(pat_t, pat_t) and pat_t = IdTagged.t(pat_term) and typ_term = | Unknown(type_provenance) @@ -134,6 +139,8 @@ and typ_term = | Ap(typ_t, typ_t) | Rec(tpat_t, typ_t) | Forall(tpat_t, typ_t) + | Label(string) + | TupLabel(typ_t, typ_t) and typ_t = IdTagged.t(typ_term) and tpat_term = | Invalid(string) @@ -301,6 +308,7 @@ and Exp: { | Float(_) | Constructor(_) | String(_) + | Label(_) | Deferral(_) | Var(_) | Undefined => term @@ -311,7 +319,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) @@ -369,6 +380,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)) => @@ -428,6 +440,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(_), _) @@ -435,11 +449,14 @@ and Exp: { | (Int(_), _) | (Float(_), _) | (String(_), _) + | (Label(_), _) | (ListLit(_), _) | (Constructor(_), _) | (Fun(_), _) | (TypFun(_), _) | (Tuple(_), _) + | (TupLabel(_), _) + | (Dot(_), _) | (Var(_), _) | (Let(_), _) | (FixF(_), _) @@ -517,12 +534,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)) @@ -533,6 +553,11 @@ and Pat: { let rec fast_equal = (p1: t, p2: t) => 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 @@ -545,6 +570,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 @@ -565,6 +591,7 @@ and Pat: { | (Int(_), _) | (Float(_), _) | (String(_), _) + | (Label(_), _) | (ListLit(_), _) | (Constructor(_), _) | (Cons(_), _) @@ -633,12 +660,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) => @@ -668,10 +698,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) @@ -697,6 +729,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 = @@ -716,6 +752,9 @@ and Typ: { | (Bool, _) => false | (String, String) => true | (String, _) => false + | (Label(name1), Label(name2)) => + LabeledTuple.match_labels(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 23265f8a2a..70944cf5bc 100644 --- a/src/haz3lcore/zipper/EditorUtil.re +++ b/src/haz3lcore/zipper/EditorUtil.re @@ -11,6 +11,7 @@ let rec append_exp = (e1: Exp.t, e2: Exp.t): Exp.t => { | Int(_) | Float(_) | String(_) + | Label(_) | ListLit(_) | Constructor(_) | Closure(_) @@ -18,6 +19,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..0cb0e1a1f2 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -9,7 +9,7 @@ let okc = "ok"; let div_err = div(~attrs=[clss(["status", errc])]); let div_ok = div(~attrs=[clss(["status", okc])]); -let code_err = (code: string): Node.t => +let code = (code: string): Node.t => div(~attrs=[clss(["code"])], [text(code)]); let explain_this_toggle = (~inject, ~show_explain_this: bool): Node.t => { @@ -66,7 +66,13 @@ let elements_noun: Cls.t => string = | Exp(ListConcat) => "Operands" | _ => failwith("elements_noun: Cls doesn't have elements"); -let common_err_view = (cls: Cls.t, err: Info.error_common) => +let common_err_view = + ( + ~lifted_ty as _: option(Typ.t)=?, + ~sugar_info: option(Info.sugar)=?, + cls: Cls.t, + err: Info.error_common, + ) => switch (err) { | NoType(BadToken(token)) => switch (Form.bad_token_cls(token)) { @@ -79,25 +85,50 @@ let common_err_view = (cls: Cls.t, err: Info.error_common) => text("inconsistent with"), Type.view(Prod([]) |> Typ.fresh), ] - | NoType(FreeConstructor(name)) => [code_err(name), text("not found")] + | NoType(FreeConstructor(name)) => [code(name), text("not found")] + | NoType(WantTuple) => [ + text("Invalid Dot Operation: requires tuple for first argument"), + ] + | NoType(LabelNotFound) => [ + text("Invalid Dot Operation: label not found in tuple"), + ] + | DuplicateLabels(_) => [text("Duplicate labels within a tuple")] + | Duplicate(_) => [text("Duplicated Label")] | Inconsistent(WithArrow(typ)) => [ text(":"), Type.view(typ), text("inconsistent with arrow type"), ] - | Inconsistent(Expectation({ana, syn})) => [ + | Inconsistent(Expectation({ana, syn})) => + [ text(":"), Type.view(syn), text("inconsistent with expected type"), Type.view(ana), ] + @ ( + switch (sugar_info) { + | None => [] + | Some(AutoLabel(label)) => [ + text(" after automatically added label "), + code(label), + ] // TODO Figure out styling as well as how to handle nested labels + } + ) | Inconsistent(Internal(tys)) => [ text(elements_noun(cls) ++ " have inconsistent types:"), ...ListUtil.join(text(","), List.map(Type.view, tys)), ] }; -let common_ok_view = (cls: Cls.t, ok: Info.ok_pat) => { +let common_ok_view = + ( + ~auto_labels: list(string)=[], + ~lifted_ty: option(Typ.t)=?, + ~sugar_info: option(Info.sugar)=?, + cls: Cls.t, + ok: Info.ok_common, + ) => { switch (cls, ok) { | (Exp(MultiHole) | Pat(MultiHole), _) => [ text("Expecting operator or delimiter"), @@ -117,17 +148,42 @@ let common_ok_view = (cls: Cls.t, ok: Info.ok_pat) => { text(":"), Type.view(ana), ] - | (_, Ana(Consistent({ana, syn, _}))) when ana == syn => [ - text(":"), - Type.view(syn), - text("equals expected type"), - ] - | (_, Ana(Consistent({ana, syn, _}))) => [ - text(":"), - Type.view(syn), - text("consistent with expected type"), - Type.view(ana), + | (_, Ana(Consistent({ana, syn, _}))) when ana == syn => + [text(":"), Type.view(syn), text("equals expected type")] + @ ( + switch (lifted_ty) { + | None => [] + | Some(lifted) => [text(" lifted to"), Type.view(lifted)] + } + ) + @ ( + switch (sugar_info) { + | None => [] + | Some(AutoLabel(label)) => [ + text(" automatically added label "), + code(label), + ] // TODO Figure out styling as well as how to handle nested labels + } + ) + + | (_, Ana(Consistent({ana, syn, _}))) => + [text(":"), Type.view(syn), text("consistent with expected type")] + @ [ + switch (lifted_ty) { + | None => Type.view(ana) + | Some(lifted) => Type.view(lifted) + }, ] + @ ( + switch (auto_labels) { + | [] => [] + | [a] => [text("by automatically added label "), code(a)] + | _ => [ + text("by automatically added labels "), + ...ListUtil.join(text(","), List.map(code, auto_labels)), + ] + } + ) | (_, Ana(InternallyInconsistent({ana, nojoin: tys}))) => [ text(elements_noun(cls) ++ " have inconsistent types:"), @@ -163,23 +219,45 @@ let typ_err_view = (ok: Info.error_typ) => Type.view(Var(name) |> Typ.fresh), text("not found"), ] - | BadToken(token) => [ - code_err(token), - text("not a type or type operator"), - ] + | BadToken(token) => [code(token), text("not a type or type operator")] | WantConstructorFoundAp | WantConstructorFoundType(_) => [text("Expected a constructor")] | WantTypeFoundAp => [text("Must be part of a sum type")] + | WantTuple => [text("Expect a valid tuple")] + | WantLabel => [text("Expect a valid label")] + | DuplicateLabels(_) => [text("Duplicate labels within a tuple")] + | Duplicate(_) => [text("Duplicated Label")] | DuplicateConstructor(name) => [ Type.view(Var(name) |> Typ.fresh), text("already used in this sum"), ] }; +let rec automatic_inserted_labels_exp = + (~statics, info: option(Info.exp)): list(string) => + switch (Option.bind(info, i => i.sugar_info)) { + | None => [] + | Some(AutoLabel(label)) => + [label] + @ automatic_inserted_labels_exp( + ~statics, + Option.bind(info, i => i.unelaborated_info), + ) + }; + +let rec automatic_inserted_labels_pat = + (~statics, info: option(Info.pat)): list(string) => + switch (Option.bind(info, i => i.elaboration_provenance)) { + | None => [] + | Some((ui, AutoLabel(label))) => + [label] @ automatic_inserted_labels_pat(~statics, Some(ui)) + }; + +let rec exp_view = + (~statics, cls: Cls.t, status: Info.status_exp, info: Info.exp) => { + let labels = automatic_inserted_labels_exp(~statics, Some(info)); -let rec exp_view = (cls: Cls.t, status: Info.status_exp) => switch (status) { - | InHole(FreeVariable(name)) => - div_err([code_err(name), text("not found")]) + | InHole(FreeVariable(name)) => div_err([code(name), text("not found")]) | InHole(InexhaustiveMatch(additional_err)) => let cls_str = Cls.show(cls); switch (additional_err) { @@ -187,7 +265,7 @@ let rec exp_view = (cls: Cls.t, status: Info.status_exp) => | Some(err) => let cls_str = String.uncapitalize_ascii(cls_str); div_err([ - exp_view(cls, InHole(Common(err))), + exp_view(~statics, cls, InHole(Common(err)), info), text("; " ++ cls_str ++ " is inexhaustive"), ]); }; @@ -207,25 +285,48 @@ let rec exp_view = (cls: Cls.t, status: Info.status_exp) => ++ " arguments", ), ]) - | InHole(Common(error)) => div_err(common_err_view(cls, error)) + | InHole(Common(error)) => + div_err( + common_err_view( + ~lifted_ty=?Option.map(_ => info.ty, info.sugar_info), + ~sugar_info=?info.sugar_info, + cls, + error, + ), + ) | NotInHole(AnaDeferralConsistent(ana)) => div_ok([text("Expecting type"), Type.view(ana)]) - | NotInHole(Common(ok)) => div_ok(common_ok_view(cls, ok)) + | NotInHole(Common(ok)) => + div_ok( + common_ok_view( + ~auto_labels=labels, + ~lifted_ty=?Option.map(_ => info.ty, info.sugar_info), + ~sugar_info=?info.sugar_info, + cls, + ok, + ), + ) }; +}; -let rec pat_view = (cls: Cls.t, status: Info.status_pat) => +let rec pat_view = + (~statics, cls: Cls.t, status: Info.status_pat, info: Info.pat) => { + let labels = automatic_inserted_labels_pat(~statics, Some(info)); switch (status) { | InHole(ExpectedConstructor) => div_err([text("Expected a constructor")]) | InHole(Redundant(additional_err)) => switch (additional_err) { | None => div_err([text("Pattern is redundant")]) | Some(err) => - div_err([pat_view(cls, InHole(err)), text("; pattern is redundant")]) + div_err([ + pat_view(~statics, cls, InHole(err), info), + text("; pattern is redundant"), + ]) } | InHole(Common(error)) => div_err(common_err_view(cls, error)) - | NotInHole(ok) => div_ok(common_ok_view(cls, ok)) + | NotInHole(ok) => div_ok(common_ok_view(~auto_labels=labels, cls, ok)) }; - +}; let typ_view = (cls: Cls.t, status: Info.status_typ) => switch (status) { | NotInHole(ok) => div_ok(typ_ok_view(cls, ok)) @@ -258,31 +359,38 @@ let tpat_view = (_: Cls.t, status: Info.status_tpat) => let secondary_view = (cls: Cls.t) => div_ok([text(cls |> Cls.show)]); -let view_of_info = (~inject, ~settings, ci): list(Node.t) => { +let view_of_info = (~inject, ~settings, ~statics, ci): list(Node.t) => { let wrapper = status_view => [ term_view(~inject, ~settings, ci), status_view, ]; switch (ci) { | Secondary(_) => wrapper(div([])) - | InfoExp({cls, status, _}) => wrapper(exp_view(cls, status)) - | InfoPat({cls, status, _}) => wrapper(pat_view(cls, status)) + | InfoExp({cls, status, _} as ie) => + wrapper(exp_view(~statics, cls, status, ie)) + | InfoPat({cls, status, _} as info) => + wrapper(pat_view(~statics, cls, status, info)) | InfoTyp({cls, status, _}) => wrapper(typ_view(cls, status)) | InfoTPat({cls, status, _}) => wrapper(tpat_view(cls, status)) }; }; -let inspector_view = (~inject, ~settings, ci): Node.t => +let inspector_view = (~inject, ~settings, ~statics, ci): Node.t => div( ~attrs=[ Attr.id("cursor-inspector"), clss([Info.is_error(ci) ? errc : okc]), ], - view_of_info(~inject, ~settings, ci), + view_of_info(~inject, ~settings, ~statics, ci), ); let view = - (~inject, ~settings: Settings.t, editor, cursor_info: option(Info.t)) => { + ( + ~inject, + ~settings: Settings.t, + editor: Editor.t, + cursor_info: option(Info.t), + ) => { let bar_view = div(~attrs=[Attr.id("bottom-bar")]); let err_view = err => bar_view([ @@ -296,7 +404,12 @@ let view = | None => err_view("Whitespace or Comment") | Some(ci) => bar_view([ - inspector_view(~inject, ~settings, ci), + inspector_view( + ~inject, + ~settings, + ~statics=editor.state.meta.statics, + ci, + ), ProjectorView.Panel.view( ~inject=a => inject(PerformAction(Project(a))), editor, diff --git a/src/haz3lweb/view/ExplainThis.re b/src/haz3lweb/view/ExplainThis.re index a74a5187d8..e508bb2eb2 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 82dfd0a9e3..0e30fbe673 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(_) => ty_view("Label", "Label") | 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 c515487535..daf513d109 100644 --- a/test/Test_Elaboration.re +++ b/test/Test_Elaboration.re @@ -10,7 +10,45 @@ 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 rec strip_casts = (e: Exp.t): Exp.t => { + print_endline("Stripping casts: " ++ Exp.show(e)); + Exp.map_term( + ~f_pat= + (fn, t) => + switch (t.term) { + | Cast(e, _, _) => strip_casts_pat(e) + | _ => fn(t) + }, + ~f_exp= + (fn: Exp.t => Exp.t, t: Exp.t) => + switch (t.term) { + | Cast(e, _, _) => strip_casts(e) + | _ => fn(t) + }, + e, + ); +} +and strip_casts_pat = (p: Pat.t): Pat.t => { + print_endline("Stripping casts: " ++ Pat.show(p)); + Pat.map_term( + ~f_pat= + (fn, t) => + switch (t.term) { + | Cast(e, _, _) => fn(e) + | _ => fn(t) + }, + ~f_exp= + (fn: Exp.t => Exp.t, t: Exp.t) => + switch (t.term) { + | Cast(e, _, _) => strip_casts(e) + | _ => fn(t) + }, + p, + ); +}; let u1: Exp.t = {ids: [id_at(0)], term: Int(8), copied: false}; let single_integer = () => alco_check("Integer literal 8", u1, dhexp_of_uexp(u1)); @@ -190,6 +228,7 @@ let deferral = () => ) |> Exp.fresh, dhexp_of_uexp( + // This test seems broken DeferredAp( Var("string_sub") |> Exp.fresh, [ @@ -283,20 +322,38 @@ let ap_of_deferral_of_hole = () => ], ) |> Exp.fresh, - Tuple([ + Cast( Cast( - Float(1.) |> Exp.fresh, - Float |> Typ.fresh, - Unknown(Internal) |> Typ.fresh, + Tuple([ + Cast( + Float(1.) |> Exp.fresh, + Float |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Exp.fresh, + Cast( + Bool(true) |> Exp.fresh, + Bool |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ) + |> Exp.fresh, + ]) + |> Exp.fresh, + Prod([ + Unknown(Internal) |> Typ.fresh, + Unknown(Internal) |> Typ.fresh, + ]) + |> Typ.fresh, + Prod([Float |> Typ.fresh, Bool |> Typ.fresh]) |> Typ.fresh, ) |> Exp.fresh, - Cast( - Bool(true) |> Exp.fresh, - Bool |> Typ.fresh, + Prod([Float |> Typ.fresh, Bool |> Typ.fresh]) |> Typ.fresh, + Prod([ Unknown(Internal) |> Typ.fresh, - ) - |> Exp.fresh, - ]) + Unknown(Internal) |> Typ.fresh, + ]) + |> Typ.fresh, + ) |> Exp.fresh, ) |> Exp.fresh, @@ -319,6 +376,178 @@ let ap_of_deferral_of_hole = () => ), ); +/* + 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), @@ -335,6 +564,240 @@ 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:Int) -> 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)|})) // Ignoring casts for now + ) + ), + test_case( + "Singleton labeled argument function application with no label in ap", + `Quick, + () => + alco_check( + {|(fun a=(x:Int) -> x)(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, String("") |> 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 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, + strip_casts(dhexp_of_uexp(parse_exp({|(fun a=x->x)(a=1)|}))), + ) + ), + 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, + strip_casts(dhexp_of_uexp(parse_exp({|let x : (a=?) = (a=1) in x|}))) // Ignoring casts for now + ) + ), test_case( "Function application with a single remaining argument after deferral", `Quick, diff --git a/test/Test_Evaluator.re b/test/Test_Evaluator.re index 37fcaba764..8eb0180401 100644 --- a/test/Test_Evaluator.re +++ b/test/Test_Evaluator.re @@ -11,7 +11,11 @@ let evaluation_test = (msg, expected, unevaluated) => snd(Evaluator.evaluate(Builtins.env_init, {d: unevaluated})), ), ); - +let parse_exp = (s: string) => + MakeTerm.from_zip_for_sem(Option.get(Printer.zipper_of_string(s))).term; +let dhexp_of_uexp = u => + Elaborator.elaborate(Statics.mk(CoreSettings.on, Builtins.ctx_init, u), u) + |> fst; let test_int = () => evaluation_test("8", Int(8) |> Exp.fresh, Int(8) |> Exp.fresh); @@ -22,6 +26,23 @@ 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, + Label("a") |> Exp.fresh // This is a var now for parsing reasons + ) + |> Exp.fresh, + ); + let test_function_application = () => evaluation_test( "float_of_int(1)", @@ -171,7 +192,32 @@ let tet_ap_of_hole_deferral = () => 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, + ), test_case("Function application", `Quick, test_function_application), test_case("Function deferral", `Quick, test_function_deferral), test_case("Deferral applied to hole", `Quick, tet_ap_of_hole_deferral), + test_case("Elaborated Pattern for labeled tuple", `Quick, () => + check( + dhexp_typ, + {|let x : (a=Int) -> Int = fun a -> a in x(2)|}, + Int(2) |> Exp.fresh, + Evaluator.Result.unbox( + snd( + Evaluator.evaluate( + Builtins.env_init, + { + d: + dhexp_of_uexp( + parse_exp("let x : (a=Int) -> Int = fun a -> a in x(2)"), + ), + }, + ), + ), + ), + ) + ), ]; 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 index 46818664a9..6cbc40f6fc 100644 --- a/test/Test_MakeTerm.re +++ b/test/Test_MakeTerm.re @@ -7,12 +7,106 @@ 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|}, + ) + ), test_case("Integer Literal", `Quick, () => { exp_check(Int(0) |> Exp.fresh, "0") }), diff --git a/test/Test_Statics.re b/test/Test_Statics.re index 71fdafc8ba..59ba23283e 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,456 @@ 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|}), + ), + fully_consistent_typecheck( + "Singleton labeled argument function application with unknown type", + {|(fun a=x->x)(a=1)|}, + Some(unknown(Internal)), + 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, + ), + fully_consistent_typecheck( + "Singleton labeled argument function application with no labeled param", + {|(fun a=x->x)(1)|}, + Some(unknown(Internal)), + 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, + ), + fully_consistent_typecheck( + "Singleton labeled argument not labeled in pattern", + {|let x : (a=Int) -> Int = fun a -> a in x(2)|}, + Some(int), + parse_exp("let x : (a=Int) -> Int = fun a -> a in x(2)"), ), ]; diff --git a/test/haz3ltest.re b/test/haz3ltest.re index 8e4a838b0a..b9cbea0c0a 100644 --- a/test/haz3ltest.re +++ b/test/haz3ltest.re @@ -5,11 +5,12 @@ let (suite, _) = ~and_exit=false, "HazelTests", [ - ("Elaboration", Test_Elaboration.elaboration_tests), + ("MakeTerm", Test_MakeTerm.tests), + ("LabeledTuple", Test_LabeledTuple.tests), ("Statics", Test_Statics.tests), + ("Elaboration", Test_Elaboration.elaboration_tests), ("Evaluator", Test_Evaluator.tests), Test_ListUtil.tests, - ("MakeTerm", Test_MakeTerm.tests), ], ); Junit.to_file(Junit.make([suite]), "junit_tests.xml");