From 2606648e00c6f8dc89cc1530431fa43219795931 Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Fri, 18 Aug 2023 16:54:58 -0400 Subject: [PATCH 01/56] Add: mold and forms of parameterized type --- src/haz3lcore/lang/Form.re | 2 ++ src/haz3lcore/statics/Info.re | 18 ++++++++-- src/haz3lcore/statics/MakeTerm.re | 50 ++++++++++++++++++++-------- src/haz3lcore/statics/Statics.re | 55 +++++++++++++++++++++++++++++++ src/haz3lcore/statics/Term.re | 11 ++++--- src/haz3lcore/statics/TermBase.re | 2 ++ src/haz3lcore/statics/TypBase.re | 28 +++++++++++++--- src/haz3lweb/view/CtxInspector.re | 3 +- src/haz3lweb/view/Kind.re | 2 ++ src/haz3lweb/view/LangDoc.re | 1 + 10 files changed, 146 insertions(+), 26 deletions(-) diff --git a/src/haz3lcore/lang/Form.re b/src/haz3lcore/lang/Form.re index f115522c3c..080137dd2d 100644 --- a/src/haz3lcore/lang/Form.re +++ b/src/haz3lcore/lang/Form.re @@ -91,6 +91,7 @@ let is_reserved = str => is_bool(str); let is_var = str => !is_reserved(str) && regexp("^[a-z][A-Za-z0-9_]*$", str); let is_capitalized_name = regexp("^[A-Z][A-Za-z0-9_]*$"); let is_ctr = is_capitalized_name; +let is_type_input = regexp("^[a-z]*$"); let base_typs = ["String", "Int", "Float", "Bool"]; let is_base_typ = regexp("^(" ++ String.concat("|", base_typs) ++ ")$"); let is_typ_var = is_capitalized_name; @@ -258,6 +259,7 @@ let forms: list((string, t)) = [ ("if_", mk(ds, ["if", "then", "else"], mk_pre(P.if_, Exp, [Exp, Exp]))), ("ap_exp", mk(ii, ["(", ")"], mk_post(P.ap, Exp, [Exp]))), ("ap_pat", mk(ii, ["(", ")"], mk_post(P.ap, Pat, [Pat]))), + ("ap_tpat", mk(ii, ["(", ")"], mk_post(P.ap, TPat, [TPat]))), ("ap_typ", mk(ii, ["(", ")"], mk_post(P.ap, Typ, [Typ]))), ("let_", mk(ds, ["let", "=", "in"], mk_pre(P.let_, Exp, [Pat, Exp]))), ( diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 69d3871db6..9c24e3bd79 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -337,7 +337,11 @@ let status_exp = (ctx: Ctx.t, mode: Mode.t, self: Self.exp): status_exp => free, and whether a ctr name is a dupe. */ let status_typ = (ctx: Ctx.t, expects: typ_expects, term: TermBase.UTyp.t, ty: Typ.t) - : status_typ => + : status_typ => { + //Printf.printf("status_ctx: %s\n", TermBase.UTyp.show(term)); + //Printf.printf("status_expects: %s\n", Typ.show(ty)); + //Printf.printf("status_term: %s\n", TermBase.UTyp.show(term)); + //Printf.printf("status_ty: %s\n", Typ.show(ty)); switch (term.term) { | Invalid(token) => InHole(BadToken(token)) | EmptyHole => NotInHole(Type(ty)) @@ -375,7 +379,7 @@ let status_typ = | VariantExpected(_) => InHole(WantConstructorFoundType(ty)) } }; - +}; let status_tpat = (ctx: Ctx.t, utpat: UTPat.t): status_tpat => switch (utpat.term) { | EmptyHole => NotInHole(Empty) @@ -385,6 +389,16 @@ let status_tpat = (ctx: Ctx.t, utpat: UTPat.t): status_tpat => | Var(name) => NotInHole(Var(name)) | Invalid(_) => InHole(NotAVar(NotCapitalized)) | MultiHole(_) => InHole(NotAVar(Other)) + | Ap(t, _) => + switch (t.term) { + | Var(name) => + if (Form.is_base_typ(name) || Ctx.lookup_alias(ctx, name) != None) { + InHole(ShadowsType(name)); + } else { + NotInHole(Var(name)); + } + | _ => InHole(NotAVar(Other)) + } }; /* Determines whether any term is in an error hole. */ diff --git a/src/haz3lcore/statics/MakeTerm.re b/src/haz3lcore/statics/MakeTerm.re index 1c170c63ee..cdf21a754f 100644 --- a/src/haz3lcore/statics/MakeTerm.re +++ b/src/haz3lcore/statics/MakeTerm.re @@ -228,7 +228,12 @@ and exp_term: unsorted => (UExp.term, list(Id.t)) = { | (["fun", "->"], [Pat(pat)]) => Fun(pat, r) | (["let", "=", "in"], [Pat(pat), Exp(def)]) => Let(pat, def, r) | (["type", "=", "in"], [TPat(tpat), Typ(def)]) => - TyAlias(tpat, def, r) + Printf.printf( + "tpat: %s, def: %s\n", + UTPat.show(tpat), + UTyp.show(def), + ); + TyAlias(tpat, def, r); | (["if", "then", "else"], [Exp(cond), Exp(conseq)]) => If(cond, conseq, r) | _ => hole(tm) @@ -297,10 +302,10 @@ and pat = unsorted => { let ids = ids(unsorted) @ inner_ids; return(p => Pat(p), ids, {ids, term}); } -and pat_term: unsorted => (UPat.term, list(Id.t)) = { +and pat_term = (unsorted: unsorted): (UPat.term, list(Id.t)) => { let ret = (term: UPat.term) => (term, []); let hole = unsorted => Term.UPat.hole(kids_of_unsorted(unsorted)); - fun + switch (unsorted) { | Op(tiles) as tm => switch (tiles) { | ([(_id, tile)], []) => @@ -356,17 +361,19 @@ and pat_term: unsorted => (UPat.term, list(Id.t)) = { | _ => ret(hole(tm)) } } - | tm => ret(hole(tm)); + | tm => ret(hole(tm)) + }; } and typ = unsorted => { let (term, inner_ids) = typ_term(unsorted); let ids = ids(unsorted) @ inner_ids; return(ty => Typ(ty), ids, {ids, term}); } -and typ_term: unsorted => (UTyp.term, list(Id.t)) = { +and typ_term = (unsorted: unsorted): (UTyp.term, list(Id.t)) => { let ret = (term: UTyp.term) => (term, []); let hole = unsorted => Term.UTyp.hole(kids_of_unsorted(unsorted)); - fun + //Printf.printf("typ_term: %s\n", show_unsorted(unsorted)); + switch (unsorted) { | Op(tiles) as tm => switch (tiles) { | ([(_id, tile)], []) => @@ -378,6 +385,7 @@ and typ_term: unsorted => (UTyp.term, list(Id.t)) = { | (["Float"], []) => Float | (["String"], []) => String | ([t], []) when Form.is_typ_var(t) => Var(t) + | ([t], []) when Form.is_type_input(t) => Var(t) | (["(", ")"], [Typ(body)]) => Parens(body) | (["[", "]"], [Typ(body)]) => List(body) | ([t], []) when t != " " => Invalid(t) @@ -417,17 +425,18 @@ and typ_term: unsorted => (UTyp.term, list(Id.t)) = { | _ => ret(hole(tm)) } } - | tm => ret(hole(tm)); + | tm => ret(hole(tm)) + }; } and tpat = unsorted => { let term = tpat_term(unsorted); let ids = ids(unsorted); return(ty => TPat(ty), ids, {ids, term}); } -and tpat_term: unsorted => UTPat.term = { +and tpat_term = (unsorted: unsorted): UTPat.term => { let ret = (term: UTPat.term) => term; let hole = unsorted => Term.UTPat.hole(kids_of_unsorted(unsorted)); - fun + switch (unsorted) { | Op(tiles) as tm => switch (tiles) { | ([(_id, tile)], []) => @@ -440,10 +449,26 @@ and tpat_term: unsorted => UTPat.term = { ) | _ => ret(hole(tm)) } - | (Pre(_) | Post(_)) as tm => ret(hole(tm)) - | tm => ret(hole(tm)); + | Post(TPat(l), tiles) as tm => + switch (tiles) { + | ([(_id, tile)], []) => + ret( + switch (tile) { + | (["(", ")"], [TPat(arg)]) => + switch (arg.term) { + | Invalid(s) when Form.is_type_input(s) => + Ap(l, {ids: arg.ids, term: Var(s)}) + | _ => ret(hole(tm)) + } + | _ => hole(tm) + }, + ) + | _ => ret(hole(tm)) + } + | Pre(_) as tm => ret(hole(tm)) + | tm => ret(hole(tm)) + }; } - // and rul = unsorted => { // let term = rul_term(unsorted); // let ids = ids(unsorted); @@ -468,7 +493,6 @@ and rul = (unsorted: unsorted): URul.t => { | e => {ids: [], term: Rules(e, [])} }; } - and unsorted = (skel: Skel.t, seg: Segment.t): unsorted => { let tile_kids = (p: Piece.t): list(any) => switch (p) { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 1fb4d040c5..46b3d92794 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -326,6 +326,60 @@ and uexp_to_info_map = let ty_escape = Typ.subst(ty_def, name, ty_body); let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; add(~self=Just(ty_escape), ~co_ctx, m); + | Ap(t1, _) => + let constructor = + switch (t1.term) { + | Var(s) => s + | _ => "" + }; + //let arg = + // switch (t2.term) { + // | Var(s) => s + // | _ => "" + // }; + Printf.printf( + "typat: %s, utyp: %s, body:%s \n", + UTPat.show(typat), + UTyp.show(utyp), + UExp.show(body), + ); + let (ty_def, ctx_def, ctx_body) = { + let ty_pre = + UTyp.to_typ(Ctx.extend_dummy_tvar(ctx, constructor), utyp); + switch (utyp.term) { + | Sum(_) when List.mem(constructor, Typ.free_vars(ty_pre)) => + let ty_rec = + Typ.Rec("α", Typ.subst(Var("α"), constructor, ty_pre)); + let ctx_def = + Ctx.extend_alias(ctx, constructor, UTPat.rep_id(typat), ty_rec); + (ty_rec, ctx_def, ctx_def); + | _ => + let ty = UTyp.to_typ(ctx, utyp); + ( + ty, + ctx, + Ctx.extend_alias(ctx, constructor, UTPat.rep_id(typat), ty), + ); + }; + }; + //Printf.printf( + // "ty_def: %s, ctx_def: %s, ctx_body: %s \n", + // Typ.show(ty_def), + // Ctx.show(ctx_def), + // Ctx.show(ctx_body), + //); + let ctx_body = + switch (Typ.get_sum_constructors(ctx, ty_def)) { + | Some(sm) => + Ctx.add_ctrs(ctx_body, constructor, 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, constructor, 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 @@ -488,6 +542,7 @@ and utpat_to_info_map = let (_, m) = multi(~ctx, ~ancestors, m, tms); add(m); | Invalid(_) + | Ap(_) | EmptyHole | Var(_) => add(m) }; diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index f62a502e8c..e297f47942 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -155,8 +155,8 @@ module UTPat = { | Invalid | EmptyHole | MultiHole - | Var; - + | Var + | Ap; include TermBase.UTPat; let rep_id = ({ids, _}) => { @@ -175,14 +175,15 @@ module UTPat = { | Invalid(_) => Invalid | EmptyHole => EmptyHole | MultiHole(_) => MultiHole - | Var(_) => Var; - + | Var(_) => Var + | Ap(_) => Ap; let show_cls: cls => string = fun | Invalid => "Invalid type alias" | MultiHole => "Broken type alias" | EmptyHole => "Empty type alias hole" - | Var => "Type alias"; + | Var => "Type alias" + | Ap => "Type Application"; }; module UPat = { diff --git a/src/haz3lcore/statics/TermBase.re b/src/haz3lcore/statics/TermBase.re index ee0280b17c..585c331842 100644 --- a/src/haz3lcore/statics/TermBase.re +++ b/src/haz3lcore/statics/TermBase.re @@ -379,6 +379,7 @@ and UTPat: { | EmptyHole | MultiHole(list(Any.t)) | Var(TypVar.t) + | Ap(t, t) and t = { ids: list(Id.t), term, @@ -390,6 +391,7 @@ and UTPat: { | EmptyHole | MultiHole(list(Any.t)) | Var(TypVar.t) + | Ap(t, t) and t = { ids: list(Id.t), term, diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 3ad0570301..ab368d6161 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -432,7 +432,8 @@ and Ctx: { type entry = | VarEntry(var_entry) | ConstructorEntry(var_entry) - | TVarEntry(tvar_entry); + | TVarEntry(tvar_entry) + | TConstructorEntry(tvar_entry); [@deriving (show({with_path: false}), sexp, yojson)] type t = list(entry); @@ -471,7 +472,8 @@ and Ctx: { type entry = | VarEntry(var_entry) | ConstructorEntry(var_entry) - | TVarEntry(tvar_entry); + | TVarEntry(tvar_entry) + | TConstructorEntry(tvar_entry); [@deriving (show({with_path: false}), sexp, yojson)] type t = list(entry); @@ -480,10 +482,14 @@ and Ctx: { let extend_tvar = (ctx: t, tvar_entry: tvar_entry): t => extend(ctx, TVarEntry(tvar_entry)); + //let extend_tConstructor = (ctx: t, tvar_entry: tvar_entry): t => + // extend(ctx, TConstructorEntry(tvar_entry)); + //let extend_ctr = + // (ctx: t, name: TypVar.t, id: Id.t, ty1: Typ.t, ty2: Typ.t): t => + // extend_tConstructor(ctx, {name, id, kind: Arrow(ty1, ty2)}); let extend_alias = (ctx: t, name: TypVar.t, id: Id.t, ty: Typ.t): t => extend_tvar(ctx, {name, id, kind: Singleton(ty)}); - let extend_dummy_tvar = (ctx: t, name: TypVar.t) => extend_tvar(ctx, {kind: Abstract, name, id: Id.invalid}); @@ -494,9 +500,17 @@ and Ctx: { | _ => None, ctx, ); + //let lookup_tctr = (ctx: t, name: TypVar.t): option(tvar_entry) => + // List.find_map( + // fun + // | TConstructorEntry(v) when v.name == name => Some(v) + // | _ => None, + // ctx, + // ); let lookup_alias = (ctx: t, t: TypVar.t): option(Typ.t) => switch (lookup_tvar(ctx, t)) { + | Some({kind: Arrow(ty_in, ty_out), _}) => Some(Arrow(ty_in, ty_out)) | Some({kind: Singleton(ty), _}) => Some(ty) | Some({kind: Abstract, _}) | None => None @@ -506,7 +520,8 @@ and Ctx: { fun | VarEntry({id, _}) | ConstructorEntry({id, _}) - | TVarEntry({id, _}) => id; + | TVarEntry({id, _}) => id + | TConstructorEntry({id, _}) => id; let lookup_var = (ctx: t, name: string): option(var_entry) => List.find_map( @@ -583,7 +598,8 @@ and Ctx: { VarSet.mem(name, term_set) ? (ctx, term_set, typ_set) : ([entry, ...ctx], VarSet.add(name, term_set), typ_set) - | TVarEntry({name, _}) => + | TVarEntry({name, _}) + | TConstructorEntry({name, _}) => VarSet.mem(name, typ_set) ? (ctx, term_set, typ_set) : ([entry, ...ctx], term_set, VarSet.add(name, typ_set)) @@ -599,11 +615,13 @@ and Ctx: { and Kind: { [@deriving (show({with_path: false}), sexp, yojson)] type t = + | Arrow(Typ.t, Typ.t) | Singleton(Typ.t) | Abstract; } = { [@deriving (show({with_path: false}), sexp, yojson)] type t = + | Arrow(Typ.t, Typ.t) | Singleton(Typ.t) | Abstract; }; diff --git a/src/haz3lweb/view/CtxInspector.re b/src/haz3lweb/view/CtxInspector.re index a148f149cc..9ac4b1b828 100644 --- a/src/haz3lweb/view/CtxInspector.re +++ b/src/haz3lweb/view/CtxInspector.re @@ -25,7 +25,8 @@ let context_entry_view = (~inject, entry: Haz3lcore.Ctx.entry): Node.t => { Type.view(typ), ], ) - | TVarEntry({name, kind, _}) => + | TVarEntry({name, kind, _}) + | TConstructorEntry({name, kind, _}) => div_c( "context-entry", [ diff --git a/src/haz3lweb/view/Kind.re b/src/haz3lweb/view/Kind.re index f84672515c..416427a9d1 100644 --- a/src/haz3lweb/view/Kind.re +++ b/src/haz3lweb/view/Kind.re @@ -4,6 +4,8 @@ open Util.Web; let view = (kind: Haz3lcore.Kind.t): Node.t => switch (kind) { + | Arrow(ty1, ty2) => + div_c("kind-view", [Type.view(ty1), text(" -> "), Type.view(ty2)]) | Singleton(ty) => div_c("kind-view", [Type.view(ty)]) | Abstract => div_c("kind-view", [text("Type")]) }; diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index b0eedb8869..bc8cfeeeb9 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -2817,6 +2817,7 @@ let get_doc = ), [], ); + | _ => default } | None => default }; From fe2761462c97effd4ac47993e277e5dcf07fb749 Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Sun, 20 Aug 2023 23:51:13 -0400 Subject: [PATCH 02/56] Fix: the type in let works --- src/haz3lcore/dynamics/Builtins.re | 2 +- src/haz3lcore/dynamics/Evaluator.re | 1 + src/haz3lcore/statics/Info.re | 31 +++++--- src/haz3lcore/statics/MakeTerm.re | 8 +- src/haz3lcore/statics/Statics.re | 62 +++++++++------- src/haz3lcore/statics/Term.re | 21 +++++- src/haz3lcore/statics/TypBase.re | 85 +++++++++++++++------- src/haz3lweb/view/CtxInspector.re | 3 +- src/haz3lweb/view/Type.re | 5 ++ src/haz3lweb/view/dhcode/layout/HTypDoc.re | 1 + 10 files changed, 142 insertions(+), 77 deletions(-) diff --git a/src/haz3lcore/dynamics/Builtins.re b/src/haz3lcore/dynamics/Builtins.re index 85bda5dbe1..466a090039 100644 --- a/src/haz3lcore/dynamics/Builtins.re +++ b/src/haz3lcore/dynamics/Builtins.re @@ -279,7 +279,7 @@ module Pervasives = { let ctx_init: Ctx.t = List.map( ((name, Builtin.{typ, _})) => - Ctx.VarEntry({name, typ, id: Id.invalid}), + Ctx.VarEntry({name, parameter: "", typ, id: Id.invalid}), Pervasives.builtins, ); diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 529ca04260..b945c73cb3 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -45,6 +45,7 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { | String | Var(_) | Rec(_) + | TypeConstructorAp(_, _) | Arrow(Unknown(_), Unknown(_)) | List(Unknown(_)) => Ground | Prod(tys) => diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 9c24e3bd79..1ef074e068 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -338,10 +338,6 @@ let status_exp = (ctx: Ctx.t, mode: Mode.t, self: Self.exp): status_exp => let status_typ = (ctx: Ctx.t, expects: typ_expects, term: TermBase.UTyp.t, ty: Typ.t) : status_typ => { - //Printf.printf("status_ctx: %s\n", TermBase.UTyp.show(term)); - //Printf.printf("status_expects: %s\n", Typ.show(ty)); - //Printf.printf("status_term: %s\n", TermBase.UTyp.show(term)); - //Printf.printf("status_ty: %s\n", Typ.show(ty)); switch (term.term) { | Invalid(token) => InHole(BadToken(token)) | EmptyHole => NotInHole(Type(ty)) @@ -370,7 +366,17 @@ let status_typ = | _ => NotInHole(VariantIncomplete(Arrow(ty_in, ty_variant))) }; | ConstructorExpected(_) => InHole(WantConstructorFoundAp) - | TypeExpected => InHole(WantTypeFoundAp) + | TypeExpected => + let constructor = + switch (t1.term) { + | Var(s) => s + | _ => "" + }; + switch (Ctx.is_alias(ctx, constructor)) { + | false => InHole(FreeTypeVariable(constructor)) + | true => + NotInHole(TypeAlias(constructor, Typ.weak_head_normalize(ctx, ty))) + }; } | _ => switch (expects) { @@ -405,20 +411,23 @@ let status_tpat = (ctx: Ctx.t, utpat: UTPat.t): status_tpat => let is_error = (ci: t): bool => { switch (ci) { | InfoExp({mode, self, ctx, _}) => - switch (status_exp(ctx, mode, self)) { + let status = status_exp(ctx, mode, self); + switch (status) { | InHole(_) => true | NotInHole(_) => false - } + }; | InfoPat({mode, self, ctx, _}) => - switch (status_pat(ctx, mode, self)) { + let status = status_pat(ctx, mode, self); + switch (status) { | InHole(_) => true | NotInHole(_) => false - } + }; | InfoTyp({expects, ctx, term, ty, _}) => - switch (status_typ(ctx, expects, term, ty)) { + let status = status_typ(ctx, expects, term, ty); + switch (status) { | InHole(_) => true | NotInHole(_) => false - } + }; | InfoTPat({term, ctx, _}) => switch (status_tpat(ctx, term)) { | InHole(_) => true diff --git a/src/haz3lcore/statics/MakeTerm.re b/src/haz3lcore/statics/MakeTerm.re index cdf21a754f..dd7d7f788a 100644 --- a/src/haz3lcore/statics/MakeTerm.re +++ b/src/haz3lcore/statics/MakeTerm.re @@ -228,12 +228,7 @@ and exp_term: unsorted => (UExp.term, list(Id.t)) = { | (["fun", "->"], [Pat(pat)]) => Fun(pat, r) | (["let", "=", "in"], [Pat(pat), Exp(def)]) => Let(pat, def, r) | (["type", "=", "in"], [TPat(tpat), Typ(def)]) => - Printf.printf( - "tpat: %s, def: %s\n", - UTPat.show(tpat), - UTyp.show(def), - ); - TyAlias(tpat, def, r); + TyAlias(tpat, def, r) | (["if", "then", "else"], [Exp(cond), Exp(conseq)]) => If(cond, conseq, r) | _ => hole(tm) @@ -372,7 +367,6 @@ and typ = unsorted => { and typ_term = (unsorted: unsorted): (UTyp.term, list(Id.t)) => { let ret = (term: UTyp.term) => (term, []); let hole = unsorted => Term.UTyp.hole(kids_of_unsorted(unsorted)); - //Printf.printf("typ_term: %s\n", show_unsorted(unsorted)); switch (unsorted) { | Op(tiles) as tm => switch (tiles) { diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 46b3d92794..65a0cc0f12 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -308,16 +308,20 @@ and uexp_to_info_map = | Sum(_) when List.mem(name, Typ.free_vars(ty_pre)) => let ty_rec = Typ.Rec("α", Typ.subst(Var("α"), name, ty_pre)); let ctx_def = - Ctx.extend_alias(ctx, name, UTPat.rep_id(typat), ty_rec); + Ctx.extend_alias(ctx, name, "", UTPat.rep_id(typat), ty_rec); (ty_rec, ctx_def, ctx_def); | _ => let ty = UTyp.to_typ(ctx, utyp); - (ty, ctx, Ctx.extend_alias(ctx, name, UTPat.rep_id(typat), ty)); + ( + ty, + ctx, + Ctx.extend_alias(ctx, name, "", UTPat.rep_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) + | 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) = @@ -326,52 +330,52 @@ and uexp_to_info_map = let ty_escape = Typ.subst(ty_def, name, ty_body); let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; add(~self=Just(ty_escape), ~co_ctx, m); - | Ap(t1, _) => + | Ap(t1, t2) => let constructor = switch (t1.term) { | Var(s) => s | _ => "" }; - //let arg = - // switch (t2.term) { - // | Var(s) => s - // | _ => "" - // }; - Printf.printf( - "typat: %s, utyp: %s, body:%s \n", - UTPat.show(typat), - UTyp.show(utyp), - UExp.show(body), - ); + let arg = + switch (t2.term) { + | Var(s) => s + | _ => "" + }; let (ty_def, ctx_def, ctx_body) = { let ty_pre = - UTyp.to_typ(Ctx.extend_dummy_tvar(ctx, constructor), utyp); + UTyp.to_typ( + Ctx.extend_dummy_tvar( + Ctx.extend_dummy_tvar(ctx, constructor), + arg, + ), + utyp, + ); switch (utyp.term) { | Sum(_) when List.mem(constructor, Typ.free_vars(ty_pre)) => let ty_rec = Typ.Rec("α", Typ.subst(Var("α"), constructor, ty_pre)); let ctx_def = - Ctx.extend_alias(ctx, constructor, UTPat.rep_id(typat), ty_rec); + Ctx.extend_alias( + ctx, + constructor, + arg, + UTPat.rep_id(typat), + ty_rec, + ); (ty_rec, ctx_def, ctx_def); | _ => let ty = UTyp.to_typ(ctx, utyp); ( ty, ctx, - Ctx.extend_alias(ctx, constructor, UTPat.rep_id(typat), ty), + Ctx.extend_alias(ctx, constructor, arg, UTPat.rep_id(typat), ty), ); }; }; - //Printf.printf( - // "ty_def: %s, ctx_def: %s, ctx_body: %s \n", - // Typ.show(ty_def), - // Ctx.show(ctx_def), - // Ctx.show(ctx_body), - //); let ctx_body = switch (Typ.get_sum_constructors(ctx, ty_def)) { | Some(sm) => - Ctx.add_ctrs(ctx_body, constructor, UTyp.rep_id(utyp), sm) + Ctx.add_ctrs(ctx_body, constructor, arg, UTyp.rep_id(utyp), sm) | None => ctx_body }; let ({co_ctx, ty: ty_body, _}: Info.exp, m) = @@ -445,7 +449,13 @@ and upat_to_info_map = Unknown(Internal) is used in this case */ let ctx_typ = Info.fixed_typ_pat(ctx, mode, Common(Just(Unknown(Internal)))); - let entry = Ctx.VarEntry({name, id: UPat.rep_id(upat), typ: ctx_typ}); + let entry = + Ctx.VarEntry({ + name, + parameter: "", + id: UPat.rep_id(upat), + typ: ctx_typ, + }); add(~self=Just(unknown), ~ctx=Ctx.extend(ctx, entry), m); | Tuple(ps) => let modes = Mode.of_prod(ctx, mode, List.length(ps)); diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index e297f47942..b762707d40 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -129,8 +129,25 @@ module UTyp = { | List(u) => List(to_typ(ctx, u)) | Parens(u) => to_typ(ctx, u) /* The below cases should occur only inside sums */ - | Constructor(_) - | Ap(_) => Unknown(Internal) + | Ap(t1, t2) => + let name = + switch (t1.term) { + | Var(s) => s + | _ => "" + }; + switch (Ctx.lookup_tvar(ctx, name)) { + | Some(ty) => + let arg = ty.parameter; + let res_ty = + switch (ty.kind) { + | Arrow(ty_in, ty_out) => Typ.Arrow(ty_in, ty_out) + | Singleton(ty) => ty + | Abstract => Unknown(Internal) + }; + Typ.subst(to_typ(ctx, t2), arg, res_ty); + | None => Unknown(Free(name)) + }; + | Constructor(_) => Unknown(Internal) } and to_variant: (Ctx.t, variant) => option(ConstructorMap.binding(option(Typ.t))) = diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index ab368d6161..9c0f134164 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -33,6 +33,8 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) + | TypeConstructorAp(TypVar.t, t) + and sum_map = ConstructorMap.t(option(t)); [@deriving (show({with_path: false}), sexp, yojson)] @@ -91,6 +93,7 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) + | TypeConstructorAp(TypVar.t, t) and sum_map = ConstructorMap.t(option(t)); [@deriving (show({with_path: false}), sexp, yojson)] @@ -157,6 +160,7 @@ module rec Typ: { | Var(_) | Rec(_) | Sum(_) => precedence_Sum + | TypeConstructorAp(_, _) | List(_) => precedence_Const | Prod(_) => precedence_Prod | Arrow(_, _) => precedence_Arrow @@ -176,6 +180,7 @@ module rec Typ: { | Rec(y, ty) => Rec(y, subst(s, x, ty)) | List(ty) => List(subst(s, x, ty)) | Var(y) => TypVar.eq(x, y) ? s : Var(y) + | TypeConstructorAp(y, ty) => TypeConstructorAp(y, subst(s, x, ty)) }; }; @@ -212,6 +217,9 @@ module rec Typ: { | (Sum(_), _) => false | (Var(n1), Var(n2)) => n1 == n2 | (Var(_), _) => false + | (TypeConstructorAp(n1, t1), TypeConstructorAp(n2, t2)) => + n1 == n2 && eq(t1, t2) + | (TypeConstructorAp(_), _) => false }; }; @@ -234,6 +242,7 @@ module rec Typ: { ) | Prod(tys) => ListUtil.flat_map(free_vars(~bound), tys) | Rec(x, ty) => free_vars(~bound=[x, ...bound], ty) + | TypeConstructorAp(_, ty) => free_vars(~bound, ty) }; /* Lattice join on types. This is a LUB join in the hazel2 @@ -319,6 +328,14 @@ module rec Typ: { let+ ty = join'(ty1, ty2); List(ty); | (List(_), _) => None + | (TypeConstructorAp(name1, ty1), TypeConstructorAp(name2, ty2)) => + if (name1 == name2) { + let+ ty = join'(ty1, ty2); + TypeConstructorAp(name1, ty); + } else { + None; + } + | (TypeConstructorAp(_), _) => None }; } and join_sum_entries = @@ -381,6 +398,8 @@ module rec Typ: { as in current implementation Recs do not occur in the surface syntax, so we won't try to jump to them. */ Rec(name, normalize(Ctx.extend_dummy_tvar(ctx, name), ty)) + | TypeConstructorAp(name, ty) => + TypeConstructorAp(name, normalize(ctx, ty)) }; }; @@ -417,6 +436,7 @@ and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type var_entry = { name: Var.t, + parameter: Var.t, id: Id.t, typ: Typ.t, }; @@ -424,6 +444,7 @@ and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type tvar_entry = { name: TypVar.t, + parameter: TypVar.t, id: Id.t, kind: Kind.t, }; @@ -432,15 +453,14 @@ and Ctx: { type entry = | VarEntry(var_entry) | ConstructorEntry(var_entry) - | TVarEntry(tvar_entry) - | TConstructorEntry(tvar_entry); + | TVarEntry(tvar_entry); [@deriving (show({with_path: false}), sexp, yojson)] type t = list(entry); let extend: (t, entry) => t; let extend_tvar: (t, tvar_entry) => t; - let extend_alias: (t, TypVar.t, Id.t, Typ.t) => t; + let extend_alias: (t, TypVar.t, TypVar.t, Id.t, Typ.t) => t; let extend_dummy_tvar: (t, TypVar.t) => t; let lookup_tvar: (t, TypVar.t) => option(tvar_entry); let lookup_alias: (t, TypVar.t) => option(Typ.t); @@ -448,7 +468,7 @@ and Ctx: { let lookup_var: (t, string) => option(var_entry); let lookup_ctr: (t, string) => option(var_entry); let is_alias: (t, TypVar.t) => bool; - let add_ctrs: (t, TypVar.t, Id.t, Typ.sum_map) => t; + let add_ctrs: (t, TypVar.t, TypVar.t, Id.t, Typ.sum_map) => t; let subtract_prefix: (t, t) => option(t); let added_bindings: (t, t) => t; let filter_duplicates: t => t; @@ -457,6 +477,7 @@ and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type var_entry = { name: Var.t, + parameter: Var.t, id: Id.t, typ: Typ.t, }; @@ -464,6 +485,7 @@ and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type tvar_entry = { name: TypVar.t, + parameter: TypVar.t, id: Id.t, kind: Kind.t, }; @@ -472,9 +494,7 @@ and Ctx: { type entry = | VarEntry(var_entry) | ConstructorEntry(var_entry) - | TVarEntry(tvar_entry) - | TConstructorEntry(tvar_entry); - + | TVarEntry(tvar_entry); [@deriving (show({with_path: false}), sexp, yojson)] type t = list(entry); @@ -482,16 +502,25 @@ and Ctx: { let extend_tvar = (ctx: t, tvar_entry: tvar_entry): t => extend(ctx, TVarEntry(tvar_entry)); - //let extend_tConstructor = (ctx: t, tvar_entry: tvar_entry): t => - // extend(ctx, TConstructorEntry(tvar_entry)); - //let extend_ctr = - // (ctx: t, name: TypVar.t, id: Id.t, ty1: Typ.t, ty2: Typ.t): t => - // extend_tConstructor(ctx, {name, id, kind: Arrow(ty1, ty2)}); - - let extend_alias = (ctx: t, name: TypVar.t, id: Id.t, ty: Typ.t): t => - extend_tvar(ctx, {name, id, kind: Singleton(ty)}); + let extend_alias = + (ctx: t, name: TypVar.t, parameter: TypVar.t, id: Id.t, ty: Typ.t): t => { + let ctx = extend_tvar(ctx, {name, parameter, id, kind: Singleton(ty)}); + if (parameter != "") { + extend_tvar( + ctx, + { + name: parameter, + parameter: "", + id, + kind: Singleton(Unknown(TypeHole)), + }, + ); + } else { + ctx; + }; + }; let extend_dummy_tvar = (ctx: t, name: TypVar.t) => - extend_tvar(ctx, {kind: Abstract, name, id: Id.invalid}); + extend_tvar(ctx, {kind: Abstract, name, parameter: "", id: Id.invalid}); let lookup_tvar = (ctx: t, name: TypVar.t): option(tvar_entry) => List.find_map( @@ -500,13 +529,6 @@ and Ctx: { | _ => None, ctx, ); - //let lookup_tctr = (ctx: t, name: TypVar.t): option(tvar_entry) => - // List.find_map( - // fun - // | TConstructorEntry(v) when v.name == name => Some(v) - // | _ => None, - // ctx, - // ); let lookup_alias = (ctx: t, t: TypVar.t): option(Typ.t) => switch (lookup_tvar(ctx, t)) { @@ -520,8 +542,7 @@ and Ctx: { fun | VarEntry({id, _}) | ConstructorEntry({id, _}) - | TVarEntry({id, _}) => id - | TConstructorEntry({id, _}) => id; + | TVarEntry({id, _}) => id; let lookup_var = (ctx: t, name: string): option(var_entry) => List.find_map( @@ -545,11 +566,20 @@ and Ctx: { | None => false }; - let add_ctrs = (ctx: t, name: TypVar.t, id: Id.t, ctrs: Typ.sum_map): t => + let add_ctrs = + ( + ctx: t, + name: TypVar.t, + parameter: TypVar.t, + id: Id.t, + ctrs: Typ.sum_map, + ) + : t => List.map( ((ctr, typ)) => ConstructorEntry({ name: ctr, + parameter, id, typ: switch (typ) { @@ -598,8 +628,7 @@ and Ctx: { VarSet.mem(name, term_set) ? (ctx, term_set, typ_set) : ([entry, ...ctx], VarSet.add(name, term_set), typ_set) - | TVarEntry({name, _}) - | TConstructorEntry({name, _}) => + | TVarEntry({name, _}) => VarSet.mem(name, typ_set) ? (ctx, term_set, typ_set) : ([entry, ...ctx], term_set, VarSet.add(name, typ_set)) diff --git a/src/haz3lweb/view/CtxInspector.re b/src/haz3lweb/view/CtxInspector.re index 9ac4b1b828..a148f149cc 100644 --- a/src/haz3lweb/view/CtxInspector.re +++ b/src/haz3lweb/view/CtxInspector.re @@ -25,8 +25,7 @@ let context_entry_view = (~inject, entry: Haz3lcore.Ctx.entry): Node.t => { Type.view(typ), ], ) - | TVarEntry({name, kind, _}) - | TConstructorEntry({name, kind, _}) => + | TVarEntry({name, kind, _}) => div_c( "context-entry", [ diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index ae88419f0e..80ba3cbe41 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -65,6 +65,11 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => text(")"), ], ) + | TypeConstructorAp(t, ts) => + div( + ~attr=clss(["typ-view", "TypeConstructorAp"]), + [text(t), text("("), view_ty(ts), text(")")], + ) | Sum(ts) => div( ~attr=clss(["typ-view", "Sum"]), diff --git a/src/haz3lweb/view/dhcode/layout/HTypDoc.re b/src/haz3lweb/view/dhcode/layout/HTypDoc.re index 8acbc0455f..3a7972f330 100644 --- a/src/haz3lweb/view/dhcode/layout/HTypDoc.re +++ b/src/haz3lweb/view/dhcode/layout/HTypDoc.re @@ -51,6 +51,7 @@ let rec mk = (~parenthesize=false, ~enforce_inline: bool, ty: Typ.t): t => { | Bool => (text("Bool"), parenthesize) | String => (text("String"), parenthesize) | Var(name) => (text(name), parenthesize) + | TypeConstructorAp(name, _) => (text(name), parenthesize) | List(ty) => ( hcats([ mk_delim("["), From e08f671bec6faee4a5818f0e1da9c2ac66fd3b11 Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Mon, 21 Aug 2023 23:20:19 -0400 Subject: [PATCH 03/56] Fix: typeHole ann bug --- src/haz3lcore/dynamics/Builtins.re | 2 +- src/haz3lcore/dynamics/Evaluator.re | 1 - src/haz3lcore/prog/Interface.re | 4 +- src/haz3lcore/statics/Self.re | 4 +- src/haz3lcore/statics/Statics.re | 85 ++++++++--- src/haz3lcore/statics/Term.re | 126 ++++++++++----- src/haz3lcore/statics/TypBase.re | 170 +++++++++++++-------- src/haz3lweb/view/CtxInspector.re | 4 +- src/haz3lweb/view/Type.re | 5 - src/haz3lweb/view/dhcode/layout/HTypDoc.re | 1 - 10 files changed, 263 insertions(+), 139 deletions(-) diff --git a/src/haz3lcore/dynamics/Builtins.re b/src/haz3lcore/dynamics/Builtins.re index 466a090039..85bda5dbe1 100644 --- a/src/haz3lcore/dynamics/Builtins.re +++ b/src/haz3lcore/dynamics/Builtins.re @@ -279,7 +279,7 @@ module Pervasives = { let ctx_init: Ctx.t = List.map( ((name, Builtin.{typ, _})) => - Ctx.VarEntry({name, parameter: "", typ, id: Id.invalid}), + Ctx.VarEntry({name, typ, id: Id.invalid}), Pervasives.builtins, ); diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index b945c73cb3..529ca04260 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -45,7 +45,6 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { | String | Var(_) | Rec(_) - | TypeConstructorAp(_, _) | Arrow(Unknown(_), Unknown(_)) | List(Unknown(_)) => Ground | Prod(tys) => diff --git a/src/haz3lcore/prog/Interface.re b/src/haz3lcore/prog/Interface.re index 77106704c8..04c9493bb5 100644 --- a/src/haz3lcore/prog/Interface.re +++ b/src/haz3lcore/prog/Interface.re @@ -1,5 +1,5 @@ exception DoesNotElaborate; -let elaborate = (map, term): DHExp.t => +let elaborate = (map, term): DHExp.t => { switch (Elaborator.uexp_elab(map, term)) { | DoesNotElaborate => let error = "Internal error: Elaboration returns None"; @@ -7,7 +7,7 @@ let elaborate = (map, term): DHExp.t => InvalidText(-666, -666, error); | Elaborates(d, _, _) => d }; - +}; exception EvalError(EvaluatorError.t); exception PostprocessError(EvaluatorPost.error); let evaluate = diff --git a/src/haz3lcore/statics/Self.re b/src/haz3lcore/statics/Self.re index f30c1e2e13..358cf46080 100644 --- a/src/haz3lcore/statics/Self.re +++ b/src/haz3lcore/statics/Self.re @@ -80,8 +80,10 @@ let of_ctr = (ctx: Ctx.t, name: Constructor.t): t => name, syn_ty: switch (Ctx.lookup_ctr(ctx, name)) { + | Some({kind: Abstract, _}) | None => None - | Some({typ, _}) => Some(typ) + | Some({kind: Singleton(typ), _}) => Some(typ) + | Some({kind: Arrow(_, t2), _}) => Some(t2) }, }); diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 65a0cc0f12..039d86303b 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -248,10 +248,49 @@ and uexp_to_info_map = | Let(p, def, body) => let (p_syn, _m) = go_pat(~is_synswitch=true, ~mode=Syn, p, m); let def_ctx = extend_let_def_ctx(ctx, p, p_syn.ctx, def); + let def_ctx = + switch (def.term) { + | Ap(fn, arg) => + switch (fn.term) { + | Constructor(ctr) => + switch (Ctx.lookup_higher_alias(def_ctx, ctr)) { + | Some((name_in, ty_in1)) => + let (ty_in2, _) = go(~mode=Syn, arg, m); + let ty = Ctx.find_parameter_type(name_in, ty_in1, ty_in2.ty); + let ctx' = Ctx.revise_tvar(def_ctx, name_in, ty); + ctx'; + | None => def_ctx + } + | _ => def_ctx + } + | _ => def_ctx + }; let (def, m) = go'(~ctx=def_ctx, ~mode=Ana(p_syn.ty), def, m); /* Analyze pattern to incorporate def type into ctx */ let (p_ana, m) = go_pat(~is_synswitch=false, ~mode=Ana(def.ty), p, m); - let (body, m) = go'(~ctx=p_ana.ctx, ~mode, body, m); + let (body, m) = + go'( + ~ctx= + switch (def.term.term) { + | Ap(fn, arg) => + switch (fn.term) { + | Constructor(ctr) => + switch (Ctx.lookup_higher_alias(p_ana.ctx, ctr)) { + | Some((name_in, ty_in1)) => + let (ty_in2, _) = go(~mode=Syn, arg, m); + let ty = Ctx.find_parameter_type(name_in, ty_in1, ty_in2.ty); + let ctx' = Ctx.revise_tvar(p_ana.ctx, name_in, ty); + ctx'; + | None => p_ana.ctx + } + | _ => p_ana.ctx + } + | _ => p_ana.ctx + }, + ~mode, + body, + m, + ); add( ~self=Just(body.ty), ~co_ctx= @@ -308,20 +347,16 @@ and uexp_to_info_map = | Sum(_) when List.mem(name, Typ.free_vars(ty_pre)) => let ty_rec = Typ.Rec("α", Typ.subst(Var("α"), name, ty_pre)); let ctx_def = - Ctx.extend_alias(ctx, name, "", UTPat.rep_id(typat), ty_rec); + Ctx.extend_alias(ctx, name, UTPat.rep_id(typat), ty_rec); (ty_rec, ctx_def, ctx_def); | _ => let ty = UTyp.to_typ(ctx, utyp); - ( - ty, - ctx, - Ctx.extend_alias(ctx, name, "", UTPat.rep_id(typat), ty), - ); + (ty, ctx, Ctx.extend_alias(ctx, name, UTPat.rep_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) + | 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) = @@ -341,6 +376,7 @@ and uexp_to_info_map = | Var(s) => s | _ => "" }; + let utyp = UTyp.remove_ap_in_def(constructor, arg, utyp); let (ty_def, ctx_def, ctx_body) = { let ty_pre = UTyp.to_typ( @@ -355,7 +391,7 @@ and uexp_to_info_map = let ty_rec = Typ.Rec("α", Typ.subst(Var("α"), constructor, ty_pre)); let ctx_def = - Ctx.extend_alias( + Ctx.extend_higher_alias( ctx, constructor, arg, @@ -364,18 +400,27 @@ and uexp_to_info_map = ); (ty_rec, ctx_def, ctx_def); | _ => - let ty = UTyp.to_typ(ctx, utyp); - ( - ty, - ctx, - Ctx.extend_alias(ctx, constructor, arg, UTPat.rep_id(typat), ty), - ); + let ctx_def = + Ctx.extend_higher_alias( + ctx, + constructor, + arg, + UTPat.rep_id(typat), + ty_pre, + ); + (ty_pre, ctx_def, ctx_def); }; }; let ctx_body = switch (Typ.get_sum_constructors(ctx, ty_def)) { | Some(sm) => - Ctx.add_ctrs(ctx_body, constructor, arg, UTyp.rep_id(utyp), sm) + Ctx.add_higher_ctrs( + ctx_body, + constructor, + arg, + UTyp.rep_id(utyp), + sm, + ) | None => ctx_body }; let ({co_ctx, ty: ty_body, _}: Info.exp, m) = @@ -449,13 +494,7 @@ and upat_to_info_map = Unknown(Internal) is used in this case */ let ctx_typ = Info.fixed_typ_pat(ctx, mode, Common(Just(Unknown(Internal)))); - let entry = - Ctx.VarEntry({ - name, - parameter: "", - id: UPat.rep_id(upat), - typ: ctx_typ, - }); + let entry = Ctx.VarEntry({name, id: UPat.rep_id(upat), typ: ctx_typ}); add(~self=Just(unknown), ~ctx=Ctx.extend(ctx, entry), m); | Tuple(ps) => let modes = Mode.of_prod(ctx, mode, List.length(ps)); diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index b762707d40..3609e0d0c5 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -109,46 +109,50 @@ module UTyp = { /* Converts a syntactic type into a semantic type */ let rec to_typ: (Ctx.t, t) => Typ.t = - (ctx, utyp) => - switch (utyp.term) { - | Invalid(_) - | MultiHole(_) => Unknown(Internal) - | EmptyHole => Unknown(TypeHole) - | Bool => Bool - | Int => Int - | Float => Float - | String => String - | Var(name) => - switch (Ctx.lookup_tvar(ctx, name)) { - | Some(_) => Var(name) - | None => Unknown(Free(name)) - } - | Arrow(u1, u2) => Arrow(to_typ(ctx, u1), to_typ(ctx, u2)) - | Tuple(us) => Prod(List.map(to_typ(ctx), us)) - | Sum(uts) => Sum(to_ctr_map(ctx, uts)) - | List(u) => List(to_typ(ctx, u)) - | Parens(u) => to_typ(ctx, u) - /* The below cases should occur only inside sums */ - | Ap(t1, t2) => - let name = - switch (t1.term) { - | Var(s) => s - | _ => "" - }; - switch (Ctx.lookup_tvar(ctx, name)) { - | Some(ty) => - let arg = ty.parameter; - let res_ty = + (ctx, utyp) => { + let res: Typ.t = + switch (utyp.term) { + | Invalid(_) + | MultiHole(_) => Unknown(Internal) + | EmptyHole => Unknown(TypeHole) + | Bool => Bool + | Int => Int + | Float => Float + | String => String + | Var(name) => + switch (Ctx.lookup_tvar(ctx, name)) { + | Some(_) => Var(name) + | None => Unknown(Free(name)) + } + | Arrow(u1, u2) => Arrow(to_typ(ctx, u1), to_typ(ctx, u2)) + | Tuple(us) => Prod(List.map(to_typ(ctx), us)) + | Sum(uts) => Sum(to_ctr_map(ctx, uts)) + | List(u) => List(to_typ(ctx, u)) + | Parens(u) => to_typ(ctx, u) + /* The below cases should occur only inside sums */ + | Ap(t1, t2) => + let name = + switch (t1.term) { + | Var(s) => s + | _ => "" + }; + switch (Ctx.lookup_tvar(ctx, name)) { + | Some(ty) => switch (ty.kind) { - | Arrow(ty_in, ty_out) => Typ.Arrow(ty_in, ty_out) - | Singleton(ty) => ty + | Arrow(ty_in, ty_out) => + switch (ty_in) { + | Var(arg) => Typ.subst(to_typ(ctx, t2), arg, ty_out) + | _ => Unknown(Internal) + } + | Singleton(_) | Abstract => Unknown(Internal) - }; - Typ.subst(to_typ(ctx, t2), arg, res_ty); - | None => Unknown(Free(name)) + } + | None => Unknown(Free(name)) + }; + | Constructor(_) => Unknown(Internal) }; - | Constructor(_) => Unknown(Internal) - } + res; + } and to_variant: (Ctx.t, variant) => option(ConstructorMap.binding(option(Typ.t))) = ctx => @@ -164,6 +168,54 @@ module UTyp = { List.filter_map(to_variant(ctx), uts), ); }; + let rec remove_ap_in_def = (ctr: string, arg: string, ty: t): t => { + let res: term = + switch (ty.term) { + | Invalid(s) => Invalid(s) + | EmptyHole => EmptyHole + | MultiHole(l) => MultiHole(l) + | Int => Int + | Float => Float + | Bool => Bool + | String => String + | List(t) => List(remove_ap_in_def(ctr, arg, t)) + | Var(string) => Var(string) + | Constructor(string) => Constructor(string) + | Arrow(t1, t2) => + Arrow( + remove_ap_in_def(ctr, arg, t1), + remove_ap_in_def(ctr, arg, t2), + ) + | Tuple(lst) => Tuple(List.map(remove_ap_in_def(ctr, arg), lst)) + | Parens(t) => Parens(remove_ap_in_def(ctr, arg, t)) + | Ap(ctr2, arg2) => + let name = + switch (ctr2.term) { + | Var(s) => s + | _ => "" + }; + if (name == ctr) { + Var(ctr); + } else { + Ap( + remove_ap_in_def(ctr, arg, ctr2), + remove_ap_in_def(ctr, arg, arg2), + ); + }; + | Sum(lst) => + let lst = + List.map( + fun + | Variant(a, b, Some(t)) => + Variant(a, b, Some(remove_ap_in_def(ctr, arg, t))) + | Variant(a, b, None) => Variant(a, b, None) + | BadEntry(t) => BadEntry(remove_ap_in_def(ctr, arg, t)), + lst, + ); + Sum(lst); + }; + {term: res, ids: ty.ids}; + }; }; module UTPat = { diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 9c0f134164..e513e0e849 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -33,8 +33,6 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) - | TypeConstructorAp(TypVar.t, t) - and sum_map = ConstructorMap.t(option(t)); [@deriving (show({with_path: false}), sexp, yojson)] @@ -93,7 +91,6 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) - | TypeConstructorAp(TypVar.t, t) and sum_map = ConstructorMap.t(option(t)); [@deriving (show({with_path: false}), sexp, yojson)] @@ -160,7 +157,6 @@ module rec Typ: { | Var(_) | Rec(_) | Sum(_) => precedence_Sum - | TypeConstructorAp(_, _) | List(_) => precedence_Const | Prod(_) => precedence_Prod | Arrow(_, _) => precedence_Arrow @@ -180,7 +176,6 @@ module rec Typ: { | Rec(y, ty) => Rec(y, subst(s, x, ty)) | List(ty) => List(subst(s, x, ty)) | Var(y) => TypVar.eq(x, y) ? s : Var(y) - | TypeConstructorAp(y, ty) => TypeConstructorAp(y, subst(s, x, ty)) }; }; @@ -217,9 +212,6 @@ module rec Typ: { | (Sum(_), _) => false | (Var(n1), Var(n2)) => n1 == n2 | (Var(_), _) => false - | (TypeConstructorAp(n1, t1), TypeConstructorAp(n2, t2)) => - n1 == n2 && eq(t1, t2) - | (TypeConstructorAp(_), _) => false }; }; @@ -242,7 +234,6 @@ module rec Typ: { ) | Prod(tys) => ListUtil.flat_map(free_vars(~bound), tys) | Rec(x, ty) => free_vars(~bound=[x, ...bound], ty) - | TypeConstructorAp(_, ty) => free_vars(~bound, ty) }; /* Lattice join on types. This is a LUB join in the hazel2 @@ -328,14 +319,6 @@ module rec Typ: { let+ ty = join'(ty1, ty2); List(ty); | (List(_), _) => None - | (TypeConstructorAp(name1, ty1), TypeConstructorAp(name2, ty2)) => - if (name1 == name2) { - let+ ty = join'(ty1, ty2); - TypeConstructorAp(name1, ty); - } else { - None; - } - | (TypeConstructorAp(_), _) => None }; } and join_sum_entries = @@ -398,8 +381,6 @@ module rec Typ: { as in current implementation Recs do not occur in the surface syntax, so we won't try to jump to them. */ Rec(name, normalize(Ctx.extend_dummy_tvar(ctx, name), ty)) - | TypeConstructorAp(name, ty) => - TypeConstructorAp(name, normalize(ctx, ty)) }; }; @@ -436,7 +417,6 @@ and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type var_entry = { name: Var.t, - parameter: Var.t, id: Id.t, typ: Typ.t, }; @@ -444,7 +424,6 @@ and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type tvar_entry = { name: TypVar.t, - parameter: TypVar.t, id: Id.t, kind: Kind.t, }; @@ -452,7 +431,7 @@ and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type entry = | VarEntry(var_entry) - | ConstructorEntry(var_entry) + | ConstructorEntry(tvar_entry) | TVarEntry(tvar_entry); [@deriving (show({with_path: false}), sexp, yojson)] @@ -460,24 +439,28 @@ and Ctx: { let extend: (t, entry) => t; let extend_tvar: (t, tvar_entry) => t; - let extend_alias: (t, TypVar.t, TypVar.t, Id.t, Typ.t) => t; + let extend_alias: (t, TypVar.t, Id.t, Typ.t) => t; + let extend_higher_alias: (t, TypVar.t, TypVar.t, Id.t, Typ.t) => t; let extend_dummy_tvar: (t, TypVar.t) => t; let lookup_tvar: (t, TypVar.t) => option(tvar_entry); let lookup_alias: (t, TypVar.t) => option(Typ.t); + let lookup_higher_alias: (t, TypVar.t) => option((TypVar.t, Typ.t)); + let revise_tvar: (t, TypVar.t, Typ.t) => t; let get_id: entry => int; let lookup_var: (t, string) => option(var_entry); - let lookup_ctr: (t, string) => option(var_entry); + let lookup_ctr: (t, string) => option(tvar_entry); let is_alias: (t, TypVar.t) => bool; - let add_ctrs: (t, TypVar.t, TypVar.t, Id.t, Typ.sum_map) => t; + let add_ctrs: (t, TypVar.t, Id.t, Typ.sum_map) => t; + let add_higher_ctrs: (t, TypVar.t, TypVar.t, Id.t, Typ.sum_map) => t; let subtract_prefix: (t, t) => option(t); let added_bindings: (t, t) => t; let filter_duplicates: t => t; let shadows_typ: (t, TypVar.t) => bool; + let find_parameter_type: (TypVar.t, Typ.t, Typ.t) => Typ.t; } = { [@deriving (show({with_path: false}), sexp, yojson)] type var_entry = { name: Var.t, - parameter: Var.t, id: Id.t, typ: Typ.t, }; @@ -485,7 +468,6 @@ and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type tvar_entry = { name: TypVar.t, - parameter: TypVar.t, id: Id.t, kind: Kind.t, }; @@ -493,35 +475,79 @@ and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type entry = | VarEntry(var_entry) - | ConstructorEntry(var_entry) + | ConstructorEntry(tvar_entry) | TVarEntry(tvar_entry); + [@deriving (show({with_path: false}), sexp, yojson)] type t = list(entry); - + let rec find_parameter_type = (name: TypVar.t, t1: Typ.t, t2: Typ.t): Typ.t => { + switch (t1, t2) { + | (Var(n1), ty) when n1 == name => ty + | (Rec(x1, t1), Rec(x2, t2)) => + find_parameter_type(name, t1, Typ.subst(Var(x1), x2, t2)) + | (Rec(_), _) => Unknown(Internal) + | (Int, _) => Unknown(Internal) + | (Float, _) => Unknown(Internal) + | (Bool, _) => Unknown(Internal) + | (String, _) => Unknown(Internal) + | (Unknown(_), _) => Unknown(Internal) + | (Arrow(t1, t2), Arrow(t1', t2')) => + switch (find_parameter_type(name, t1, t1')) { + | Unknown(Internal) => find_parameter_type(name, t2, t2') + | _ => find_parameter_type(name, t1, t1') + } + | (Arrow(_), _) => Unknown(Internal) + | (Prod(tys1), Prod(tys2)) => + switch (ListUtil.map2_opt(find_parameter_type(name), tys1, tys2)) { + | Some(tys) => + List.fold_left( + (a, b) => + if (a == Typ.Unknown(Internal)) { + b; + } else { + a; + }, + Unknown(Internal), + tys, + ) + | _ => Unknown(Internal) + } + | (Prod(_), _) => Unknown(Internal) + | (List(t1), List(t2)) => find_parameter_type(name, t1, t2) + | (List(_), _) => Unknown(Internal) + //| (Sum(sm1), Sum(sm2)) => + | (Sum(_), _) => Unknown(Internal) + | (Var(_), _) => Unknown(Internal) + }; + }; let extend = (ctx, entry) => List.cons(entry, ctx); let extend_tvar = (ctx: t, tvar_entry: tvar_entry): t => extend(ctx, TVarEntry(tvar_entry)); - let extend_alias = - (ctx: t, name: TypVar.t, parameter: TypVar.t, id: Id.t, ty: Typ.t): t => { - let ctx = extend_tvar(ctx, {name, parameter, id, kind: Singleton(ty)}); - if (parameter != "") { - extend_tvar( - ctx, - { - name: parameter, - parameter: "", - id, - kind: Singleton(Unknown(TypeHole)), - }, - ); - } else { - ctx; - }; + + let extend_alias = (ctx: t, name: TypVar.t, id: Id.t, ty: Typ.t): t => + extend_tvar(ctx, {name, id, kind: Singleton(ty)}); + let extend_higher_alias = + (ctx: t, name: TypVar.t, arg: TypVar.t, id: Id.t, ty: Typ.t): t => { + let ctx = extend_tvar(ctx, {name, id, kind: Arrow(Var(arg), ty)}); + extend_tvar(ctx, {name: arg, id, kind: Singleton(Unknown(SynSwitch))}); }; let extend_dummy_tvar = (ctx: t, name: TypVar.t) => - extend_tvar(ctx, {kind: Abstract, name, parameter: "", id: Id.invalid}); - + extend_tvar(ctx, {kind: Abstract, name, id: Id.invalid}); + let revise_tvar = (ctx: t, name: TypVar.t, typ: Typ.t): t => + List.map( + fun + | TVarEntry({name: name', id, _}) when TypVar.eq(name, name') => + TVarEntry({ + name, + id, + kind: { + Singleton(typ); + }, + }) + | entry => entry, + ctx, + ); let lookup_tvar = (ctx: t, name: TypVar.t): option(tvar_entry) => List.find_map( fun @@ -529,11 +555,11 @@ and Ctx: { | _ => None, ctx, ); - let lookup_alias = (ctx: t, t: TypVar.t): option(Typ.t) => switch (lookup_tvar(ctx, t)) { - | Some({kind: Arrow(ty_in, ty_out), _}) => Some(Arrow(ty_in, ty_out)) + | Some({kind: Arrow(_, ty), _}) | Some({kind: Singleton(ty), _}) => Some(ty) + | Some({kind: Abstract, _}) | None => None }; @@ -552,7 +578,7 @@ and Ctx: { ctx, ); - let lookup_ctr = (ctx: t, name: string): option(var_entry) => + let lookup_ctr = (ctx: t, name: string): option(tvar_entry) => List.find_map( fun | ConstructorEntry(t) when t.name == name => Some(t) @@ -565,32 +591,44 @@ and Ctx: { | Some(_) => true | None => false }; + let lookup_higher_alias = (ctx: t, t: TypVar.t): option((TypVar.t, Typ.t)) => + switch (lookup_ctr(ctx, t)) { + | Some({kind: Arrow(Var(arg), Arrow(typ, Var(_))), _}) => + Some((arg, typ)) + | _ => None + }; - let add_ctrs = - ( - ctx: t, - name: TypVar.t, - parameter: TypVar.t, - id: Id.t, - ctrs: Typ.sum_map, - ) - : t => + let add_ctrs = (ctx: t, name: TypVar.t, id: Id.t, ctrs: Typ.sum_map): t => List.map( ((ctr, typ)) => ConstructorEntry({ name: ctr, - parameter, id, - typ: + kind: switch (typ) { - | None => Var(name) - | Some(typ) => Arrow(typ, Var(name)) + | None => Singleton(Var(name)) + | Some(typ) => Singleton(Arrow(typ, Var(name))) + }, + }), + ctrs, + ) + @ ctx; + let add_higher_ctrs = + (ctx: t, name: TypVar.t, arg: TypVar.t, id: Id.t, ctrs: Typ.sum_map): t => + List.map( + ((ctr, typ)) => + ConstructorEntry({ + name: ctr, + id, + kind: + switch (typ) { + | None => Arrow(Var(arg), Var(name)) + | Some(typ) => Arrow(Var(arg), Arrow(typ, Var(name))) }, }), ctrs, ) @ ctx; - let subtract_prefix = (ctx: t, prefix_ctx: t): option(t) => { // NOTE: does not check that the prefix is an actual prefix let prefix_length = List.length(prefix_ctx); @@ -644,13 +682,13 @@ and Ctx: { and Kind: { [@deriving (show({with_path: false}), sexp, yojson)] type t = - | Arrow(Typ.t, Typ.t) | Singleton(Typ.t) + | Arrow(Typ.t, Typ.t) | Abstract; } = { [@deriving (show({with_path: false}), sexp, yojson)] type t = - | Arrow(Typ.t, Typ.t) | Singleton(Typ.t) + | Arrow(Typ.t, Typ.t) | Abstract; }; diff --git a/src/haz3lweb/view/CtxInspector.re b/src/haz3lweb/view/CtxInspector.re index a148f149cc..98d0ea6b40 100644 --- a/src/haz3lweb/view/CtxInspector.re +++ b/src/haz3lweb/view/CtxInspector.re @@ -15,8 +15,7 @@ let context_entry_view = (~inject, entry: Haz3lcore.Ctx.entry): Node.t => { ]), ); switch (entry) { - | VarEntry({name, typ, _}) - | ConstructorEntry({name, typ, _}) => + | VarEntry({name, typ, _}) => div_c( "context-entry", [ @@ -25,6 +24,7 @@ let context_entry_view = (~inject, entry: Haz3lcore.Ctx.entry): Node.t => { Type.view(typ), ], ) + | ConstructorEntry({name, kind, _}) | TVarEntry({name, kind, _}) => div_c( "context-entry", diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 80ba3cbe41..ae88419f0e 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -65,11 +65,6 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => text(")"), ], ) - | TypeConstructorAp(t, ts) => - div( - ~attr=clss(["typ-view", "TypeConstructorAp"]), - [text(t), text("("), view_ty(ts), text(")")], - ) | Sum(ts) => div( ~attr=clss(["typ-view", "Sum"]), diff --git a/src/haz3lweb/view/dhcode/layout/HTypDoc.re b/src/haz3lweb/view/dhcode/layout/HTypDoc.re index 3a7972f330..8acbc0455f 100644 --- a/src/haz3lweb/view/dhcode/layout/HTypDoc.re +++ b/src/haz3lweb/view/dhcode/layout/HTypDoc.re @@ -51,7 +51,6 @@ let rec mk = (~parenthesize=false, ~enforce_inline: bool, ty: Typ.t): t => { | Bool => (text("Bool"), parenthesize) | String => (text("String"), parenthesize) | Var(name) => (text(name), parenthesize) - | TypeConstructorAp(name, _) => (text(name), parenthesize) | List(ty) => ( hcats([ mk_delim("["), From 13a0d20274fa209d964d41a7db7f9bace3bde2a5 Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Tue, 22 Aug 2023 14:11:19 -0400 Subject: [PATCH 04/56] Fix: castfailed bug --- src/haz3lcore/dynamics/Evaluator.re | 1 + src/haz3lcore/statics/Statics.re | 68 +++++++++++----------- src/haz3lcore/statics/TypBase.re | 13 ++++- src/haz3lweb/view/Type.re | 1 + src/haz3lweb/view/dhcode/layout/HTypDoc.re | 1 + 5 files changed, 49 insertions(+), 35 deletions(-) diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 529ca04260..29f1827111 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -46,6 +46,7 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { | Var(_) | Rec(_) | Arrow(Unknown(_), Unknown(_)) + | Parameter(_) => Hole | List(Unknown(_)) => Ground | Prod(tys) => if (List.for_all( diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 039d86303b..7284955ede 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -248,45 +248,45 @@ and uexp_to_info_map = | Let(p, def, body) => let (p_syn, _m) = go_pat(~is_synswitch=true, ~mode=Syn, p, m); let def_ctx = extend_let_def_ctx(ctx, p, p_syn.ctx, def); - let def_ctx = - switch (def.term) { - | Ap(fn, arg) => - switch (fn.term) { - | Constructor(ctr) => - switch (Ctx.lookup_higher_alias(def_ctx, ctr)) { - | Some((name_in, ty_in1)) => - let (ty_in2, _) = go(~mode=Syn, arg, m); - let ty = Ctx.find_parameter_type(name_in, ty_in1, ty_in2.ty); - let ctx' = Ctx.revise_tvar(def_ctx, name_in, ty); - ctx'; - | None => def_ctx - } - | _ => def_ctx - } - | _ => def_ctx - }; + //let def_ctx = + // switch (def.term) { + // | Ap(fn, arg) => + // switch (fn.term) { + // | Constructor(ctr) => + // switch (Ctx.lookup_higher_alias(def_ctx, ctr)) { + // | Some((name_in, ty_in1)) => + // let (ty_in2, _) = go(~mode=Syn, arg, m); + // let ty = Ctx.find_parameter_type(name_in, ty_in1, ty_in2.ty); + // let ctx' = Ctx.revise_tvar(def_ctx, name_in, ty); + // ctx'; + // | None => def_ctx + // } + // | _ => def_ctx + // } + // | _ => def_ctx + // }; let (def, m) = go'(~ctx=def_ctx, ~mode=Ana(p_syn.ty), def, m); /* Analyze pattern to incorporate def type into ctx */ let (p_ana, m) = go_pat(~is_synswitch=false, ~mode=Ana(def.ty), p, m); let (body, m) = go'( - ~ctx= - switch (def.term.term) { - | Ap(fn, arg) => - switch (fn.term) { - | Constructor(ctr) => - switch (Ctx.lookup_higher_alias(p_ana.ctx, ctr)) { - | Some((name_in, ty_in1)) => - let (ty_in2, _) = go(~mode=Syn, arg, m); - let ty = Ctx.find_parameter_type(name_in, ty_in1, ty_in2.ty); - let ctx' = Ctx.revise_tvar(p_ana.ctx, name_in, ty); - ctx'; - | None => p_ana.ctx - } - | _ => p_ana.ctx - } - | _ => p_ana.ctx - }, + ~ctx=p_ana.ctx, + //switch (def.term.term) { + //| Ap(fn, arg) => + // switch (fn.term) { + // | Constructor(ctr) => + // switch (Ctx.lookup_higher_alias(p_ana.ctx, ctr)) { + // | Some((name_in, ty_in1)) => + // let (ty_in2, _) = go(~mode=Syn, arg, m); + // let ty = Ctx.find_parameter_type(name_in, ty_in1, ty_in2.ty); + // let ctx' = Ctx.revise_tvar(p_ana.ctx, name_in, ty); + // ctx'; + // | None => p_ana.ctx + // } + // | _ => p_ana.ctx + // } + //| _ => p_ana.ctx + //}, ~mode, body, m, diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index e513e0e849..9b04b0fdc2 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -33,6 +33,7 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) + | Parameter(TypVar.t) and sum_map = ConstructorMap.t(option(t)); [@deriving (show({with_path: false}), sexp, yojson)] @@ -91,6 +92,7 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) + | Parameter(TypVar.t) and sum_map = ConstructorMap.t(option(t)); [@deriving (show({with_path: false}), sexp, yojson)] @@ -157,6 +159,7 @@ module rec Typ: { | Var(_) | Rec(_) | Sum(_) => precedence_Sum + | Parameter(_) | List(_) => precedence_Const | Prod(_) => precedence_Prod | Arrow(_, _) => precedence_Arrow @@ -176,6 +179,7 @@ module rec Typ: { | Rec(y, ty) => Rec(y, subst(s, x, ty)) | List(ty) => List(subst(s, x, ty)) | Var(y) => TypVar.eq(x, y) ? s : Var(y) + | Parameter(y) => Parameter(y) }; }; @@ -189,6 +193,8 @@ module rec Typ: { but this will change when polymorphic types are implemented */ let rec eq = (t1: t, t2: t): bool => { switch (t1, t2) { + | (_, Parameter(_)) + | (Parameter(_), _) => true | (Rec(x1, t1), Rec(x2, t2)) => eq(t1, subst(Var(x1), x2, t2)) | (Rec(_), _) => false | (Int, Int) => true @@ -234,6 +240,7 @@ module rec Typ: { ) | Prod(tys) => ListUtil.flat_map(free_vars(~bound), tys) | Rec(x, ty) => free_vars(~bound=[x, ...bound], ty) + | Parameter(v) => List.mem(v, bound) ? [] : [v] }; /* Lattice join on types. This is a LUB join in the hazel2 @@ -254,6 +261,8 @@ module rec Typ: { Some(Unknown(join_type_provenance(p1, p2))) | (Unknown(_), ty) | (ty, Unknown(Internal | SynSwitch)) => Some(ty) + | (Parameter(_), ty) => Some(ty) + | (ty, Parameter(_)) => Some(ty) | (Var(n1), Var(n2)) => if (n1 == n2) { Some(Var(n1)); @@ -381,6 +390,7 @@ module rec Typ: { as in current implementation Recs do not occur in the surface syntax, so we won't try to jump to them. */ Rec(name, normalize(Ctx.extend_dummy_tvar(ctx, name), ty)) + | Parameter(_) => ty }; }; @@ -518,6 +528,7 @@ and Ctx: { //| (Sum(sm1), Sum(sm2)) => | (Sum(_), _) => Unknown(Internal) | (Var(_), _) => Unknown(Internal) + | (Parameter(_), _) => Unknown(Internal) }; }; let extend = (ctx, entry) => List.cons(entry, ctx); @@ -530,7 +541,7 @@ and Ctx: { let extend_higher_alias = (ctx: t, name: TypVar.t, arg: TypVar.t, id: Id.t, ty: Typ.t): t => { let ctx = extend_tvar(ctx, {name, id, kind: Arrow(Var(arg), ty)}); - extend_tvar(ctx, {name: arg, id, kind: Singleton(Unknown(SynSwitch))}); + extend_tvar(ctx, {name: arg, id, kind: Singleton(Parameter(arg))}); }; let extend_dummy_tvar = (ctx: t, name: TypVar.t) => extend_tvar(ctx, {kind: Abstract, name, id: Id.invalid}); diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index ae88419f0e..cc14fc3fd4 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -33,6 +33,7 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => | Float => ty_view("Float", "Float") | String => ty_view("String", "String") | Bool => ty_view("Bool", "Bool") + | Parameter(name) => ty_view("Parameter", name) | Var(name) => ty_view("Var", name) | Rec(x, t) => div( diff --git a/src/haz3lweb/view/dhcode/layout/HTypDoc.re b/src/haz3lweb/view/dhcode/layout/HTypDoc.re index 8acbc0455f..7a525ed73f 100644 --- a/src/haz3lweb/view/dhcode/layout/HTypDoc.re +++ b/src/haz3lweb/view/dhcode/layout/HTypDoc.re @@ -50,6 +50,7 @@ let rec mk = (~parenthesize=false, ~enforce_inline: bool, ty: Typ.t): t => { | Float => (text("Float"), parenthesize) | Bool => (text("Bool"), parenthesize) | String => (text("String"), parenthesize) + | Parameter(name) | Var(name) => (text(name), parenthesize) | List(ty) => ( hcats([ From 0bb43a626477d57041badc827530e9105b285fb2 Mon Sep 17 00:00:00 2001 From: disconcision Date: Thu, 9 Feb 2023 15:03:43 -0500 Subject: [PATCH 05/56] merge in poly-adt --- src/haz3lcore/dynamics/DH.re | 16 ++++- src/haz3lcore/dynamics/Elaborator.re | 24 ++++++- src/haz3lcore/dynamics/Evaluator.re | 44 +++++++++--- src/haz3lcore/dynamics/EvaluatorPost.re | 19 +++++ src/haz3lcore/dynamics/Substitution.re | 2 + src/haz3lcore/lang/Form.re | 5 ++ src/haz3lcore/statics/Kind.re | 5 +- src/haz3lcore/statics/MakeTerm.re | 19 ++++- src/haz3lcore/statics/Statics.re | 66 ++++++++++++++++- src/haz3lcore/statics/Term.re | 63 ++++++++++++++--- src/haz3lcore/statics/TermBase.re | 74 ++++++++++++++++++++ src/haz3lcore/statics/TypBase.re | 57 +++++++++++++++ src/haz3lcore/zipper/EditorUtil.re | 2 + src/haz3lweb/view/CursorInspector.re | 11 ++- src/haz3lweb/view/LangDoc.re | 31 ++++++++ src/haz3lweb/view/Type.re | 11 ++- src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re | 14 +++- src/haz3lweb/view/dhcode/layout/HTypDoc.re | 18 ++++- 18 files changed, 446 insertions(+), 35 deletions(-) diff --git a/src/haz3lcore/dynamics/DH.re b/src/haz3lcore/dynamics/DH.re index 61d7483930..72f08d00a6 100644 --- a/src/haz3lcore/dynamics/DH.re +++ b/src/haz3lcore/dynamics/DH.re @@ -15,6 +15,8 @@ module rec DHExp: { | Let(DHPat.t, t, t) | FixF(Var.t, Typ.t, t) | Fun(DHPat.t, Typ.t, t, option(Var.t)) + | TypFun(Term.UTPat.t, t) + | TypAp(t, Typ.t) | Ap(t, t) | ApBuiltin(string, list(t)) | TestLit(KeywordID.t) @@ -69,6 +71,8 @@ module rec DHExp: { | Let(DHPat.t, t, t) | FixF(Var.t, Typ.t, t) | Fun(DHPat.t, Typ.t, t, option(Var.t)) + | TypFun(Term.UTPat.t, t) + | TypAp(t, Typ.t) | Ap(t, t) | ApBuiltin(string, list(t)) | TestLit(KeywordID.t) @@ -107,8 +111,10 @@ module rec DHExp: { | Let(_, _, _) => "Let" | FixF(_, _, _) => "FixF" | Fun(_, _, _, _) => "Fun" + | TypFun(_) => "TypFun" | Closure(_, _) => "Closure" | Ap(_, _) => "Ap" + | TypAp(_) => "TypAp" | ApBuiltin(_, _) => "ApBuiltin" | TestLit(_) => "TestLit" | BoolLit(_) => "BoolLit" @@ -139,7 +145,7 @@ module rec DHExp: { | xs => Tuple(xs); let cast = (d: t, t1: Typ.t, t2: Typ.t): t => - if (Typ.eq(t1, t2) || t2 == Unknown(SynSwitch)) { + if (Typ.eq_syntactic(t1, t2) || t2 == Unknown(SynSwitch)) { d; } else { Cast(d, t1, t2); @@ -163,7 +169,9 @@ module rec DHExp: { | Let(dp, b, c) => Let(dp, strip_casts(b), strip_casts(c)) | FixF(a, b, c) => FixF(a, b, strip_casts(c)) | Fun(a, b, c, d) => Fun(a, b, strip_casts(c), d) + | TypFun(a, b) => TypFun(a, strip_casts(b)) | Ap(a, b) => Ap(strip_casts(a), strip_casts(b)) + | TypAp(a, b) => TypAp(strip_casts(a), b) | ApBuiltin(fn, args) => ApBuiltin(fn, List.map(strip_casts, args)) | BinBoolOp(a, b, c) => BinBoolOp(a, strip_casts(b), strip_casts(c)) | BinIntOp(a, b, c) => BinIntOp(a, strip_casts(b), strip_casts(c)) @@ -216,6 +224,10 @@ module rec DHExp: { f1 == f2 && ty1 == ty2 && fast_equal(d1, d2) | (Fun(dp1, ty1, d1, s1), Fun(dp2, ty2, d2, s2)) => dp1 == dp2 && ty1 == ty2 && fast_equal(d1, d2) && s1 == s2 + | (TypFun(_tpat1, d1), TypFun(_tpat2, d2)) => + // TODO (poly) + fast_equal(d1, d2) + | (TypAp(d1, ty1), TypAp(d2, ty2)) => fast_equal(d1, d2) && ty1 == ty2 | (Ap(d11, d21), Ap(d12, d22)) | (Cons(d11, d21), Cons(d12, d22)) => fast_equal(d11, d12) && fast_equal(d21, d22) @@ -250,7 +262,9 @@ module rec DHExp: { | (Let(_), _) | (FixF(_), _) | (Fun(_), _) + | (TypFun(_), _) | (Ap(_), _) + | (TypAp(_), _) | (ApBuiltin(_), _) | (Cons(_), _) | (ListConcat(_), _) diff --git a/src/haz3lcore/dynamics/Elaborator.re b/src/haz3lcore/dynamics/Elaborator.re index 9911b37710..ef76735da6 100644 --- a/src/haz3lcore/dynamics/Elaborator.re +++ b/src/haz3lcore/dynamics/Elaborator.re @@ -53,6 +53,16 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => let (_, ana_out) = Typ.matched_arrow(ana_ty); let (self_in, _) = Typ.matched_arrow(self_ty); DHExp.cast(d, Arrow(self_in, ana_out), ana_ty); + | TypFun(_) => + switch (ana_ty) { + | Unknown(prov) => + DHExp.cast( + d, + Forall({item: Unknown(prov), name: "grounded_forall"}), + ana_ty, + ) + | _ => d + } | Tuple(ds) => switch (ana_ty) { | Unknown(prov) => @@ -63,7 +73,7 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | Ap(Constructor(_), _) | Constructor(_) => switch (ana_ty, self_ty) { - | (Unknown(prov), Rec(_, Sum(_))) + | (Unknown(prov), Rec({item: Sum(_), _})) | (Unknown(prov), Sum(_)) => DHExp.cast(d, self_ty, Unknown(prov)) | _ => d } @@ -97,7 +107,10 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | BinIntOp(_) | BinFloatOp(_) | BinStringOp(_) - | TestLit(_) => DHExp.cast(d, self_ty, ana_ty) + | TestLit(_) + | TypAp(_) => + // TODO: check with andrew + DHExp.cast(d, self_ty, ana_ty) }; }; @@ -145,6 +158,10 @@ let rec dhexp_of_uexp = let* d1 = dhexp_of_uexp(m, body); let+ ty = fixed_pat_typ(m, p); DHExp.Fun(dp, ty, d1, None); + | TypFun(tpat, body) => + // TODO (typfun) + let+ d1 = dhexp_of_uexp(m, body); + DHExp.TypFun(tpat, d1); | Tuple(es) => let+ ds = es |> List.map(dhexp_of_uexp(m)) |> OptUtil.sequence; DHExp.Tuple(ds); @@ -241,6 +258,9 @@ let rec dhexp_of_uexp = let* c_fn = dhexp_of_uexp(m, fn); let+ c_arg = dhexp_of_uexp(m, arg); DHExp.Ap(c_fn, c_arg); + | TypAp(fn, uty_arg) => + let+ d_fn = dhexp_of_uexp(m, fn); + DHExp.TypAp(d_fn, Term.UTyp.to_typ(ctx, uty_arg)); | If(scrut, e1, e2) => let* d_scrut = dhexp_of_uexp(m, scrut); let* d1 = dhexp_of_uexp(m, e1); diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 529ca04260..17568ca412 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -23,6 +23,11 @@ let const_unknown: 'a => Typ.t = _ => Unknown(Internal); let grounded_Arrow = NotGroundOrHole(Arrow(Unknown(Internal), Unknown(Internal))); +// TODO (typfun): Maybe the Forall should allow a hole in the variable position? +let grounded_Forall = + NotGroundOrHole( + Forall({item: Unknown(Internal), name: "grounded_forall"}), + ); let grounded_Prod = length => NotGroundOrHole(Prod(ListUtil.replicate(length, Typ.Unknown(Internal)))); let grounded_Sum = (sm: Typ.sum_map): ground_cases => { @@ -61,6 +66,7 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { | Sum(sm) => sm |> ConstructorMap.is_ground(is_ground_arg) ? Ground : grounded_Sum(sm) | Arrow(_, _) => grounded_Arrow + | Forall(_) => grounded_Forall | List(_) => grounded_List }; }; @@ -177,8 +183,8 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => | None => DoesNotMatch } - | (Ap(_, _), Cast(d, Sum(_) | Rec(_, Sum(_)), Unknown(_))) - | (Ap(_, _), Cast(d, Unknown(_), Sum(_) | Rec(_, Sum(_)))) => + | (Ap(_, _), Cast(d, Sum(_) | Rec({item: Sum(_), _}), Unknown(_))) + | (Ap(_, _), Cast(d, Unknown(_), Sum(_) | Rec({item: Sum(_), _}))) => matches(dp, d) | (Ap(_, _), _) => DoesNotMatch @@ -285,7 +291,11 @@ and matches_cast_Sum = matches(dp, DHExp.apply_casts(d', side_casts)) | _ => DoesNotMatch } - | Cast(d', Sum(sm1) | Rec(_, Sum(sm1)), Sum(sm2) | Rec(_, Sum(sm2))) => + | Cast( + d', + Sum(sm1) | Rec({item: Sum(sm1), _}), + Sum(sm2) | Rec({item: Sum(sm2), _}), + ) => switch (cast_sum_maps(sm1, sm2)) { | Some(castmap) => matches_cast_Sum(ctr, dp, d', [castmap, ...castmaps]) | None => DoesNotMatch @@ -298,6 +308,7 @@ and matches_cast_Sum = | InvalidText(_) | Let(_) | Ap(_) + | TypAp(_) | ApBuiltin(_) | BinBoolOp(_) | BinIntOp(_) @@ -312,6 +323,7 @@ and matches_cast_Sum = | BoundVar(_) | FixF(_) | Fun(_) + | TypFun(_) | BoolLit(_) | IntLit(_) | FloatLit(_) @@ -389,7 +401,9 @@ and matches_cast_Tuple = | Let(_, _, _) => IndetMatch | FixF(_, _, _) => DoesNotMatch | Fun(_, _, _, _) => DoesNotMatch - | Closure(_, Fun(_)) => DoesNotMatch + | TypFun(_) => DoesNotMatch + | TypAp(_) => DoesNotMatch + | Closure(_, Fun(_) | TypFun(_)) => DoesNotMatch | Closure(_, _) => IndetMatch | Ap(_, _) => IndetMatch | ApBuiltin(_, _) => IndetMatch @@ -526,6 +540,8 @@ and matches_cast_Cons = | Let(_, _, _) => IndetMatch | FixF(_, _, _) => DoesNotMatch | Fun(_, _, _, _) => DoesNotMatch + | TypFun(_) => DoesNotMatch + | TypAp(_) => DoesNotMatch | Closure(_, d') => matches_cast_Cons(dp, d', elt_casts) | Ap(_, _) => IndetMatch | ApBuiltin(_, _) => IndetMatch @@ -672,6 +688,15 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = evaluate(env', d'); | Fun(_) => BoxedValue(Closure(env, d)) |> return + | TypFun(_) => BoxedValue(Closure(env, d)) |> return + + | TypAp(d1, _ty) => + let* r1 = evaluate(env, d1); + switch (r1) { + | BoxedValue(Closure(closure_env, TypFun(_, d3))) => + evaluate(closure_env, d3) + | _ => failwith("InvalidBoxedTypFun") + }; | Ap(d1, d2) => let* r1 = evaluate(env, d1); @@ -978,7 +1003,8 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = lambda closures are BoxedValues; other closures are all Indet. */ | Closure(_, d') => switch (d') { - | Fun(_) => BoxedValue(d) |> return + | Fun(_) + | TypFun(_) => BoxedValue(d) |> return | _ => Indet(d) |> return } @@ -1023,7 +1049,7 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = /* by canonical forms, d1' must be of the form d ?> */ switch (d1') { | Cast(d1'', ty'', Unknown(_)) => - if (Typ.eq(ty'', ty')) { + if (Typ.eq_syntactic(ty'', ty')) { BoxedValue(d1'') |> return; } else { Indet(FailedCast(d1', ty, ty')) |> return; @@ -1045,7 +1071,7 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = BoxedValue(Cast(d1', ty, ty')) |> return | (NotGroundOrHole(_), NotGroundOrHole(_)) => /* they might be eq in this case, so remove cast if so */ - if (Typ.eq(ty, ty')) { + if (Typ.eq_syntactic(ty, ty')) { result |> return; } else { BoxedValue(Cast(d1', ty, ty')) |> return; @@ -1063,7 +1089,7 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = | (Hole, Ground) => switch (d1') { | Cast(d1'', ty'', Unknown(_)) => - if (Typ.eq(ty'', ty')) { + if (Typ.eq_syntactic(ty'', ty')) { Indet(d1'') |> return; } else { Indet(FailedCast(d1', ty, ty')) |> return; @@ -1085,7 +1111,7 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = Indet(Cast(d1', ty, ty')) |> return | (NotGroundOrHole(_), NotGroundOrHole(_)) => /* it might be eq in this case, so remove cast if so */ - if (Typ.eq(ty, ty')) { + if (Typ.eq_syntactic(ty, ty')) { result |> return; } else { Indet(Cast(d1', ty, ty')) |> return; diff --git a/src/haz3lcore/dynamics/EvaluatorPost.re b/src/haz3lcore/dynamics/EvaluatorPost.re index 18d4ea2b44..db405f5df1 100644 --- a/src/haz3lcore/dynamics/EvaluatorPost.re +++ b/src/haz3lcore/dynamics/EvaluatorPost.re @@ -70,6 +70,10 @@ let rec pp_eval = (d: DHExp.t): m(DHExp.t) => let* d2' = pp_eval(d2); Ap(d1', d2') |> return; + | TypAp(d1, ty) => + let* d1' = pp_eval(d1); + TypAp(d1', ty) |> return; + | ApBuiltin(f, args) => let* args' = args |> List.map(pp_eval) |> sequence; ApBuiltin(f, args') |> return; @@ -151,6 +155,7 @@ let rec pp_eval = (d: DHExp.t): m(DHExp.t) => | Let(_) | ConsistentCase(_) | Fun(_) + | TypFun(_) | EmptyHole(_) | NonEmptyHole(_) | ExpandingKeyword(_) @@ -176,6 +181,10 @@ let rec pp_eval = (d: DHExp.t): m(DHExp.t) => let* d = pp_uneval(env, d); Fun(dp, ty, d, s) |> return; + | TypFun(tpat, d1) => + let* d1' = pp_uneval(env, d1); + TypFun(tpat, d1') |> return; + | Let(dp, d1, d2) => /* d1 should already be evaluated, d2 is not */ let* d1 = pp_eval(d1); @@ -292,11 +301,19 @@ and pp_uneval = (env: ClosureEnvironment.t, d: DHExp.t): m(DHExp.t) => let* d'' = pp_uneval(env, d'); Fun(dp, ty, d'', s) |> return; + | TypFun(tpat, d1) => + let* d1' = pp_uneval(env, d1); + TypFun(tpat, d1') |> return; + | Ap(d1, d2) => let* d1' = pp_uneval(env, d1); let* d2' = pp_uneval(env, d2); Ap(d1', d2') |> return; + | TypAp(d1, ty) => + let* d1' = pp_uneval(env, d1); + TypAp(d1', ty) |> return; + | ApBuiltin(f, args) => let* args' = args |> List.map(pp_uneval(env)) |> sequence; ApBuiltin(f, args') |> return; @@ -449,6 +466,8 @@ let rec track_children_of_hole = | BoundVar(_) => hii | FixF(_, _, d) | Fun(_, _, d, _) + | TypFun(_, d) + | TypAp(d, _) | Prj(d, _) | Cast(d, _, _) | FailedCast(d, _, _) diff --git a/src/haz3lcore/dynamics/Substitution.re b/src/haz3lcore/dynamics/Substitution.re index 92f8cff0fe..0b4ad84aa7 100644 --- a/src/haz3lcore/dynamics/Substitution.re +++ b/src/haz3lcore/dynamics/Substitution.re @@ -38,6 +38,7 @@ let rec subst_var = (d1: DHExp.t, x: Var.t, d2: DHExp.t): DHExp.t => let d3 = subst_var(d1, x, d3); Fun(dp, ty, d3, s); } + | TypFun(tpat, d3) => TypFun(tpat, subst_var(d1, x, d3)) | Closure(env, d3) => /* Closure shouldn't appear during substitution (which only is called from elaboration currently) */ @@ -48,6 +49,7 @@ let rec subst_var = (d1: DHExp.t, x: Var.t, d2: DHExp.t): DHExp.t => let d3 = subst_var(d1, x, d3); let d4 = subst_var(d1, x, d4); Ap(d3, d4); + | TypAp(d3, ty) => TypAp(subst_var(d1, x, d3), ty) | ApBuiltin(ident, args) => let args = List.map(subst_var(d1, x), args); ApBuiltin(ident, args); diff --git a/src/haz3lcore/lang/Form.re b/src/haz3lcore/lang/Form.re index f115522c3c..03b092232c 100644 --- a/src/haz3lcore/lang/Form.re +++ b/src/haz3lcore/lang/Form.re @@ -255,10 +255,15 @@ let forms: list((string, t)) = [ ("parens_pat", mk(ii, ["(", ")"], mk_op(Pat, [Pat]))), ("parens_typ", mk(ii, ["(", ")"], mk_op(Typ, [Typ]))), ("fun_", mk(ds, ["fun", "->"], mk_pre(P.fun_, Exp, [Pat]))), + ("typfun", mk(ds, ["typfun", "->"], mk_pre(P.fun_, Exp, [TPat]))), + ("forall", mk(ds, ["forall", "->"], mk_pre(P.fun_, Typ, [TPat]))), + ("rec", mk(ds, ["rec", "->"], mk_pre(P.fun_, Typ, [TPat]))), ("if_", mk(ds, ["if", "then", "else"], mk_pre(P.if_, Exp, [Exp, Exp]))), ("ap_exp", mk(ii, ["(", ")"], mk_post(P.ap, Exp, [Exp]))), ("ap_pat", mk(ii, ["(", ")"], mk_post(P.ap, Pat, [Pat]))), ("ap_typ", mk(ii, ["(", ")"], mk_post(P.ap, Typ, [Typ]))), + ("ap_exp_typ", mk(ii, ["@<", ">"], mk_post(P.ap, Exp, [Typ]))), + ("at_sign", mk_nul_infix("@", P.eqs)), // HACK: SUBSTRING REQ ("let_", mk(ds, ["let", "=", "in"], mk_pre(P.let_, Exp, [Pat, Exp]))), ( "type_alias", diff --git a/src/haz3lcore/statics/Kind.re b/src/haz3lcore/statics/Kind.re index 8db5638e94..cc3b0e6d34 100644 --- a/src/haz3lcore/statics/Kind.re +++ b/src/haz3lcore/statics/Kind.re @@ -1 +1,4 @@ -include TypBase.Kind; +[@deriving (show({with_path: false}), sexp, yojson)] +type t = + | Singleton(TypBase.t) + | Abstract; diff --git a/src/haz3lcore/statics/MakeTerm.re b/src/haz3lcore/statics/MakeTerm.re index 1c170c63ee..35030a7b58 100644 --- a/src/haz3lcore/statics/MakeTerm.re +++ b/src/haz3lcore/statics/MakeTerm.re @@ -226,6 +226,7 @@ and exp_term: unsorted => (UExp.term, list(Id.t)) = { | (["-"], []) => UnOp(Int(Minus), r) | (["!"], []) => UnOp(Bool(Not), r) | (["fun", "->"], [Pat(pat)]) => Fun(pat, r) + | (["typfun", "->"], [TPat(tpat)]) => TypFun(tpat, r) | (["let", "=", "in"], [Pat(pat), Exp(def)]) => Let(pat, def, r) | (["type", "=", "in"], [TPat(tpat), Typ(def)]) => TyAlias(tpat, def, r) @@ -241,9 +242,13 @@ and exp_term: unsorted => (UExp.term, list(Id.t)) = { | ([(_id, t)], []) => switch (t) { | (["()"], []) => (l.term, l.ids) //TODO(andrew): new ap error - | (["(", ")"], [Exp(arg)]) => ret(Ap(l, arg)) - | _ => ret(hole(tm)) - } + ret( + switch (t) { + | (["(", ")"], [Exp(arg)]) => Ap(l, arg) + | (["@<", ">"], [Typ(ty)]) => TypAp(l, ty) + | _ => hole(tm) + }, + ) | _ => ret(hole(tm)) } | Bin(Exp(l), tiles, Exp(r)) as tm => @@ -400,6 +405,14 @@ and typ_term: unsorted => (UTyp.term, list(Id.t)) = { | Pre(tiles, Typ(t)) as tm => switch (tiles) { | ([(_, (["+"], []))], []) => ret(Sum([parse_sum_term(t)])) + | ([(_id, x)], []) => + ret( + switch (x) { + | (["forall", "->"], [TPat(tpat)]) => Forall(tpat, t) + | (["rec", "->"], [TPat(tpat)]) => Rec(tpat, t) + | _ => hole(tm) + }, + ) | _ => ret(hole(tm)) } | Bin(Typ(t1), tiles, Typ(t2)) as tm when is_typ_bsum(tiles) != None => diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 1fb4d040c5..32ccd26f48 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -236,6 +236,11 @@ and uexp_to_info_map = ~co_ctx=CoCtx.union([fn.co_ctx, arg.co_ctx]), m, ); + | TypAp(fn, utyp) => + let (fn, m_fn) = go(~mode=Typ.ap_mode, fn); + let Typ.{item: ty_body, _} = Typ.matched_forall(fn.ty); + let ty = Term.UTyp.to_typ(ctx, utyp); + add(~self=Just(Typ.subst(ty, ty_body)), ~free=fn.free, m_fn); | Fun(p, e) => let (mode_pat, mode_body) = Mode.of_arrow(ctx, mode); let (p, m) = go_pat(~is_synswitch=false, ~mode=mode_pat, p, m); @@ -245,6 +250,25 @@ and uexp_to_info_map = ~co_ctx=CoCtx.mk(ctx, p.ctx, e.co_ctx), m, ); + | TypFun({term: Var(name), _} as utpat, body) => + let mode_body = Typ.matched_forall_mode(mode); + let m_typat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; + let ctx_body = Ctx.add_abstract(ctx, name, Term.UTPat.rep_id(utpat)); + let (body, m_body) = go'(~ctx=ctx_body, ~mode=mode_body, body); + add( + ~self=Just(Forall({item: body.ty, name})), + ~free=body.free, + union_m([m_typat, m_body]), + ); + | TypFun(utpat, body) => + let mode_body = Typ.matched_forall_mode(mode); + let m_typat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; + let (body, m_body) = go(~mode=mode_body, body); + add( + ~self=Just(Forall({item: body.ty, name: "expected_type_variable"})), + ~free=body.free, + union_m([m_typat, m_body]), + ); | Let(p, def, body) => let (p_syn, _m) = go_pat(~is_synswitch=true, ~mode=Syn, p, m); let def_ctx = extend_let_def_ctx(ctx, p, p_syn.ctx, def); @@ -298,7 +322,7 @@ and uexp_to_info_map = /* 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 won't be noticed. But we need to check for free + 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. */ @@ -314,6 +338,19 @@ and uexp_to_info_map = let ty = UTyp.to_typ(ctx, utyp); (ty, ctx, Ctx.extend_alias(ctx, name, UTPat.rep_id(typat), ty)); }; + /* 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)) { @@ -334,6 +371,10 @@ and uexp_to_info_map = go'(~ctx, ~mode, body, m); let m = utyp_to_info_map(~ctx, ~ancestors, utyp, m) |> snd; add(~self=Just(ty_body), ~co_ctx, m); + | _ => + let (Info.{free, ty: ty_body, _}, m_body) = go'(~ctx, ~mode, body); + let m_typ = utyp_to_info_map(~ctx, ~ancestors, utyp) |> snd; + add(~self=Just(ty_body), ~free, union_m([m_typat, m_body, m_typ])); }; }; } @@ -472,7 +513,28 @@ and utyp_to_info_map = (m, []), variants, ); - add(m); + add(union_m(ms)); + | Forall({term: Var(_), _} as utpat, tbody) => + /* NOTE FROM ANDREW: probably want to add var to the body's ctx in this case? */ + let m = + utyp_to_info_map(tbody, ~ctx, ~ancestors, ~expects=TypeExpected) |> snd; + let m_tpat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; + add(union_m([m, m_tpat])); // TODO: check with andrew + | Forall(utpat, tbody) => + let m = + utyp_to_info_map(tbody, ~ctx, ~ancestors, ~expects=TypeExpected) |> snd; + let m_tpat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; + add(union_m([m, m_tpat])); // TODO: check with andrew + | Rec(utpat, tbody) => + /* NOTE FROM ANDREW: probably want to add var to the body's ctx in this case? */ + let m = + utyp_to_info_map(tbody, ~ctx, ~ancestors, ~expects=TypeExpected) |> snd; + let m_tpat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; + add(union_m([m, m_tpat])); // TODO: check with andrew + | MultiHole(tms) => + let (_, ms) = + tms |> List.map(any_to_info_map(~ctx, ~ancestors)) |> List.split; + add(union_m(ms)); }; } and utpat_to_info_map = diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index f62a502e8c..c938b899d6 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -17,7 +17,6 @@ without correponding syntax classes */ include TermBase.Any; - type any = t; module UTyp = { [@deriving (show({with_path: false}), sexp, yojson)] @@ -36,7 +35,9 @@ module UTyp = { | Var | Constructor | Parens - | Ap; + | Ap + | Forall + | Rec; include TermBase.UTyp; @@ -67,7 +68,9 @@ module UTyp = { | Tuple(_) => Tuple | Parens(_) => Parens | Ap(_) => Ap - | Sum(_) => Sum; + | Sum(_) => Sum + | Forall(_) => Forall + | Rec(_) => Rec; let show_cls: cls => string = fun @@ -85,7 +88,9 @@ module UTyp = { | Tuple => "Product type" | Sum => "Sum type" | Parens => "Parenthesized type" - | Ap => "Constructor application"; + | Ap => "Constructor application" + | Forall => "Forall Type" + | Rec => "Recursive Type"; let rec is_arrow = (typ: t) => { switch (typ.term) { @@ -103,7 +108,30 @@ module UTyp = { | Var(_) | Constructor(_) | Ap(_) - | Sum(_) => false + | Sum(_) + | Forall(_) + | Rec(_) => false + }; + + let rec is_forall = (typ: t) => { + switch (typ.term) { + | Parens(typ) => is_forall(typ) + | Forall(_) => true + | Invalid(_) + | EmptyHole + | MultiHole(_) + | Int + | Float + | Bool + | String + | Arrow(_) + | List(_) + | Tuple(_) + | Var(_) + | Constructor(_) + | Ap(_) + | Sum(_) + | Rec(_) => false }; }; @@ -128,6 +156,15 @@ module UTyp = { | Sum(uts) => Sum(to_ctr_map(ctx, uts)) | List(u) => List(to_typ(ctx, u)) | Parens(u) => to_typ(ctx, u) + | Forall({term: Var(name), _} as utpat, tbody) => + let ctx = Ctx.add_abstract(ctx, name, UTPat.rep_id(utpat)); + Forall({item: to_typ(ctx, tbody), name}); + | Forall(_, tbody) => to_typ(ctx, tbody) + // Forall is same as Rec + | Rec({term: Var(name), _} as utpat, tbody) => + let ctx = Ctx.add_abstract(ctx, name, UTPat.rep_id(utpat)); + Rec({item: to_typ(ctx, tbody), name}); + | Rec(_, tbody) => to_typ(ctx, tbody) /* The below cases should occur only inside sums */ | Constructor(_) | Ap(_) => Unknown(Internal) @@ -353,7 +390,7 @@ module UPat = { switch (pat.term) { | Parens(pat) => get_fun_var(pat) | TypeAnn(pat, typ) => - if (UTyp.is_arrow(typ)) { + if (UTyp.is_arrow(typ) || UTyp.is_forall(typ)) { get_var(pat) |> Option.map(var => var); } else { None; @@ -431,11 +468,13 @@ module UExp = { | ListLit | Constructor | Fun + | TypFun | Tuple | Var | Let | TyAlias | Ap + | TypAp | If | Seq | Test @@ -470,11 +509,13 @@ module UExp = { | ListLit(_) => ListLit | Constructor(_) => Constructor | Fun(_) => Fun + | TypFun(_) => TypFun | Tuple(_) => Tuple | Var(_) => Var | Let(_) => Let | TyAlias(_) => TyAlias | Ap(_) => Ap + | TypAp(_) => TypAp | If(_) => If | Seq(_) => Seq | Test(_) => Test @@ -548,7 +589,7 @@ module UExp = { | Invalid => "Invalid expression" | MultiHole => "Broken expression" | EmptyHole => "Empty expression hole" - | Triv => "Trivial litera" + | Triv => "Trivial literal" | Bool => "Boolean literal" | Int => "Integer literal" | Float => "Float literal" @@ -556,11 +597,13 @@ module UExp = { | ListLit => "List literal" | Constructor => "Constructor" | Fun => "Function literal" + | TypFun => "Type Function Literal" | Tuple => "Tuple literal" | Var => "Variable reference" | Let => "Let expression" | TyAlias => "Type Alias definition" | Ap => "Application" + | TypAp => "Type Application" | If => "If expression" | Seq => "Sequence expression" | Test => "Test" @@ -573,7 +616,8 @@ module UExp = { let rec is_fun = (e: t) => { switch (e.term) { - | Parens(e) => is_fun(e) + | Parens(e) + | TypFun(_, e) => is_fun(e) | Fun(_) => true | Invalid(_) | EmptyHole @@ -589,6 +633,7 @@ module UExp = { | Let(_) | TyAlias(_) | Ap(_) + | TypAp(_) | If(_) | Seq(_) | Test(_) @@ -617,10 +662,12 @@ module UExp = { | String(_) | ListLit(_) | Fun(_) + | TypFun(_) | Var(_) | Let(_) | TyAlias(_) | Ap(_) + | TypAp(_) | If(_) | Seq(_) | Test(_) diff --git a/src/haz3lcore/statics/TermBase.re b/src/haz3lcore/statics/TermBase.re index ee0280b17c..65d2ad7134 100644 --- a/src/haz3lcore/statics/TermBase.re +++ b/src/haz3lcore/statics/TermBase.re @@ -97,6 +97,35 @@ and UExp: { | Bool(op_bin_bool) | String(op_bin_string); + [@deriving (show({with_path: false}), sexp, yojson)] + type cls = + | Invalid + | EmptyHole + | MultiHole + | Triv + | Bool + | Int + | Float + | String + | ListLit + | Constructor + | Fun + | TypFun + | Tuple + | Var + | Let + | TyAlias + | Ap + | TypAp + | If + | Seq + | Test + | Parens + | Cons + | UnOp(op_un) + | BinOp(op_bin) + | Match; + [@deriving (show({with_path: false}), sexp, yojson)] type term = | Invalid(string) @@ -110,11 +139,13 @@ and UExp: { | ListLit(list(t)) | Constructor(string) | Fun(UPat.t, t) + | TypFun(UTPat.t, t) | Tuple(list(t)) | Var(Var.t) | Let(UPat.t, t, t) | TyAlias(UTPat.t, UTyp.t, t) | Ap(t, t) + | TypAp(t, UTyp.t) | If(t, t, t) | Seq(t, t) | Test(t) @@ -193,6 +224,35 @@ and UExp: { | Bool(op_bin_bool) | String(op_bin_string); + [@deriving (show({with_path: false}), sexp, yojson)] + type cls = + | Invalid + | EmptyHole + | MultiHole + | Triv + | Bool + | Int + | Float + | String + | ListLit + | Constructor + | Fun + | TypFun + | Tuple + | Var + | Let + | TyAlias + | Ap + | TypAp + | If + | Seq + | Test + | Parens + | Cons + | UnOp(op_un) + | BinOp(op_bin) + | Match; + [@deriving (show({with_path: false}), sexp, yojson)] type term = | Invalid(string) @@ -206,11 +266,13 @@ and UExp: { | ListLit(list(t)) | Constructor(string) | Fun(UPat.t, t) + | TypFun(UTPat.t, t) | Tuple(list(t)) | Var(Var.t) | Let(UPat.t, t, t) | TyAlias(UTPat.t, UTyp.t, t) | Ap(t, t) + | TypAp(t, UTyp.t) | If(t, t, t) | Seq(t, t) | Test(t) @@ -338,10 +400,16 @@ and UTyp: { | Tuple(list(t)) | Parens(t) | Ap(t, t) +<<<<<<< HEAD | Sum(list(variant)) and variant = | Variant(Constructor.t, list(Id.t), option(t)) | BadEntry(t) +======= + | USum(list(t)) + | Forall(UTPat.t, t) + | Rec(UTPat.t, t) +>>>>>>> 4c7587694 (merge in poly-adt) and t = { ids: list(Id.t), term, @@ -363,10 +431,16 @@ and UTyp: { | Tuple(list(t)) | Parens(t) | Ap(t, t) +<<<<<<< HEAD | Sum(list(variant)) and variant = | Variant(Constructor.t, list(Id.t), option(t)) | BadEntry(t) +======= + | USum(list(t)) + | Forall(UTPat.t, t) + | Rec(UTPat.t, t) +>>>>>>> 4c7587694 (merge in poly-adt) and t = { ids: list(Id.t), term, diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 3ad0570301..fcc763efd7 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -33,6 +33,7 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) + | Forall(TypVar.t, t) and sum_map = ConstructorMap.t(option(t)); [@deriving (show({with_path: false}), sexp, yojson)] @@ -52,6 +53,7 @@ module rec Typ: { let join_type_provenance: (type_provenance, type_provenance) => type_provenance; let matched_arrow: t => (t, t); + let matched_forall: t => t; let matched_prod: (int, t) => list(t); let matched_cons: t => (t, t); let matched_list: t => t; @@ -91,6 +93,7 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) + | Forall(TypVar.t, t) and sum_map = ConstructorMap.t(option(t)); [@deriving (show({with_path: false}), sexp, yojson)] @@ -128,6 +131,12 @@ module rec Typ: { | Unknown(SynSwitch) => (Unknown(SynSwitch), Unknown(SynSwitch)) | _ => (Unknown(Internal), Unknown(Internal)); + let matched_forall: t => (TypVar.t, t) = + fun + | Forall(t, ty) => (t, ty) + | Unknown(prov) => ("matched_forall", Unknown(prov)) + | _ => ("matched_forall", Unknown(Internal)); /* TODO: Might need to be fresh? */ + let matched_prod: (int, t) => list(t) = length => fun @@ -156,6 +165,7 @@ module rec Typ: { | Unknown(_) | Var(_) | Rec(_) + | Forall(_) | Sum(_) => precedence_Sum | List(_) => precedence_Const | Prod(_) => precedence_Prod @@ -174,6 +184,8 @@ module rec Typ: { | Sum(sm) => Sum(ConstructorMap.map(Option.map(subst(s, x)), sm)) | Rec(y, ty) when TypVar.eq(x, y) => Rec(y, ty) | Rec(y, ty) => Rec(y, subst(s, x, ty)) + | Forall(y, ty) when TypVar.eq(x, y) => Forall(y, ty) + | Forall(y, ty) => Forall(y, subst(s, x, ty)) | List(ty) => List(subst(s, x, ty)) | Var(y) => TypVar.eq(x, y) ? s : Var(y) }; @@ -191,6 +203,8 @@ module rec Typ: { switch (t1, t2) { | (Rec(x1, t1), Rec(x2, t2)) => eq(t1, subst(Var(x1), x2, t2)) | (Rec(_), _) => false + | (Forall(x1, t1), Forall(x2, t2)) => eq(t1, subst(Var(x1), x2, t2)) /* TODO: correct? */ + | (Forall(_), _) => false | (Int, Int) => true | (Int, _) => false | (Float, Float) => true @@ -234,6 +248,8 @@ module rec Typ: { ) | Prod(tys) => ListUtil.flat_map(free_vars(~bound), tys) | Rec(x, ty) => free_vars(~bound=[x, ...bound], ty) + | Forall({item: inside, name: n}) => [] /* free_vars(~bound=[x, ...bound], ty) */ + /* TODO: unclear how to finish this until Typ is fully rebased. */ }; /* Lattice join on types. This is a LUB join in the hazel2 @@ -281,7 +297,14 @@ module rec Typ: { let+ ty_body = join(~resolve, ~fix, ctx, ty1, subst(Var(x1), x2, ty2)); Rec(x1, ty_body); + | (Forall({item: t1, name}), Forall({item: t2, _})) => + /* See note above in Rec case */ + switch (join(Ctx.add_abstract(ctx, name, -1), t1, t2)) { + | Some(t) => Some(Forall({item: t, name})) + | None => None + } | (Rec(_), _) => None + | (Forall(_), _) => None | (Int, Int) => Some(Int) | (Int, _) => None | (Float, Float) => Some(Float) @@ -381,6 +404,8 @@ module rec Typ: { as in current implementation Recs do not occur in the surface syntax, so we won't try to jump to them. */ Rec(name, normalize(Ctx.extend_dummy_tvar(ctx, name), ty)) + | Forall(name, ty) => + Forall(name, normalize(Ctx.extend_dummy_tvar(ctx, name), ty)) }; }; @@ -413,6 +438,7 @@ module rec Typ: { | _ => false }; } + and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type var_entry = { @@ -606,4 +632,35 @@ and Kind: { type t = | Singleton(Typ.t) | Abstract; + +/* Is not needed as not using debrujin indices */ +/* + let rec incr = (ty: t, i: int): t => { + switch (ty) { + | Var({item: Some(j), name}) => Var({item: Some(i + j), name}) + | Var(_) => ty + | List(ty) => List(incr(ty, i)) + | Arrow(ty1, ty2) => Arrow(incr(ty1, i), incr(ty2, i)) + | Sum(map) => + Sum( + VarMap.map( + ((_, ty)) => + switch (ty) { + | Some(ty) => Some(incr(ty, i)) + | None => None + }, + map, + ), + ) + | Prod(tys) => Prod(List.map(ty => incr(ty, i), tys)) + | Rec({item, name}) => Rec({item: incr(item, i), name}) + | Forall({item, name}) => Forall({item: incr(item, i), name}) + | Int => Int + | Float => Float + | Bool => Bool + | String => String + | Unknown(_) => ty + }; +*/ + }; diff --git a/src/haz3lcore/zipper/EditorUtil.re b/src/haz3lcore/zipper/EditorUtil.re index 4483997e1d..29bac63f20 100644 --- a/src/haz3lcore/zipper/EditorUtil.re +++ b/src/haz3lcore/zipper/EditorUtil.re @@ -66,9 +66,11 @@ let rec append_exp = (id, e1: TermBase.UExp.t, e2: TermBase.UExp.t) => { | ListLit(_) | Constructor(_) | Fun(_) + | TypFun(_) | Tuple(_) | Var(_) | Ap(_) + | TypAp(_) | If(_) | Test(_) | Parens(_) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 50bc3c36e7..e97934b72d 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -131,12 +131,21 @@ let common_ok_view = (cls: Term.Cls.t, ok: Info.ok_pat) => { let typ_ok_view = (cls: Term.Cls.t, ok: Info.ok_typ) => switch (ok) { | Type(_) when cls == Typ(EmptyHole) => [text("Fillable by any type")] - | Type(ty) => [Type.view(ty)] + | Type(ty) => [Type.view(ty), text("is a type")] | TypeAlias(name, ty_lookup) => [ Type.view(Var(name)), text("is an alias for"), Type.view(ty_lookup), ] + | Variant(name, sum_ty) => [ + Type.view(Var({name, item: None})), + text("is a sum type constuctor of type"), + Type.view(sum_ty), + ] + | VariantIncomplete(sum_ty) => [ + text("An incomplete sum type constuctor of type"), + Type.view(sum_ty), + ] | Variant(name, _sum_ty) => [Type.view(Var(name))] | VariantIncomplete(_sum_ty) => [text("is incomplete")] }; diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index b0eedb8869..f104290532 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -667,6 +667,20 @@ let get_doc = ), [], ); + | TypFun(_, _) => + // TODO (typfun) + let (doc, options) = + LangDocMessages.get_form_and_options( + LangDocMessages.triv_exp_group, + docs, + ); + get_message( + doc, + options, + LangDocMessages.triv_exp_group, + doc.explanation.message, + [], + ); | Fun(pat, body) => let basic = (doc: LangDocMessages.form, group_id, options) => { let pat_id = List.nth(pat.ids, 0); @@ -1902,6 +1916,20 @@ let get_doc = LangDocMessages.funapp_exp_coloring_ids, ); }; + | TypAp(_, _) => + // TODO (typfun) + let (doc, options) = + LangDocMessages.get_form_and_options( + LangDocMessages.triv_exp_group, + docs, + ); + get_message( + doc, + options, + LangDocMessages.triv_exp_group, + doc.explanation.message, + [], + ); | If(cond, then_, else_) => let (doc, options) = LangDocMessages.get_form_and_options( @@ -2795,6 +2823,9 @@ let get_doc = | Ap(_) => basic_info(LangDocMessages.sum_typ_unary_constructor_def_group) | Parens(_) => default // Shouldn't be hit? | Invalid(_) => default + // TODO (typfun): Add langdoc + | Forall(_) => default + | Rec(_) => default } | Some(InfoTPat(info)) => switch (info.term.term) { diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index ae88419f0e..290eb81f61 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -33,11 +33,16 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => | Float => ty_view("Float", "Float") | String => ty_view("String", "String") | Bool => ty_view("Bool", "Bool") - | Var(name) => ty_view("Var", name) - | Rec(x, t) => + | Var({name, _}) => ty_view("Var", name) + | Rec({item: t, name}) => div( ~attr=clss(["typ-view", "Rec"]), - [text("Rec " ++ x ++ ". "), view_ty(t)], + [text("Rec " ++ name ++ ". "), view_ty(t)], + ) + | Forall({item: t, name}) => + div( + ~attr=clss(["typ-view", "Forall"]), + [text("Forall " ++ name ++ ". "), view_ty(t)], ) | List(t) => div( diff --git a/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re b/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re index 2dc53757b5..32780da431 100644 --- a/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re +++ b/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re @@ -60,6 +60,7 @@ let rec precedence = (~show_casts: bool, d: DHExp.t) => { | FailedCast(_) | InvalidOperation(_) | Fun(_) + | TypFun(_) | Closure(_) => DHDoc_common.precedence_const | Cast(d1, _, _) => show_casts ? DHDoc_common.precedence_const : precedence'(d1) @@ -71,7 +72,8 @@ let rec precedence = (~show_casts: bool, d: DHExp.t) => { | BinIntOp(op, _, _) => precedence_bin_int_op(op) | BinFloatOp(op, _, _) => precedence_bin_float_op(op) | BinStringOp(op, _, _) => precedence_bin_string_op(op) - | Ap(_) => DHDoc_common.precedence_Ap + | Ap(_) + | TypAp(_) => DHDoc_common.precedence_Ap | ApBuiltin(_) => DHDoc_common.precedence_Ap | Cons(_) => DHDoc_common.precedence_Cons | ListConcat(_) => DHDoc_common.precedence_Plus @@ -193,6 +195,11 @@ let rec mk = go'(~parenthesize=false, d2), ); DHDoc_common.mk_Ap(mk_cast(doc1), mk_cast(doc2)); + | TypAp(d1, ty) => + DHDoc_common.mk_Ap( + mk_cast(go(~enforce_inline, d1)), + DHDoc_Typ.mk(~enforce_inline=true, ty), + ) | ApBuiltin(ident, args) => switch (args) { | [hd, ...tl] => @@ -262,7 +269,8 @@ let rec mk = ]), mk_cast(go(~enforce_inline=false, dbody)), ]); - | FailedCast(Cast(d, ty1, ty2), ty2', ty3) when Typ.eq(ty2, ty2') => + | FailedCast(Cast(d, ty1, ty2), ty2', ty3) + when Typ.eq_syntactic(ty2, ty2') => let (d_doc, _) = go'(d); let cast_decoration = hcats([ @@ -338,6 +346,8 @@ let rec mk = | Some(name) => annot(DHAnnot.Collapsed, text("<" ++ name ++ ">")) }; } + | TypFun(_tpat, _dbody) => + annot(DHAnnot.Collapsed, text("")) | FixF(x, ty, dbody) => if (settings.show_fn_bodies) { let doc_body = (~enforce_inline) => diff --git a/src/haz3lweb/view/dhcode/layout/HTypDoc.re b/src/haz3lweb/view/dhcode/layout/HTypDoc.re index 8acbc0455f..bff18b7240 100644 --- a/src/haz3lweb/view/dhcode/layout/HTypDoc.re +++ b/src/haz3lweb/view/dhcode/layout/HTypDoc.re @@ -50,7 +50,7 @@ let rec mk = (~parenthesize=false, ~enforce_inline: bool, ty: Typ.t): t => { | Float => (text("Float"), parenthesize) | Bool => (text("Bool"), parenthesize) | String => (text("String"), parenthesize) - | Var(name) => (text(name), parenthesize) + | Var({name, _}) => (text(name), parenthesize) | List(ty) => ( hcats([ mk_delim("["), @@ -106,9 +106,21 @@ let rec mk = (~parenthesize=false, ~enforce_inline: bool, ty: Typ.t): t => { ) |> hcats; (center, true); - | Rec(x, ty) => ( + | Rec({item: ty, name}) => ( hcats([ - text("Rec " ++ x ++ ".{"), + text("Rec " ++ name ++ ".{"), + ( + (~enforce_inline) => + annot(HTypAnnot.Step(0), mk(~enforce_inline, ty)) + ) + |> pad_child(~enforce_inline), + mk_delim("}"), + ]), + parenthesize, + ) + | Forall({item: ty, name}) => ( + hcats([ + text("Forall " ++ name ++ ".{"), ( (~enforce_inline) => annot(HTypAnnot.Step(0), mk(~enforce_inline, ty)) From 7e495cb10aee70d400cb649b33199e34d7512f5a Mon Sep 17 00:00:00 2001 From: Kevin Li Date: Mon, 20 Feb 2023 10:50:49 -0500 Subject: [PATCH 06/56] Fixed body_ctx of Forall and Rec in Statics --- src/haz3lcore/statics/Statics.re | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 32ccd26f48..4066b837ba 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -514,10 +514,16 @@ and utyp_to_info_map = variants, ); add(union_m(ms)); - | Forall({term: Var(_), _} as utpat, tbody) => - /* NOTE FROM ANDREW: probably want to add var to the body's ctx in this case? */ + | Forall({term: Var(name), _} as utpat, tbody) => + let body_ctx = Ctx.add_abstract(ctx, name, Term.UTPat.rep_id(utpat)); let m = - utyp_to_info_map(tbody, ~ctx, ~ancestors, ~expects=TypeExpected) |> snd; + utyp_to_info_map( + tbody, + ~ctx=body_ctx, + ~ancestors, + ~expects=TypeExpected, + ) + |> snd; let m_tpat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; add(union_m([m, m_tpat])); // TODO: check with andrew | Forall(utpat, tbody) => @@ -525,8 +531,19 @@ and utyp_to_info_map = utyp_to_info_map(tbody, ~ctx, ~ancestors, ~expects=TypeExpected) |> snd; let m_tpat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; add(union_m([m, m_tpat])); // TODO: check with andrew + | Rec({term: Var(name), _} as utpat, tbody) => + let body_ctx = Ctx.add_abstract(ctx, name, Term.UTPat.rep_id(utpat)); + let m = + utyp_to_info_map( + tbody, + ~ctx=body_ctx, + ~ancestors, + ~expects=TypeExpected, + ) + |> snd; + let m_tpat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; + add(union_m([m, m_tpat])); // TODO: check with andrew | Rec(utpat, tbody) => - /* NOTE FROM ANDREW: probably want to add var to the body's ctx in this case? */ let m = utyp_to_info_map(tbody, ~ctx, ~ancestors, ~expects=TypeExpected) |> snd; let m_tpat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; From bc7e4717446dd60b97ffd7f17d98dc9630647fb1 Mon Sep 17 00:00:00 2001 From: Kevin Li Date: Mon, 20 Feb 2023 11:40:43 -0500 Subject: [PATCH 07/56] Allow Indet on the left of TypAp in Evaluator, similar to Ap --- src/haz3lcore/dynamics/Evaluator.re | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 17568ca412..4b5445eaa8 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -695,7 +695,8 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = switch (r1) { | BoxedValue(Closure(closure_env, TypFun(_, d3))) => evaluate(closure_env, d3) - | _ => failwith("InvalidBoxedTypFun") + | Indet(_) => r1 |> return + | _ => failwith("InvalidBoxedTypFun: " ++ show(r1)) }; | Ap(d1, d2) => From ceee07c7ad3c11d36b06a3ba9882f15d42ee7ca5 Mon Sep 17 00:00:00 2001 From: Kevin Li Date: Mon, 20 Feb 2023 11:55:57 -0500 Subject: [PATCH 08/56] Fix mode of TypAp to Syn, not SynFun --- src/haz3lcore/statics/Statics.re | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 4066b837ba..feff396a1b 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -237,7 +237,7 @@ and uexp_to_info_map = m, ); | TypAp(fn, utyp) => - let (fn, m_fn) = go(~mode=Typ.ap_mode, fn); + let (fn, m_fn) = go(~mode=Syn, fn); let Typ.{item: ty_body, _} = Typ.matched_forall(fn.ty); let ty = Term.UTyp.to_typ(ctx, utyp); add(~self=Just(Typ.subst(ty, ty_body)), ~free=fn.free, m_fn); From 8770d6e8f34612a66cc2c2c671a226e181c85c14 Mon Sep 17 00:00:00 2001 From: Kevin Li Date: Mon, 20 Feb 2023 12:13:29 -0500 Subject: [PATCH 09/56] Update is_fun and is_fun_var to recognize forall --- src/haz3lcore/statics/Term.re | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index c938b899d6..96d6ed573c 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -321,7 +321,8 @@ module UPat = { let rec is_fun_var = (pat: t) => { switch (pat.term) { | Parens(pat) => is_fun_var(pat) - | TypeAnn(pat, typ) => is_var(pat) && UTyp.is_arrow(typ) + | TypeAnn(pat, typ) => + is_var(pat) && (UTyp.is_arrow(typ) || UTyp.is_forall(typ)) | Invalid(_) | EmptyHole | MultiHole(_) @@ -614,10 +615,13 @@ module UExp = { | UnOp(op) => show_unop(op) | Match => "Case expression"; + // TODO (poly): May need to create a separate is_typfun function, + // so that is_fun pairs with is_fun_var over Arrow + // and is_typfun pairs with is_typfun_var over Forall let rec is_fun = (e: t) => { switch (e.term) { - | Parens(e) - | TypFun(_, e) => is_fun(e) + | Parens(e) => is_fun(e) + | TypFun(_) | Fun(_) => true | Invalid(_) | EmptyHole From 031067efd96ae2205fed52b50678375f98b97fe2 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Mon, 1 May 2023 00:47:16 -0400 Subject: [PATCH 10/56] Implement semantics of type function application as type substition on terms. --- src/haz3lcore/dynamics/Evaluator.re | 71 ++++++++++++++++++++++++++++- 1 file changed, 70 insertions(+), 1 deletion(-) diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 4b5445eaa8..9744ce0f69 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -636,6 +636,74 @@ let eval_bin_string_op = | Equals => BoolLit(s1 == s2) }; +let rec ty_subst = + (~idx=0, exp, targ) + : DHExp.t /* TODO: Maybe just keep error instead of recursing? */ => { + open DH.DHExp; + let re = e2 => ty_subst(~idx, e2, targ); + switch (exp) { + | Cast(t, t1, t2) => + Cast(re(t), Typ.subst(targ, ~x=idx, t1), Typ.subst(targ, ~x=idx, t2)) + | FixF(arg, ty, body) => FixF(arg, Typ.subst(targ, ~x=idx, ty), re(body)) + | Fun(arg, ty, body, var) => + Fun(arg, Typ.subst(targ, ~x=idx, ty), re(body), var) + | TypAp(tfun, ty) => TypAp(re(tfun), Typ.subst(targ, ~x=idx, ty)) + | ListLit(mv, mvi, lerr, t, lst) => + ListLit(mv, mvi, lerr, Typ.subst(targ, ~x=idx, t), List.map(re, lst)) + + | TypFun(utpat, body) => TypFun(utpat, ty_subst(~idx=idx + 1, body, targ)) + + | NonEmptyHole(errstat, mv, hid, t) => + NonEmptyHole(errstat, mv, hid, re(t)) + | InconsistentBranches(mv, hid, case) => + InconsistentBranches(mv, hid, ty_subst_case(~idx, case, targ)) + | Closure(ce, t) => Closure(ce, re(t)) + | Sequence(t1, t2) => Sequence(re(t1), re(t2)) + | Let(dhpat, t1, t2) => Let(dhpat, re(t1), re(t2)) + | Ap(t1, t2) => Ap(re(t1), re(t2)) + | ApBuiltin(s, args) => ApBuiltin(s, List.map(re, args)) + | BinBoolOp(op, t1, t2) => BinBoolOp(op, re(t1), re(t2)) + | BinIntOp(op, t1, t2) => BinIntOp(op, re(t1), re(t2)) + | BinFloatOp(op, t1, t2) => BinFloatOp(op, re(t1), re(t2)) + | BinStringOp(op, t1, t2) => BinStringOp(op, re(t1), re(t2)) + | Cons(t1, t2) => Cons(re(t1), re(t2)) + | Tuple(args) => Tuple(List.map(re, args)) + | Prj(t, n) => Prj(re(t), n) + | ConsistentCase(case) => ConsistentCase(ty_subst_case(~idx, case, targ)) + | InvalidOperation(t, err) => InvalidOperation(re(t), err) + + | EmptyHole(_) + | ExpandingKeyword(_, _, _) + | FreeVar(_, _, _) + | InvalidText(_, _, _) + | BoundVar(_) + | TestLit(_) + | BoolLit(_) + | IntLit(_) + | FloatLit(_) + | StringLit(_) + | Tag(_) + | FailedCast(_, _, _) => exp + }; +} //TODO: is this correct? +//TODO: Need to check again for inconsistency? +//TODO: Same as inconsistent branch. +/* cases with types we may need to substitute */ +/* special case of changing debruijn indices */ +/* cases where we just syntactically recurse */ +/* Recursion is probably necessary in the following cases for error reporting */ +/* Cases where we don't need to recurse */ + +and ty_subst_case = (~idx=0, Case(t, rules, n), targ) => + Case( + ty_subst(~idx, t, targ), + List.map( + (DHExp.Rule(dhpat, t)) => DHExp.Rule(dhpat, ty_subst(~idx, t, targ)), + rules, + ), + n, + ); + let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = (env, d) => { /* Increment number of evaluation steps (calls to `evaluate`). */ @@ -691,10 +759,11 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = | TypFun(_) => BoxedValue(Closure(env, d)) |> return | TypAp(d1, _ty) => + // print_endline("Evaluating TypAp."); let* r1 = evaluate(env, d1); switch (r1) { | BoxedValue(Closure(closure_env, TypFun(_, d3))) => - evaluate(closure_env, d3) + evaluate(closure_env, ty_subst(d3, _ty)) | Indet(_) => r1 |> return | _ => failwith("InvalidBoxedTypFun: " ++ show(r1)) }; From d210f8f5542148122ee037829a062de74b5ac043 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Tue, 23 May 2023 03:51:48 -0400 Subject: [PATCH 11/56] Add synthesis mode for type function and add necessary casting cases. Add ground case for forall type (as Forall _ . ?). --- src/haz3lcore/dynamics/Elaborator.re | 13 +++++++++++++ src/haz3lcore/dynamics/Evaluator.re | 10 ++-------- src/haz3lcore/statics/Info.re | 15 +++++++++++++-- src/haz3lcore/statics/Mode.re | 20 ++++++++++++++------ src/haz3lcore/statics/Statics.re | 7 ++++++- 5 files changed, 48 insertions(+), 17 deletions(-) diff --git a/src/haz3lcore/dynamics/Elaborator.re b/src/haz3lcore/dynamics/Elaborator.re index ef76735da6..46eca8d3c0 100644 --- a/src/haz3lcore/dynamics/Elaborator.re +++ b/src/haz3lcore/dynamics/Elaborator.re @@ -37,6 +37,18 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | Arrow(_) => d | _ => failwith("Elaborator.wrap: SynFun non-arrow-type") } + | SynTypFun => + switch (self_ty) { + | Unknown(prov) => + /* ? |> forall _. ? */ + DHExp.cast( + d, + Unknown(prov), + Forall({item: Unknown(prov), name: "_"}), + ) + | Forall(_) => d + | _ => failwith("Elaborator.wrap: SynTypFun non-forall-type") + } | Ana(ana_ty) => let ana_ty = Typ.normalize(ctx, ana_ty); /* Forms with special ana rules get cast from their appropriate Matched types */ @@ -71,6 +83,7 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | _ => d } | Ap(Constructor(_), _) + | TypAp(Constructor(_), _) | Constructor(_) => switch (ana_ty, self_ty) { | (Unknown(prov), Rec({item: Sum(_), _})) diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 9744ce0f69..c49369ef6f 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -51,6 +51,7 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { | Var(_) | Rec(_) | Arrow(Unknown(_), Unknown(_)) + | Forall({item: Unknown(_), name: _}) | List(Unknown(_)) => Ground | Prod(tys) => if (List.for_all( @@ -686,13 +687,7 @@ let rec ty_subst = | FailedCast(_, _, _) => exp }; } //TODO: is this correct? -//TODO: Need to check again for inconsistency? -//TODO: Same as inconsistent branch. -/* cases with types we may need to substitute */ -/* special case of changing debruijn indices */ -/* cases where we just syntactically recurse */ -/* Recursion is probably necessary in the following cases for error reporting */ -/* Cases where we don't need to recurse */ +//TODO: Inconsistent cases: need to check again for inconsistency? and ty_subst_case = (~idx=0, Case(t, rules, n), targ) => Case( @@ -759,7 +754,6 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = | TypFun(_) => BoxedValue(Closure(env, d)) |> return | TypAp(d1, _ty) => - // print_endline("Evaluating TypAp."); let* r1 = evaluate(env, d1); switch (r1) { | BoxedValue(Closure(closure_env, TypFun(_, d3))) => diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 69d3871db6..f860def7f8 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -259,7 +259,18 @@ let pat_ty: pat => Typ.t = ({ty, _}) => ty; let rec status_common = (ctx: Ctx.t, mode: Mode.t, self: Self.t): status_common => switch (self, mode) { - | (Just(syn), Syn) => NotInHole(Syn(syn)) + | (Just(ty), Syn) => NotInHole(Syn(ty)) + | (Just(ty), SynFun) => + switch (Typ.join(ctx, Arrow(Unknown(Internal), Unknown(Internal)), ty)) { + | Some(_) => NotInHole(Syn(ty)) + | None => InHole(InconsistentWithArrow(ty)) + } + | (Just(ty), SynTypFun) => + /* Use ty first to preserve name if it exists. */ + switch (Typ.join(ctx, ty, Forall({item: Unknown(Internal), name: "_"}))) { + | Some(_) => NotInHole(Syn(ty)) + | None => InHole(InconsistentWithArrow(ty)) + } | (Just(syn), Ana(ana)) => switch (Typ.join_fix(ctx, ana, syn)) { | None => InHole(Inconsistent(Expectation({syn, ana}))) @@ -293,7 +304,7 @@ let rec status_common = Ana(InternallyInconsistent({ana, nojoin: Typ.of_source(tys)})), ) }; - | (NoJoin(_, tys), Syn | SynFun) => + | (NoJoin(_, tys), Syn | SynFun | SynTypFun) => InHole(Inconsistent(Internal(Typ.of_source(tys)))) }; diff --git a/src/haz3lcore/statics/Mode.re b/src/haz3lcore/statics/Mode.re index 58594f928d..9af16e32c4 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -20,6 +20,7 @@ open OptUtil.Syntax; [@deriving (show({with_path: false}), sexp, yojson)] type t = | SynFun /* Used only in function position of applications */ + | SynTypFun | Syn | Ana(Typ.t); @@ -31,11 +32,13 @@ let ty_of: t => Typ.t = | Ana(ty) => ty | Syn => Unknown(SynSwitch) | SynFun => Arrow(Unknown(SynSwitch), Unknown(SynSwitch)); + | SynTypFun => Forall("syntypfun", Unknown(SynSwitch)) /* TODO: naming the type variable? */ let of_arrow = (ctx: Ctx.t, mode: t): (t, t) => switch (mode) { | Syn - | SynFun => (Syn, Syn) + | SynFun + | SynTypFun => (Syn, Syn) | Ana(ty) => ty |> Typ.weak_head_normalize(ctx) @@ -46,7 +49,8 @@ let of_arrow = (ctx: Ctx.t, mode: t): (t, t) => let of_prod = (ctx: Ctx.t, mode: t, length): list(t) => switch (mode) { | Syn - | SynFun => List.init(length, _ => Syn) + | SynFun + | SynTypFun => List.init(length, _ => Syn) | Ana(ty) => ty |> Typ.weak_head_normalize(ctx) @@ -60,28 +64,32 @@ let matched_list_normalize = (ctx: Ctx.t, ty: Typ.t): Typ.t => let of_cons_hd = (ctx: Ctx.t, mode: t): t => switch (mode) { | Syn - | SynFun => Syn + | SynFun + | SynTypFun => Syn | Ana(ty) => Ana(matched_list_normalize(ctx, ty)) }; let of_cons_tl = (ctx: Ctx.t, mode: t, hd_ty: Typ.t): t => switch (mode) { | Syn - | SynFun => Ana(List(hd_ty)) + | SynFun + | SynTypFun => Ana(List(hd_ty)) | Ana(ty) => Ana(List(matched_list_normalize(ctx, ty))) }; let of_list = (ctx: Ctx.t, mode: t): t => switch (mode) { | Syn - | SynFun => Syn + | SynFun + | SynTypFun => Syn | Ana(ty) => Ana(matched_list_normalize(ctx, ty)) }; let of_list_concat = (mode: t): t => switch (mode) { | Syn - | SynFun => Ana(List(Unknown(SynSwitch))) + | SynFun + | SynTypFun => Ana(List(Unknown(SynSwitch))) | Ana(ty) => Ana(List(Typ.matched_list(ty))) }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index feff396a1b..64d5944947 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -237,7 +237,12 @@ and uexp_to_info_map = m, ); | TypAp(fn, utyp) => - let (fn, m_fn) = go(~mode=Syn, fn); + /* Might need something similar to Ap's case where we check analysis mode when tagged? */ + let typfn_mode = /* switch(fn) { + | {term: Tag(name), _} => Typ.tag_typap_mode(ctx, mode, name) + | _ => Typ.typap_mode + }; */ Typ.typap_mode; + let (fn, m_fn) = go(~mode=typfn_mode, fn); let Typ.{item: ty_body, _} = Typ.matched_forall(fn.ty); let ty = Term.UTyp.to_typ(ctx, utyp); add(~self=Just(Typ.subst(ty, ty_body)), ~free=fn.free, m_fn); From 4d02ccbec40fb108e76eabff330b6cf5e527eb9d Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Tue, 23 May 2023 05:57:41 -0400 Subject: [PATCH 12/56] Add rule for evaluation of type application on cast. --- src/haz3lcore/dynamics/Evaluator.re | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index c49369ef6f..24eaeaa8f8 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -753,11 +753,30 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = | Fun(_) => BoxedValue(Closure(env, d)) |> return | TypFun(_) => BoxedValue(Closure(env, d)) |> return - | TypAp(d1, _ty) => + | TypAp(d1, tau) => let* r1 = evaluate(env, d1); switch (r1) { - | BoxedValue(Closure(closure_env, TypFun(_, d3))) => - evaluate(closure_env, ty_subst(d3, _ty)) + | BoxedValue(Closure(closure_env, TypFun(_, d2))) => + // TODO: Maybe additional cases to be done? + evaluate(closure_env, ty_subst(d2, tau)) + | BoxedValue( + Cast( + d1', + Forall({item: t, name: _}), + Forall({item: t', name: _}), + ), + ) + | Indet( + Cast( + d1', + Forall({item: t, name: _}), + Forall({item: t', name: _}), + ), + ) => + evaluate( + env, + Cast(TypAp(d1', tau), Typ.subst(t, tau), Typ.subst(t', tau)), + ) | Indet(_) => r1 |> return | _ => failwith("InvalidBoxedTypFun: " ++ show(r1)) }; From b52560c8b8540d15c2bb2210074c8431e9902141 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Thu, 24 Aug 2023 20:26:07 -0400 Subject: [PATCH 13/56] Some resolutions to conflicts from rebasing. --- src/haz3lcore/dynamics/DH.re | 2 +- src/haz3lcore/statics/Info.re | 19 +++---- src/haz3lcore/statics/Kind.re | 2 +- src/haz3lcore/statics/MakeTerm.re | 12 ++-- src/haz3lcore/statics/Mode.re | 28 +++++++--- src/haz3lcore/statics/Statics.re | 16 ++---- src/haz3lcore/statics/Term.re | 92 +++++++++++++++++-------------- src/haz3lcore/statics/TermBase.re | 16 ++---- src/haz3lcore/statics/TypBase.re | 74 ++++++++++++------------- 9 files changed, 130 insertions(+), 131 deletions(-) diff --git a/src/haz3lcore/dynamics/DH.re b/src/haz3lcore/dynamics/DH.re index 72f08d00a6..931d27d758 100644 --- a/src/haz3lcore/dynamics/DH.re +++ b/src/haz3lcore/dynamics/DH.re @@ -145,7 +145,7 @@ module rec DHExp: { | xs => Tuple(xs); let cast = (d: t, t1: Typ.t, t2: Typ.t): t => - if (Typ.eq_syntactic(t1, t2) || t2 == Unknown(SynSwitch)) { + if (Typ.eq(t1, t2) || t2 == Unknown(SynSwitch)) { d; } else { Cast(d, t1, t2); diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index f860def7f8..af8aa33b15 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -261,28 +261,23 @@ let rec status_common = switch (self, mode) { | (Just(ty), Syn) => NotInHole(Syn(ty)) | (Just(ty), SynFun) => - switch (Typ.join(ctx, Arrow(Unknown(Internal), Unknown(Internal)), ty)) { + switch ( + Typ.join_fix(ctx, Arrow(Unknown(Internal), Unknown(Internal)), ty) + ) { | Some(_) => NotInHole(Syn(ty)) - | None => InHole(InconsistentWithArrow(ty)) + | None => InHole(Inconsistent(WithArrow(ty))) } | (Just(ty), SynTypFun) => /* Use ty first to preserve name if it exists. */ - switch (Typ.join(ctx, ty, Forall({item: Unknown(Internal), name: "_"}))) { + switch (Typ.join_fix(ctx, ty, Forall("_", Unknown(Internal)))) { | Some(_) => NotInHole(Syn(ty)) - | None => InHole(InconsistentWithArrow(ty)) + | None => InHole(Inconsistent(WithArrow(ty))) } | (Just(syn), Ana(ana)) => switch (Typ.join_fix(ctx, ana, syn)) { | None => InHole(Inconsistent(Expectation({syn, ana}))) | Some(join) => NotInHole(Ana(Consistent({ana, syn, join}))) } - | (Just(syn), SynFun) => - switch ( - Typ.join_fix(ctx, Arrow(Unknown(Internal), Unknown(Internal)), syn) - ) { - | None => InHole(Inconsistent(WithArrow(syn))) - | Some(_) => NotInHole(Syn(syn)) - } | (IsConstructor({name, syn_ty}), _) => /* If a ctr is being analyzed against (an arrow type returning) a sum type having that ctr as a variant, its self type is @@ -310,7 +305,7 @@ let rec status_common = let status_pat = (ctx: Ctx.t, mode: Mode.t, self: Self.pat): status_pat => switch (mode, self) { - | (Syn | Ana(_), Common(self_pat)) + | (Syn | SynTypFun | Ana(_), Common(self_pat)) | (SynFun, Common(IsConstructor(_) as self_pat)) => /* Little bit of a hack. Anything other than a bound ctr will, in function position, have SynFun mode (see Typ.ap_mode). Since we diff --git a/src/haz3lcore/statics/Kind.re b/src/haz3lcore/statics/Kind.re index cc3b0e6d34..21b1604440 100644 --- a/src/haz3lcore/statics/Kind.re +++ b/src/haz3lcore/statics/Kind.re @@ -1,4 +1,4 @@ [@deriving (show({with_path: false}), sexp, yojson)] type t = - | Singleton(TypBase.t) + | Singleton(Typ.t) | Abstract; diff --git a/src/haz3lcore/statics/MakeTerm.re b/src/haz3lcore/statics/MakeTerm.re index 35030a7b58..68d4c88cc3 100644 --- a/src/haz3lcore/statics/MakeTerm.re +++ b/src/haz3lcore/statics/MakeTerm.re @@ -242,13 +242,10 @@ and exp_term: unsorted => (UExp.term, list(Id.t)) = { | ([(_id, t)], []) => switch (t) { | (["()"], []) => (l.term, l.ids) //TODO(andrew): new ap error - ret( - switch (t) { - | (["(", ")"], [Exp(arg)]) => Ap(l, arg) - | (["@<", ">"], [Typ(ty)]) => TypAp(l, ty) - | _ => hole(tm) - }, - ) + | (["(", ")"], [Exp(arg)]) => ret(Ap(l, arg)) + | (["@<", ">"], [Typ(ty)]) => ret(TypAp(l, ty)) + | _ => ret(hole(tm)) + } | _ => ret(hole(tm)) } | Bin(Exp(l), tiles, Exp(r)) as tm => @@ -296,7 +293,6 @@ and exp_term: unsorted => (UExp.term, list(Id.t)) = { } | tm => ret(hole(tm)); } - and pat = unsorted => { let (term, inner_ids) = pat_term(unsorted); let ids = ids(unsorted) @ inner_ids; diff --git a/src/haz3lcore/statics/Mode.re b/src/haz3lcore/statics/Mode.re index 9af16e32c4..267f465abb 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -31,13 +31,13 @@ let ty_of: t => Typ.t = fun | Ana(ty) => ty | Syn => Unknown(SynSwitch) - | SynFun => Arrow(Unknown(SynSwitch), Unknown(SynSwitch)); - | SynTypFun => Forall("syntypfun", Unknown(SynSwitch)) /* TODO: naming the type variable? */ + | SynFun => Arrow(Unknown(SynSwitch), Unknown(SynSwitch)) + | SynTypFun => Forall("syntypfun", Unknown(SynSwitch)); /* TODO: naming the type variable? */ let of_arrow = (ctx: Ctx.t, mode: t): (t, t) => switch (mode) { | Syn - | SynFun + | SynFun | SynTypFun => (Syn, Syn) | Ana(ty) => ty @@ -46,10 +46,20 @@ let of_arrow = (ctx: Ctx.t, mode: t): (t, t) => |> TupleUtil.map2(ana) }; +let of_forall = (mode: t): t => + switch (mode) { + | Syn + | SynFun + | SynTypFun => Syn + | Ana(ty) => + let (_, item) = Typ.matched_forall(ty); + Ana(item); + }; + let of_prod = (ctx: Ctx.t, mode: t, length): list(t) => switch (mode) { | Syn - | SynFun + | SynFun | SynTypFun => List.init(length, _ => Syn) | Ana(ty) => ty @@ -64,7 +74,7 @@ let matched_list_normalize = (ctx: Ctx.t, ty: Typ.t): Typ.t => let of_cons_hd = (ctx: Ctx.t, mode: t): t => switch (mode) { | Syn - | SynFun + | SynFun | SynTypFun => Syn | Ana(ty) => Ana(matched_list_normalize(ctx, ty)) }; @@ -72,7 +82,7 @@ let of_cons_hd = (ctx: Ctx.t, mode: t): t => let of_cons_tl = (ctx: Ctx.t, mode: t, hd_ty: Typ.t): t => switch (mode) { | Syn - | SynFun + | SynFun | SynTypFun => Ana(List(hd_ty)) | Ana(ty) => Ana(List(matched_list_normalize(ctx, ty))) }; @@ -80,7 +90,7 @@ let of_cons_tl = (ctx: Ctx.t, mode: t, hd_ty: Typ.t): t => let of_list = (ctx: Ctx.t, mode: t): t => switch (mode) { | Syn - | SynFun + | SynFun | SynTypFun => Syn | Ana(ty) => Ana(matched_list_normalize(ctx, ty)) }; @@ -88,7 +98,7 @@ let of_list = (ctx: Ctx.t, mode: t): t => let of_list_concat = (mode: t): t => switch (mode) { | Syn - | SynFun + | SynFun | SynTypFun => Ana(List(Unknown(SynSwitch))) | Ana(ty) => Ana(List(Typ.matched_list(ty))) }; @@ -139,3 +149,5 @@ let of_ap = (ctx, mode, ctr: option(Constructor.t)): t => } | None => SynFun }; + +let typap_mode: t = SynTypFun; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 64d5944947..caa8545166 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -237,15 +237,11 @@ and uexp_to_info_map = m, ); | TypAp(fn, utyp) => - /* Might need something similar to Ap's case where we check analysis mode when tagged? */ - let typfn_mode = /* switch(fn) { - | {term: Tag(name), _} => Typ.tag_typap_mode(ctx, mode, name) - | _ => Typ.typap_mode - }; */ Typ.typap_mode; - let (fn, m_fn) = go(~mode=typfn_mode, fn); - let Typ.{item: ty_body, _} = Typ.matched_forall(fn.ty); + let typfn_mode = Mode.typap_mode; + let (fn, m_fn) = go(~mode=typfn_mode, fn, m); + let (name, ty_body) = Typ.matched_forall(fn.ty); let ty = Term.UTyp.to_typ(ctx, utyp); - add(~self=Just(Typ.subst(ty, ty_body)), ~free=fn.free, m_fn); + add(~self=Just(Typ.subst(ty, name, ty_body)), ~co_ctx=fn.co_ctx, m_fn); | Fun(p, e) => let (mode_pat, mode_body) = Mode.of_arrow(ctx, mode); let (p, m) = go_pat(~is_synswitch=false, ~mode=mode_pat, p, m); @@ -256,7 +252,7 @@ and uexp_to_info_map = m, ); | TypFun({term: Var(name), _} as utpat, body) => - let mode_body = Typ.matched_forall_mode(mode); + let mode_body = Mode.of_forall(mode); let m_typat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; let ctx_body = Ctx.add_abstract(ctx, name, Term.UTPat.rep_id(utpat)); let (body, m_body) = go'(~ctx=ctx_body, ~mode=mode_body, body); @@ -266,7 +262,7 @@ and uexp_to_info_map = union_m([m_typat, m_body]), ); | TypFun(utpat, body) => - let mode_body = Typ.matched_forall_mode(mode); + let mode_body = Mode.of_forall(mode); let m_typat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; let (body, m_body) = go(~mode=mode_body, body); add( diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index 96d6ed573c..b075c17c4c 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -18,6 +18,43 @@ include TermBase.Any; type any = t; + +module UTPat = { + [@deriving (show({with_path: false}), sexp, yojson)] + type cls = + | Invalid + | EmptyHole + | MultiHole + | Var; + + include TermBase.UTPat; + + let rep_id = ({ids, _}) => { + assert(ids != []); + List.hd(ids); + }; + + let hole = (tms: list(any)) => + switch (tms) { + | [] => EmptyHole + | [_, ..._] => MultiHole(tms) + }; + + let cls_of_term: term => cls = + fun + | Invalid(_) => Invalid + | EmptyHole => EmptyHole + | MultiHole(_) => MultiHole + | Var(_) => Var; + + let show_cls: cls => string = + fun + | Invalid => "Invalid type alias" + | MultiHole => "Broken type alias" + | EmptyHole => "Empty type alias hole" + | Var => "Type alias"; +}; + module UTyp = { [@deriving (show({with_path: false}), sexp, yojson)] type cls = @@ -112,7 +149,8 @@ module UTyp = { | Forall(_) | Rec(_) => false }; - + }; + let rec is_forall = (typ: t) => { switch (typ.term) { | Parens(typ) => is_forall(typ) @@ -157,13 +195,21 @@ module UTyp = { | List(u) => List(to_typ(ctx, u)) | Parens(u) => to_typ(ctx, u) | Forall({term: Var(name), _} as utpat, tbody) => - let ctx = Ctx.add_abstract(ctx, name, UTPat.rep_id(utpat)); - Forall({item: to_typ(ctx, tbody), name}); + let ctx = + Ctx.extend_tvar( + ctx, + {name, id: UTPat.rep_id(utpat), kind: Abstract}, + ); + Forall(name, to_typ(ctx, tbody)); | Forall(_, tbody) => to_typ(ctx, tbody) // Forall is same as Rec | Rec({term: Var(name), _} as utpat, tbody) => - let ctx = Ctx.add_abstract(ctx, name, UTPat.rep_id(utpat)); - Rec({item: to_typ(ctx, tbody), name}); + let ctx = + Ctx.extend_tvar( + ctx, + {name, id: UTPat.rep_id(utpat), kind: Abstract}, + ); + Rec(name, to_typ(ctx, tbody)); | Rec(_, tbody) => to_typ(ctx, tbody) /* The below cases should occur only inside sums */ | Constructor(_) @@ -186,42 +232,6 @@ module UTyp = { }; }; -module UTPat = { - [@deriving (show({with_path: false}), sexp, yojson)] - type cls = - | Invalid - | EmptyHole - | MultiHole - | Var; - - include TermBase.UTPat; - - let rep_id = ({ids, _}) => { - assert(ids != []); - List.hd(ids); - }; - - let hole = (tms: list(any)) => - switch (tms) { - | [] => EmptyHole - | [_, ..._] => MultiHole(tms) - }; - - let cls_of_term: term => cls = - fun - | Invalid(_) => Invalid - | EmptyHole => EmptyHole - | MultiHole(_) => MultiHole - | Var(_) => Var; - - let show_cls: cls => string = - fun - | Invalid => "Invalid type alias" - | MultiHole => "Broken type alias" - | EmptyHole => "Empty type alias hole" - | Var => "Type alias"; -}; - module UPat = { [@deriving (show({with_path: false}), sexp, yojson)] type cls = diff --git a/src/haz3lcore/statics/TermBase.re b/src/haz3lcore/statics/TermBase.re index 65d2ad7134..55f77da428 100644 --- a/src/haz3lcore/statics/TermBase.re +++ b/src/haz3lcore/statics/TermBase.re @@ -400,16 +400,12 @@ and UTyp: { | Tuple(list(t)) | Parens(t) | Ap(t, t) -<<<<<<< HEAD | Sum(list(variant)) + | Forall(UTPat.t, t) + | Rec(UTPat.t, t) and variant = | Variant(Constructor.t, list(Id.t), option(t)) | BadEntry(t) -======= - | USum(list(t)) - | Forall(UTPat.t, t) - | Rec(UTPat.t, t) ->>>>>>> 4c7587694 (merge in poly-adt) and t = { ids: list(Id.t), term, @@ -431,16 +427,12 @@ and UTyp: { | Tuple(list(t)) | Parens(t) | Ap(t, t) -<<<<<<< HEAD | Sum(list(variant)) + | Forall(UTPat.t, t) + | Rec(UTPat.t, t) and variant = | Variant(Constructor.t, list(Id.t), option(t)) | BadEntry(t) -======= - | USum(list(t)) - | Forall(UTPat.t, t) - | Rec(UTPat.t, t) ->>>>>>> 4c7587694 (merge in poly-adt) and t = { ids: list(Id.t), term, diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index fcc763efd7..683764fcb4 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -53,7 +53,7 @@ module rec Typ: { let join_type_provenance: (type_provenance, type_provenance) => type_provenance; let matched_arrow: t => (t, t); - let matched_forall: t => t; + let matched_forall: t => (string, t); let matched_prod: (int, t) => list(t); let matched_cons: t => (t, t); let matched_list: t => t; @@ -136,7 +136,7 @@ module rec Typ: { | Forall(t, ty) => (t, ty) | Unknown(prov) => ("matched_forall", Unknown(prov)) | _ => ("matched_forall", Unknown(Internal)); /* TODO: Might need to be fresh? */ - + let matched_prod: (int, t) => list(t) = length => fun @@ -248,8 +248,8 @@ module rec Typ: { ) | Prod(tys) => ListUtil.flat_map(free_vars(~bound), tys) | Rec(x, ty) => free_vars(~bound=[x, ...bound], ty) - | Forall({item: inside, name: n}) => [] /* free_vars(~bound=[x, ...bound], ty) */ - /* TODO: unclear how to finish this until Typ is fully rebased. */ + | Forall(x, ty) => free_vars(~bound=[x, ...bound], ty) + /* TODO: check that these are correct. */ }; /* Lattice join on types. This is a LUB join in the hazel2 @@ -297,10 +297,10 @@ module rec Typ: { let+ ty_body = join(~resolve, ~fix, ctx, ty1, subst(Var(x1), x2, ty2)); Rec(x1, ty_body); - | (Forall({item: t1, name}), Forall({item: t2, _})) => + | (Forall(name, t1), Forall(_, t2)) => /* See note above in Rec case */ - switch (join(Ctx.add_abstract(ctx, name, -1), t1, t2)) { - | Some(t) => Some(Forall({item: t, name})) + switch (join(~resolve, ~fix, Ctx.extend_dummy_tvar(ctx, name), t1, t2)) { + | Some(t) => Some(Forall(name, t)) | None => None } | (Rec(_), _) => None @@ -632,35 +632,33 @@ and Kind: { type t = | Singleton(Typ.t) | Abstract; - -/* Is not needed as not using debrujin indices */ -/* - let rec incr = (ty: t, i: int): t => { - switch (ty) { - | Var({item: Some(j), name}) => Var({item: Some(i + j), name}) - | Var(_) => ty - | List(ty) => List(incr(ty, i)) - | Arrow(ty1, ty2) => Arrow(incr(ty1, i), incr(ty2, i)) - | Sum(map) => - Sum( - VarMap.map( - ((_, ty)) => - switch (ty) { - | Some(ty) => Some(incr(ty, i)) - | None => None - }, - map, - ), - ) - | Prod(tys) => Prod(List.map(ty => incr(ty, i), tys)) - | Rec({item, name}) => Rec({item: incr(item, i), name}) - | Forall({item, name}) => Forall({item: incr(item, i), name}) - | Int => Int - | Float => Float - | Bool => Bool - | String => String - | Unknown(_) => ty - }; -*/ - + /* Is not needed as not using debrujin indices */ + /* + let rec incr = (ty: t, i: int): t => { + switch (ty) { + | Var({item: Some(j), name}) => Var({item: Some(i + j), name}) + | Var(_) => ty + | List(ty) => List(incr(ty, i)) + | Arrow(ty1, ty2) => Arrow(incr(ty1, i), incr(ty2, i)) + | Sum(map) => + Sum( + VarMap.map( + ((_, ty)) => + switch (ty) { + | Some(ty) => Some(incr(ty, i)) + | None => None + }, + map, + ), + ) + | Prod(tys) => Prod(List.map(ty => incr(ty, i), tys)) + | Rec({item, name}) => Rec({item: incr(item, i), name}) + | Forall({item, name}) => Forall({item: incr(item, i), name}) + | Int => Int + | Float => Float + | Bool => Bool + | String => String + | Unknown(_) => ty + }; + */ }; From 7337f8fb899d96a05dbe1a072f7162b332844a27 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Fri, 25 Aug 2023 16:46:03 -0400 Subject: [PATCH 14/56] Resolving issues in Statics and Elaborator. --- src/haz3lcore/dynamics/Elaborator.re | 14 ++---- src/haz3lcore/statics/Kind.re | 4 -- src/haz3lcore/statics/Statics.re | 72 +++++++++++++++------------- 3 files changed, 41 insertions(+), 49 deletions(-) delete mode 100644 src/haz3lcore/statics/Kind.re diff --git a/src/haz3lcore/dynamics/Elaborator.re b/src/haz3lcore/dynamics/Elaborator.re index 46eca8d3c0..926355d411 100644 --- a/src/haz3lcore/dynamics/Elaborator.re +++ b/src/haz3lcore/dynamics/Elaborator.re @@ -41,11 +41,7 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => switch (self_ty) { | Unknown(prov) => /* ? |> forall _. ? */ - DHExp.cast( - d, - Unknown(prov), - Forall({item: Unknown(prov), name: "_"}), - ) + DHExp.cast(d, Unknown(prov), Forall("_", Unknown(prov))) | Forall(_) => d | _ => failwith("Elaborator.wrap: SynTypFun non-forall-type") } @@ -68,11 +64,7 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | TypFun(_) => switch (ana_ty) { | Unknown(prov) => - DHExp.cast( - d, - Forall({item: Unknown(prov), name: "grounded_forall"}), - ana_ty, - ) + DHExp.cast(d, Forall("grounded_forall", Unknown(prov)), ana_ty) | _ => d } | Tuple(ds) => @@ -86,7 +78,7 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | TypAp(Constructor(_), _) | Constructor(_) => switch (ana_ty, self_ty) { - | (Unknown(prov), Rec({item: Sum(_), _})) + | (Unknown(prov), Rec(_, Sum(_))) | (Unknown(prov), Sum(_)) => DHExp.cast(d, self_ty, Unknown(prov)) | _ => d } diff --git a/src/haz3lcore/statics/Kind.re b/src/haz3lcore/statics/Kind.re deleted file mode 100644 index 21b1604440..0000000000 --- a/src/haz3lcore/statics/Kind.re +++ /dev/null @@ -1,4 +0,0 @@ -[@deriving (show({with_path: false}), sexp, yojson)] -type t = - | Singleton(Typ.t) - | Abstract; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index caa8545166..8b10e7118b 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -253,22 +253,22 @@ and uexp_to_info_map = ); | TypFun({term: Var(name), _} as utpat, body) => let mode_body = Mode.of_forall(mode); - let m_typat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; - let ctx_body = Ctx.add_abstract(ctx, name, Term.UTPat.rep_id(utpat)); - let (body, m_body) = go'(~ctx=ctx_body, ~mode=mode_body, body); - add( - ~self=Just(Forall({item: body.ty, name})), - ~free=body.free, - union_m([m_typat, m_body]), - ); + let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; + let ctx_body = + Ctx.extend_tvar( + ctx, + {name, id: Term.UTPat.rep_id(utpat), kind: Abstract}, + ); + let (body, m) = go'(~ctx=ctx_body, ~mode=mode_body, body, m); + add(~self=Just(Forall(name, body.ty)), ~co_ctx=body.co_ctx, m); | TypFun(utpat, body) => let mode_body = Mode.of_forall(mode); - let m_typat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; - let (body, m_body) = go(~mode=mode_body, body); + let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; + let (body, m) = go(~mode=mode_body, body, m); add( - ~self=Just(Forall({item: body.ty, name: "expected_type_variable"})), - ~free=body.free, - union_m([m_typat, m_body]), + ~self=Just(Forall("expected_type_variable", body.ty)), + ~co_ctx=body.co_ctx, + m, ); | Let(p, def, body) => let (p_syn, _m) = go_pat(~is_synswitch=true, ~mode=Syn, p, m); @@ -372,10 +372,6 @@ and uexp_to_info_map = go'(~ctx, ~mode, body, m); let m = utyp_to_info_map(~ctx, ~ancestors, utyp, m) |> snd; add(~self=Just(ty_body), ~co_ctx, m); - | _ => - let (Info.{free, ty: ty_body, _}, m_body) = go'(~ctx, ~mode, body); - let m_typ = utyp_to_info_map(~ctx, ~ancestors, utyp) |> snd; - add(~self=Just(ty_body), ~free, union_m([m_typat, m_body, m_typ])); }; }; } @@ -514,45 +510,53 @@ and utyp_to_info_map = (m, []), variants, ); - add(union_m(ms)); + add(m); | Forall({term: Var(name), _} as utpat, tbody) => - let body_ctx = Ctx.add_abstract(ctx, name, Term.UTPat.rep_id(utpat)); + let body_ctx = + Ctx.extend_tvar( + ctx, + {name, id: Term.UTPat.rep_id(utpat), kind: Abstract}, + ); let m = utyp_to_info_map( tbody, ~ctx=body_ctx, ~ancestors, ~expects=TypeExpected, + m, ) |> snd; - let m_tpat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; - add(union_m([m, m_tpat])); // TODO: check with andrew + let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; + add(m); // TODO: check with andrew | Forall(utpat, tbody) => let m = - utyp_to_info_map(tbody, ~ctx, ~ancestors, ~expects=TypeExpected) |> snd; - let m_tpat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; - add(union_m([m, m_tpat])); // TODO: check with andrew + utyp_to_info_map(tbody, ~ctx, ~ancestors, ~expects=TypeExpected, m) + |> snd; + let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; + add(m); // TODO: check with andrew | Rec({term: Var(name), _} as utpat, tbody) => - let body_ctx = Ctx.add_abstract(ctx, name, Term.UTPat.rep_id(utpat)); + let body_ctx = + Ctx.extend_tvar( + ctx, + {name, id: Term.UTPat.rep_id(utpat), kind: Abstract}, + ); let m = utyp_to_info_map( tbody, ~ctx=body_ctx, ~ancestors, ~expects=TypeExpected, + m, ) |> snd; - let m_tpat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; - add(union_m([m, m_tpat])); // TODO: check with andrew + let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; + add(m); // TODO: check with andrew | Rec(utpat, tbody) => let m = - utyp_to_info_map(tbody, ~ctx, ~ancestors, ~expects=TypeExpected) |> snd; - let m_tpat = utpat_to_info_map(~ctx, ~ancestors, utpat) |> snd; - add(union_m([m, m_tpat])); // TODO: check with andrew - | MultiHole(tms) => - let (_, ms) = - tms |> List.map(any_to_info_map(~ctx, ~ancestors)) |> List.split; - add(union_m(ms)); + utyp_to_info_map(tbody, ~ctx, ~ancestors, ~expects=TypeExpected, m) + |> snd; + let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; + add(m); // TODO: check with andrew }; } and utpat_to_info_map = From d78057e057a7a9518c67f259cb8527ef4ec2a935 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Fri, 25 Aug 2023 16:46:46 -0400 Subject: [PATCH 15/56] Edit constructors in frontend. --- src/haz3lweb/view/CursorInspector.re | 4 +--- src/haz3lweb/view/Kind.re | 2 +- src/haz3lweb/view/Type.re | 6 +++--- src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re | 3 +-- src/haz3lweb/view/dhcode/layout/HTypDoc.re | 6 +++--- 5 files changed, 9 insertions(+), 12 deletions(-) diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index e97934b72d..1419aa81c1 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -138,7 +138,7 @@ let typ_ok_view = (cls: Term.Cls.t, ok: Info.ok_typ) => Type.view(ty_lookup), ] | Variant(name, sum_ty) => [ - Type.view(Var({name, item: None})), + Type.view(Var(name)), text("is a sum type constuctor of type"), Type.view(sum_ty), ] @@ -146,8 +146,6 @@ let typ_ok_view = (cls: Term.Cls.t, ok: Info.ok_typ) => text("An incomplete sum type constuctor of type"), Type.view(sum_ty), ] - | Variant(name, _sum_ty) => [Type.view(Var(name))] - | VariantIncomplete(_sum_ty) => [text("is incomplete")] }; let typ_err_view = (ok: Info.error_typ) => diff --git a/src/haz3lweb/view/Kind.re b/src/haz3lweb/view/Kind.re index f84672515c..148336e1c2 100644 --- a/src/haz3lweb/view/Kind.re +++ b/src/haz3lweb/view/Kind.re @@ -2,7 +2,7 @@ open Virtual_dom.Vdom; open Node; open Util.Web; -let view = (kind: Haz3lcore.Kind.t): Node.t => +let view = (kind: Haz3lcore.TypBase.Kind.t): Node.t => switch (kind) { | Singleton(ty) => div_c("kind-view", [Type.view(ty)]) | Abstract => div_c("kind-view", [text("Type")]) diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 290eb81f61..e3afd602bb 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -33,13 +33,13 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => | Float => ty_view("Float", "Float") | String => ty_view("String", "String") | Bool => ty_view("Bool", "Bool") - | Var({name, _}) => ty_view("Var", name) - | Rec({item: t, name}) => + | Var(name) => ty_view("Var", name) + | Rec(name, t) => div( ~attr=clss(["typ-view", "Rec"]), [text("Rec " ++ name ++ ". "), view_ty(t)], ) - | Forall({item: t, name}) => + | Forall(name, t) => div( ~attr=clss(["typ-view", "Forall"]), [text("Forall " ++ name ++ ". "), view_ty(t)], diff --git a/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re b/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re index 32780da431..cc14be633a 100644 --- a/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re +++ b/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re @@ -269,8 +269,7 @@ let rec mk = ]), mk_cast(go(~enforce_inline=false, dbody)), ]); - | FailedCast(Cast(d, ty1, ty2), ty2', ty3) - when Typ.eq_syntactic(ty2, ty2') => + | FailedCast(Cast(d, ty1, ty2), ty2', ty3) when Typ.eq(ty2, ty2') => let (d_doc, _) = go'(d); let cast_decoration = hcats([ diff --git a/src/haz3lweb/view/dhcode/layout/HTypDoc.re b/src/haz3lweb/view/dhcode/layout/HTypDoc.re index bff18b7240..2552da95e5 100644 --- a/src/haz3lweb/view/dhcode/layout/HTypDoc.re +++ b/src/haz3lweb/view/dhcode/layout/HTypDoc.re @@ -50,7 +50,7 @@ let rec mk = (~parenthesize=false, ~enforce_inline: bool, ty: Typ.t): t => { | Float => (text("Float"), parenthesize) | Bool => (text("Bool"), parenthesize) | String => (text("String"), parenthesize) - | Var({name, _}) => (text(name), parenthesize) + | Var(name) => (text(name), parenthesize) | List(ty) => ( hcats([ mk_delim("["), @@ -106,7 +106,7 @@ let rec mk = (~parenthesize=false, ~enforce_inline: bool, ty: Typ.t): t => { ) |> hcats; (center, true); - | Rec({item: ty, name}) => ( + | Rec(name, ty) => ( hcats([ text("Rec " ++ name ++ ".{"), ( @@ -118,7 +118,7 @@ let rec mk = (~parenthesize=false, ~enforce_inline: bool, ty: Typ.t): t => { ]), parenthesize, ) - | Forall({item: ty, name}) => ( + | Forall(name, ty) => ( hcats([ text("Forall " ++ name ++ ".{"), ( From 06cbf1d3f75e91333994ebd757bbe7139659c5f4 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Fri, 25 Aug 2023 17:32:35 -0400 Subject: [PATCH 16/56] Change dhexp substitution to use binding names rather than debrujin. --- src/haz3lcore/dynamics/Evaluator.re | 95 +++++++++++++---------------- src/haz3lcore/statics/Term.re | 6 ++ 2 files changed, 50 insertions(+), 51 deletions(-) diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 24eaeaa8f8..c7fcf624bb 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -25,9 +25,7 @@ let grounded_Arrow = NotGroundOrHole(Arrow(Unknown(Internal), Unknown(Internal))); // TODO (typfun): Maybe the Forall should allow a hole in the variable position? let grounded_Forall = - NotGroundOrHole( - Forall({item: Unknown(Internal), name: "grounded_forall"}), - ); + NotGroundOrHole(Forall("grounded_forall", Unknown(Internal))); let grounded_Prod = length => NotGroundOrHole(Prod(ListUtil.replicate(length, Typ.Unknown(Internal)))); let grounded_Sum = (sm: Typ.sum_map): ground_cases => { @@ -51,7 +49,7 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { | Var(_) | Rec(_) | Arrow(Unknown(_), Unknown(_)) - | Forall({item: Unknown(_), name: _}) + | Forall(_, Unknown(_)) | List(Unknown(_)) => Ground | Prod(tys) => if (List.for_all( @@ -184,8 +182,8 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => | None => DoesNotMatch } - | (Ap(_, _), Cast(d, Sum(_) | Rec({item: Sum(_), _}), Unknown(_))) - | (Ap(_, _), Cast(d, Unknown(_), Sum(_) | Rec({item: Sum(_), _}))) => + | (Ap(_, _), Cast(d, Sum(_) | Rec(_, Sum(_)), Unknown(_))) + | (Ap(_, _), Cast(d, Unknown(_), Sum(_) | Rec(_, Sum(_)))) => matches(dp, d) | (Ap(_, _), _) => DoesNotMatch @@ -292,11 +290,7 @@ and matches_cast_Sum = matches(dp, DHExp.apply_casts(d', side_casts)) | _ => DoesNotMatch } - | Cast( - d', - Sum(sm1) | Rec({item: Sum(sm1), _}), - Sum(sm2) | Rec({item: Sum(sm2), _}), - ) => + | Cast(d', Sum(sm1) | Rec(_, Sum(sm1)), Sum(sm2) | Rec(_, Sum(sm2))) => switch (cast_sum_maps(sm1, sm2)) { | Some(castmap) => matches_cast_Sum(ctr, dp, d', [castmap, ...castmaps]) | None => DoesNotMatch @@ -638,26 +632,27 @@ let eval_bin_string_op = }; let rec ty_subst = - (~idx=0, exp, targ) + (s: Typ.t, x: TypVar.t, exp) : DHExp.t /* TODO: Maybe just keep error instead of recursing? */ => { open DH.DHExp; - let re = e2 => ty_subst(~idx, e2, targ); + let re = e2 => ty_subst(s, x, e2); + let t_re = ty => Typ.subst(s, x, ty); switch (exp) { - | Cast(t, t1, t2) => - Cast(re(t), Typ.subst(targ, ~x=idx, t1), Typ.subst(targ, ~x=idx, t2)) - | FixF(arg, ty, body) => FixF(arg, Typ.subst(targ, ~x=idx, ty), re(body)) - | Fun(arg, ty, body, var) => - Fun(arg, Typ.subst(targ, ~x=idx, ty), re(body), var) - | TypAp(tfun, ty) => TypAp(re(tfun), Typ.subst(targ, ~x=idx, ty)) - | ListLit(mv, mvi, lerr, t, lst) => - ListLit(mv, mvi, lerr, Typ.subst(targ, ~x=idx, t), List.map(re, lst)) - - | TypFun(utpat, body) => TypFun(utpat, ty_subst(~idx=idx + 1, body, targ)) - + | Cast(t, t1, t2) => Cast(re(t), t_re(t1), t_re(t2)) + | FixF(arg, ty, body) => FixF(arg, t_re(ty), re(body)) + | Fun(arg, ty, body, var) => Fun(arg, t_re(ty), re(body), var) + | TypAp(tfun, ty) => TypAp(re(tfun), t_re(ty)) + | ListLit(mv, mvi, t, lst) => + ListLit(mv, mvi, t_re(t), List.map(re, lst)) + | TypFun(utpat, body) => + switch (Term.UTPat.tyvar_of_utpat(utpat)) { + | Some(x') when x == x' => exp + | _ => TypFun(utpat, re(body)) + } | NonEmptyHole(errstat, mv, hid, t) => NonEmptyHole(errstat, mv, hid, re(t)) | InconsistentBranches(mv, hid, case) => - InconsistentBranches(mv, hid, ty_subst_case(~idx, case, targ)) + InconsistentBranches(mv, hid, ty_subst_case(s, x, case)) | Closure(ce, t) => Closure(ce, re(t)) | Sequence(t1, t2) => Sequence(re(t1), re(t2)) | Let(dhpat, t1, t2) => Let(dhpat, re(t1), re(t2)) @@ -668,32 +663,33 @@ let rec ty_subst = | BinFloatOp(op, t1, t2) => BinFloatOp(op, re(t1), re(t2)) | BinStringOp(op, t1, t2) => BinStringOp(op, re(t1), re(t2)) | Cons(t1, t2) => Cons(re(t1), re(t2)) + | ListConcat(t1, t2) => ListConcat(re(t1), re(t2)) | Tuple(args) => Tuple(List.map(re, args)) | Prj(t, n) => Prj(re(t), n) - | ConsistentCase(case) => ConsistentCase(ty_subst_case(~idx, case, targ)) + | ConsistentCase(case) => ConsistentCase(ty_subst_case(s, x, case)) | InvalidOperation(t, err) => InvalidOperation(re(t), err) | EmptyHole(_) | ExpandingKeyword(_, _, _) | FreeVar(_, _, _) | InvalidText(_, _, _) + | Constructor(_) | BoundVar(_) | TestLit(_) | BoolLit(_) | IntLit(_) | FloatLit(_) | StringLit(_) - | Tag(_) | FailedCast(_, _, _) => exp }; } //TODO: is this correct? //TODO: Inconsistent cases: need to check again for inconsistency? -and ty_subst_case = (~idx=0, Case(t, rules, n), targ) => +and ty_subst_case = (s, x, Case(t, rules, n)) => Case( - ty_subst(~idx, t, targ), + ty_subst(s, x, t), List.map( - (DHExp.Rule(dhpat, t)) => DHExp.Rule(dhpat, ty_subst(~idx, t, targ)), + (DHExp.Rule(dhpat, t)) => DHExp.Rule(dhpat, ty_subst(s, x, t)), rules, ), n, @@ -756,26 +752,23 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = | TypAp(d1, tau) => let* r1 = evaluate(env, d1); switch (r1) { - | BoxedValue(Closure(closure_env, TypFun(_, d2))) => + | BoxedValue(Closure(closure_env, TypFun(utpat, d2))) => // TODO: Maybe additional cases to be done? - evaluate(closure_env, ty_subst(d2, tau)) - | BoxedValue( - Cast( - d1', - Forall({item: t, name: _}), - Forall({item: t', name: _}), - ), - ) - | Indet( - Cast( - d1', - Forall({item: t, name: _}), - Forall({item: t', name: _}), - ), - ) => + switch (Term.UTPat.tyvar_of_utpat(utpat)) { + | Some(tyvar) => evaluate(closure_env, ty_subst(tau, tyvar, d2)) + | None => + /* Treat a hole or invalid tyvar name as a unique type variable that doesn't appear anywhere else. Thus instantiating it at anything doesn't produce any substitutions. */ + evaluate(closure_env, d2) + } + | BoxedValue(Cast(d1', Forall(x, t), Forall(x', t'))) + | Indet(Cast(d1', Forall(x, t), Forall(x', t'))) => evaluate( env, - Cast(TypAp(d1', tau), Typ.subst(t, tau), Typ.subst(t', tau)), + Cast( + TypAp(d1', tau), + Typ.subst(tau, x, t), + Typ.subst(tau, x', t'), + ), ) | Indet(_) => r1 |> return | _ => failwith("InvalidBoxedTypFun: " ++ show(r1)) @@ -1132,7 +1125,7 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = /* by canonical forms, d1' must be of the form d ?> */ switch (d1') { | Cast(d1'', ty'', Unknown(_)) => - if (Typ.eq_syntactic(ty'', ty')) { + if (Typ.eq(ty'', ty')) { BoxedValue(d1'') |> return; } else { Indet(FailedCast(d1', ty, ty')) |> return; @@ -1154,7 +1147,7 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = BoxedValue(Cast(d1', ty, ty')) |> return | (NotGroundOrHole(_), NotGroundOrHole(_)) => /* they might be eq in this case, so remove cast if so */ - if (Typ.eq_syntactic(ty, ty')) { + if (Typ.eq(ty, ty')) { result |> return; } else { BoxedValue(Cast(d1', ty, ty')) |> return; @@ -1172,7 +1165,7 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = | (Hole, Ground) => switch (d1') { | Cast(d1'', ty'', Unknown(_)) => - if (Typ.eq_syntactic(ty'', ty')) { + if (Typ.eq(ty'', ty')) { Indet(d1'') |> return; } else { Indet(FailedCast(d1', ty, ty')) |> return; @@ -1194,7 +1187,7 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = Indet(Cast(d1', ty, ty')) |> return | (NotGroundOrHole(_), NotGroundOrHole(_)) => /* it might be eq in this case, so remove cast if so */ - if (Typ.eq_syntactic(ty, ty')) { + if (Typ.eq(ty, ty')) { result |> return; } else { Indet(Cast(d1', ty, ty')) |> return; diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index b075c17c4c..c0418f8be3 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -53,6 +53,12 @@ module UTPat = { | MultiHole => "Broken type alias" | EmptyHole => "Empty type alias hole" | Var => "Type alias"; + + let tyvar_of_utpat = ({ids: _, term}) => + switch (term) { + | Var(x) => Some(x) + | _ => None + }; }; module UTyp = { From 749da41b91d36da460cf56933ff4bd731bc2bc3b Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Fri, 25 Aug 2023 17:50:40 -0400 Subject: [PATCH 17/56] Fix issue with looking up tvars in ctx. --- src/haz3lcore/statics/Info.re | 6 +++++- src/haz3lcore/statics/TypBase.re | 7 +++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index af8aa33b15..ea96f63bc8 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -358,7 +358,11 @@ let status_typ = InHole(DuplicateConstructor(name)) | TypeExpected => switch (Ctx.is_alias(ctx, name)) { - | false => InHole(FreeTypeVariable(name)) + | false => + switch (Ctx.is_tvar(ctx, name)) { + | false => InHole(FreeTypeVariable(name)) + | true => NotInHole(Type(Var(name))) + } | true => NotInHole(TypeAlias(name, Typ.weak_head_normalize(ctx, ty))) } } diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 683764fcb4..15964f3f48 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -473,6 +473,7 @@ and Ctx: { let lookup_var: (t, string) => option(var_entry); let lookup_ctr: (t, string) => option(var_entry); let is_alias: (t, TypVar.t) => bool; + let is_tvar: (t, TypVar.t) => bool; let add_ctrs: (t, TypVar.t, Id.t, Typ.sum_map) => t; let subtract_prefix: (t, t) => option(t); let added_bindings: (t, t) => t; @@ -556,6 +557,12 @@ and Ctx: { | None => false }; + let is_tvar = (ctx: t, name: TypVar.t): bool => + switch (lookup_tvar(ctx, name)) { + | Some(_) => true + | None => false + }; + let add_ctrs = (ctx: t, name: TypVar.t, id: Id.t, ctrs: Typ.sum_map): t => List.map( ((ctr, typ)) => From 66870d3e4ac4b8dcbb338bc9a10955b7251429f7 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Fri, 25 Aug 2023 18:26:00 -0400 Subject: [PATCH 18/56] Fix error in alpha equiv --- src/haz3lcore/statics/TypBase.re | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 15964f3f48..2d6eed9553 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -199,11 +199,16 @@ module rec Typ: { /* Type Equality: At the moment, this coincides with alpha equivalence, but this will change when polymorphic types are implemented */ - let rec eq = (t1: t, t2: t): bool => { + let rec eq_internal = (n: int, t1: t, t2: t) => { switch (t1, t2) { - | (Rec(x1, t1), Rec(x2, t2)) => eq(t1, subst(Var(x1), x2, t2)) + | (Rec(x1, t1), Rec(x2, t2)) + | (Forall(x1, t1), Forall(x2, t2)) => + eq_internal( + n + 1, + subst(Var("@" ++ string_of_int(n)), x1, t1), + subst(Var("@" ++ string_of_int(n)), x2, t2), + ) | (Rec(_), _) => false - | (Forall(x1, t1), Forall(x2, t2)) => eq(t1, subst(Var(x1), x2, t2)) /* TODO: correct? */ | (Forall(_), _) => false | (Int, Int) => true | (Int, _) => false @@ -215,20 +220,23 @@ module rec Typ: { | (String, _) => false | (Unknown(_), Unknown(_)) => true | (Unknown(_), _) => false - | (Arrow(t1, t2), Arrow(t1', t2')) => eq(t1, t1') && eq(t2, t2') + | (Arrow(t1, t2), Arrow(t1', t2')) => + eq_internal(n, t1, t1') && eq_internal(n, t2, t2') | (Arrow(_), _) => false - | (Prod(tys1), Prod(tys2)) => List.equal(eq, tys1, tys2) + | (Prod(tys1), Prod(tys2)) => List.equal(eq_internal(n), tys1, tys2) | (Prod(_), _) => false - | (List(t1), List(t2)) => eq(t1, t2) + | (List(t1), List(t2)) => eq_internal(n, t1, t2) | (List(_), _) => false | (Sum(sm1), Sum(sm2)) => - ConstructorMap.equal(Option.equal(eq), sm1, sm2) + ConstructorMap.equal(Option.equal(eq_internal(n)), sm1, sm2) | (Sum(_), _) => false | (Var(n1), Var(n2)) => n1 == n2 | (Var(_), _) => false }; }; + let eq = (t1: t, t2: t): bool => eq_internal(0, t1, t2); + let rec free_vars = (~bound=[], ty: t): list(Var.t) => switch (ty) { | Unknown(_) From e63913db8475a6b226218afd8620332a17f47a99 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Sat, 26 Aug 2023 14:24:26 -0400 Subject: [PATCH 19/56] Fix typechecking with mismatching type variable names. --- src/haz3lcore/statics/Mode.re | 9 ++++++--- src/haz3lcore/statics/Statics.re | 4 ++-- src/haz3lcore/statics/TypBase.re | 12 ++++++------ 3 files changed, 14 insertions(+), 11 deletions(-) diff --git a/src/haz3lcore/statics/Mode.re b/src/haz3lcore/statics/Mode.re index 267f465abb..05300ca116 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -46,14 +46,17 @@ let of_arrow = (ctx: Ctx.t, mode: t): (t, t) => |> TupleUtil.map2(ana) }; -let of_forall = (mode: t): t => +let of_forall = (name_opt: option(TypVar.t), mode: t): t => switch (mode) { | Syn | SynFun | SynTypFun => Syn | Ana(ty) => - let (_, item) = Typ.matched_forall(ty); - Ana(item); + let (name_expected, item) = Typ.matched_forall(ty); + switch (name_opt) { + | Some(name) => Ana(Typ.subst(Var(name), name_expected, item)) + | None => Ana(item) + }; }; let of_prod = (ctx: Ctx.t, mode: t, length): list(t) => diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 8b10e7118b..2f5ef952a8 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -252,7 +252,7 @@ and uexp_to_info_map = m, ); | TypFun({term: Var(name), _} as utpat, body) => - let mode_body = Mode.of_forall(mode); + let mode_body = Mode.of_forall(Some(name), mode); let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; let ctx_body = Ctx.extend_tvar( @@ -262,7 +262,7 @@ and uexp_to_info_map = let (body, m) = go'(~ctx=ctx_body, ~mode=mode_body, body, m); add(~self=Just(Forall(name, body.ty)), ~co_ctx=body.co_ctx, m); | TypFun(utpat, body) => - let mode_body = Mode.of_forall(mode); + let mode_body = Mode.of_forall(None, mode); let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; let (body, m) = go(~mode=mode_body, body, m); add( diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 2d6eed9553..04094e5ad7 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -185,7 +185,7 @@ module rec Typ: { | Rec(y, ty) when TypVar.eq(x, y) => Rec(y, ty) | Rec(y, ty) => Rec(y, subst(s, x, ty)) | Forall(y, ty) when TypVar.eq(x, y) => Forall(y, ty) - | Forall(y, ty) => Forall(y, subst(s, x, ty)) + | Forall(y, ty) => Forall(y, subst(s, x, ty)) /* TODO: Need to implement capture avoiding subst */ | List(ty) => List(subst(s, x, ty)) | Var(y) => TypVar.eq(x, y) ? s : Var(y) }; @@ -305,12 +305,12 @@ module rec Typ: { let+ ty_body = join(~resolve, ~fix, ctx, ty1, subst(Var(x1), x2, ty2)); Rec(x1, ty_body); - | (Forall(name, t1), Forall(_, t2)) => + | (Forall(x1, ty1), Forall(x2, ty2)) => /* See note above in Rec case */ - switch (join(~resolve, ~fix, Ctx.extend_dummy_tvar(ctx, name), t1, t2)) { - | Some(t) => Some(Forall(name, t)) - | None => None - } + let ctx = Ctx.extend_dummy_tvar(ctx, x1); + let+ ty_body = + join(~resolve, ~fix, ctx, ty1, subst(Var(x1), x2, ty2)); + Forall(x1, ty_body); | (Rec(_), _) => None | (Forall(_), _) => None | (Int, Int) => Some(Int) From c3f44b43fb026cd6b649c1fbd55687a23395ddd7 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Sat, 26 Aug 2023 15:08:37 -0400 Subject: [PATCH 20/56] Implement capture avoiding substitution. --- src/haz3lcore/statics/TypBase.re | 62 ++++++++++++++++++-------------- 1 file changed, 36 insertions(+), 26 deletions(-) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 04094e5ad7..98e018234b 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -172,6 +172,36 @@ module rec Typ: { | Arrow(_, _) => precedence_Arrow }; + let rec free_vars = (~bound=[], ty: t): list(Var.t) => + switch (ty) { + | Unknown(_) + | Int + | Float + | Bool + | String => [] + | Var(v) => List.mem(v, bound) ? [] : [v] + | List(ty) => free_vars(~bound, ty) + | Arrow(t1, t2) => free_vars(~bound, t1) @ free_vars(~bound, t2) + | Sum(sm) => + ListUtil.flat_map( + fun + | None => [] + | Some(typ) => free_vars(~bound, typ), + List.map(snd, sm), + ) + | Prod(tys) => ListUtil.flat_map(free_vars(~bound), tys) + | Rec(x, ty) => free_vars(~bound=[x, ...bound], ty) + | Forall(x, ty) => free_vars(~bound=[x, ...bound], ty) + /* TODO: check that these are correct. */ + }; + + let var_count = ref(0); + let fresh_var = () => { + let x = var_count^; + var_count := x + 1; + "@" ++ string_of_int(x); + }; + let rec subst = (s: t, x: TypVar.t, ty: t) => { switch (ty) { | Int => Int @@ -185,7 +215,10 @@ module rec Typ: { | Rec(y, ty) when TypVar.eq(x, y) => Rec(y, ty) | Rec(y, ty) => Rec(y, subst(s, x, ty)) | Forall(y, ty) when TypVar.eq(x, y) => Forall(y, ty) - | Forall(y, ty) => Forall(y, subst(s, x, ty)) /* TODO: Need to implement capture avoiding subst */ + | Forall(y, ty) when List.mem(y, free_vars(s)) => + let fresh = fresh_var(); + Forall(fresh, subst(s, x, subst(Var(fresh), y, ty))); + | Forall(y, ty) => Forall(y, subst(s, x, ty)) | List(ty) => List(subst(s, x, ty)) | Var(y) => TypVar.eq(x, y) ? s : Var(y) }; @@ -205,8 +238,8 @@ module rec Typ: { | (Forall(x1, t1), Forall(x2, t2)) => eq_internal( n + 1, - subst(Var("@" ++ string_of_int(n)), x1, t1), - subst(Var("@" ++ string_of_int(n)), x2, t2), + subst(Var("=" ++ string_of_int(n)), x1, t1), + subst(Var("=" ++ string_of_int(n)), x2, t2), ) | (Rec(_), _) => false | (Forall(_), _) => false @@ -237,29 +270,6 @@ module rec Typ: { let eq = (t1: t, t2: t): bool => eq_internal(0, t1, t2); - let rec free_vars = (~bound=[], ty: t): list(Var.t) => - switch (ty) { - | Unknown(_) - | Int - | Float - | Bool - | String => [] - | Var(v) => List.mem(v, bound) ? [] : [v] - | List(ty) => free_vars(~bound, ty) - | Arrow(t1, t2) => free_vars(~bound, t1) @ free_vars(~bound, t2) - | Sum(sm) => - ListUtil.flat_map( - fun - | None => [] - | Some(typ) => free_vars(~bound, typ), - List.map(snd, sm), - ) - | Prod(tys) => ListUtil.flat_map(free_vars(~bound), tys) - | Rec(x, ty) => free_vars(~bound=[x, ...bound], ty) - | Forall(x, ty) => free_vars(~bound=[x, ...bound], ty) - /* TODO: check that these are correct. */ - }; - /* Lattice join on types. This is a LUB join in the hazel2 sense in that any type dominates Unknown. The optional resolve parameter specifies whether, in the case of a type From 4ef0651d03f027f4e191db38ce74a7efc5560de0 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Sat, 26 Aug 2023 15:16:49 -0400 Subject: [PATCH 21/56] Add capture avoiding binding to recursive types. --- src/haz3lcore/statics/TypBase.re | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 98e018234b..b089ee0fc4 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -213,6 +213,9 @@ module rec Typ: { | Prod(tys) => Prod(List.map(subst(s, x), tys)) | Sum(sm) => Sum(ConstructorMap.map(Option.map(subst(s, x)), sm)) | Rec(y, ty) when TypVar.eq(x, y) => Rec(y, ty) + | Rec(y, ty) when List.mem(y, free_vars(s)) => + let fresh = fresh_var(); + Rec(fresh, subst(s, x, subst(Var(fresh), y, ty))); | Rec(y, ty) => Rec(y, subst(s, x, ty)) | Forall(y, ty) when TypVar.eq(x, y) => Forall(y, ty) | Forall(y, ty) when List.mem(y, free_vars(s)) => From 609997d90583d455fe76608a9af6c9fe334c59d7 Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Sun, 27 Aug 2023 11:16:29 -0400 Subject: [PATCH 22/56] merge typFun and typAp --- src/haz3lcore/dynamics/DH.re | 13 ++ src/haz3lcore/dynamics/Elaborator.re | 23 +++ src/haz3lcore/dynamics/Evaluator.re | 99 +++++++++++- src/haz3lcore/dynamics/EvaluatorPost.re | 19 ++- src/haz3lcore/dynamics/Substitution.re | 4 + src/haz3lcore/lang/Form.re | 4 + src/haz3lcore/statics/Info.re | 24 ++- src/haz3lcore/statics/Mode.re | 20 ++- src/haz3lcore/statics/Self.re | 4 +- src/haz3lcore/statics/TypBase.re | 161 ++++++++++--------- src/haz3lweb/view/CtxInspector.re | 2 +- src/haz3lweb/view/LangDoc.re | 29 ++++ src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re | 13 +- src/haz3lweb/view/dhcode/layout/HTypDoc.re | 14 +- 14 files changed, 328 insertions(+), 101 deletions(-) diff --git a/src/haz3lcore/dynamics/DH.re b/src/haz3lcore/dynamics/DH.re index 61d7483930..0813e4c49a 100644 --- a/src/haz3lcore/dynamics/DH.re +++ b/src/haz3lcore/dynamics/DH.re @@ -16,6 +16,8 @@ module rec DHExp: { | FixF(Var.t, Typ.t, t) | Fun(DHPat.t, Typ.t, t, option(Var.t)) | Ap(t, t) + | TypFun(Term.UTPat.t, t) + | TypAp(t, Typ.t) | ApBuiltin(string, list(t)) | TestLit(KeywordID.t) | BoolLit(bool) @@ -70,6 +72,8 @@ module rec DHExp: { | FixF(Var.t, Typ.t, t) | Fun(DHPat.t, Typ.t, t, option(Var.t)) | Ap(t, t) + | TypFun(Term.UTPat.t, t) + | TypAp(t, Typ.t) | ApBuiltin(string, list(t)) | TestLit(KeywordID.t) | BoolLit(bool) @@ -109,6 +113,8 @@ module rec DHExp: { | Fun(_, _, _, _) => "Fun" | Closure(_, _) => "Closure" | Ap(_, _) => "Ap" + | TypFun(_, _) => "TypFun" + | TypAp(_) => "TypAp" | ApBuiltin(_, _) => "ApBuiltin" | TestLit(_) => "TestLit" | BoolLit(_) => "BoolLit" @@ -164,6 +170,8 @@ module rec DHExp: { | FixF(a, b, c) => FixF(a, b, strip_casts(c)) | Fun(a, b, c, d) => Fun(a, b, strip_casts(c), d) | Ap(a, b) => Ap(strip_casts(a), strip_casts(b)) + | TypFun(a, b) => TypFun(a, strip_casts(b)) + | TypAp(a, b) => TypAp(strip_casts(a), b) | ApBuiltin(fn, args) => ApBuiltin(fn, List.map(strip_casts, args)) | BinBoolOp(a, b, c) => BinBoolOp(a, strip_casts(b), strip_casts(c)) | BinIntOp(a, b, c) => BinIntOp(a, strip_casts(b), strip_casts(c)) @@ -216,6 +224,9 @@ module rec DHExp: { f1 == f2 && ty1 == ty2 && fast_equal(d1, d2) | (Fun(dp1, ty1, d1, s1), Fun(dp2, ty2, d2, s2)) => dp1 == dp2 && ty1 == ty2 && fast_equal(d1, d2) && s1 == s2 + | (TypFun(ty1, d1), TypFun(ty2, d2)) => + ty1 == ty2 && fast_equal(d1, d2) + | (TypAp(d1, ty1), TypAp(d2, ty2)) => fast_equal(d1, d2) && ty1 == ty2 | (Ap(d11, d21), Ap(d12, d22)) | (Cons(d11, d21), Cons(d12, d22)) => fast_equal(d11, d12) && fast_equal(d21, d22) @@ -251,6 +262,8 @@ module rec DHExp: { | (FixF(_), _) | (Fun(_), _) | (Ap(_), _) + | (TypFun(_), _) + | (TypAp(_), _) | (ApBuiltin(_), _) | (Cons(_), _) | (ListConcat(_), _) diff --git a/src/haz3lcore/dynamics/Elaborator.re b/src/haz3lcore/dynamics/Elaborator.re index 9911b37710..ae0c5840ec 100644 --- a/src/haz3lcore/dynamics/Elaborator.re +++ b/src/haz3lcore/dynamics/Elaborator.re @@ -37,6 +37,14 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | Arrow(_) => d | _ => failwith("Elaborator.wrap: SynFun non-arrow-type") } + | SynTypFun => + switch (self_ty) { + | Unknown(prov) => + /* ? |> forall _. ? */ + DHExp.cast(d, Unknown(prov), Forall("_", Unknown(prov))) + | Forall(_) => d + | _ => failwith("Elaborator.wrap: SynTypFun non-forall-type") + } | Ana(ana_ty) => let ana_ty = Typ.normalize(ctx, ana_ty); /* Forms with special ana rules get cast from their appropriate Matched types */ @@ -53,6 +61,12 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => let (_, ana_out) = Typ.matched_arrow(ana_ty); let (self_in, _) = Typ.matched_arrow(self_ty); DHExp.cast(d, Arrow(self_in, ana_out), ana_ty); + | TypFun(_) => + switch (ana_ty) { + | Unknown(prov) => + DHExp.cast(d, Forall("grounded_forall", Unknown(prov)), ana_ty) + | _ => d + } | Tuple(ds) => switch (ana_ty) { | Unknown(prov) => @@ -61,6 +75,7 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | _ => d } | Ap(Constructor(_), _) + | TypAp(Constructor(_), _) | Constructor(_) => switch (ana_ty, self_ty) { | (Unknown(prov), Rec(_, Sum(_))) @@ -97,6 +112,7 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | BinIntOp(_) | BinFloatOp(_) | BinStringOp(_) + | TypAp(_) | TestLit(_) => DHExp.cast(d, self_ty, ana_ty) }; }; @@ -145,6 +161,10 @@ let rec dhexp_of_uexp = let* d1 = dhexp_of_uexp(m, body); let+ ty = fixed_pat_typ(m, p); DHExp.Fun(dp, ty, d1, None); + | TypFun(tpat, body) => + // TODO (typfun) + let+ d1 = dhexp_of_uexp(m, body); + DHExp.TypFun(tpat, d1); | Tuple(es) => let+ ds = es |> List.map(dhexp_of_uexp(m)) |> OptUtil.sequence; DHExp.Tuple(ds); @@ -241,6 +261,9 @@ let rec dhexp_of_uexp = let* c_fn = dhexp_of_uexp(m, fn); let+ c_arg = dhexp_of_uexp(m, arg); DHExp.Ap(c_fn, c_arg); + | TypAp(fn, uty_arg) => + let+ d_fn = dhexp_of_uexp(m, fn); + DHExp.TypAp(d_fn, Term.UTyp.to_typ(ctx, uty_arg)); | If(scrut, e1, e2) => let* d_scrut = dhexp_of_uexp(m, scrut); let* d1 = dhexp_of_uexp(m, e1); diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 29f1827111..7f82fed3ad 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -30,7 +30,10 @@ let grounded_Sum = (sm: Typ.sum_map): ground_cases => { NotGroundOrHole(Sum(sm')); }; let grounded_List = NotGroundOrHole(List(Unknown(Internal))); - +let grounded_Forall = + NotGroundOrHole(Forall("grounded_forall", Unknown(Internal))); +let grounded_Ap = + NotGroundOrHole(Ap(Unknown(Internal), Unknown(Internal))); let rec ground_cases_of = (ty: Typ.t): ground_cases => { let is_ground_arg: option(Typ.t) => bool = fun @@ -46,7 +49,6 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { | Var(_) | Rec(_) | Arrow(Unknown(_), Unknown(_)) - | Parameter(_) => Hole | List(Unknown(_)) => Ground | Prod(tys) => if (List.for_all( @@ -63,6 +65,8 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { sm |> ConstructorMap.is_ground(is_ground_arg) ? Ground : grounded_Sum(sm) | Arrow(_, _) => grounded_Arrow | List(_) => grounded_List + | Forall(_) => grounded_Forall + | Ap(_) => grounded_Ap }; }; @@ -299,6 +303,7 @@ and matches_cast_Sum = | InvalidText(_) | Let(_) | Ap(_) + | TypAp(_) | ApBuiltin(_) | BinBoolOp(_) | BinIntOp(_) @@ -313,6 +318,7 @@ and matches_cast_Sum = | BoundVar(_) | FixF(_) | Fun(_) + | TypFun(_) | BoolLit(_) | IntLit(_) | FloatLit(_) @@ -390,7 +396,9 @@ and matches_cast_Tuple = | Let(_, _, _) => IndetMatch | FixF(_, _, _) => DoesNotMatch | Fun(_, _, _, _) => DoesNotMatch - | Closure(_, Fun(_)) => DoesNotMatch + | TypFun(_) => DoesNotMatch + | TypAp(_) => DoesNotMatch + | Closure(_, Fun(_) | TypFun(_)) => DoesNotMatch | Closure(_, _) => IndetMatch | Ap(_, _) => IndetMatch | ApBuiltin(_, _) => IndetMatch @@ -527,6 +535,8 @@ and matches_cast_Cons = | Let(_, _, _) => IndetMatch | FixF(_, _, _) => DoesNotMatch | Fun(_, _, _, _) => DoesNotMatch + | TypFun(_) => DoesNotMatch + | TypAp(_) => DoesNotMatch | Closure(_, d') => matches_cast_Cons(dp, d', elt_casts) | Ap(_, _) => IndetMatch | ApBuiltin(_, _) => IndetMatch @@ -621,6 +631,67 @@ let eval_bin_string_op = | Equals => BoolLit(s1 == s2) }; +let rec ty_subst = + (str, exp, targ) + : DHExp.t /* TODO: Maybe just keep error instead of recursing? */ => { + open DH.DHExp; + let re = e2 => ty_subst(str, e2, targ); + switch (exp) { + | Cast(t, t1, t2) => + Cast(re(t), Typ.subst(targ, str, t1), Typ.subst(targ, str, t2)) + | FixF(arg, ty, body) => FixF(arg, Typ.subst(targ, str, ty), re(body)) + | Fun(arg, ty, body, var) => + Fun(arg, Typ.subst(targ, str, ty), re(body), var) + | TypAp(tfun, ty) => TypAp(re(tfun), Typ.subst(targ, str, ty)) + | ListLit(mv, mvi, t, lst) => + ListLit(mv, mvi, Typ.subst(targ, str, t), List.map(re, lst)) + + | TypFun(utpat, body) => TypFun(utpat, ty_subst(str, body, targ)) + + | NonEmptyHole(errstat, mv, hid, t) => + NonEmptyHole(errstat, mv, hid, re(t)) + | InconsistentBranches(mv, hid, case) => + InconsistentBranches(mv, hid, ty_subst_case(str, case, targ)) + | Closure(ce, t) => Closure(ce, re(t)) + | Sequence(t1, t2) => Sequence(re(t1), re(t2)) + | Let(dhpat, t1, t2) => Let(dhpat, re(t1), re(t2)) + | Ap(t1, t2) => Ap(re(t1), re(t2)) + | ApBuiltin(s, args) => ApBuiltin(s, List.map(re, args)) + | BinBoolOp(op, t1, t2) => BinBoolOp(op, re(t1), re(t2)) + | BinIntOp(op, t1, t2) => BinIntOp(op, re(t1), re(t2)) + | BinFloatOp(op, t1, t2) => BinFloatOp(op, re(t1), re(t2)) + | BinStringOp(op, t1, t2) => BinStringOp(op, re(t1), re(t2)) + | Cons(t1, t2) => Cons(re(t1), re(t2)) + | Tuple(args) => Tuple(List.map(re, args)) + | Prj(t, n) => Prj(re(t), n) + | ConsistentCase(case) => ConsistentCase(ty_subst_case(str, case, targ)) + | InvalidOperation(t, err) => InvalidOperation(re(t), err) + | ListConcat(t1, t2) => ListConcat(re(t1), re(t2)) + | Constructor(_) + | EmptyHole(_) + | ExpandingKeyword(_, _, _) + | FreeVar(_, _, _) + | InvalidText(_, _, _) + | BoundVar(_) + | TestLit(_) + | BoolLit(_) + | IntLit(_) + | FloatLit(_) + | StringLit(_) + | FailedCast(_, _, _) => exp + }; +} //TODO: is this correct? +//TODO: Inconsistent cases: need to check again for inconsistency? + +and ty_subst_case = (str, Case(t, rules, n), targ) => + Case( + ty_subst(str, t, targ), + List.map( + (DHExp.Rule(dhpat, t)) => DHExp.Rule(dhpat, ty_subst(str, t, targ)), + rules, + ), + n, + ); let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = (env, d) => { /* Increment number of evaluation steps (calls to `evaluate`). */ @@ -673,7 +744,28 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = evaluate(env', d'); | Fun(_) => BoxedValue(Closure(env, d)) |> return + | TypFun(_) => BoxedValue(Closure(env, d)) |> return + | TypAp(d1, tau) => + let* r1 = evaluate(env, d1); + switch (r1) { + | BoxedValue(Closure(closure_env, TypFun({term: Var(name), _}, d2))) => + // TODO: Maybe additional cases to be done? + evaluate(closure_env, ty_subst(name, d2, tau)) + | BoxedValue(Constructor(name)) => evaluate(env, Constructor(name)) + | BoxedValue(Cast(d1', Forall("_", t), Forall("_", t'))) + | Indet(Cast(d1', Forall("_", t), Forall("_", t'))) => + evaluate( + env, + Cast( + TypAp(d1', tau), + Typ.subst(t, "_", tau), + Typ.subst(t', "_", tau), + ), + ) + | Indet(_) => r1 |> return + | _ => failwith("InvalidBoxedTypFun: " ++ show(r1)) + }; | Ap(d1, d2) => let* r1 = evaluate(env, d1); switch (r1) { @@ -980,6 +1072,7 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = | Closure(_, d') => switch (d') { | Fun(_) => BoxedValue(d) |> return + | TypFun(_) => BoxedValue(d) |> return | _ => Indet(d) |> return } diff --git a/src/haz3lcore/dynamics/EvaluatorPost.re b/src/haz3lcore/dynamics/EvaluatorPost.re index 18d4ea2b44..2cfe38b7ce 100644 --- a/src/haz3lcore/dynamics/EvaluatorPost.re +++ b/src/haz3lcore/dynamics/EvaluatorPost.re @@ -69,7 +69,9 @@ let rec pp_eval = (d: DHExp.t): m(DHExp.t) => let* d1' = pp_eval(d1); let* d2' = pp_eval(d2); Ap(d1', d2') |> return; - + | TypAp(d1, ty) => + let* d1' = pp_eval(d1); + TypAp(d1', ty) |> return; | ApBuiltin(f, args) => let* args' = args |> List.map(pp_eval) |> sequence; ApBuiltin(f, args') |> return; @@ -151,6 +153,7 @@ let rec pp_eval = (d: DHExp.t): m(DHExp.t) => | Let(_) | ConsistentCase(_) | Fun(_) + | TypFun(_) | EmptyHole(_) | NonEmptyHole(_) | ExpandingKeyword(_) @@ -175,7 +178,9 @@ let rec pp_eval = (d: DHExp.t): m(DHExp.t) => | Fun(dp, ty, d, s) => let* d = pp_uneval(env, d); Fun(dp, ty, d, s) |> return; - + | TypFun(tpat, d1) => + let* d1' = pp_uneval(env, d1); + TypFun(tpat, d1') |> return; | Let(dp, d1, d2) => /* d1 should already be evaluated, d2 is not */ let* d1 = pp_eval(d1); @@ -291,12 +296,16 @@ and pp_uneval = (env: ClosureEnvironment.t, d: DHExp.t): m(DHExp.t) => | Fun(dp, ty, d', s) => let* d'' = pp_uneval(env, d'); Fun(dp, ty, d'', s) |> return; - + | TypFun(tpat, d1) => + let* d1' = pp_uneval(env, d1); + TypFun(tpat, d1') |> return; | Ap(d1, d2) => let* d1' = pp_uneval(env, d1); let* d2' = pp_uneval(env, d2); Ap(d1', d2') |> return; - + | TypAp(d1, ty) => + let* d1' = pp_uneval(env, d1); + TypAp(d1', ty) |> return; | ApBuiltin(f, args) => let* args' = args |> List.map(pp_uneval(env)) |> sequence; ApBuiltin(f, args') |> return; @@ -449,6 +458,8 @@ let rec track_children_of_hole = | BoundVar(_) => hii | FixF(_, _, d) | Fun(_, _, d, _) + | TypFun(_, d) + | TypAp(d, _) | Prj(d, _) | Cast(d, _, _) | FailedCast(d, _, _) diff --git a/src/haz3lcore/dynamics/Substitution.re b/src/haz3lcore/dynamics/Substitution.re index 92f8cff0fe..4b1e4ae2fc 100644 --- a/src/haz3lcore/dynamics/Substitution.re +++ b/src/haz3lcore/dynamics/Substitution.re @@ -38,6 +38,8 @@ let rec subst_var = (d1: DHExp.t, x: Var.t, d2: DHExp.t): DHExp.t => let d3 = subst_var(d1, x, d3); Fun(dp, ty, d3, s); } + | TypFun(tpat, d3) => TypFun(tpat, subst_var(d1, x, d3)) + | Closure(env, d3) => /* Closure shouldn't appear during substitution (which only is called from elaboration currently) */ @@ -48,6 +50,8 @@ let rec subst_var = (d1: DHExp.t, x: Var.t, d2: DHExp.t): DHExp.t => let d3 = subst_var(d1, x, d3); let d4 = subst_var(d1, x, d4); Ap(d3, d4); + | TypAp(d3, ty) => TypAp(subst_var(d1, x, d3), ty) + | ApBuiltin(ident, args) => let args = List.map(subst_var(d1, x), args); ApBuiltin(ident, args); diff --git a/src/haz3lcore/lang/Form.re b/src/haz3lcore/lang/Form.re index 9303fb4e17..3cf1699707 100644 --- a/src/haz3lcore/lang/Form.re +++ b/src/haz3lcore/lang/Form.re @@ -254,11 +254,15 @@ let forms: list((string, t)) = [ ("parens_pat", mk(ii, ["(", ")"], mk_op(Pat, [Pat]))), ("parens_typ", mk(ii, ["(", ")"], mk_op(Typ, [Typ]))), ("fun_", mk(ds, ["fun", "->"], mk_pre(P.fun_, Exp, [Pat]))), + ("typfun", mk(ds, ["typfun", "->"], mk_pre(P.fun_, Exp, [TPat]))), + ("forall", mk(ds, ["forall", "->"], mk_pre(P.fun_, Typ, [TPat]))), ("if_", mk(ds, ["if", "then", "else"], mk_pre(P.if_, Exp, [Exp, Exp]))), ("ap_exp", mk(ii, ["(", ")"], mk_post(P.ap, Exp, [Exp]))), ("ap_pat", mk(ii, ["(", ")"], mk_post(P.ap, Pat, [Pat]))), ("ap_tpat", mk(ii, ["(", ")"], mk_post(P.ap, TPat, [TPat]))), ("ap_typ", mk(ii, ["(", ")"], mk_post(P.ap, Typ, [Typ]))), + ("ap_exp_typ", mk(ii, ["@<", ">"], mk_post(P.ap, Exp, [Typ]))), + ("at_sign", mk_nul_infix("@", P.eqs)), // HACK: SUBSTRING REQ ("let_", mk(ds, ["let", "=", "in"], mk_pre(P.let_, Exp, [Pat, Exp]))), ( "type_alias", diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 1ef074e068..cd49f4529d 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -272,6 +272,13 @@ let rec status_common = | None => InHole(Inconsistent(WithArrow(syn))) | Some(_) => NotInHole(Syn(syn)) } + | (Just(ty), SynTypFun) => + /* Use ty first to preserve name if it exists. */ + switch (Typ.join_fix(ctx, ty, Forall("_", Unknown(Internal)))) { + | Some(_) => NotInHole(Syn(ty)) + | None => InHole(Inconsistent(WithArrow(ty))) + } + | (IsConstructor({name, syn_ty}), _) => /* If a ctr is being analyzed against (an arrow type returning) a sum type having that ctr as a variant, its self type is @@ -293,13 +300,13 @@ let rec status_common = Ana(InternallyInconsistent({ana, nojoin: Typ.of_source(tys)})), ) }; - | (NoJoin(_, tys), Syn | SynFun) => + | (NoJoin(_, tys), Syn | SynFun | SynTypFun) => InHole(Inconsistent(Internal(Typ.of_source(tys)))) }; -let status_pat = (ctx: Ctx.t, mode: Mode.t, self: Self.pat): status_pat => +let status_pat = (ctx: Ctx.t, mode: Mode.t, self: Self.pat): status_pat => { switch (mode, self) { - | (Syn | Ana(_), Common(self_pat)) + | (SynTypFun | Syn | Ana(_), Common(self_pat)) | (SynFun, Common(IsConstructor(_) as self_pat)) => /* Little bit of a hack. Anything other than a bound ctr will, in function position, have SynFun mode (see Typ.ap_mode). Since we @@ -313,7 +320,7 @@ let status_pat = (ctx: Ctx.t, mode: Mode.t, self: Self.pat): status_pat => } | (SynFun, _) => InHole(ExpectedConstructor) }; - +}; /* Determines whether an expression or pattern is in an error hole, depending on the mode, which represents the expectations of the surrounding syntactic context, and the self which represents the @@ -352,7 +359,12 @@ let status_typ = InHole(DuplicateConstructor(name)) | TypeExpected => switch (Ctx.is_alias(ctx, name)) { - | false => InHole(FreeTypeVariable(name)) + | false => + switch (Ctx.is_tyVar(ctx, name)) { + | false => InHole(FreeTypeVariable(name)) + | true => + NotInHole(TypeAlias(name, Typ.weak_head_normalize(ctx, ty))) + } | true => NotInHole(TypeAlias(name, Typ.weak_head_normalize(ctx, ty))) } } @@ -372,7 +384,7 @@ let status_typ = | Var(s) => s | _ => "" }; - switch (Ctx.is_alias(ctx, constructor)) { + switch (Ctx.is_tyVar(ctx, constructor)) { | false => InHole(FreeTypeVariable(constructor)) | true => NotInHole(TypeAlias(constructor, Typ.weak_head_normalize(ctx, ty))) diff --git a/src/haz3lcore/statics/Mode.re b/src/haz3lcore/statics/Mode.re index 58594f928d..e75371b721 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -20,6 +20,7 @@ open OptUtil.Syntax; [@deriving (show({with_path: false}), sexp, yojson)] type t = | SynFun /* Used only in function position of applications */ + | SynTypFun | Syn | Ana(Typ.t); @@ -30,11 +31,13 @@ let ty_of: t => Typ.t = fun | Ana(ty) => ty | Syn => Unknown(SynSwitch) - | SynFun => Arrow(Unknown(SynSwitch), Unknown(SynSwitch)); + | SynFun + | SynTypFun => Arrow(Unknown(SynSwitch), Unknown(SynSwitch)); let of_arrow = (ctx: Ctx.t, mode: t): (t, t) => switch (mode) { | Syn + | SynTypFun | SynFun => (Syn, Syn) | Ana(ty) => ty @@ -42,10 +45,19 @@ let of_arrow = (ctx: Ctx.t, mode: t): (t, t) => |> Typ.matched_arrow |> TupleUtil.map2(ana) }; - +let of_forall: t => t = + fun + | SynFun + | SynTypFun + | Syn => Syn + | Ana(ty) => { + let (_, body) = Typ.matched_forall(ty); + Ana(body); + }; let of_prod = (ctx: Ctx.t, mode: t, length): list(t) => switch (mode) { | Syn + | SynTypFun | SynFun => List.init(length, _ => Syn) | Ana(ty) => ty @@ -60,6 +72,7 @@ let matched_list_normalize = (ctx: Ctx.t, ty: Typ.t): Typ.t => let of_cons_hd = (ctx: Ctx.t, mode: t): t => switch (mode) { | Syn + | SynTypFun | SynFun => Syn | Ana(ty) => Ana(matched_list_normalize(ctx, ty)) }; @@ -67,6 +80,7 @@ let of_cons_hd = (ctx: Ctx.t, mode: t): t => let of_cons_tl = (ctx: Ctx.t, mode: t, hd_ty: Typ.t): t => switch (mode) { | Syn + | SynTypFun | SynFun => Ana(List(hd_ty)) | Ana(ty) => Ana(List(matched_list_normalize(ctx, ty))) }; @@ -74,6 +88,7 @@ let of_cons_tl = (ctx: Ctx.t, mode: t, hd_ty: Typ.t): t => let of_list = (ctx: Ctx.t, mode: t): t => switch (mode) { | Syn + | SynTypFun | SynFun => Syn | Ana(ty) => Ana(matched_list_normalize(ctx, ty)) }; @@ -81,6 +96,7 @@ let of_list = (ctx: Ctx.t, mode: t): t => let of_list_concat = (mode: t): t => switch (mode) { | Syn + | SynTypFun | SynFun => Ana(List(Unknown(SynSwitch))) | Ana(ty) => Ana(List(Typ.matched_list(ty))) }; diff --git a/src/haz3lcore/statics/Self.re b/src/haz3lcore/statics/Self.re index 358cf46080..f30c1e2e13 100644 --- a/src/haz3lcore/statics/Self.re +++ b/src/haz3lcore/statics/Self.re @@ -80,10 +80,8 @@ let of_ctr = (ctx: Ctx.t, name: Constructor.t): t => name, syn_ty: switch (Ctx.lookup_ctr(ctx, name)) { - | Some({kind: Abstract, _}) | None => None - | Some({kind: Singleton(typ), _}) => Some(typ) - | Some({kind: Arrow(_, t2), _}) => Some(t2) + | Some({typ, _}) => Some(typ) }, }); diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 9b04b0fdc2..197bfa6b65 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -33,7 +33,8 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) - | Parameter(TypVar.t) + | Forall(TypVar.t, t) + | Ap(t, t) and sum_map = ConstructorMap.t(option(t)); [@deriving (show({with_path: false}), sexp, yojson)] @@ -52,6 +53,7 @@ module rec Typ: { let of_source: list(source) => list(t); let join_type_provenance: (type_provenance, type_provenance) => type_provenance; + let matched_forall: t => (TypVar.t, t); let matched_arrow: t => (t, t); let matched_prod: (int, t) => list(t); let matched_cons: t => (t, t); @@ -92,7 +94,8 @@ module rec Typ: { | Sum(sum_map) | Prod(list(t)) | Rec(TypVar.t, t) - | Parameter(TypVar.t) + | Forall(TypVar.t, t) + | Ap(t, t) and sum_map = ConstructorMap.t(option(t)); [@deriving (show({with_path: false}), sexp, yojson)] @@ -123,7 +126,11 @@ module rec Typ: { | (_, Internal | Free(_)) => Internal | (SynSwitch, SynSwitch) => SynSwitch }; - + let matched_forall: t => (TypVar.t, t) = + fun + | Forall(name, ty) => (name, ty) + | Unknown(prov) => ("expected_forall", Unknown(prov)) + | _ => ("expected_forall", Unknown(Internal)); let matched_arrow: t => (t, t) = fun | Arrow(ty_in, ty_out) => (ty_in, ty_out) @@ -159,7 +166,8 @@ module rec Typ: { | Var(_) | Rec(_) | Sum(_) => precedence_Sum - | Parameter(_) + | Forall(_, _) + | Ap(_, _) | List(_) => precedence_Const | Prod(_) => precedence_Prod | Arrow(_, _) => precedence_Arrow @@ -179,7 +187,9 @@ module rec Typ: { | Rec(y, ty) => Rec(y, subst(s, x, ty)) | List(ty) => List(subst(s, x, ty)) | Var(y) => TypVar.eq(x, y) ? s : Var(y) - | Parameter(y) => Parameter(y) + | Forall(y, ty) when TypVar.eq(x, y) => Forall(y, ty) + | Forall(y, ty) => Forall(y, subst(s, x, ty)) + | Ap(ty1, ty2) => Ap(subst(s, x, ty1), subst(s, x, ty2)) }; }; @@ -193,8 +203,6 @@ module rec Typ: { but this will change when polymorphic types are implemented */ let rec eq = (t1: t, t2: t): bool => { switch (t1, t2) { - | (_, Parameter(_)) - | (Parameter(_), _) => true | (Rec(x1, t1), Rec(x2, t2)) => eq(t1, subst(Var(x1), x2, t2)) | (Rec(_), _) => false | (Int, Int) => true @@ -218,6 +226,10 @@ module rec Typ: { | (Sum(_), _) => false | (Var(n1), Var(n2)) => n1 == n2 | (Var(_), _) => false + | (Forall(x1, t1), Forall(x2, t2)) => eq(t1, subst(Var(x1), x2, t2)) + | (Forall(_), _) => false + | (Ap(t1, t2), Ap(t1', t2')) => eq(t1, t1') && eq(t2, t2') + | (Ap(_), _) => false }; }; @@ -240,7 +252,8 @@ module rec Typ: { ) | Prod(tys) => ListUtil.flat_map(free_vars(~bound), tys) | Rec(x, ty) => free_vars(~bound=[x, ...bound], ty) - | Parameter(v) => List.mem(v, bound) ? [] : [v] + | Forall(x, ty) => free_vars(~bound=[x, ...bound], ty) + | Ap(t1, t2) => free_vars(~bound, t1) @ free_vars(~bound, t2) }; /* Lattice join on types. This is a LUB join in the hazel2 @@ -261,8 +274,6 @@ module rec Typ: { Some(Unknown(join_type_provenance(p1, p2))) | (Unknown(_), ty) | (ty, Unknown(Internal | SynSwitch)) => Some(ty) - | (Parameter(_), ty) => Some(ty) - | (ty, Parameter(_)) => Some(ty) | (Var(n1), Var(n2)) => if (n1 == n2) { Some(Var(n1)); @@ -278,6 +289,27 @@ module rec Typ: { let+ ty_join = join'(ty_name, ty); !resolve && eq(ty_name, ty_join) ? Var(name) : ty_join; /* Note: Ordering of Unknown, Var, and Rec above is load-bearing! */ + | (ty2, Ap(Var(name), ty)) + | (Ap(Var(name), ty), ty2) => + switch (Ctx.lookup_higher_kind(ctx, name)) { + | Some((arg, ty_out)) => join'(subst(ty, arg, ty_out), ty2) + + | _ => None + } + | (ty, Ap(Forall(name, t1), t2)) + | (Ap(Forall(name, t1), t2), ty) => + join(~resolve, ~fix, ctx, Typ.subst(t2, name, t1), ty) + | (Ap(ty1, ty2), Ap(ty1', ty2')) => + let* ty1 = join'(ty1, ty1'); + let+ ty2 = join'(ty2, ty2'); + Ap(ty1, ty2); + | (Ap(_), _) => None + | (Forall(name, t1), Forall(_, t2)) => + switch (join(~resolve, ~fix, Ctx.extend_dummy_tvar(ctx, name), t1, t2)) { + | Some(t) => Some(Forall(name, t)) + | None => None + } + | (Forall(_), _) => None | (Rec(x1, ty1), Rec(x2, ty2)) => /* TODO: This code isn't fully correct, as we may be doing @@ -390,7 +422,9 @@ module rec Typ: { as in current implementation Recs do not occur in the surface syntax, so we won't try to jump to them. */ Rec(name, normalize(Ctx.extend_dummy_tvar(ctx, name), ty)) - | Parameter(_) => ty + | Forall(name, ty) => + Forall(name, normalize(Ctx.extend_dummy_tvar(ctx, name), ty)) + | Ap(t1, t2) => Ap(normalize(ctx, t1), normalize(ctx, t2)) }; }; @@ -441,7 +475,7 @@ and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type entry = | VarEntry(var_entry) - | ConstructorEntry(tvar_entry) + | ConstructorEntry(var_entry) | TVarEntry(tvar_entry); [@deriving (show({with_path: false}), sexp, yojson)] @@ -450,23 +484,24 @@ and Ctx: { let extend: (t, entry) => t; let extend_tvar: (t, tvar_entry) => t; let extend_alias: (t, TypVar.t, Id.t, Typ.t) => t; - let extend_higher_alias: (t, TypVar.t, TypVar.t, Id.t, Typ.t) => t; + let extend_higher_kind: (t, TypVar.t, TypVar.t, Id.t, Typ.t) => t; let extend_dummy_tvar: (t, TypVar.t) => t; let lookup_tvar: (t, TypVar.t) => option(tvar_entry); let lookup_alias: (t, TypVar.t) => option(Typ.t); - let lookup_higher_alias: (t, TypVar.t) => option((TypVar.t, Typ.t)); + let lookup_higher_kind: (t, TypVar.t) => option((TypVar.t, Typ.t)); let revise_tvar: (t, TypVar.t, Typ.t) => t; let get_id: entry => int; let lookup_var: (t, string) => option(var_entry); - let lookup_ctr: (t, string) => option(tvar_entry); + let lookup_ctr: (t, string) => option(var_entry); let is_alias: (t, TypVar.t) => bool; + let is_tyVar: (t, TypVar.t) => bool; let add_ctrs: (t, TypVar.t, Id.t, Typ.sum_map) => t; - let add_higher_ctrs: (t, TypVar.t, TypVar.t, Id.t, Typ.sum_map) => t; + let add_ctr_with_typ_parameter: + (t, TypVar.t, Id.t, Typ.sum_map, TypVar.t) => t; let subtract_prefix: (t, t) => option(t); let added_bindings: (t, t) => t; let filter_duplicates: t => t; let shadows_typ: (t, TypVar.t) => bool; - let find_parameter_type: (TypVar.t, Typ.t, Typ.t) => Typ.t; } = { [@deriving (show({with_path: false}), sexp, yojson)] type var_entry = { @@ -485,52 +520,11 @@ and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] type entry = | VarEntry(var_entry) - | ConstructorEntry(tvar_entry) + | ConstructorEntry(var_entry) | TVarEntry(tvar_entry); [@deriving (show({with_path: false}), sexp, yojson)] type t = list(entry); - let rec find_parameter_type = (name: TypVar.t, t1: Typ.t, t2: Typ.t): Typ.t => { - switch (t1, t2) { - | (Var(n1), ty) when n1 == name => ty - | (Rec(x1, t1), Rec(x2, t2)) => - find_parameter_type(name, t1, Typ.subst(Var(x1), x2, t2)) - | (Rec(_), _) => Unknown(Internal) - | (Int, _) => Unknown(Internal) - | (Float, _) => Unknown(Internal) - | (Bool, _) => Unknown(Internal) - | (String, _) => Unknown(Internal) - | (Unknown(_), _) => Unknown(Internal) - | (Arrow(t1, t2), Arrow(t1', t2')) => - switch (find_parameter_type(name, t1, t1')) { - | Unknown(Internal) => find_parameter_type(name, t2, t2') - | _ => find_parameter_type(name, t1, t1') - } - | (Arrow(_), _) => Unknown(Internal) - | (Prod(tys1), Prod(tys2)) => - switch (ListUtil.map2_opt(find_parameter_type(name), tys1, tys2)) { - | Some(tys) => - List.fold_left( - (a, b) => - if (a == Typ.Unknown(Internal)) { - b; - } else { - a; - }, - Unknown(Internal), - tys, - ) - | _ => Unknown(Internal) - } - | (Prod(_), _) => Unknown(Internal) - | (List(t1), List(t2)) => find_parameter_type(name, t1, t2) - | (List(_), _) => Unknown(Internal) - //| (Sum(sm1), Sum(sm2)) => - | (Sum(_), _) => Unknown(Internal) - | (Var(_), _) => Unknown(Internal) - | (Parameter(_), _) => Unknown(Internal) - }; - }; let extend = (ctx, entry) => List.cons(entry, ctx); let extend_tvar = (ctx: t, tvar_entry: tvar_entry): t => @@ -538,10 +532,14 @@ and Ctx: { let extend_alias = (ctx: t, name: TypVar.t, id: Id.t, ty: Typ.t): t => extend_tvar(ctx, {name, id, kind: Singleton(ty)}); - let extend_higher_alias = + let extend_higher_kind = (ctx: t, name: TypVar.t, arg: TypVar.t, id: Id.t, ty: Typ.t): t => { - let ctx = extend_tvar(ctx, {name, id, kind: Arrow(Var(arg), ty)}); - extend_tvar(ctx, {name: arg, id, kind: Singleton(Parameter(arg))}); + let ctx = + extend_tvar( + ctx, + {name, id, kind: Arrow(Singleton(Var(arg)), Singleton(ty))}, + ); + extend_tvar(ctx, {name: arg, id, kind: Abstract}); }; let extend_dummy_tvar = (ctx: t, name: TypVar.t) => extend_tvar(ctx, {kind: Abstract, name, id: Id.invalid}); @@ -568,11 +566,8 @@ and Ctx: { ); let lookup_alias = (ctx: t, t: TypVar.t): option(Typ.t) => switch (lookup_tvar(ctx, t)) { - | Some({kind: Arrow(_, ty), _}) | Some({kind: Singleton(ty), _}) => Some(ty) - - | Some({kind: Abstract, _}) - | None => None + | _ => None }; let get_id: entry => int = @@ -589,7 +584,7 @@ and Ctx: { ctx, ); - let lookup_ctr = (ctx: t, name: string): option(tvar_entry) => + let lookup_ctr = (ctx: t, name: string): option(var_entry) => List.find_map( fun | ConstructorEntry(t) when t.name == name => Some(t) @@ -602,9 +597,14 @@ and Ctx: { | Some(_) => true | None => false }; - let lookup_higher_alias = (ctx: t, t: TypVar.t): option((TypVar.t, Typ.t)) => - switch (lookup_ctr(ctx, t)) { - | Some({kind: Arrow(Var(arg), Arrow(typ, Var(_))), _}) => + let is_tyVar = (ctx: t, name: TypVar.t): bool => + switch (lookup_tvar(ctx, name)) { + | Some(_) => true + | _ => false + }; + let lookup_higher_kind = (ctx: t, t: TypVar.t): option((TypVar.t, Typ.t)) => + switch (lookup_tvar(ctx, t)) { + | Some({kind: Arrow(Singleton(Var(arg)), Singleton(typ)), _}) => Some((arg, typ)) | _ => None }; @@ -615,26 +615,27 @@ and Ctx: { ConstructorEntry({ name: ctr, id, - kind: + typ: switch (typ) { - | None => Singleton(Var(name)) - | Some(typ) => Singleton(Arrow(typ, Var(name))) + | None => Var(name) + | Some(typ) => Arrow(typ, Var(name)) }, }), ctrs, ) @ ctx; - let add_higher_ctrs = - (ctx: t, name: TypVar.t, arg: TypVar.t, id: Id.t, ctrs: Typ.sum_map): t => + let add_ctr_with_typ_parameter = + (ctx: t, name: TypVar.t, id: Id.t, ctrs: Typ.sum_map, arg: TypVar.t): t => List.map( ((ctr, typ)) => ConstructorEntry({ name: ctr, id, - kind: + typ: switch (typ) { - | None => Arrow(Var(arg), Var(name)) - | Some(typ) => Arrow(Var(arg), Arrow(typ, Var(name))) + | None => Forall(arg, Ap(Var(name), Var(arg))) + | Some(typ) => + Forall(arg, Arrow(typ, Ap(Var(name), Var(arg)))) }, }), ctrs, @@ -694,12 +695,12 @@ and Kind: { [@deriving (show({with_path: false}), sexp, yojson)] type t = | Singleton(Typ.t) - | Arrow(Typ.t, Typ.t) + | Arrow(t, t) | Abstract; } = { [@deriving (show({with_path: false}), sexp, yojson)] type t = | Singleton(Typ.t) - | Arrow(Typ.t, Typ.t) + | Arrow(t, t) | Abstract; }; diff --git a/src/haz3lweb/view/CtxInspector.re b/src/haz3lweb/view/CtxInspector.re index 98d0ea6b40..f160250ff1 100644 --- a/src/haz3lweb/view/CtxInspector.re +++ b/src/haz3lweb/view/CtxInspector.re @@ -15,6 +15,7 @@ let context_entry_view = (~inject, entry: Haz3lcore.Ctx.entry): Node.t => { ]), ); switch (entry) { + | ConstructorEntry({name, typ, _}) | VarEntry({name, typ, _}) => div_c( "context-entry", @@ -24,7 +25,6 @@ let context_entry_view = (~inject, entry: Haz3lcore.Ctx.entry): Node.t => { Type.view(typ), ], ) - | ConstructorEntry({name, kind, _}) | TVarEntry({name, kind, _}) => div_c( "context-entry", diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index bc8cfeeeb9..9c88a933ed 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -667,6 +667,21 @@ let get_doc = ), [], ); + | TypFun(_, _) => + // TODO (typfun) + let (doc, options) = + LangDocMessages.get_form_and_options( + LangDocMessages.triv_exp_group, + docs, + ); + get_message( + doc, + options, + LangDocMessages.triv_exp_group, + doc.explanation.message, + [], + ); + | Fun(pat, body) => let basic = (doc: LangDocMessages.form, group_id, options) => { let pat_id = List.nth(pat.ids, 0); @@ -1902,6 +1917,20 @@ let get_doc = LangDocMessages.funapp_exp_coloring_ids, ); }; + | TypAp(_, _) => + // TODO (typfun) + let (doc, options) = + LangDocMessages.get_form_and_options( + LangDocMessages.triv_exp_group, + docs, + ); + get_message( + doc, + options, + LangDocMessages.triv_exp_group, + doc.explanation.message, + [], + ); | If(cond, then_, else_) => let (doc, options) = LangDocMessages.get_form_and_options( diff --git a/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re b/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re index 2dc53757b5..ecece46d5d 100644 --- a/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re +++ b/src/haz3lweb/view/dhcode/layout/DHDoc_Exp.re @@ -60,6 +60,7 @@ let rec precedence = (~show_casts: bool, d: DHExp.t) => { | FailedCast(_) | InvalidOperation(_) | Fun(_) + | TypFun(_) | Closure(_) => DHDoc_common.precedence_const | Cast(d1, _, _) => show_casts ? DHDoc_common.precedence_const : precedence'(d1) @@ -71,7 +72,8 @@ let rec precedence = (~show_casts: bool, d: DHExp.t) => { | BinIntOp(op, _, _) => precedence_bin_int_op(op) | BinFloatOp(op, _, _) => precedence_bin_float_op(op) | BinStringOp(op, _, _) => precedence_bin_string_op(op) - | Ap(_) => DHDoc_common.precedence_Ap + | Ap(_) + | TypAp(_) => DHDoc_common.precedence_Ap | ApBuiltin(_) => DHDoc_common.precedence_Ap | Cons(_) => DHDoc_common.precedence_Cons | ListConcat(_) => DHDoc_common.precedence_Plus @@ -193,6 +195,12 @@ let rec mk = go'(~parenthesize=false, d2), ); DHDoc_common.mk_Ap(mk_cast(doc1), mk_cast(doc2)); + | TypAp(d1, ty) => + DHDoc_common.mk_Ap( + mk_cast(go(~enforce_inline, d1)), + DHDoc_Typ.mk(~enforce_inline=true, ty), + ) + | ApBuiltin(ident, args) => switch (args) { | [hd, ...tl] => @@ -338,6 +346,9 @@ let rec mk = | Some(name) => annot(DHAnnot.Collapsed, text("<" ++ name ++ ">")) }; } + | TypFun(_tpat, _dbody) => + annot(DHAnnot.Collapsed, text("")) + | FixF(x, ty, dbody) => if (settings.show_fn_bodies) { let doc_body = (~enforce_inline) => diff --git a/src/haz3lweb/view/dhcode/layout/HTypDoc.re b/src/haz3lweb/view/dhcode/layout/HTypDoc.re index 7a525ed73f..10ad518d2c 100644 --- a/src/haz3lweb/view/dhcode/layout/HTypDoc.re +++ b/src/haz3lweb/view/dhcode/layout/HTypDoc.re @@ -50,8 +50,20 @@ let rec mk = (~parenthesize=false, ~enforce_inline: bool, ty: Typ.t): t => { | Float => (text("Float"), parenthesize) | Bool => (text("Bool"), parenthesize) | String => (text("String"), parenthesize) - | Parameter(name) | Var(name) => (text(name), parenthesize) + | Ap(_) => (text("Ap"), parenthesize) + | Forall(name, ty) => ( + hcats([ + text("Forall " ++ name ++ ".{"), + ( + (~enforce_inline) => + annot(HTypAnnot.Step(0), mk(~enforce_inline, ty)) + ) + |> pad_child(~enforce_inline), + mk_delim("}"), + ]), + parenthesize, + ) | List(ty) => ( hcats([ mk_delim("["), From 9ccf6191411ba48114dc64ac4c8a52571d5f06f8 Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Sun, 27 Aug 2023 11:17:04 -0400 Subject: [PATCH 23/56] Add: parameterized-types, leave the case branch not working --- src/haz3lcore/statics/MakeTerm.re | 6 +- src/haz3lcore/statics/Statics.re | 155 +++++++++++++++-------------- src/haz3lcore/statics/Term.re | 23 +++-- src/haz3lcore/statics/TermBase.re | 4 + src/haz3lcore/zipper/EditorUtil.re | 2 + src/haz3lweb/view/Kind.re | 4 +- src/haz3lweb/view/Type.re | 11 +- 7 files changed, 121 insertions(+), 84 deletions(-) diff --git a/src/haz3lcore/statics/MakeTerm.re b/src/haz3lcore/statics/MakeTerm.re index 41527e08dd..7cc8f39339 100644 --- a/src/haz3lcore/statics/MakeTerm.re +++ b/src/haz3lcore/statics/MakeTerm.re @@ -57,7 +57,9 @@ let is_rules = ((ts, kids): tiles): option(Aba.t(UPat.t, UExp.t)) => { ts |> List.map( fun - | (_, (["|", "=>"], [Pat(p)])) => Some(p) + | (_, (["|", "=>"], [Pat(p)])) => { + Some(p); + } | _ => None, ) |> OptUtil.sequence @@ -182,6 +184,7 @@ and exp_term: unsorted => (UExp.term, list(Id.t)) = { | (["-"], []) => UnOp(Int(Minus), r) | (["!"], []) => UnOp(Bool(Not), r) | (["fun", "->"], [Pat(pat)]) => Fun(pat, r) + | (["typfun", "->"], [TPat(tpat)]) => TypFun(tpat, r) | (["let", "=", "in"], [Pat(pat), Exp(def)]) => Let(pat, def, r) | (["type", "=", "in"], [TPat(tpat), Typ(def)]) => TyAlias(tpat, def, r) @@ -198,6 +201,7 @@ and exp_term: unsorted => (UExp.term, list(Id.t)) = { switch (t) { | (["()"], []) => (l.term, l.ids) //TODO(andrew): new ap error | (["(", ")"], [Exp(arg)]) => ret(Ap(l, arg)) + | (["@<", ">"], [Typ(ty)]) => ret(TypAp(l, ty)) | _ => ret(hole(tm)) } | _ => ret(hole(tm)) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 7284955ede..51b51071eb 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -236,6 +236,21 @@ and uexp_to_info_map = ~co_ctx=CoCtx.union([fn.co_ctx, arg.co_ctx]), m, ); + | TypAp(fn, utyp) => + /* Might need something similar to Ap's case where we check analysis mode when tagged? */ + let typfn_mode = + /* switch(fn) { + | {term: Tag(name), _} => Typ.tag_typap_mode(ctx, mode, name) + | _ => Typ.typap_mode + }; */ Mode.SynTypFun; + let (fn, m_fn) = go(~mode=typfn_mode, fn, m); + let (name, ty_body) = Typ.matched_forall(fn.ty); + let ty = Term.UTyp.to_typ(ctx, utyp); + add( + ~self=Just(Typ.subst(ty, name, ty_body)), + ~co_ctx=CoCtx.union([fn.co_ctx]), + m_fn, + ); | Fun(p, e) => let (mode_pat, mode_body) = Mode.of_arrow(ctx, mode); let (p, m) = go_pat(~is_synswitch=false, ~mode=mode_pat, p, m); @@ -245,52 +260,28 @@ and uexp_to_info_map = ~co_ctx=CoCtx.mk(ctx, p.ctx, e.co_ctx), m, ); + | TypFun({term: Var(name), _} as utpat, body) => + let mode_body = Mode.of_forall(mode); + let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; + let ctx_body = Ctx.extend_dummy_tvar(ctx, name); + let (body, m) = go'(~ctx=ctx_body, ~mode=mode_body, body, m); + add(~self=Just(Forall(name, body.ty)), ~co_ctx=body.co_ctx, m); + | TypFun(utpat, body) => + let mode_body = Mode.of_forall(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("expected_type_variable", body.ty)), + ~co_ctx=body.co_ctx, + m, + ); | Let(p, def, body) => let (p_syn, _m) = go_pat(~is_synswitch=true, ~mode=Syn, p, m); let def_ctx = extend_let_def_ctx(ctx, p, p_syn.ctx, def); - //let def_ctx = - // switch (def.term) { - // | Ap(fn, arg) => - // switch (fn.term) { - // | Constructor(ctr) => - // switch (Ctx.lookup_higher_alias(def_ctx, ctr)) { - // | Some((name_in, ty_in1)) => - // let (ty_in2, _) = go(~mode=Syn, arg, m); - // let ty = Ctx.find_parameter_type(name_in, ty_in1, ty_in2.ty); - // let ctx' = Ctx.revise_tvar(def_ctx, name_in, ty); - // ctx'; - // | None => def_ctx - // } - // | _ => def_ctx - // } - // | _ => def_ctx - // }; let (def, m) = go'(~ctx=def_ctx, ~mode=Ana(p_syn.ty), def, m); /* Analyze pattern to incorporate def type into ctx */ let (p_ana, m) = go_pat(~is_synswitch=false, ~mode=Ana(def.ty), p, m); - let (body, m) = - go'( - ~ctx=p_ana.ctx, - //switch (def.term.term) { - //| Ap(fn, arg) => - // switch (fn.term) { - // | Constructor(ctr) => - // switch (Ctx.lookup_higher_alias(p_ana.ctx, ctr)) { - // | Some((name_in, ty_in1)) => - // let (ty_in2, _) = go(~mode=Syn, arg, m); - // let ty = Ctx.find_parameter_type(name_in, ty_in1, ty_in2.ty); - // let ctx' = Ctx.revise_tvar(p_ana.ctx, name_in, ty); - // ctx'; - // | None => p_ana.ctx - // } - // | _ => p_ana.ctx - // } - //| _ => p_ana.ctx - //}, - ~mode, - body, - m, - ); + let (body, m) = go'(~ctx=p_ana.ctx, ~mode, body, m); add( ~self=Just(body.ty), ~co_ctx= @@ -308,6 +299,15 @@ and uexp_to_info_map = m, ); | Match(scrut, rules) => + List.iter( + a => + Printf.printf( + "Upat: %s, UExp: %s\n", + UPat.show(fst(a)), + UExp.show(snd(a)), + ), + rules, + ); let (scrut, m) = go(~mode=Syn, scrut, m); let (ps, es) = List.split(rules); let branch_ids = List.map(UExp.rep_id, es); @@ -366,7 +366,7 @@ and uexp_to_info_map = let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; add(~self=Just(ty_escape), ~co_ctx, m); | Ap(t1, t2) => - let constructor = + let name = switch (t1.term) { | Var(s) => s | _ => "" @@ -376,57 +376,68 @@ and uexp_to_info_map = | Var(s) => s | _ => "" }; - let utyp = UTyp.remove_ap_in_def(constructor, arg, utyp); + let utyp_without_ap = UTyp.remove_ap_in_def(name, arg, utyp); let (ty_def, ctx_def, ctx_body) = { let ty_pre = UTyp.to_typ( - Ctx.extend_dummy_tvar( - Ctx.extend_dummy_tvar(ctx, constructor), - arg, - ), + Ctx.extend_dummy_tvar(Ctx.extend_dummy_tvar(ctx, name), arg), utyp, ); + Printf.printf("ty_pre: %s\n", Typ.show(ty_pre)); switch (utyp.term) { - | Sum(_) when List.mem(constructor, Typ.free_vars(ty_pre)) => - let ty_rec = - Typ.Rec("α", Typ.subst(Var("α"), constructor, ty_pre)); + | Sum(_) when List.mem(name, Typ.free_vars(ty_pre)) => + let ty_pre = + UTyp.to_typ( + Ctx.extend_dummy_tvar(Ctx.extend_dummy_tvar(ctx, name), arg), + utyp_without_ap, + ); + let ty_rec = Typ.Rec("α", Typ.subst(Var("α"), name, ty_pre)); let ctx_def = - Ctx.extend_higher_alias( + Ctx.extend_higher_kind( ctx, - constructor, + name, arg, UTPat.rep_id(typat), ty_rec, ); (ty_rec, ctx_def, ctx_def); | _ => - let ctx_def = - Ctx.extend_higher_alias( - ctx, - constructor, - arg, - UTPat.rep_id(typat), - ty_pre, - ); - (ty_pre, ctx_def, ctx_def); + let ty = UTyp.to_typ(ctx, utyp); + ( + ty, + ctx, + Ctx.extend_higher_kind(ctx, name, arg, UTPat.rep_id(typat), ty), + ); }; }; let ctx_body = - switch (Typ.get_sum_constructors(ctx, ty_def)) { - | Some(sm) => - Ctx.add_higher_ctrs( - ctx_body, - constructor, - arg, - UTyp.rep_id(utyp), - sm, - ) - | None => ctx_body - }; + Ctx.add_ctr_with_typ_parameter( + ctx_body, + name, + UTyp.rep_id(utyp), + [ + ("Nil", None), + ("Cons", Some(Prod([Var(arg), Ap(Var(name), Var(arg))]))), + ], + arg, + ); + //switch (Typ.get_sum_constructors(ctx, ty_def)) { + //| Some(sm) => + // Printf.printf("sm: %s\n", Typ.show_sum_map(sm)); + // Ctx.add_ctr_with_typ_parameter( + // ctx_body, + // name, + // UTyp.rep_id(utyp), + // sm, + // arg, + // ); + //| None => ctx_body + //}; + Printf.printf("ctx_body: %s\n", Ctx.show(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, constructor, ty_body); + let ty_escape = Typ.subst(ty_def, name, ty_body); let m = utyp_to_info_map(~ctx=ctx_def, ~ancestors, utyp, m) |> snd; add(~self=Just(ty_escape), ~co_ctx, m); | Var(_) diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index 3609e0d0c5..297c4ae173 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -139,13 +139,10 @@ module UTyp = { switch (Ctx.lookup_tvar(ctx, name)) { | Some(ty) => switch (ty.kind) { - | Arrow(ty_in, ty_out) => - switch (ty_in) { - | Var(arg) => Typ.subst(to_typ(ctx, t2), arg, ty_out) - | _ => Unknown(Internal) - } - | Singleton(_) - | Abstract => Unknown(Internal) + | Arrow(Singleton(Var(arg)), Singleton(ty_out)) => + Typ.subst(to_typ(ctx, t2), arg, ty_out) + | Abstract => Ap(Var(name), to_typ(ctx, t2)) + | _ => Unknown(Internal) } | None => Unknown(Free(name)) }; @@ -501,11 +498,13 @@ module UExp = { | ListLit | Constructor | Fun + | TypFun | Tuple | Var | Let | TyAlias | Ap + | TypAp | If | Seq | Test @@ -540,11 +539,13 @@ module UExp = { | ListLit(_) => ListLit | Constructor(_) => Constructor | Fun(_) => Fun + | TypFun(_) => TypFun | Tuple(_) => Tuple | Var(_) => Var | Let(_) => Let | TyAlias(_) => TyAlias | Ap(_) => Ap + | TypAp(_) => TypAp | If(_) => If | Seq(_) => Seq | Test(_) => Test @@ -626,11 +627,13 @@ module UExp = { | ListLit => "List literal" | Constructor => "Constructor" | Fun => "Function literal" + | TypFun => "Type Function Literal" | Tuple => "Tuple literal" | Var => "Variable reference" | Let => "Let expression" | TyAlias => "Type Alias definition" | Ap => "Application" + | TypAp => "Type Application" | If => "If expression" | Seq => "Sequence expression" | Test => "Test" @@ -644,7 +647,8 @@ module UExp = { let rec is_fun = (e: t) => { switch (e.term) { | Parens(e) => is_fun(e) - | Fun(_) => true + | Fun(_) + | TypFun(_) => true | Invalid(_) | EmptyHole | MultiHole(_) @@ -659,6 +663,7 @@ module UExp = { | Let(_) | TyAlias(_) | Ap(_) + | TypAp(_) | If(_) | Seq(_) | Test(_) @@ -687,10 +692,12 @@ module UExp = { | String(_) | ListLit(_) | Fun(_) + | TypFun(_) | Var(_) | Let(_) | TyAlias(_) | Ap(_) + | TypAp(_) | If(_) | Seq(_) | Test(_) diff --git a/src/haz3lcore/statics/TermBase.re b/src/haz3lcore/statics/TermBase.re index 585c331842..ac7ea4f5fe 100644 --- a/src/haz3lcore/statics/TermBase.re +++ b/src/haz3lcore/statics/TermBase.re @@ -110,11 +110,13 @@ and UExp: { | ListLit(list(t)) | Constructor(string) | Fun(UPat.t, t) + | TypFun(UTPat.t, t) | Tuple(list(t)) | Var(Var.t) | Let(UPat.t, t, t) | TyAlias(UTPat.t, UTyp.t, t) | Ap(t, t) + | TypAp(t, UTyp.t) | If(t, t, t) | Seq(t, t) | Test(t) @@ -206,11 +208,13 @@ and UExp: { | ListLit(list(t)) | Constructor(string) | Fun(UPat.t, t) + | TypFun(UTPat.t, t) | Tuple(list(t)) | Var(Var.t) | Let(UPat.t, t, t) | TyAlias(UTPat.t, UTyp.t, t) | Ap(t, t) + | TypAp(t, UTyp.t) | If(t, t, t) | Seq(t, t) | Test(t) diff --git a/src/haz3lcore/zipper/EditorUtil.re b/src/haz3lcore/zipper/EditorUtil.re index 4483997e1d..29bac63f20 100644 --- a/src/haz3lcore/zipper/EditorUtil.re +++ b/src/haz3lcore/zipper/EditorUtil.re @@ -66,9 +66,11 @@ let rec append_exp = (id, e1: TermBase.UExp.t, e2: TermBase.UExp.t) => { | ListLit(_) | Constructor(_) | Fun(_) + | TypFun(_) | Tuple(_) | Var(_) | Ap(_) + | TypAp(_) | If(_) | Test(_) | Parens(_) diff --git a/src/haz3lweb/view/Kind.re b/src/haz3lweb/view/Kind.re index 416427a9d1..704412e818 100644 --- a/src/haz3lweb/view/Kind.re +++ b/src/haz3lweb/view/Kind.re @@ -2,10 +2,10 @@ open Virtual_dom.Vdom; open Node; open Util.Web; -let view = (kind: Haz3lcore.Kind.t): Node.t => +let rec view = (kind: Haz3lcore.Kind.t): Node.t => switch (kind) { | Arrow(ty1, ty2) => - div_c("kind-view", [Type.view(ty1), text(" -> "), Type.view(ty2)]) + div_c("kind-view", [view(ty1), text(" -> "), view(ty2)]) | Singleton(ty) => div_c("kind-view", [Type.view(ty)]) | Abstract => div_c("kind-view", [text("Type")]) }; diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index cc14fc3fd4..acaab163af 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -33,13 +33,22 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => | Float => ty_view("Float", "Float") | String => ty_view("String", "String") | Bool => ty_view("Bool", "Bool") - | Parameter(name) => ty_view("Parameter", name) + | Ap(t1, t2) => + div( + ~attr=clss(["typ-view", "Ap"]), + [view_ty(t1), text("("), view_ty(t2), text(")")], + ) | Var(name) => ty_view("Var", name) | Rec(x, t) => div( ~attr=clss(["typ-view", "Rec"]), [text("Rec " ++ x ++ ". "), view_ty(t)], ) + | Forall(name, t) => + div( + ~attr=clss(["typ-view", "Forall"]), + [text("Forall " ++ name ++ ". "), view_ty(t)], + ) | List(t) => div( ~attr=clss(["typ-view", "atom", "List"]), From 93477bdcd6e2ff014854614501f2e12572775a46 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Mon, 28 Aug 2023 14:48:41 -0400 Subject: [PATCH 24/56] Add a comment to justify not needing capture avoidance in evaluator. --- src/haz3lcore/dynamics/Evaluator.re | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index c7fcf624bb..e059b15965 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -647,7 +647,9 @@ let rec ty_subst = | TypFun(utpat, body) => switch (Term.UTPat.tyvar_of_utpat(utpat)) { | Some(x') when x == x' => exp - | _ => TypFun(utpat, re(body)) + | _ => + /* Note that we do not have to worry about capture avoidance, since s will always be closed. */ + TypFun(utpat, re(body)) } | NonEmptyHole(errstat, mv, hid, t) => NonEmptyHole(errstat, mv, hid, re(t)) From 57f725e902ee72da48570ba22b966fbaca11d427 Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Mon, 28 Aug 2023 21:15:50 -0400 Subject: [PATCH 25/56] Revise info and evaluator pattern match to fix the case branch inconsistent --- src/haz3lcore/dynamics/Evaluator.re | 3 ++- src/haz3lcore/statics/Info.re | 11 ++++++++++- src/haz3lcore/statics/Statics.re | 1 - src/haz3lcore/statics/TypBase.re | 21 ++++++++++++++------- 4 files changed, 26 insertions(+), 10 deletions(-) diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 7f82fed3ad..ddcb7e8e2d 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -183,7 +183,7 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => } | (Ap(_, _), Cast(d, Sum(_) | Rec(_, Sum(_)), Unknown(_))) - | (Ap(_, _), Cast(d, Unknown(_), Sum(_) | Rec(_, Sum(_)))) => + | (Ap(_, _), Cast(d, Unknown(_) | Ap(_), Sum(_) | Rec(_, Sum(_)))) => matches(dp, d) | (Ap(_, _), _) => DoesNotMatch @@ -201,6 +201,7 @@ let rec matches = (dp: DHPat.t, d: DHExp.t): match_result => matches(dp, d) | (Constructor(_), Cast(d, Unknown(_), Sum(_) | Rec(_, Sum(_)))) => matches(dp, d) + | (Constructor(_) as a, TypAp(Constructor(_) as b, _)) => matches(a, b) | (Constructor(_), _) => DoesNotMatch | (Tuple(dps), Tuple(ds)) => diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index cd49f4529d..141302cf08 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -314,10 +314,19 @@ let status_pat = (ctx: Ctx.t, mode: Mode.t, self: Self.pat): status_pat => { we catch them here, diverting to an ExpectedConstructor error. But we avoid capturing the second case above, as these will ultimately get a (more precise) unbound ctr via status_common */ + let self_pat: Self.t = + switch (self_pat) { + | IsConstructor({name, syn_ty: Some(Forall(name2, ty))}) => + IsConstructor({ + name, + syn_ty: Some(Typ.subst(Unknown(Internal), name2, ty)), + }) + | _ => self_pat + }; switch (status_common(ctx, mode, self_pat)) { | NotInHole(ok_exp) => NotInHole(ok_exp) | InHole(err_pat) => InHole(Common(err_pat)) - } + }; | (SynFun, _) => InHole(ExpectedConstructor) }; }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 51b51071eb..1d7da30a23 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -383,7 +383,6 @@ and uexp_to_info_map = Ctx.extend_dummy_tvar(Ctx.extend_dummy_tvar(ctx, name), arg), utyp, ); - Printf.printf("ty_pre: %s\n", Typ.show(ty_pre)); switch (utyp.term) { | Sum(_) when List.mem(name, Typ.free_vars(ty_pre)) => let ty_pre = diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 197bfa6b65..8eff449245 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -289,23 +289,30 @@ module rec Typ: { let+ ty_join = join'(ty_name, ty); !resolve && eq(ty_name, ty_join) ? Var(name) : ty_join; /* Note: Ordering of Unknown, Var, and Rec above is load-bearing! */ + | (Ap(ty1, ty2), Ap(ty1', ty2')) => + let* ty1 = join'(ty1, ty1'); + let+ ty2 = join'(ty2, ty2'); + Ap(ty1, ty2); | (ty2, Ap(Var(name), ty)) | (Ap(Var(name), ty), ty2) => switch (Ctx.lookup_higher_kind(ctx, name)) { | Some((arg, ty_out)) => join'(subst(ty, arg, ty_out), ty2) - | _ => None } | (ty, Ap(Forall(name, t1), t2)) | (Ap(Forall(name, t1), t2), ty) => join(~resolve, ~fix, ctx, Typ.subst(t2, name, t1), ty) - | (Ap(ty1, ty2), Ap(ty1', ty2')) => - let* ty1 = join'(ty1, ty1'); - let+ ty2 = join'(ty2, ty2'); - Ap(ty1, ty2); | (Ap(_), _) => None - | (Forall(name, t1), Forall(_, t2)) => - switch (join(~resolve, ~fix, Ctx.extend_dummy_tvar(ctx, name), t1, t2)) { + | (Forall(name, t1), Forall(name2, t2)) => + switch ( + join( + ~resolve, + ~fix, + Ctx.extend_dummy_tvar(Ctx.extend_dummy_tvar(ctx, name2), name), + t1, + t2, + ) + ) { | Some(t) => Some(Forall(name, t)) | None => None } From 58e5cd7430a4ab56c0fa07a7f890e91ce77d2877 Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Mon, 28 Aug 2023 21:28:48 -0400 Subject: [PATCH 26/56] Rmove debug print code --- src/haz3lcore/statics/Statics.re | 52 ++++++++++++-------------------- src/haz3lcore/statics/TypBase.re | 1 - 2 files changed, 19 insertions(+), 34 deletions(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 1d7da30a23..8e0bda633c 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -299,15 +299,6 @@ and uexp_to_info_map = m, ); | Match(scrut, rules) => - List.iter( - a => - Printf.printf( - "Upat: %s, UExp: %s\n", - UPat.show(fst(a)), - UExp.show(snd(a)), - ), - rules, - ); let (scrut, m) = go(~mode=Syn, scrut, m); let (ps, es) = List.split(rules); let branch_ids = List.map(UExp.rep_id, es); @@ -409,30 +400,25 @@ and uexp_to_info_map = ); }; }; - let ctx_body = - Ctx.add_ctr_with_typ_parameter( - ctx_body, - name, - UTyp.rep_id(utyp), - [ - ("Nil", None), - ("Cons", Some(Prod([Var(arg), Ap(Var(name), Var(arg))]))), - ], - arg, - ); - //switch (Typ.get_sum_constructors(ctx, ty_def)) { - //| Some(sm) => - // Printf.printf("sm: %s\n", Typ.show_sum_map(sm)); - // Ctx.add_ctr_with_typ_parameter( - // ctx_body, - // name, - // UTyp.rep_id(utyp), - // sm, - // arg, - // ); - //| None => ctx_body - //}; - Printf.printf("ctx_body: %s\n", Ctx.show(ctx_body)); + let ctx_body = { + let ty_pre = + UTyp.to_typ( + Ctx.extend_dummy_tvar(Ctx.extend_dummy_tvar(ctx, name), arg), + utyp, + ); + + switch (ty_pre) { + | Sum(sm_map) => + Ctx.add_ctr_with_typ_parameter( + ctx_body, + name, + UTyp.rep_id(utyp), + sm_map, + arg, + ) + | _ => 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 */ diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 8eff449245..1ef1c2d331 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -434,7 +434,6 @@ module rec Typ: { | Ap(t1, t2) => Ap(normalize(ctx, t1), normalize(ctx, t2)) }; }; - let sum_entry = (ctr: Constructor.t, ctrs: sum_map): option(sum_entry) => List.find_map( fun From 644203431b9a01f378b570011d593d4aaeb568cc Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Tue, 29 Aug 2023 00:04:55 -0400 Subject: [PATCH 27/56] Fix: incorrect type of ctrs --- src/haz3lcore/dynamics/Elaborator.re | 9 +++-- src/haz3lcore/dynamics/Evaluator.re | 9 ++++- src/haz3lcore/prog/Interface.re | 1 + src/haz3lcore/statics/Statics.re | 1 + src/haz3lcore/statics/TypBase.re | 55 +++++++++++++++++++++++----- 5 files changed, 59 insertions(+), 16 deletions(-) diff --git a/src/haz3lcore/dynamics/Elaborator.re b/src/haz3lcore/dynamics/Elaborator.re index ae0c5840ec..2c1ec48e44 100644 --- a/src/haz3lcore/dynamics/Elaborator.re +++ b/src/haz3lcore/dynamics/Elaborator.re @@ -27,7 +27,7 @@ let fixed_pat_typ = (m: Statics.Map.t, p: Term.UPat.t): option(Typ.t) => | _ => None }; -let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => +let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => { switch (mode) { | Syn => d | SynFun => @@ -74,12 +74,13 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => DHExp.cast(d, Prod(us), Unknown(prov)); | _ => d } - | Ap(Constructor(_), _) + | Ap(Constructor(_) | TypAp(_), _) | TypAp(Constructor(_), _) | Constructor(_) => switch (ana_ty, self_ty) { | (Unknown(prov), Rec(_, Sum(_))) - | (Unknown(prov), Sum(_)) => DHExp.cast(d, self_ty, Unknown(prov)) + | (Unknown(prov), Ap(_) | Sum(_)) => + DHExp.cast(d, self_ty, Unknown(prov)) | _ => d } /* Forms with special ana rules but no particular typing requirements */ @@ -116,7 +117,7 @@ let cast = (ctx: Ctx.t, mode: Mode.t, self_ty: Typ.t, d: DHExp.t) => | TestLit(_) => DHExp.cast(d, self_ty, ana_ty) }; }; - +}; /* Handles cast insertion and non-empty-hole wrapping for elaborated expressions */ let wrap = (ctx: Ctx.t, u: Id.t, mode: Mode.t, self, d: DHExp.t): DHExp.t => diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index ddcb7e8e2d..13f02d3d5f 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -49,6 +49,8 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { | Var(_) | Rec(_) | Arrow(Unknown(_), Unknown(_)) + | Ap(Unknown(_), Unknown(_)) + | Forall("_", Unknown(_)) | List(Unknown(_)) => Ground | Prod(tys) => if (List.for_all( @@ -66,7 +68,7 @@ let rec ground_cases_of = (ty: Typ.t): ground_cases => { | Arrow(_, _) => grounded_Arrow | List(_) => grounded_List | Forall(_) => grounded_Forall - | Ap(_) => grounded_Ap + | Ap(_, _) => grounded_Ap }; }; @@ -697,7 +699,8 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = (env, d) => { /* Increment number of evaluation steps (calls to `evaluate`). */ let* () = take_step; - + //Printf.printf("env: %s\n", ClosureEnvironment.show(env)); + //Printf.printf("d: %s\n", DHExp.show(d)); switch (d) { | BoundVar(x) => let d = @@ -748,7 +751,9 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = | TypFun(_) => BoxedValue(Closure(env, d)) |> return | TypAp(d1, tau) => + //Printf.printf("TypAp, env: %s\n", ClosureEnvironment.show(env)); let* r1 = evaluate(env, d1); + //Printf.printf("r1: %s\n", EvaluatorResult.show(r1)); switch (r1) { | BoxedValue(Closure(closure_env, TypFun({term: Var(name), _}, d2))) => // TODO: Maybe additional cases to be done? diff --git a/src/haz3lcore/prog/Interface.re b/src/haz3lcore/prog/Interface.re index 04c9493bb5..13dc646919 100644 --- a/src/haz3lcore/prog/Interface.re +++ b/src/haz3lcore/prog/Interface.re @@ -56,6 +56,7 @@ let evaluate = // }; let evaluate = (d: DHExp.t): ProgramResult.t => { + //Printf.printf("Evaluating: %s\n", DHExp.show(d)); let result = try(evaluate(d)) { | EvaluatorError.Exception(reason) => diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 8e0bda633c..c6f2bfdd9a 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -415,6 +415,7 @@ and uexp_to_info_map = UTyp.rep_id(utyp), sm_map, arg, + ty_def, ) | _ => ctx_body }; diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 1ef1c2d331..9bea4c4db6 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -60,6 +60,7 @@ module rec Typ: { let matched_list: t => t; let precedence: t => int; let subst: (t, TypVar.t, t) => t; + let subst_ap: (t, TypVar.t, TypVar.t, t) => t; let unroll: t => t; let eq: (t, t) => bool; let free_vars: (~bound: list(Var.t)=?, t) => list(Var.t); @@ -172,7 +173,27 @@ module rec Typ: { | Prod(_) => precedence_Prod | Arrow(_, _) => precedence_Arrow }; - + let rec subst_ap = (s: t, ctr: TypVar.t, arg: TypVar.t, ty: t) => { + switch (ty) { + | Int => Int + | Float => Float + | Bool => Bool + | String => String + | Unknown(prov) => Unknown(prov) + | Arrow(ty1, ty2) => + Arrow(subst_ap(s, ctr, arg, ty1), subst_ap(s, ctr, arg, ty2)) + | Prod(tys) => Prod(List.map(subst_ap(s, ctr, arg), tys)) + | Sum(sm) => + Sum(ConstructorMap.map(Option.map(subst_ap(s, ctr, arg)), sm)) + | Rec(y, ty) => Rec(y, subst_ap(s, ctr, arg, ty)) + | List(ty) => List(subst_ap(s, ctr, arg, ty)) + | Var(y) => Var(y) + | Forall(y, ty) => Forall(y, subst_ap(s, ctr, arg, ty)) + | Ap(Var(v1), Var(v2)) when v1 == ctr && v2 == arg => s + | Ap(ty1, ty2) => + Ap(subst_ap(s, ctr, arg, ty1), subst_ap(s, ctr, arg, ty2)) + }; + }; let rec subst = (s: t, x: TypVar.t, ty: t) => { switch (ty) { | Int => Int @@ -289,10 +310,6 @@ module rec Typ: { let+ ty_join = join'(ty_name, ty); !resolve && eq(ty_name, ty_join) ? Var(name) : ty_join; /* Note: Ordering of Unknown, Var, and Rec above is load-bearing! */ - | (Ap(ty1, ty2), Ap(ty1', ty2')) => - let* ty1 = join'(ty1, ty1'); - let+ ty2 = join'(ty2, ty2'); - Ap(ty1, ty2); | (ty2, Ap(Var(name), ty)) | (Ap(Var(name), ty), ty2) => switch (Ctx.lookup_higher_kind(ctx, name)) { @@ -302,6 +319,10 @@ module rec Typ: { | (ty, Ap(Forall(name, t1), t2)) | (Ap(Forall(name, t1), t2), ty) => join(~resolve, ~fix, ctx, Typ.subst(t2, name, t1), ty) + | (Ap(ty1, ty2), Ap(ty1', ty2')) => + let* ty1 = join'(ty1, ty1'); + let+ ty2 = join'(ty2, ty2'); + Ap(ty1, ty2); | (Ap(_), _) => None | (Forall(name, t1), Forall(name2, t2)) => switch ( @@ -395,9 +416,9 @@ module rec Typ: { ts, ); - let is_consistent = (ctx: Ctx.t, ty1: t, ty2: t): bool => + let is_consistent = (ctx: Ctx.t, ty1: t, ty2: t): bool => { join(~fix=false, ctx, ty1, ty2) != None; - + }; let rec weak_head_normalize = (ctx: Ctx.t, ty: t): t => switch (ty) { | Var(x) => @@ -503,7 +524,7 @@ and Ctx: { let is_tyVar: (t, TypVar.t) => bool; let add_ctrs: (t, TypVar.t, Id.t, Typ.sum_map) => t; let add_ctr_with_typ_parameter: - (t, TypVar.t, Id.t, Typ.sum_map, TypVar.t) => t; + (t, TypVar.t, Id.t, Typ.sum_map, TypVar.t, Typ.t) => t; let subtract_prefix: (t, t) => option(t); let added_bindings: (t, t) => t; let filter_duplicates: t => t; @@ -631,7 +652,15 @@ and Ctx: { ) @ ctx; let add_ctr_with_typ_parameter = - (ctx: t, name: TypVar.t, id: Id.t, ctrs: Typ.sum_map, arg: TypVar.t): t => + ( + ctx: t, + name: TypVar.t, + id: Id.t, + ctrs: Typ.sum_map, + arg: TypVar.t, + ty: Typ.t, + ) + : t => List.map( ((ctr, typ)) => ConstructorEntry({ @@ -641,7 +670,13 @@ and Ctx: { switch (typ) { | None => Forall(arg, Ap(Var(name), Var(arg))) | Some(typ) => - Forall(arg, Arrow(typ, Ap(Var(name), Var(arg)))) + Forall( + arg, + Arrow( + Typ.subst_ap(ty, name, arg, typ), + Ap(Var(name), Var(arg)), + ), + ) }, }), ctrs, From 3142ed32af0876feb2a0ec45699b6f14f2477d07 Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Tue, 29 Aug 2023 11:55:47 -0400 Subject: [PATCH 28/56] Fix: typeann typehole cause case match failed --- src/haz3lcore/dynamics/Evaluator.re | 4 ---- src/haz3lcore/prog/Interface.re | 1 - src/haz3lcore/statics/TypBase.re | 5 +++++ 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/haz3lcore/dynamics/Evaluator.re b/src/haz3lcore/dynamics/Evaluator.re index 13f02d3d5f..6e75f48870 100644 --- a/src/haz3lcore/dynamics/Evaluator.re +++ b/src/haz3lcore/dynamics/Evaluator.re @@ -699,8 +699,6 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = (env, d) => { /* Increment number of evaluation steps (calls to `evaluate`). */ let* () = take_step; - //Printf.printf("env: %s\n", ClosureEnvironment.show(env)); - //Printf.printf("d: %s\n", DHExp.show(d)); switch (d) { | BoundVar(x) => let d = @@ -751,9 +749,7 @@ let rec evaluate: (ClosureEnvironment.t, DHExp.t) => m(EvaluatorResult.t) = | TypFun(_) => BoxedValue(Closure(env, d)) |> return | TypAp(d1, tau) => - //Printf.printf("TypAp, env: %s\n", ClosureEnvironment.show(env)); let* r1 = evaluate(env, d1); - //Printf.printf("r1: %s\n", EvaluatorResult.show(r1)); switch (r1) { | BoxedValue(Closure(closure_env, TypFun({term: Var(name), _}, d2))) => // TODO: Maybe additional cases to be done? diff --git a/src/haz3lcore/prog/Interface.re b/src/haz3lcore/prog/Interface.re index 13dc646919..04c9493bb5 100644 --- a/src/haz3lcore/prog/Interface.re +++ b/src/haz3lcore/prog/Interface.re @@ -56,7 +56,6 @@ let evaluate = // }; let evaluate = (d: DHExp.t): ProgramResult.t => { - //Printf.printf("Evaluating: %s\n", DHExp.show(d)); let result = try(evaluate(d)) { | EvaluatorError.Exception(reason) => diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 9bea4c4db6..9c1fb559c1 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -452,6 +452,11 @@ module rec Typ: { Rec(name, normalize(Ctx.extend_dummy_tvar(ctx, name), ty)) | Forall(name, ty) => Forall(name, normalize(Ctx.extend_dummy_tvar(ctx, name), ty)) + | Ap(Var(name), t2) => + switch (Ctx.lookup_higher_kind(ctx, name)) { + | Some((arg, ty_out)) => normalize(ctx, subst(t2, arg, ty_out)) + | None => Ap(Var(name), normalize(ctx, t2)) + } | Ap(t1, t2) => Ap(normalize(ctx, t1), normalize(ctx, t2)) }; }; From 21e33659a00cf7ad1b8b3d3f988d1356889e39ac Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Tue, 29 Aug 2023 19:34:13 -0400 Subject: [PATCH 29/56] Fix: ctr_ap type error --- src/haz3lcore/statics/Info.re | 20 +++++++++----------- src/haz3lcore/statics/Statics.re | 25 +++++++++++++++++-------- src/haz3lcore/statics/TypBase.re | 28 ++++++++++------------------ src/haz3lweb/view/CursorInspector.re | 3 ++- 4 files changed, 38 insertions(+), 38 deletions(-) diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 141302cf08..6d27d350ac 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -170,7 +170,8 @@ type error_tpat = [@deriving (show({with_path: false}), sexp, yojson)] type ok_tpat = | Empty - | Var(TypVar.t); + | Var(TypVar.t) + | Ap(TypVar.t, TypVar.t); [@deriving (show({with_path: false}), sexp, yojson)] type status_tpat = @@ -416,16 +417,13 @@ let status_tpat = (ctx: Ctx.t, utpat: UTPat.t): status_tpat => | Var(name) => NotInHole(Var(name)) | Invalid(_) => InHole(NotAVar(NotCapitalized)) | MultiHole(_) => InHole(NotAVar(Other)) - | Ap(t, _) => - switch (t.term) { - | Var(name) => - if (Form.is_base_typ(name) || Ctx.lookup_alias(ctx, name) != None) { - InHole(ShadowsType(name)); - } else { - NotInHole(Var(name)); - } - | _ => InHole(NotAVar(Other)) - } + | Ap({term: Var(name1), _}, {term: Var(_), _}) + when Form.is_base_typ(name1) || Ctx.lookup_alias(ctx, name1) != None => + InHole(ShadowsType(name1)) + | Ap({term: Var(name1), _}, {term: Var(name2), _}) => + NotInHole(Ap(name1, name2)) + + | Ap(_) => InHole(NotAVar(Other)) }; /* Determines whether any term is in an error hole. */ diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index c6f2bfdd9a..6f4e99a053 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -391,13 +391,23 @@ and uexp_to_info_map = ty_rec, ); (ty_rec, ctx_def, ctx_def); - | _ => - let ty = UTyp.to_typ(ctx, utyp); - ( - ty, - ctx, - Ctx.extend_higher_kind(ctx, name, arg, UTPat.rep_id(typat), ty), - ); + | _ => ( + ty_pre, + Ctx.extend_higher_kind( + ctx, + name, + arg, + UTPat.rep_id(typat), + ty_pre, + ), + Ctx.extend_higher_kind( + ctx, + name, + arg, + UTPat.rep_id(typat), + ty_pre, + ), + ) }; }; let ctx_body = { @@ -415,7 +425,6 @@ and uexp_to_info_map = UTyp.rep_id(utyp), sm_map, arg, - ty_def, ) | _ => ctx_body }; diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 9c1fb559c1..ce9422e550 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -468,8 +468,9 @@ module rec Typ: { ctrs, ); - let get_sum_constructors = (ctx: Ctx.t, ty: t): option(sum_map) => { + let rec get_sum_constructors = (ctx: Ctx.t, ty: t): option(sum_map) => { let ty = weak_head_normalize(ctx, ty); + Printf.printf("get_sum_constructors: %s\n", show(ty)); switch (ty) { | Sum(sm) => Some(sm) | Rec(_) => @@ -479,6 +480,11 @@ module rec Typ: { | Sum(sm) => Some(sm) | _ => None } + | Ap(Var(name), ty_arg) => + switch (Ctx.lookup_higher_kind(ctx, name)) { + | Some((arg, ty)) => get_sum_constructors(ctx, subst(ty_arg, arg, ty)) + | None => None + } | _ => None }; }; @@ -529,7 +535,7 @@ and Ctx: { let is_tyVar: (t, TypVar.t) => bool; let add_ctrs: (t, TypVar.t, Id.t, Typ.sum_map) => t; let add_ctr_with_typ_parameter: - (t, TypVar.t, Id.t, Typ.sum_map, TypVar.t, Typ.t) => t; + (t, TypVar.t, Id.t, Typ.sum_map, TypVar.t) => t; let subtract_prefix: (t, t) => option(t); let added_bindings: (t, t) => t; let filter_duplicates: t => t; @@ -657,15 +663,7 @@ and Ctx: { ) @ ctx; let add_ctr_with_typ_parameter = - ( - ctx: t, - name: TypVar.t, - id: Id.t, - ctrs: Typ.sum_map, - arg: TypVar.t, - ty: Typ.t, - ) - : t => + (ctx: t, name: TypVar.t, id: Id.t, ctrs: Typ.sum_map, arg: TypVar.t): t => List.map( ((ctr, typ)) => ConstructorEntry({ @@ -675,13 +673,7 @@ and Ctx: { switch (typ) { | None => Forall(arg, Ap(Var(name), Var(arg))) | Some(typ) => - Forall( - arg, - Arrow( - Typ.subst_ap(ty, name, arg, typ), - Ap(Var(name), Var(arg)), - ), - ) + Forall(arg, Arrow(typ, Ap(Var(name), Var(arg)))) }, }), ctrs, diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 50bc3c36e7..6f4ed17085 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -3,7 +3,6 @@ open Node; open Util.Web; open Util; open Haz3lcore; - let errc = "error"; let okc = "ok"; let div_err = div(~attr=clss([errc])); @@ -182,6 +181,8 @@ let tpat_view = (_: Term.Cls.t, status: Info.status_tpat) => switch (status) { | NotInHole(Empty) => div_ok([text("Fillable with a new alias")]) | NotInHole(Var(name)) => div_ok([Type.alias_view(name)]) + | NotInHole(Ap(name1, name2)) => + div_ok([Type.alias_view(name1), Type.alias_view(name2)]) | InHole(NotAVar(NotCapitalized)) => div_err([text("Must begin with a capital letter")]) | InHole(NotAVar(_)) => div_err([text("Expected an alias")]) From d6d8c177382d2d0e00b61f886a3672b213dbe718 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 30 Aug 2023 02:46:48 -0400 Subject: [PATCH 30/56] Add parentheses to left type of functions when necessary. Lowercase forall and rec. --- src/haz3lweb/view/Type.re | 37 +++++++++++++++++++++++++++++++------ 1 file changed, 31 insertions(+), 6 deletions(-) diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index e3afd602bb..ed08e6099e 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -17,8 +17,24 @@ let prov_view: Typ.type_provenance => Node.t = | TypeHole => div(~attr=clss(["typ-mod", "type-hole"]), [text("𝜏")]) | SynSwitch => div(~attr=clss(["typ-mod", "syn-switch"]), [text("⇒")]); +/* Does the type require parentheses when on the left of an arrow? */ +let needs_parens = (ty: Haz3lcore.Typ.t): bool => + switch (ty) { + | Unknown(_) + | Int + | Float + | String + | Bool + | Var(_) => false + | Rec(_, _) + | Forall(_, _) => true + | List(_) => false /* is already wrapped in [] */ + | Arrow(_, _) => true + | Prod(_) + | Sum(_) => true /* disambiguate between (A + B) -> C and A + (B -> C) */ + }; + let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => - //TODO: parens on ops when ambiguous switch (ty) { | Unknown(prov) => div( @@ -37,12 +53,12 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => | Rec(name, t) => div( ~attr=clss(["typ-view", "Rec"]), - [text("Rec " ++ name ++ ". "), view_ty(t)], + [text("rec " ++ name ++ ". "), view_ty(t)], ) | Forall(name, t) => div( ~attr=clss(["typ-view", "Forall"]), - [text("Forall " ++ name ++ ". "), view_ty(t)], + [text("forall " ++ name ++ ". "), view_ty(t)], ) | List(t) => div( @@ -52,7 +68,7 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => | Arrow(t1, t2) => div( ~attr=clss(["typ-view", "Arrow"]), - [view_ty(t1), text(" -> "), view_ty(t2)], + paren_view(t1) @ [text(" -> "), view_ty(t2)], ) | Prod([]) => div(~attr=clss(["typ-view", "Prod"]), [text("()")]) | Prod([_]) => @@ -64,8 +80,11 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => text("("), div( ~attr=clss(["typ-view", "Prod"]), - [view_ty(t0)] - @ (List.map(t => [text(", "), view_ty(t)], ts) |> List.flatten), + paren_view(t0) + @ ( + List.map(t => [text(", "), ...paren_view(t)], ts) + |> List.flatten + ), ), text(")"), ], @@ -87,6 +106,12 @@ and ctr_view = ((ctr, typ)) => switch (typ) { | None => [text(ctr)] | Some(typ) => [text(ctr ++ "("), view_ty(typ), text(")")] + } +and paren_view = typ => + if (needs_parens(typ)) { + [text("("), view_ty(typ), text(")")]; + } else { + [view_ty(typ)]; }; let view = (ty: Haz3lcore.Typ.t): Node.t => From ca727f2eb9dcab6835c62ea09231e70b879b8228 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 30 Aug 2023 03:04:23 -0400 Subject: [PATCH 31/56] Disallow shadowing with type variables. --- src/haz3lcore/statics/Info.re | 4 +--- src/haz3lcore/statics/Statics.re | 10 ++++++++-- src/haz3lcore/statics/TypBase.re | 2 +- 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index ea96f63bc8..3e67eb31be 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -389,9 +389,7 @@ let status_typ = let status_tpat = (ctx: Ctx.t, utpat: UTPat.t): status_tpat => switch (utpat.term) { | EmptyHole => NotInHole(Empty) - | Var(name) - when Form.is_base_typ(name) || Ctx.lookup_alias(ctx, name) != None => - InHole(ShadowsType(name)) + | Var(name) when Ctx.shadows_typ(ctx, name) => InHole(ShadowsType(name)) | Var(name) => NotInHole(Var(name)) | Invalid(_) => InHole(NotAVar(NotCapitalized)) | MultiHole(_) => InHole(NotAVar(Other)) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 2f5ef952a8..ed437719c0 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -251,7 +251,8 @@ and uexp_to_info_map = ~co_ctx=CoCtx.mk(ctx, p.ctx, e.co_ctx), m, ); - | TypFun({term: Var(name), _} as utpat, body) => + | TypFun({term: Var(name), _} as utpat, body) + when !Ctx.shadows_typ(ctx, name) => let mode_body = Mode.of_forall(Some(name), mode); let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; let ctx_body = @@ -261,12 +262,17 @@ and uexp_to_info_map = ); let (body, m) = go'(~ctx=ctx_body, ~mode=mode_body, body, m); add(~self=Just(Forall(name, body.ty)), ~co_ctx=body.co_ctx, m); + | TypFun({term: Var(name), _} as utpat, body) + when Ctx.shadows_typ(ctx, name) => + let ({co_ctx, ty: ty_body, _}: Info.exp, m) = go'(~ctx, ~mode, body, m); + let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; + add(~self=Just(Forall(name, ty_body)), ~co_ctx, m); | TypFun(utpat, body) => let mode_body = Mode.of_forall(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("expected_type_variable", body.ty)), + ~self=Just(Forall("?", body.ty)), ~co_ctx=body.co_ctx, m, ); diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index b089ee0fc4..fd8fe821a9 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -648,7 +648,7 @@ and Ctx: { |> (((ctx, _, _)) => List.rev(ctx)); let shadows_typ = (ctx: t, name: TypVar.t): bool => - Form.is_base_typ(name) || lookup_alias(ctx, name) != None; + Form.is_base_typ(name) || is_alias(ctx, name) || is_tvar(ctx, name); } and Kind: { [@deriving (show({with_path: false}), sexp, yojson)] From a140fa6adc3796fc188f983d45eeb8f9f42289b7 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 30 Aug 2023 03:16:50 -0400 Subject: [PATCH 32/56] Add disallowing of shadowing for type variables. --- src/haz3lcore/statics/Info.re | 19 +++++++++++++++++-- src/haz3lcore/statics/Statics.re | 6 +----- src/haz3lweb/view/CursorInspector.re | 9 +++++++-- 3 files changed, 25 insertions(+), 9 deletions(-) diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 3e67eb31be..46e8e9591f 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -160,10 +160,17 @@ type type_var_err = | Other | NotCapitalized; +/* What are we shadowing? */ +[@deriving (show({with_path: false}), sexp, yojson)] +type shadow_src = + | BaseTyp + | TyAlias + | TyVar; + /* Type pattern term errors */ [@deriving (show({with_path: false}), sexp, yojson)] type error_tpat = - | ShadowsType(TypVar.t) + | ShadowsType(TypVar.t, shadow_src) | NotAVar(type_var_err); /* Type pattern ok statuses for cursor inspector */ @@ -389,7 +396,15 @@ let status_typ = let status_tpat = (ctx: Ctx.t, utpat: UTPat.t): status_tpat => switch (utpat.term) { | EmptyHole => NotInHole(Empty) - | Var(name) when Ctx.shadows_typ(ctx, name) => InHole(ShadowsType(name)) + | Var(name) when Ctx.shadows_typ(ctx, name) => + let f = src => InHole(ShadowsType(name, src)); + if (Form.is_base_typ(name)) { + f(BaseTyp); + } else if (Ctx.is_alias(ctx, name)) { + f(TyAlias); + } else { + f(TyVar); + }; | Var(name) => NotInHole(Var(name)) | Invalid(_) => InHole(NotAVar(NotCapitalized)) | MultiHole(_) => InHole(NotAVar(Other)) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index ed437719c0..e16242db47 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -271,11 +271,7 @@ and uexp_to_info_map = let mode_body = Mode.of_forall(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("?", body.ty)), - ~co_ctx=body.co_ctx, - m, - ); + add(~self=Just(Forall("?", body.ty)), ~co_ctx=body.co_ctx, m); | Let(p, def, body) => let (p_syn, _m) = go_pat(~is_synswitch=true, ~mode=Syn, p, m); let def_ctx = extend_let_def_ctx(ctx, p, p_syn.ctx, def); diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 1419aa81c1..dc027a8277 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -192,10 +192,15 @@ let tpat_view = (_: Term.Cls.t, status: Info.status_tpat) => | InHole(NotAVar(NotCapitalized)) => div_err([text("Must begin with a capital letter")]) | InHole(NotAVar(_)) => div_err([text("Expected an alias")]) - | InHole(ShadowsType(name)) when Form.is_base_typ(name) => + | InHole(ShadowsType(name, BaseTyp)) => div_err([text("Can't shadow base type"), Type.view(Var(name))]) - | InHole(ShadowsType(name)) => + | InHole(ShadowsType(name, TyAlias)) => div_err([text("Can't shadow existing alias"), Type.view(Var(name))]) + | InHole(ShadowsType(name, TyVar)) => + div_err([ + text("Can't shadow existing type variable"), + Type.view(Var(name)), + ]) }; let view_of_info = From 256a8fcedbd5e89390f8fefad93aadc8d16154b8 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 30 Aug 2023 03:58:52 -0400 Subject: [PATCH 33/56] Use . (as opposed to ->) to delineate forall/rec binding from body. --- src/haz3lcore/lang/Form.re | 4 ++-- src/haz3lcore/statics/MakeTerm.re | 4 ++-- src/haz3lcore/statics/Term.re | 8 ++++---- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/haz3lcore/lang/Form.re b/src/haz3lcore/lang/Form.re index 03b092232c..522579d47f 100644 --- a/src/haz3lcore/lang/Form.re +++ b/src/haz3lcore/lang/Form.re @@ -256,8 +256,8 @@ let forms: list((string, t)) = [ ("parens_typ", mk(ii, ["(", ")"], mk_op(Typ, [Typ]))), ("fun_", mk(ds, ["fun", "->"], mk_pre(P.fun_, Exp, [Pat]))), ("typfun", mk(ds, ["typfun", "->"], mk_pre(P.fun_, Exp, [TPat]))), - ("forall", mk(ds, ["forall", "->"], mk_pre(P.fun_, Typ, [TPat]))), - ("rec", mk(ds, ["rec", "->"], mk_pre(P.fun_, Typ, [TPat]))), + ("forall", mk(ds, ["forall", "."], mk_pre(P.fun_, Typ, [TPat]))), + ("rec", mk(ds, ["rec", "."], mk_pre(P.fun_, Typ, [TPat]))), ("if_", mk(ds, ["if", "then", "else"], mk_pre(P.if_, Exp, [Exp, Exp]))), ("ap_exp", mk(ii, ["(", ")"], mk_post(P.ap, Exp, [Exp]))), ("ap_pat", mk(ii, ["(", ")"], mk_post(P.ap, Pat, [Pat]))), diff --git a/src/haz3lcore/statics/MakeTerm.re b/src/haz3lcore/statics/MakeTerm.re index 68d4c88cc3..56277f9940 100644 --- a/src/haz3lcore/statics/MakeTerm.re +++ b/src/haz3lcore/statics/MakeTerm.re @@ -404,8 +404,8 @@ and typ_term: unsorted => (UTyp.term, list(Id.t)) = { | ([(_id, x)], []) => ret( switch (x) { - | (["forall", "->"], [TPat(tpat)]) => Forall(tpat, t) - | (["rec", "->"], [TPat(tpat)]) => Rec(tpat, t) + | (["forall", "."], [TPat(tpat)]) => Forall(tpat, t) + | (["rec", "."], [TPat(tpat)]) => Rec(tpat, t) | _ => hole(tm) }, ) diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index c0418f8be3..660ed07bfc 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -49,10 +49,10 @@ module UTPat = { let show_cls: cls => string = fun - | Invalid => "Invalid type alias" - | MultiHole => "Broken type alias" - | EmptyHole => "Empty type alias hole" - | Var => "Type alias"; + | Invalid => "Invalid type variable name" + | MultiHole => "Broken type name" + | EmptyHole => "Empty type variable hole" + | Var => "Type variable"; let tyvar_of_utpat = ({ids: _, term}) => switch (term) { From 9c4403d7a1677f5692d77a3aedf34a74718bcadd Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 30 Aug 2023 04:24:17 -0400 Subject: [PATCH 34/56] Make forall/rec bind tighter than sum to fix parsing bug. --- src/haz3lcore/statics/MakeTerm.re | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/haz3lcore/statics/MakeTerm.re b/src/haz3lcore/statics/MakeTerm.re index 56277f9940..badafed0ba 100644 --- a/src/haz3lcore/statics/MakeTerm.re +++ b/src/haz3lcore/statics/MakeTerm.re @@ -392,6 +392,13 @@ and typ_term: unsorted => (UTyp.term, list(Id.t)) = { | ([(_, (["(", ")"], [Typ(typ)]))], []) => ret(Ap(t, typ)) | _ => ret(hole(tm)) } + /* forall and rec have to be before sum so that they bind tighter. + * Thus `rec A . Left(A) + Right(B)` get parsed as `rec A . (Left(A) + Right(B))` + * If this is below the case for sum, then it gets parsed as an invalid form. */ + | Pre(([(_id, (["forall", "."], [TPat(tpat)]))], []), Typ(t)) => + ret(Forall(tpat, t)) + | Pre(([(_id, (["rec", "."], [TPat(tpat)]))], []), Typ(t)) => + ret(Rec(tpat, t)) | Pre(tiles, Typ({term: Sum(t0), ids})) as tm => /* Case for leading prefix + preceeding a sum */ switch (tiles) { @@ -401,14 +408,6 @@ and typ_term: unsorted => (UTyp.term, list(Id.t)) = { | Pre(tiles, Typ(t)) as tm => switch (tiles) { | ([(_, (["+"], []))], []) => ret(Sum([parse_sum_term(t)])) - | ([(_id, x)], []) => - ret( - switch (x) { - | (["forall", "."], [TPat(tpat)]) => Forall(tpat, t) - | (["rec", "."], [TPat(tpat)]) => Rec(tpat, t) - | _ => hole(tm) - }, - ) | _ => ret(hole(tm)) } | Bin(Typ(t1), tiles, Typ(t2)) as tm when is_typ_bsum(tiles) != None => From cb8191175807bc7c7f4d378ae6a786aef5a83d78 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 30 Aug 2023 14:05:46 -0400 Subject: [PATCH 35/56] Change display information to "type binding" instead of alias or variable. --- src/haz3lcore/statics/Term.re | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index 660ed07bfc..90f1d1a7f6 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -49,10 +49,10 @@ module UTPat = { let show_cls: cls => string = fun - | Invalid => "Invalid type variable name" - | MultiHole => "Broken type name" - | EmptyHole => "Empty type variable hole" - | Var => "Type variable"; + | Invalid => "Invalid type binding name" + | MultiHole => "Broken type binding" + | EmptyHole => "Empty type binding hole" + | Var => "Type binding"; let tyvar_of_utpat = ({ids: _, term}) => switch (term) { From 4e4b1cfe55df83feb71172979b4f3ea0a0d753ee Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 30 Aug 2023 14:07:31 -0400 Subject: [PATCH 36/56] Make shadowing typfun use the same case as a hole in tvar name. --- src/haz3lcore/statics/Statics.re | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index e16242db47..4221ca4a34 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -262,11 +262,6 @@ and uexp_to_info_map = ); let (body, m) = go'(~ctx=ctx_body, ~mode=mode_body, body, m); add(~self=Just(Forall(name, body.ty)), ~co_ctx=body.co_ctx, m); - | TypFun({term: Var(name), _} as utpat, body) - when Ctx.shadows_typ(ctx, name) => - let ({co_ctx, ty: ty_body, _}: Info.exp, m) = go'(~ctx, ~mode, body, m); - let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; - add(~self=Just(Forall(name, ty_body)), ~co_ctx, m); | TypFun(utpat, body) => let mode_body = Mode.of_forall(None, mode); let m = utpat_to_info_map(~ctx, ~ancestors, utpat, m) |> snd; From 3f95648bd637dd8fa3b16647f2606b51c49d2901 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 30 Aug 2023 14:53:55 -0400 Subject: [PATCH 37/56] Add () around tuple output. --- src/haz3lweb/view/dhcode/layout/DHDoc_common.re | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/haz3lweb/view/dhcode/layout/DHDoc_common.re b/src/haz3lweb/view/dhcode/layout/DHDoc_common.re index 8b8ec43794..66aa66e5d7 100644 --- a/src/haz3lweb/view/dhcode/layout/DHDoc_common.re +++ b/src/haz3lweb/view/dhcode/layout/DHDoc_common.re @@ -134,7 +134,7 @@ let mk_comma_seq = (ld, rd, l) => { let mk_ListLit = l => mk_comma_seq("[", "]", l); -let mk_Tuple = elts => mk_comma_seq("", "", elts); +let mk_Tuple = elts => mk_comma_seq("(", ")", elts); let mk_Ap = (doc1, doc2) => Doc.(hcats([doc1, text("("), doc2, text(")")])); From 1fe28e25dd09a6e5996912016d7d1b82f855a838 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 30 Aug 2023 15:07:31 -0400 Subject: [PATCH 38/56] Add Example scratchpad for polymorphism and recursive types. --- src/haz3lweb/Init.ml | 1275 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1275 insertions(+) diff --git a/src/haz3lweb/Init.ml b/src/haz3lweb/Init.ml index 0306751d59..be135988a7 100644 --- a/src/haz3lweb/Init.ml +++ b/src/haz3lweb/Init.ml @@ -9300,6 +9300,1281 @@ let startup : PersistentData.t = let Yo(1): +Yo(Bool) = Yo(true) in #err: type incons#\n\ \"Thats all, folks\"\n"; } ) ); + ( "Polymorphism", + ( 4819, + { + zipper = + "((selection((focus \ + Left)(content())))(backpack())(relatives((siblings(((Tile((id \ + 4778)(label(ex1))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 4779)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 14))(sort Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 4781)(content(Whitespace\" \"))))(Tile((id \ + 4788)(label(ex2))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 4789)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 14))(sort Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 4791)(content(Whitespace\" \")))))((Tile((id \ + 4794)(label(ex3))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 4795)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 14))(sort Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 4797)(content(Whitespace\" \"))))(Tile((id \ + 4800)(label(ex4))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 4801)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 14))(sort Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 4803)(content(Whitespace\" \"))))(Tile((id \ + 4806)(label(ex5))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children()))))))(ancestors((((id \ + 4808)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards((0)(1)))(children(()())))(((Secondary((id \ + 1497)(content(Comment\"# Polymorphism #\"))))(Secondary((id \ + 1465)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 1544)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 1675)(content(Comment\"# We can take types as parameters to \ + type functions, #\"))))(Secondary((id \ + 1676)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 1722)(content(Comment\"# and use them in annoatations in \ + the body: #\"))))(Secondary((id \ + 1466)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 1502)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 1503)(content(Whitespace\" \"))))(Tile((id \ + 1506)(label(id))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 1507)(content(Whitespace\" \")))))((Secondary((id \ + 1508)(content(Whitespace\" \"))))(Tile((id \ + 1516)(label(typfun ->))(mold((out \ + Exp)(in_(TPat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 1517)(content(Whitespace\" \ + \"))))(Tile((id 1518)(label(A))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 1520)(content(Whitespace\" \")))))))))(Secondary((id \ + 1522)(content(Whitespace\" \"))))(Tile((id 1527)(label(fun \ + ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 1528)(content(Whitespace\" \ + \"))))(Tile((id 1529)(label(x))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 1531)(content(Whitespace\" \"))))(Tile((id \ + 1532)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 11))(sort Pat))((shape(Concave 11))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 1533)(content(Whitespace\" \"))))(Tile((id \ + 1534)(label(A))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 1536)(content(Whitespace\" \")))))))))(Secondary((id \ + 1538)(content(Whitespace\" \"))))(Tile((id \ + 1539)(label(x))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 1543)(content(Whitespace\" \")))))))))(Secondary((id \ + 1467)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 1723)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 1761)(content(Comment\"# Such functions are applied like \ + so: #\"))))(Secondary((id \ + 1468)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 4680)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 4681)(content(Whitespace\" \"))))(Tile((id \ + 4686)(label(ex1))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 4688)(content(Whitespace\" \")))))((Secondary((id \ + 4689)(content(Whitespace\" \"))))(Tile((id \ + 4685)(label(id))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id 1766)(label(@< \ + >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ + Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Tile((id 1770)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Tile((id \ + 2088)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2090)(label(1))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + 4694)(content(Whitespace\" \")))))))))(Secondary((id \ + 2023)(content(Whitespace\" \"))))(Secondary((id \ + 2085)(content(Comment\"# 1 #\"))))(Secondary((id \ + 1469)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 1470)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 1878)(content(Comment\"# We can annotate the type of a type \ + function with a forall. #\"))))(Secondary((id \ + 4690)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 1884)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 1885)(content(Whitespace\" \"))))(Tile((id \ + 1891)(label(const))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 1892)(content(Whitespace\" \"))))(Tile((id \ + 1893)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 11))(sort Pat))((shape(Concave 11))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 1894)(content(Whitespace\" \"))))(Tile((id \ + 1902)(label(forall .))(mold((out \ + Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ + 1))(children(((Secondary((id 1903)(content(Whitespace\" \ + \"))))(Tile((id 1904)(label(A))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 1914)(content(Whitespace\" \")))))))))(Secondary((id \ + 1915)(content(Whitespace\" \"))))(Tile((id \ + 1929)(label(forall .))(mold((out \ + Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ + 1))(children(((Secondary((id 1930)(content(Whitespace\" \ + \"))))(Tile((id 1931)(label(B))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 1933)(content(Whitespace\" \")))))))))(Secondary((id \ + 1934)(content(Whitespace\" \"))))(Tile((id \ + 1935)(label(A))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 1937)(content(Whitespace\" \"))))(Tile((id \ + 1939)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 6))(sort Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 1940)(content(Whitespace\" \"))))(Tile((id \ + 1941)(label(B))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 1943)(content(Whitespace\" \"))))(Tile((id \ + 1945)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 6))(sort Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 1946)(content(Whitespace\" \"))))(Tile((id \ + 1947)(label(A))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 1948)(content(Whitespace\" \")))))((Secondary((id \ + 1953)(content(Whitespace\" \"))))(Secondary((id \ + 2008)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 1985)(label(typfun ->))(mold((out \ + Exp)(in_(TPat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 1986)(content(Whitespace\" \ + \"))))(Tile((id 1989)(label(A))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 1991)(content(Whitespace\" \")))))))))(Secondary((id \ + 1993)(content(Whitespace\" \"))))(Tile((id \ + 2001)(label(typfun ->))(mold((out \ + Exp)(in_(TPat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2002)(content(Whitespace\" \ + \"))))(Tile((id 2003)(label(B))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2005)(content(Whitespace\" \")))))))))(Secondary((id \ + 2007)(content(Whitespace\" \"))))(Tile((id 1957)(label(fun \ + ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 1958)(content(Whitespace\" \ + \"))))(Tile((id 1960)(label(x))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 1961)(content(Whitespace\" \")))))))))(Secondary((id \ + 1964)(content(Whitespace\" \"))))(Tile((id 1968)(label(fun \ + ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 1969)(content(Whitespace\" \ + \"))))(Tile((id 1971)(label(y))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 1972)(content(Whitespace\" \")))))))))(Secondary((id \ + 1975)(content(Whitespace\" \"))))(Tile((id \ + 1976)(label(x))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 1977)(content(Whitespace\" \")))))))))(Secondary((id \ + 1879)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 4700)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 4701)(content(Whitespace\" \"))))(Tile((id \ + 4706)(label(ex2))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 4708)(content(Whitespace\" \")))))((Secondary((id \ + 4709)(content(Whitespace\" \"))))(Tile((id \ + 4705)(label(const))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id 2025)(label(@< \ + >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ + Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Tile((id 2033)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Tile((id \ + 2049)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2056)(label(String))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Tile((id \ + 2057)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2062)(label(2))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Tile((id \ + 2064)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2077)(label(\"\\\"Hello World\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + 4713)(content(Whitespace\" \")))))))))(Secondary((id \ + 2079)(content(Whitespace\" \"))))(Secondary((id \ + 2083)(content(Comment\"# 2 #\"))))(Secondary((id \ + 2009)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 2091)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 2158)(content(Comment\"# We can go beyond rank 1 \ + polymorphism: #\"))))(Secondary((id \ + 2092)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 2164)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 2165)(content(Whitespace\" \"))))(Tile((id \ + 2187)(label(apply_both))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 2188)(content(Whitespace\" \"))))(Tile((id \ + 2191)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 11))(sort Pat))((shape(Concave 11))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2218)(content(Whitespace\" \"))))(Tile((id \ + 2227)(label(forall .))(mold((out \ + Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ + 1))(children(((Secondary((id 2228)(content(Whitespace\" \ + \"))))(Tile((id 2229)(label(A))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2231)(content(Whitespace\" \")))))))))(Secondary((id \ + 2232)(content(Whitespace\" \"))))(Tile((id \ + 2240)(label(forall .))(mold((out \ + Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ + 1))(children(((Secondary((id 2241)(content(Whitespace\" \ + \"))))(Tile((id 2242)(label(B))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2244)(content(Whitespace\" \")))))))))(Secondary((id \ + 2245)(content(Whitespace\" \"))))(Tile((id \ + 2274)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 2282)(label(forall .))(mold((out \ + Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ + 1))(children(((Secondary((id 2283)(content(Whitespace\" \ + \"))))(Tile((id 2284)(label(D))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2286)(content(Whitespace\" \")))))))))(Secondary((id \ + 2287)(content(Whitespace\" \"))))(Tile((id \ + 2288)(label(D))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2306)(content(Whitespace\" \"))))(Tile((id \ + 2304)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 6))(sort Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2316)(content(Whitespace\" \"))))(Tile((id \ + 2317)(label(D))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 2324)(content(Whitespace\" \"))))(Tile((id \ + 2321)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 6))(sort Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2323)(content(Whitespace\" \"))))(Tile((id \ + 2327)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 2329)(label(A))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2330)(content(Whitespace\" \"))))(Tile((id \ + 2331)(label(,))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 14))(sort Typ))((shape(Concave 14))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2333)(content(Whitespace\" \"))))(Tile((id \ + 2334)(label(B))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 2341)(content(Whitespace\" \"))))(Tile((id \ + 2338)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 6))(sort Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2345)(content(Whitespace\" \"))))(Tile((id \ + 2346)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 2347)(label(A))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2348)(content(Whitespace\" \"))))(Tile((id \ + 2349)(label(,))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 14))(sort Typ))((shape(Concave 14))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2351)(content(Whitespace\" \"))))(Tile((id \ + 2352)(label(B))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 2353)(content(Whitespace\" \")))))((Secondary((id \ + 2355)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 2377)(label(typfun ->))(mold((out \ + Exp)(in_(TPat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2378)(content(Whitespace\" \ + \"))))(Tile((id 2380)(label(A))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2381)(content(Whitespace\" \")))))))))(Secondary((id \ + 2384)(content(Whitespace\" \"))))(Tile((id \ + 2391)(label(typfun ->))(mold((out \ + Exp)(in_(TPat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2392)(content(Whitespace\" \ + \"))))(Tile((id 2394)(label(B))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2395)(content(Whitespace\" \")))))))))(Secondary((id \ + 2402)(content(Whitespace\" \"))))(Tile((id 2408)(label(fun \ + ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2409)(content(Whitespace\" \ + \"))))(Tile((id 2411)(label(f))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 2412)(content(Whitespace\" \")))))))))(Secondary((id \ + 2415)(content(Whitespace\" \"))))(Tile((id 2419)(label(fun \ + ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2420)(content(Whitespace\" \ + \"))))(Tile((id 2422)(label(\"(\"\")\"))(mold((out \ + Pat)(in_(Pat))(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0 1))(children(((Tile((id \ + 2423)(label(x))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Tile((id \ + 2424)(label(,))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 14))(sort Pat))((shape(Concave 14))(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 2426)(content(Whitespace\" \"))))(Tile((id \ + 2427)(label(y))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children()))))))))(Secondary((id \ + 2428)(content(Whitespace\" \")))))))))(Secondary((id \ + 2431)(content(Whitespace\" \"))))(Tile((id \ + 2432)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2433)(label(f))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id 2452)(label(@< \ + >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ + Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Tile((id 2453)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Tile((id \ + 2440)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2442)(label(x))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Tile((id \ + 2443)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 14))(sort Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 2445)(content(Whitespace\" \"))))(Tile((id \ + 2446)(label(f))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id 2455)(label(@< \ + >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ + Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Tile((id 2456)(label(B))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Tile((id \ + 2447)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2449)(label(y))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))))))))))))(Secondary((id \ + 2450)(content(Whitespace\" \")))))))))(Secondary((id \ + 2308)(content(Whitespace\" \"))))(Secondary((id \ + 2313)(content(Whitespace\" \"))))(Secondary((id \ + 2159)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 4719)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 4720)(content(Whitespace\" \"))))(Tile((id \ + 4725)(label(ex3))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 4727)(content(Whitespace\" \")))))((Secondary((id \ + 4728)(content(Whitespace\" \"))))(Tile((id \ + 4724)(label(apply_both))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id 2476)(label(@< \ + >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ + Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Tile((id 2481)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Tile((id \ + 2483)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2490)(label(String))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Tile((id \ + 2491)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2494)(label(id))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Tile((id \ + 2495)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2501)(label(3))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 2503)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 14))(sort Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 2504)(content(Whitespace\" \"))))(Tile((id \ + 2517)(label(\"\\\"Hello World\\\"\"))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + 4732)(content(Whitespace\" \")))))))))(Secondary((id \ + 2526)(content(Whitespace\" \"))))(Secondary((id \ + 2548)(content(Comment\"# (3, \\\"Hello World\\\") \ + #\"))))(Secondary((id 2521)(content(Whitespace\" \ + \"))))(Secondary((id \ + 2457)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 2549)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 2650)(content(Comment\"# Finally, here is a more in-depth, \ + yet applicable example: polymorphic map \ + #\"))))(Secondary((id \ + 2550)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 2932)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 2933)(content(Whitespace\" \"))))(Tile((id \ + 2943)(label(emptylist))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 2944)(content(Whitespace\" \"))))(Tile((id \ + 2945)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 11))(sort Pat))((shape(Concave 11))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2946)(content(Whitespace\" \"))))(Tile((id \ + 2954)(label(forall .))(mold((out \ + Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ + 1))(children(((Secondary((id 2955)(content(Whitespace\" \ + \"))))(Tile((id 2956)(label(A))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2958)(content(Whitespace\" \")))))))))(Secondary((id \ + 2959)(content(Whitespace\" \"))))(Tile((id 2960)(label([ \ + ]))(mold((out Typ)(in_(Typ))(nibs(((shape Convex)(sort \ + Typ))((shape Convex)(sort Typ))))))(shards(0 \ + 1))(children(((Tile((id 2961)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 2963)(content(Whitespace\" \")))))((Secondary((id \ + 2964)(content(Whitespace\" \"))))(Tile((id \ + 2972)(label(typfun ->))(mold((out \ + Exp)(in_(TPat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2973)(content(Whitespace\" \ + \"))))(Tile((id 2974)(label(A))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2976)(content(Whitespace\" \")))))))))(Secondary((id \ + 2978)(content(Whitespace\" \"))))(Tile((id \ + 2980)(label([]))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 2984)(content(Whitespace\" \")))))))))(Secondary((id \ + 2986)(content(Whitespace\" \"))))(Secondary((id \ + 3009)(content(Comment\"# polymorphic constant \ + #\"))))(Secondary((id \ + 2927)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 2656)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 2657)(content(Whitespace\" \"))))(Tile((id \ + 2661)(label(map))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 2662)(content(Whitespace\" \"))))(Tile((id \ + 2663)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 11))(sort Pat))((shape(Concave 11))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2664)(content(Whitespace\" \"))))(Tile((id \ + 2672)(label(forall .))(mold((out \ + Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ + 1))(children(((Secondary((id 2673)(content(Whitespace\" \ + \"))))(Tile((id 2674)(label(A))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2676)(content(Whitespace\" \")))))))))(Secondary((id \ + 2677)(content(Whitespace\" \"))))(Tile((id \ + 2685)(label(forall .))(mold((out \ + Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ + 1))(children(((Secondary((id 2686)(content(Whitespace\" \ + \"))))(Tile((id 2687)(label(B))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2689)(content(Whitespace\" \")))))))))(Secondary((id \ + 2690)(content(Whitespace\" \"))))(Tile((id \ + 2691)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 2692)(label(A))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2701)(content(Whitespace\" \"))))(Tile((id \ + 2697)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 6))(sort Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2698)(content(Whitespace\" \"))))(Tile((id \ + 2699)(label(B))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 2702)(content(Whitespace\" \"))))(Tile((id \ + 2704)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 6))(sort Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2705)(content(Whitespace\" \"))))(Tile((id \ + 2706)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 2707)(label([ ]))(mold((out Typ)(in_(Typ))(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort Typ))))))(shards(0 \ + 1))(children(((Tile((id 2708)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 2719)(content(Whitespace\" \"))))(Tile((id \ + 2713)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 6))(sort Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2714)(content(Whitespace\" \"))))(Tile((id 2715)(label([ \ + ]))(mold((out Typ)(in_(Typ))(nibs(((shape Convex)(sort \ + Typ))((shape Convex)(sort Typ))))))(shards(0 \ + 1))(children(((Tile((id 2716)(label(B))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children())))))))))))))(Secondary((id \ + 2720)(content(Whitespace\" \")))))((Secondary((id \ + 2721)(content(Whitespace\" \"))))(Secondary((id \ + 2722)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 2730)(label(typfun ->))(mold((out \ + Exp)(in_(TPat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2731)(content(Whitespace\" \ + \"))))(Tile((id 2732)(label(A))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2734)(content(Whitespace\" \")))))))))(Secondary((id \ + 2736)(content(Whitespace\" \"))))(Tile((id \ + 2744)(label(typfun ->))(mold((out \ + Exp)(in_(TPat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2745)(content(Whitespace\" \ + \"))))(Tile((id 2746)(label(B))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 2748)(content(Whitespace\" \")))))))))(Secondary((id \ + 2755)(content(Whitespace\" \"))))(Tile((id 2759)(label(fun \ + ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2760)(content(Whitespace\" \ + \"))))(Tile((id 2762)(label(f))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 2763)(content(Whitespace\" \"))))(Tile((id \ + 2764)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 11))(sort Pat))((shape(Concave 11))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2766)(content(Whitespace\" \"))))(Tile((id \ + 2775)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 2776)(label(A))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2788)(content(Whitespace\" \"))))(Tile((id \ + 2780)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 6))(sort Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2782)(content(Whitespace\" \"))))(Tile((id \ + 2783)(label(B))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 2784)(content(Whitespace\" \")))))))))(Secondary((id \ + 2787)(content(Whitespace\" \"))))(Tile((id 2792)(label(fun \ + ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2793)(content(Whitespace\" \ + \"))))(Tile((id 2795)(label(l))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 2797)(content(Whitespace\" \"))))(Tile((id \ + 2798)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 11))(sort Pat))((shape(Concave 11))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 2800)(content(Whitespace\" \"))))(Tile((id 2801)(label([ \ + ]))(mold((out Typ)(in_(Typ))(nibs(((shape Convex)(sort \ + Typ))((shape Convex)(sort Typ))))))(shards(0 \ + 1))(children(((Tile((id 2802)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 2803)(content(Whitespace\" \")))))))))(Secondary((id \ + 2807)(content(Whitespace\" \"))))(Secondary((id \ + 4473)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 2826)(label(case end))(mold((out \ + Exp)(in_(Rul))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2827)(content(Whitespace\" \ + \"))))(Tile((id 2829)(label(l))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 2838)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 2839)(label(| =>))(mold((out \ + Rul)(in_(Pat))(nibs(((shape(Concave 19))(sort \ + Exp))((shape(Concave 19))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2841)(content(Whitespace\" \ + \"))))(Tile((id 2842)(label(h))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 2843)(content(Whitespace\" \"))))(Tile((id \ + 2846)(label(::))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 6))(sort Pat))((shape(Concave 6))(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 2847)(content(Whitespace\" \"))))(Tile((id \ + 2848)(label(t))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 2849)(content(Whitespace\" \")))))))))(Secondary((id \ + 2852)(content(Whitespace\" \"))))(Tile((id \ + 2863)(label(f))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 2864)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2866)(label(h))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + 2867)(content(Whitespace\" \"))))(Tile((id \ + 2870)(label(::))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 6))(sort Exp))((shape(Concave 6))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 2871)(content(Whitespace\" \"))))(Tile((id \ + 2874)(label(map))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id 2878)(label(@< \ + >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ + Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Tile((id 2879)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Tile((id \ + 2882)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2883)(label(B))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Tile((id \ + 2884)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2886)(label(f))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Tile((id \ + 2887)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 2889)(label(t))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + 2890)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 2891)(label(| =>))(mold((out \ + Rul)(in_(Pat))(nibs(((shape(Concave 19))(sort \ + Exp))((shape(Concave 19))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 2893)(content(Whitespace\" \ + \"))))(Tile((id 2925)(label(_))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 2926)(content(Whitespace\" \")))))))))(Secondary((id \ + 2899)(content(Whitespace\" \"))))(Tile((id \ + 3020)(label(emptylist))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id 3023)(label(@< \ + >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ + Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Tile((id 3024)(label(B))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 2836)(content(Whitespace\"\\226\\143\\142\")))))))))(Secondary((id \ + 2837)(content(Whitespace\" \")))))))))(Secondary((id \ + 2651)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 4740)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 4741)(content(Whitespace\" \"))))(Tile((id \ + 4746)(label(ex4))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 4748)(content(Whitespace\" \")))))((Secondary((id \ + 4749)(content(Whitespace\" \"))))(Tile((id \ + 4745)(label(map))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id 3033)(label(@< \ + >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ + Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Tile((id 3037)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Tile((id \ + 3039)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 3046)(label(String))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Tile((id \ + 3051)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 3068)(label(string_of_int))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Tile((id \ + 3073)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 3080)(label([ ]))(mold((out Exp)(in_(Exp))(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Tile((id 3082)(label(1))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 3086)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 14))(sort Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 3089)(label(2))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 3090)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 14))(sort Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 3092)(label(3))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))))))))))))(Secondary((id \ + 4753)(content(Whitespace\" \")))))))))(Secondary((id \ + 3101)(content(Whitespace\" \"))))(Secondary((id \ + 3125)(content(Comment\"# [\\\"1\\\", \\\"2\\\", \\\"3\\\"] \ + #\"))))(Secondary((id \ + 3126)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 3128)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 3129)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 3147)(content(Comment\"# Recursive types \ + #\"))))(Secondary((id \ + 3148)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 3149)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 3266)(content(Comment\"# We can express types that are the \ + least fixed point of #\"))))(Secondary((id \ + 3267)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 3319)(content(Comment\"# some type function with the rec \ + keyword. #\"))))(Secondary((id \ + 1472)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 681)(label(type = in))(mold((out Exp)(in_(TPat \ + Typ))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 682)(content(Whitespace\" \"))))(Tile((id \ + 970)(label(MyList))(mold((out TPat)(in_())(nibs(((shape \ + Convex)(sort TPat))((shape Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 975)(content(Whitespace\" \")))))((Secondary((id \ + 3332)(content(Whitespace\" \"))))(Tile((id 891)(label(rec \ + .))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ + 1))(children(((Secondary((id 989)(content(Whitespace\" \ + \"))))(Tile((id 4015)(label(A))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ + TPat))))))(shards(0))(children()))))))))(Secondary((id \ + 4013)(content(Whitespace\" \"))))(Tile((id \ + 1075)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 894)(label(Nil))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 851)(content(Whitespace\" \"))))(Tile((id \ + 849)(label(+))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 10))(sort Typ))((shape(Concave 10))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 852)(content(Whitespace\" \"))))(Tile((id \ + 856)(label(Cons))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 868)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape(Concave 1))(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 4021)(label(Int))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 873)(label(,))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 14))(sort Typ))((shape(Concave 14))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 875)(content(Whitespace\" \"))))(Tile((id \ + 4017)(label(A))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))))))))))))(Secondary((id \ + 885)(content(Whitespace\" \")))))))))(Secondary((id \ + 3562)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 4217)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 4356)(content(Comment\"# Hazel does not (yet) support \ + higher-kinded or existential types, #\"))))(Secondary((id \ + 4287)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 4357)(content(Comment\"# So we cannot implement our own \ + polymorphic lists. #\"))))(Secondary((id \ + 4218)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 3782)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 3899)(content(Comment\"# Now anything that returns an \ + element of the least fixed point matches MyList. \ + #\"))))(Secondary((id \ + 3900)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 3905)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 3906)(content(Whitespace\" \"))))(Tile((id \ + 3907)(label(x))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 3909)(content(Whitespace\" \"))))(Tile((id \ + 3910)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 11))(sort Pat))((shape(Concave 11))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 3911)(content(Whitespace\" \"))))(Tile((id \ + 3918)(label(MyList))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 3979)(content(Whitespace\" \")))))((Secondary((id \ + 3920)(content(Whitespace\" \"))))(Tile((id \ + 3995)(label(Cons))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 3926)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 3927)(label(1))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 3929)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 14))(sort Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 3930)(content(Whitespace\" \"))))(Tile((id \ + 3935)(label(Cons))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 3936)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 3937)(label(2))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 3939)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 14))(sort Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 3940)(content(Whitespace\" \"))))(Tile((id \ + 3945)(label(Cons))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 3946)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 3947)(label(3))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Tile((id \ + 3949)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 14))(sort Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 3950)(content(Whitespace\" \"))))(Tile((id \ + 3954)(label(Nil))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children()))))))))))))))))))(Secondary((id \ + 3957)(content(Whitespace\" \")))))))))(Secondary((id \ + 3783)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 3563)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 4216)(content(Comment\"# Note that if the sum is the top \ + level operator, #\"))))(Secondary((id \ + 3616)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 3701)(content(Comment\"# type aliases are implicitly least \ + fixed points on their own name: #\"))))(Secondary((id \ + 990)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 1002)(label(type = in))(mold((out Exp)(in_(TPat \ + Typ))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 1011)(content(Whitespace\" \"))))(Tile((id \ + 1091)(label(MyList2))(mold((out TPat)(in_())(nibs(((shape \ + Convex)(sort TPat))((shape Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 1141)(content(Whitespace\" \")))))((Secondary((id \ + 3513)(content(Whitespace\" \"))))(Tile((id \ + 3507)(label(Nil))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 3378)(content(Whitespace\" \"))))(Tile((id \ + 3379)(label(+))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 10))(sort Typ))((shape(Concave 10))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 3381)(content(Whitespace\" \"))))(Tile((id \ + 3385)(label(Cons))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 3386)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape(Concave 1))(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 3705)(label(Int))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 3389)(label(,))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 14))(sort Typ))((shape(Concave 14))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 3391)(content(Whitespace\" \"))))(Tile((id \ + 3398)(label(MyList2))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 3399)(content(Whitespace\" \")))))))))(Secondary((id \ + 3706)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 3715)(label(type = in))(mold((out Exp)(in_(TPat \ + Typ))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 3716)(content(Whitespace\" \"))))(Tile((id \ + 4079)(label(Broken))(mold((out TPat)(in_())(nibs(((shape \ + Convex)(sort TPat))((shape Convex)(sort \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 3730)(content(Whitespace\" \")))))((Secondary((id \ + 3740)(content(Whitespace\" \"))))(Tile((id \ + 4111)(label(Int))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 4122)(content(Whitespace\" \"))))(Tile((id \ + 4121)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 6))(sort Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 3744)(content(Whitespace\" \"))))(Tile((id \ + 4120)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 4134)(label(HasInt))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 4135)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape(Concave 1))(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 4138)(label(Int))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children()))))))))(Secondary((id \ + 4062)(content(Whitespace\" \"))))(Tile((id \ + 4063)(label(+))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 10))(sort Typ))((shape(Concave 10))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 4065)(content(Whitespace\" \"))))(Tile((id \ + 4149)(label(HasMore))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 4098)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape(Concave 1))(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 4154)(label(Int))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Tile((id \ + 4155)(label(,))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 14))(sort Typ))((shape(Concave 14))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 4156)(content(Whitespace\" \"))))(Tile((id \ + 4153)(label(Broken))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))))))))))))(Secondary((id \ + 4106)(content(Whitespace\" \")))))))))(Secondary((id \ + 3779)(content(Whitespace\" \"))))(Secondary((id \ + 3780)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 3781)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 907)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 4566)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 4567)(content(Whitespace\" \"))))(Tile((id \ + 4585)(label(list_of_mylist))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 921)(content(Whitespace\" \"))))(Tile((id \ + 4410)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 11))(sort Pat))((shape(Concave 11))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 4412)(content(Whitespace\" \"))))(Tile((id \ + 4435)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 4418)(label(MyList))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 4448)(content(Whitespace\" \"))))(Tile((id \ + 4439)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ + 6))(sort Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 4441)(content(Whitespace\" \"))))(Tile((id 4603)(label([ \ + ]))(mold((out Typ)(in_(Typ))(nibs(((shape Convex)(sort \ + Typ))((shape Convex)(sort Typ))))))(shards(0 \ + 1))(children(((Tile((id 4444)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ + Typ))))))(shards(0))(children())))))))))))))(Secondary((id \ + 4604)(content(Whitespace\" \")))))((Secondary((id \ + 4449)(content(Whitespace\" \"))))(Tile((id 4453)(label(fun \ + ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 4454)(content(Whitespace\" \ + \"))))(Tile((id 4458)(label(myl))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 4459)(content(Whitespace\" \"))))(Tile((id \ + 4460)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 11))(sort Pat))((shape(Concave 11))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 4462)(content(Whitespace\" \"))))(Tile((id \ + 4468)(label(MyList))(mold((out Typ)(in_())(nibs(((shape \ + Convex)(sort Typ))((shape Convex)(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 4469)(content(Whitespace\" \")))))))))(Secondary((id \ + 4472)(content(Whitespace\" \"))))(Secondary((id \ + 4479)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 4484)(label(case end))(mold((out \ + Exp)(in_(Rul))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 4485)(content(Whitespace\" \ + \"))))(Tile((id 4489)(label(myl))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 4490)(content(Whitespace\" \"))))(Secondary((id \ + 4491)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 4492)(label(| =>))(mold((out \ + Rul)(in_(Pat))(nibs(((shape(Concave 19))(sort \ + Exp))((shape(Concave 19))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 4494)(content(Whitespace\" \ + \"))))(Tile((id 4497)(label(Nil))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 4498)(content(Whitespace\" \")))))))))(Secondary((id \ + 4506)(content(Whitespace\" \"))))(Tile((id \ + 4508)(label([]))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 4509)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 4510)(label(| =>))(mold((out \ + Rul)(in_(Pat))(nibs(((shape(Concave 19))(sort \ + Exp))((shape(Concave 19))(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id 4512)(content(Whitespace\" \ + \"))))(Tile((id 4516)(label(Cons))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ + 4517)(label(\"(\"\")\"))(mold((out \ + Pat)(in_(Pat))(nibs(((shape(Concave 1))(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0 1))(children(((Tile((id \ + 4519)(label(h))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Tile((id \ + 4520)(label(,))(mold((out Pat)(in_())(nibs(((shape(Concave \ + 14))(sort Pat))((shape(Concave 14))(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 4522)(content(Whitespace\" \"))))(Tile((id \ + 4525)(label(t))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children()))))))))(Secondary((id \ + 4526)(content(Whitespace\" \")))))))))(Secondary((id \ + 4529)(content(Whitespace\" \"))))(Tile((id \ + 4530)(label(h))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 4531)(content(Whitespace\" \"))))(Tile((id \ + 4534)(label(::))(mold((out Exp)(in_())(nibs(((shape(Concave \ + 6))(sort Exp))((shape(Concave 6))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 4535)(content(Whitespace\" \"))))(Tile((id \ + 4549)(label(list_of_mylist))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 4550)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 4552)(label(t))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + 4560)(content(Whitespace\" \"))))(Secondary((id \ + 4554)(content(Whitespace\"\\226\\143\\142\")))))))))(Secondary((id \ + 4601)(content(Whitespace\" \")))))))))(Secondary((id \ + 4606)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 4759)(label(let = in))(mold((out Exp)(in_(Pat \ + Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ + 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ + 4760)(content(Whitespace\" \"))))(Tile((id \ + 4765)(label(ex5))(mold((out Pat)(in_())(nibs(((shape \ + Convex)(sort Pat))((shape Convex)(sort \ + Pat))))))(shards(0))(children())))(Secondary((id \ + 4767)(content(Whitespace\" \")))))((Secondary((id \ + 4768)(content(Whitespace\" \"))))(Tile((id \ + 4764)(label(list_of_mylist))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 4621)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 4623)(label(x))(mold((out Exp)(in_())(nibs(((shape \ + Convex)(sort Exp))((shape Convex)(sort \ + Exp))))))(shards(0))(children()))))))))(Secondary((id \ + 4771)(content(Whitespace\" \")))))))))(Secondary((id \ + 4773)(content(Whitespace\" \"))))(Secondary((id \ + 4640)(content(Comment\"# [1, 2, 3] #\"))))(Secondary((id \ + 4643)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 4644)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 4645)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 4673)(content(Comment\"# All output from examples: \ + #\"))))(Secondary((id \ + 4674)(content(Whitespace\"\\226\\143\\142\")))))()))))))(caret \ + Outer))"; + backup_text = + "# Polymorphism #\n\n\ + # We can take types as parameters to type functions, #\n\ + # and use them in annoatations in the body: #\n\ + let id = typfun A -> fun x : A -> x in\n\n\ + # Such functions are applied like so: #\n\ + let ex1 = id@(1) in # 1 #\n\n\ + # We can annotate the type of a type function with a \ + forall. #\n\ + let const : forall A . forall B . A -> B -> A = \n\ + typfun A -> typfun B -> fun x -> fun y -> x in\n\ + let ex2 = const@@(2)(\"Hello World\") in # 2 #\n\n\ + # We can go beyond rank 1 polymorphism: #\n\ + let apply_both : forall A . forall B . (forall D . D -> D) \ + -> (A , B) -> (A , B) =\n\ + typfun A -> typfun B -> fun f -> fun (x, y) -> (f@(x), \ + f@(y)) in \n\ + let ex3 = apply_both@@(id)(3, \"Hello World\") \ + in # (3, \"Hello World\") # \n\n\ + # Finally, here is a more in-depth, yet applicable example: \ + polymorphic map #\n\ + let emptylist : forall A . [A] = typfun A -> [] in # \ + polymorphic constant #\n\ + let map : forall A . forall B . (A -> B) -> ([A] -> [B]) = \n\ + typfun A -> typfun B -> fun f : (A -> B) -> fun l : [A] -> \n\ + case l\n\ + | h :: t => f(h) :: map@@(f)(t)\n\ + | _ => emptylist@\n\ + end in\n\ + let ex4 = map@@(string_of_int)([1,2,3]) in # \ + [\"1\", \"2\", \"3\"] #\n\n\n\ + # Recursive types #\n\n\ + # We can express types that are the least fixed point of #\n\ + # some type function with the rec keyword. #\n\ + type MyList = rec A. (Nil + Cons(Int, A)) in\n\n\ + # Hazel does not (yet) support higher-kinded or existential \ + types, #\n\ + # So we cannot implement our own polymorphic lists. #\n\n\ + # Now anything that returns an element of the least fixed \ + point matches MyList. #\n\ + let x : MyList = Cons(1, Cons(2, Cons(3, Nil))) in\n\n\ + # Note that if the sum is the top level operator, #\n\ + # type aliases are implicitly least fixed points on their \ + own name: #\n\ + type MyList2 = Nil + Cons(Int, MyList2) in\n\ + type Broken = Int -> (HasInt(Int) + HasMore(Int, Broken)) \ + in \n\n\n\ + let list_of_mylist : (MyList -> [Int]) = fun myl : MyList -> \n\ + case myl \n\ + | Nil => []\n\ + | Cons(h, t) => h :: list_of_mylist(t) \n\ + end in\n\ + let ex5 = list_of_mylist(x) in # [1, 2, 3] #\n\n\n\ + # All output from examples: #\n\ + (ex1, ex2, ex3, ex4, ex5)"; + } ) ); ( "Basic Reference", ( 13633, { From 3923e390141c71f69aba1bcccc31321851c9068b Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 30 Aug 2023 15:29:52 -0400 Subject: [PATCH 39/56] Correct minor error in is_tvar (should not affect anywhere where it's currently used) --- src/haz3lcore/statics/TypBase.re | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index fd8fe821a9..6a94ecabbe 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -580,8 +580,8 @@ and Ctx: { let is_tvar = (ctx: t, name: TypVar.t): bool => switch (lookup_tvar(ctx, name)) { - | Some(_) => true - | None => false + | Some({kind: Abstract, _}) => true + | _ => false }; let add_ctrs = (ctx: t, name: TypVar.t, id: Id.t, ctrs: Typ.sum_map): t => From 084f41441655f60fe8be80298942a1919f3421f4 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 30 Aug 2023 15:41:49 -0400 Subject: [PATCH 40/56] Preserve binding names from synthetic to give more intuitive cursor information. --- src/haz3lcore/statics/Info.re | 4 ++-- src/haz3lcore/statics/TypBase.re | 8 -------- 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 46e8e9591f..ec45060d40 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -281,7 +281,7 @@ let rec status_common = | None => InHole(Inconsistent(WithArrow(ty))) } | (Just(syn), Ana(ana)) => - switch (Typ.join_fix(ctx, ana, syn)) { + switch (Typ.join_fix(ctx, syn, ana)) { | None => InHole(Inconsistent(Expectation({syn, ana}))) | Some(join) => NotInHole(Ana(Consistent({ana, syn, join}))) } @@ -299,7 +299,7 @@ let rec status_common = | (IsMulti, _) => NotInHole(Syn(Unknown(Internal))) | (NoJoin(wrap, tys), Ana(ana)) => let syn: Typ.t = wrap(Unknown(Internal)); - switch (Typ.join_fix(ctx, ana, syn)) { + switch (Typ.join_fix(ctx, syn, ana)) { | None => InHole(Inconsistent(Expectation({ana, syn}))) | Some(_) => NotInHole( diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 6a94ecabbe..11bdfcc358 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -307,19 +307,11 @@ module rec Typ: { !resolve && eq(ty_name, ty_join) ? Var(name) : ty_join; /* Note: Ordering of Unknown, Var, and Rec above is load-bearing! */ | (Rec(x1, ty1), Rec(x2, ty2)) => - /* TODO: - This code isn't fully correct, as we may be doing - substitution on open terms; if x1 occurs in ty2, - we should be substituting x1 for a fresh variable - in ty2. This is annoying, and should be obviated - by the forthcoming debruijn index implementation - */ let ctx = Ctx.extend_dummy_tvar(ctx, x1); let+ ty_body = join(~resolve, ~fix, ctx, ty1, subst(Var(x1), x2, ty2)); Rec(x1, ty_body); | (Forall(x1, ty1), Forall(x2, ty2)) => - /* See note above in Rec case */ let ctx = Ctx.extend_dummy_tvar(ctx, x1); let+ ty_body = join(~resolve, ~fix, ctx, ty1, subst(Var(x1), x2, ty2)); From 6ea7f14545e53d6e100e630acbc8a73ae9cc3446 Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Sun, 10 Sep 2023 15:00:42 -0400 Subject: [PATCH 41/56] Fix: sort-inconsistent in mold/labels --- src/haz3lcore/lang/Form.re | 9 ++++++++- src/haz3lcore/statics/TypBase.re | 1 - src/haz3lweb/view/CursorInspector.re | 7 ++++++- 3 files changed, 14 insertions(+), 3 deletions(-) diff --git a/src/haz3lcore/lang/Form.re b/src/haz3lcore/lang/Form.re index 3cf1699707..423c9e5f16 100644 --- a/src/haz3lcore/lang/Form.re +++ b/src/haz3lcore/lang/Form.re @@ -185,7 +185,13 @@ let bad_token_cls: string => bad_token_cls = priority for forms with overlapping regexps */ let atomic_forms: list((string, (string => bool, list(Mold.t)))) = [ ("bad_lit", (is_bad_lit, [mk_op(Any, [])])), - ("var", (is_var, [mk_op(Exp, []), mk_op(Pat, [])])), + ( + "var", + ( + is_var, + [mk_op(Exp, []), mk_op(Pat, []), mk_op(TPat, []), mk_op(Typ, [])], + ), + ), ("ty_var", (is_typ_var, [mk_op(Typ, [])])), ("ty_var_p", (is_typ_var, [mk_op(TPat, [])])), ("ctr", (is_ctr, [mk_op(Exp, []), mk_op(Pat, [])])), @@ -253,6 +259,7 @@ let forms: list((string, t)) = [ ("parens_exp", mk(ii, ["(", ")"], mk_op(Exp, [Exp]))), ("parens_pat", mk(ii, ["(", ")"], mk_op(Pat, [Pat]))), ("parens_typ", mk(ii, ["(", ")"], mk_op(Typ, [Typ]))), + ("parens_tpat", mk(ii, ["(", ")"], mk_op(TPat, [TPat]))), ("fun_", mk(ds, ["fun", "->"], mk_pre(P.fun_, Exp, [Pat]))), ("typfun", mk(ds, ["typfun", "->"], mk_pre(P.fun_, Exp, [TPat]))), ("forall", mk(ds, ["forall", "->"], mk_pre(P.fun_, Typ, [TPat]))), diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index ec97478c15..15c02d85a4 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -473,7 +473,6 @@ module rec Typ: { let rec get_sum_constructors = (ctx: Ctx.t, ty: t): option(sum_map) => { let ty = weak_head_normalize(ctx, ty); - Printf.printf("get_sum_constructors: %s\n", show(ty)); switch (ty) { | Sum(sm) => Some(sm) | Rec(_) => diff --git a/src/haz3lweb/view/CursorInspector.re b/src/haz3lweb/view/CursorInspector.re index 579ea2c326..493341410c 100644 --- a/src/haz3lweb/view/CursorInspector.re +++ b/src/haz3lweb/view/CursorInspector.re @@ -182,7 +182,12 @@ let tpat_view = (_: Term.Cls.t, status: Info.status_tpat) => | NotInHole(Empty) => div_ok([text("Fillable with a new alias")]) | NotInHole(Var(name)) => div_ok([Type.alias_view(name)]) | NotInHole(Ap(name1, name2)) => - div_ok([Type.alias_view(name1), Type.alias_view(name2)]) + div_ok([ + Type.alias_view(name1), + Type.alias_view("("), + Type.alias_view(name2), + Type.alias_view(")"), + ]) | InHole(NotAVar(NotCapitalized)) => div_err([text("Must begin with a capital letter")]) | InHole(NotAVar(_)) => div_err([text("Expected an alias")]) From 60696767800b6e5570c6ef7d702bbd2a0a0c194a Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Sun, 10 Sep 2023 23:50:45 -0400 Subject: [PATCH 42/56] Allow type names to be lowercase. --- src/haz3lcore/lang/Form.re | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/haz3lcore/lang/Form.re b/src/haz3lcore/lang/Form.re index ae23e84aa8..95be7b05d5 100644 --- a/src/haz3lcore/lang/Form.re +++ b/src/haz3lcore/lang/Form.re @@ -93,7 +93,7 @@ let is_capitalized_name = regexp("^[A-Z][A-Za-z0-9_]*$"); let is_ctr = is_capitalized_name; let base_typs = ["String", "Int", "Float", "Bool"]; let is_base_typ = regexp("^(" ++ String.concat("|", base_typs) ++ ")$"); -let is_typ_var = is_capitalized_name; +let is_typ_var = str => is_var(str) || is_capitalized_name(str); let wild = "_"; let is_wild = regexp("^" ++ wild ++ "$"); From b0298edafb4ca84a258b3cca2a86dc19e2f3f7f8 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Tue, 12 Sep 2023 03:32:19 -0400 Subject: [PATCH 43/56] Improve clarity of type outputs by fixing some parentheses. --- src/haz3lweb/view/Type.re | 32 ++++++++++++++++++++++++-------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index ed08e6099e..84d10c51dc 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -34,7 +34,7 @@ let needs_parens = (ty: Haz3lcore.Typ.t): bool => | Sum(_) => true /* disambiguate between (A + B) -> C and A + (B -> C) */ }; -let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => +let rec view_ty = (~strip_outer_parens=false, ty: Haz3lcore.Typ.t): Node.t => switch (ty) { | Unknown(prov) => div( @@ -53,12 +53,12 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => | Rec(name, t) => div( ~attr=clss(["typ-view", "Rec"]), - [text("rec " ++ name ++ ". "), view_ty(t)], + [text("rec " ++ name ++ ". "), ...paren_view(t)], ) | Forall(name, t) => div( ~attr=clss(["typ-view", "Forall"]), - [text("forall " ++ name ++ ". "), view_ty(t)], + [text("forall " ++ name ++ ". "), ...paren_view(t)], ) | List(t) => div( @@ -76,8 +76,14 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => | Prod([t0, ...ts]) => div( ~attr=clss(["typ-view", "atom", "Prod"]), - [ - text("("), + ( + if (!strip_outer_parens) { + [text("(")]; + } else { + []; + } + ) + @ [ div( ~attr=clss(["typ-view", "Prod"]), paren_view(t0) @@ -86,8 +92,14 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => |> List.flatten ), ), - text(")"), - ], + ] + @ ( + if (!strip_outer_parens) { + [text(")")]; + } else { + []; + } + ), ) | Sum(ts) => div( @@ -105,7 +117,11 @@ let rec view_ty = (ty: Haz3lcore.Typ.t): Node.t => and ctr_view = ((ctr, typ)) => switch (typ) { | None => [text(ctr)] - | Some(typ) => [text(ctr ++ "("), view_ty(typ), text(")")] + | Some(typ) => [ + text(ctr ++ "("), + view_ty(~strip_outer_parens=true, typ), + text(")"), + ] } and paren_view = typ => if (needs_parens(typ)) { From 6f62655ef934468df71201b8c4506c41ca71adc0 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Tue, 12 Sep 2023 03:32:29 -0400 Subject: [PATCH 44/56] Add langdocs and examples for forall and rec. --- src/haz3lweb/LangDocMessages.re | 60 +++++++++++++++++++++++++++++++++ src/haz3lweb/view/LangDoc.re | 4 +-- src/haz3lweb/view/Type.re | 2 +- 3 files changed, 63 insertions(+), 3 deletions(-) diff --git a/src/haz3lweb/LangDocMessages.re b/src/haz3lweb/LangDocMessages.re index aebf0ea835..46cd4cddd8 100644 --- a/src/haz3lweb/LangDocMessages.re +++ b/src/haz3lweb/LangDocMessages.re @@ -60,6 +60,8 @@ let mk_parens_typ = Example.mk_tile(Form.get("parens_typ")); let mk_list_exp = Example.mk_tile(Form.get("list_lit_exp")); let mk_list_pat = Example.mk_tile(Form.get("list_lit_pat")); let mk_list_typ = Example.mk_tile(Form.get("list_typ")); +let mk_forall_typ = Example.mk_tile(Form.get("forall")); +let mk_rec_typ = Example.mk_tile(Form.get("rec")); let arrow = () => Example.mk_monotile(Form.get("type-arrow")); let unary_minus = () => Example.mk_monotile(Form.get("unary_minus")); let unary_not = () => Example.mk_monotile(Form.get("not")); @@ -95,6 +97,7 @@ let comma_typ = () => Example.mk_monotile(Form.get("comma_typ")); let nil = () => exp("[]"); let typeann = () => Example.mk_monotile(Form.get("typeann")); let mk_fun = Example.mk_tile(Form.get("fun_")); +let mk_typfun = Example.mk_tile(Form.get("typfun")); let mk_ap_exp = Example.mk_tile(Form.get("ap_exp")); let mk_ap_pat = Example.mk_tile(Form.get("ap_pat")); let mk_let = Example.mk_tile(Form.get("let_")); @@ -369,6 +372,21 @@ let ap_fun_ex = { message: "When given a Some constructor argument, the function evaluates to the constructor's argument.", feedback: Unselected, }; +let poly_id_ex = { + sub_id: "poly_id_ex", + term: + mk_example( + "let id : \n forall X . (X -> X) = \n typfun X -> \n fun x : X -> x \n in id", + ), + message: "The polymorphic identity function. It may be instantiated at any type X, after which the function acts as type (X -> X).", + feedback: Unselected, +}; +let peano_ex = { + sub_id: "peano_ex", + term: mk_example("type Peano = \n rec P . Z + S(P) \n in S(S(S(Z)))"), + message: "The type of the Peano numbers and the representation of the number 3.", + feedback: Unselected, +}; // TODO for shared examples, should the feedback be stored separately for each "instance"? let _pat_body_function_exp_coloring_ids = (sf_pat_id: Id.t, sf_body_id: Id.t, ~pat_id: Id.t, ~body_id: Id.t) @@ -3163,6 +3181,44 @@ let list_typ: form = { }; }; +let forall_typ_group = "forall_typ_group"; +let forall_typ: form = { + let explanation = { + message: "Polymorphic type. The forall binds a type variable that can later be instantiated at a concrete type.", + feedback: Unselected, + }; + { + id: "forall_typ", + syntactic_form: [ + mk_forall_typ([[space(), _tpat, space()]]), + space(), + typ("ty_body"), + ], + expandable_id: None, + explanation, + examples: [poly_id_ex], + }; +}; + +let rec_typ_group = "rec_typ_group"; +let rec_typ: form = { + let explanation = { + message: "Recursive type. The type this represents is the least fixed point of a type constructor operating on the bound type variable.", + feedback: Unselected, + }; + { + id: "rec_typ", + syntactic_form: [ + mk_rec_typ([[space(), _tpat, space()]]), + space(), + typ("ty_body"), + ], + expandable_id: None, + explanation, + examples: [peano_ex], + }; +}; + let arrow_typ_group = "arrow_typ_group"; let arrow3_typ_group = "arrow3_typ_group"; let _typ_arg = typ("ty_arg"); @@ -3584,6 +3640,8 @@ let init = { bool_typ, str_typ, list_typ, + forall_typ, + rec_typ, arrow_typ, arrow3_typ, labelled_sum_typ, @@ -3970,6 +4028,8 @@ let init = { (bool_typ_group, init_options([(bool_typ.id, [])])), (str_typ_group, init_options([(str_typ.id, [])])), (list_typ_group, init_options([(list_typ.id, [])])), + (forall_typ_group, init_options([(forall_typ.id, [])])), + (rec_typ_group, init_options([(rec_typ.id, [])])), (arrow_typ_group, init_options([(arrow_typ.id, [])])), ( arrow3_typ_group, diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index d07e4c4da9..79dfac0fe2 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -2829,8 +2829,8 @@ let get_doc = | Parens(_) => default // Shouldn't be hit? | Invalid(_) => default // TODO (typfun): Add langdoc - | Forall(_) => default - | Rec(_) => default + | Forall(_, _) => basic_info(LangDocMessages.forall_typ_group) + | Rec(_) => basic_info(LangDocMessages.rec_typ_group) } | Some(InfoTPat(info)) => switch (info.term.term) { diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 84d10c51dc..6e53ae5834 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -125,7 +125,7 @@ and ctr_view = ((ctr, typ)) => } and paren_view = typ => if (needs_parens(typ)) { - [text("("), view_ty(typ), text(")")]; + [text("("), view_ty(~strip_outer_parens=true, typ), text(")")]; } else { [view_ty(typ)]; }; From 55b49529185e8719021be5a342cc86bb8dc3f653 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 13 Sep 2023 22:18:00 -0400 Subject: [PATCH 45/56] Add langdoc for typfun and typap. TODO more cases for typfun. --- src/haz3lweb/LangDocMessages.re | 95 +++++++++++++++++++++++++++++ src/haz3lweb/view/LangDoc.re | 102 +++++++++++++++++++++++--------- 2 files changed, 169 insertions(+), 28 deletions(-) diff --git a/src/haz3lweb/LangDocMessages.re b/src/haz3lweb/LangDocMessages.re index 46cd4cddd8..02920127dc 100644 --- a/src/haz3lweb/LangDocMessages.re +++ b/src/haz3lweb/LangDocMessages.re @@ -100,6 +100,7 @@ let mk_fun = Example.mk_tile(Form.get("fun_")); let mk_typfun = Example.mk_tile(Form.get("typfun")); let mk_ap_exp = Example.mk_tile(Form.get("ap_exp")); let mk_ap_pat = Example.mk_tile(Form.get("ap_pat")); +let mk_tyap_exp = Example.mk_tile(Form.get("ap_exp_typ")); let mk_let = Example.mk_tile(Form.get("let_")); let mk_tyalias = Example.mk_tile(Form.get("type_alias")); @@ -270,6 +271,8 @@ let function_tuple_2_group = "function_tuple_2_group"; let function_tuple_3_group = "function_tuple_3_group"; let function_ctr_group = "function_ctr_group"; let function_ap_group = "function_ap_group"; +let typ_function_group = "typ_function_group"; +let typ_function_hole_group = "typ_function_hole_group"; let basic_fun_ex = { sub_id: "basic_fun_ex", term: mk_example("fun x -> x"), @@ -783,6 +786,83 @@ let function_ap_exp: form = { }; }; +let _tp = tpat("X"); +let _e = exp("e"); + +let typ_fun_pat_coloring_ids = + (~tpat_id: Id.t, ~body_id: Id.t): list((Id.t, Id.t)) => [ + (Piece.id(_tp), tpat_id), + (Piece.id(_e), body_id), +]; + +let typ_function_exp: form = { + let explanation = { + message: "Type function literal. When instantiated at a type that matches the [*argument pattern*](%s), evaluates to the [*body*](%s).", + feedback: Unselected, + }; + let form = [mk_typfun([[space(), _tp, space()]]), space(), _e]; + { + id: "typ_function_exp_id", + syntactic_form: form, + expandable_id: Some(Piece.id(tpat("EmptyHole"))), + explanation, + examples: [poly_id_ex], + }; +}; + +let _tp = tpat("EmptyHole"); +let _e = exp("e"); + +let typ_fun_hole_pat_coloring_ids = + (~tpat_id: Id.t, ~body_id: Id.t): list((Id.t, Id.t)) => [ + (Piece.id(_tp), tpat_id), + (Piece.id(_e), body_id), +]; + +let typ_function_hole: form = { + let explanation = { + message: "Type function literal. When instantiated at a type that matches the [*argument pattern*](%s) after the [empty hole pattern](%s) is filled, evaluates to the [*body*](%s).", + feedback: Unselected, + }; + let form = [mk_typfun([[space(), _tp, space()]]), space(), _e]; + { + id: "typ_function_hole_id", + syntactic_form: form, + expandable_id: Some(Piece.id(_pat)), + explanation, + examples: [poly_id_ex], + }; +}; + +let typfunapp_exp_group = "typfunapp_exp_group"; +let typfunapp_exp_ex = { + sub_id: "typfunapp_exp_ex", + term: mk_example("(typfun X -> fun x : X \n -> x)@"), + message: "The polymorphic identity function instantiated at Int. Int is substituted in place of the type variable X in the body, so the body is effectively the identity function on integers.", + feedback: Unselected, +}; + +let _ty_fun = exp("ty_fun"); +let _ty_arg = typ("ty_arg"); +let typfunapp_exp_coloring_ids = + (~x_id: Id.t, ~arg_id: Id.t): list((Id.t, Id.t)) => [ + (Piece.id(_ty_fun), x_id), + (Piece.id(_ty_arg), arg_id), +]; +let typfunapp_exp: form = { + let explanation = { + message: "Type function application. Instantiate the [*polymorphic expression*](%s) at the [*argument type*](%s).", + feedback: Unselected, + }; + { + id: "typfunapp_exp", + syntactic_form: [_ty_fun, mk_tyap_exp([[_ty_arg]])], + expandable_id: None, + explanation, + examples: [typfunapp_exp_ex], + }; +}; + let tuple_exp_group = "tuple_exp_group"; let tuple_exp_2_group = "tuple_exp_2_group"; let tuple_exp_3_group = "tuple_exp_3_group"; @@ -3551,6 +3631,8 @@ let init = { function_tuple3_exp, function_ctr_exp, function_ap_exp, + typ_function_exp, + typ_function_hole, tuple_exp, tuple_exp_size2, tuple_exp_size3, @@ -3577,6 +3659,7 @@ let init = { tyalias_base_exp, funapp_exp, conapp_exp, + typfunapp_exp, if_exp, seq_exp, test_exp, @@ -3796,6 +3879,17 @@ let init = { ), ]), ), + ( + typ_function_group, + init_options([(typ_function_exp.id, [tpat("X")])]), + ), + ( + typ_function_hole_group, + init_options([ + (typ_function_exp.id, [tpat("X")]), + (typ_function_hole.id, [tpat("EmptyHole")]), + ]), + ), (tuple_exp_group, init_options([(tuple_exp.id, [])])), ( tuple_exp_2_group, @@ -3944,6 +4038,7 @@ let init = { (tyalias_exp_group, init_options([(tyalias_base_exp.id, [])])), (funapp_exp_group, init_options([(funapp_exp.id, [])])), (conapp_exp_group, init_options([(conapp_exp.id, [])])), + (typfunapp_exp_group, init_options([(typfunapp_exp.id, [])])), (if_exp_group, init_options([(if_exp.id, [])])), (seq_exp_group, init_options([(seq_exp.id, [])])), (test_group, init_options([(test_exp.id, [])])), diff --git a/src/haz3lweb/view/LangDoc.re b/src/haz3lweb/view/LangDoc.re index 79dfac0fe2..cd5cb814f1 100644 --- a/src/haz3lweb/view/LangDoc.re +++ b/src/haz3lweb/view/LangDoc.re @@ -672,20 +672,78 @@ let get_doc = ), [], ); - | TypFun(_, _) => - // TODO (typfun) - let (doc, options) = - LangDocMessages.get_form_and_options( - LangDocMessages.triv_exp_group, - docs, - ); - get_message( - doc, - options, - LangDocMessages.triv_exp_group, - doc.explanation.message, - [], - ); + | TypFun(_, _ /* tpat, body */) => + basic_info(LangDocMessages.typ_function_group) + /* TODO: Cannot quite get the below to work. The EmptyHole case throws an unhandled exception Not_found. + let basic = (doc: LangDocMessages.form, group_id, options) => { + let tpat_id = List.nth(tpat.ids, 0); + let body_id = List.nth(body.ids, 0); + get_message( + doc, + options, + group_id, + Printf.sprintf( + Scanf.format_from_string(doc.explanation.message, "%s%s"), + tpat_id |> Id.to_string, + body_id |> Id.to_string, + ), + LangDocMessages.typ_fun_pat_coloring_ids(~tpat_id, ~body_id), + ); + }; + switch (tpat.term) { + | EmptyHole => + let (doc, options) = + LangDocMessages.get_form_and_options( + LangDocMessages.typ_function_hole_group, + docs, + ); + if (LangDocMessages.typ_function_hole.id == doc.id) { + let tpat_id = List.nth(tpat.ids, 0); + let body_id = List.nth(body.ids, 0); + get_message( + doc, + options, + LangDocMessages.typ_function_hole_group, + Printf.sprintf( + Scanf.format_from_string(doc.explanation.message, "%s%s%s"), + tpat_id |> Id.to_string, + body_id |> Id.to_string, + tpat_id |> Id.to_string, + ), + LangDocMessages.typ_fun_hole_pat_coloring_ids( + ~tpat_id, + ~body_id, + ), + ); + } else { + basic(doc, LangDocMessages.typ_function_hole_group, options); + }; + | Var(var) => + let (doc, options) = + LangDocMessages.get_form_and_options( + LangDocMessages.typ_function_group, + docs, + ); + if (LangDocMessages.typ_function_exp.id == doc.id) { + let tpat_id = List.nth(tpat.ids, 0); + let body_id = List.nth(body.ids, 0); + get_message( + doc, + options, + LangDocMessages.typ_function_group, + Printf.sprintf( + Scanf.format_from_string(doc.explanation.message, "%s%s"), + var, + body_id |> Id.to_string, + ), + LangDocMessages.typ_fun_pat_coloring_ids(~tpat_id, ~body_id), + ); + } else { + basic(doc, LangDocMessages.typ_function_group, options); + }; + | _ => default + }; + */ | Fun(pat, body) => let basic = (doc: LangDocMessages.form, group_id, options) => { let pat_id = List.nth(pat.ids, 0); @@ -1921,20 +1979,8 @@ let get_doc = LangDocMessages.funapp_exp_coloring_ids, ); }; - | TypAp(_, _) => - // TODO (typfun) - let (doc, options) = - LangDocMessages.get_form_and_options( - LangDocMessages.triv_exp_group, - docs, - ); - get_message( - doc, - options, - LangDocMessages.triv_exp_group, - doc.explanation.message, - [], - ); + | TypAp(_, _) => basic_info(LangDocMessages.typfunapp_exp_group) + /* TODO: improve formating for TypAp? See TypFun. */ | If(cond, then_, else_) => let (doc, options) = LangDocMessages.get_form_and_options( From 3d85639288230745b69b0c2c0a544cc7b69c2a0a Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Thu, 14 Sep 2023 23:16:51 -0400 Subject: [PATCH 46/56] Keep original variable name in alpha rename. --- src/haz3lcore/statics/TypBase.re | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 79155f9bfd..d1ff9239a3 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -164,10 +164,10 @@ module rec Typ: { }; let var_count = ref(0); - let fresh_var = () => { + let fresh_var = (var_name: string) => { let x = var_count^; var_count := x + 1; - "@" ++ string_of_int(x); + var_name ++ "_α" ++ string_of_int(x); }; let rec subst = (s: t, x: TypVar.t, ty: t) => { From 709f6d0d8bd0b3946b10548a6c4e7479b9bbbdbc Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Sat, 16 Sep 2023 21:05:41 -0400 Subject: [PATCH 47/56] Fix error in previous commit. --- src/haz3lcore/statics/TypBase.re | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index d1ff9239a3..8dc4162ee2 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -182,12 +182,12 @@ module rec Typ: { | Sum(sm) => Sum(ConstructorMap.map(Option.map(subst(s, x)), sm)) | Rec(y, ty) when TypVar.eq(x, y) => Rec(y, ty) | Rec(y, ty) when List.mem(y, free_vars(s)) => - let fresh = fresh_var(); + let fresh = fresh_var(y); Rec(fresh, subst(s, x, subst(Var(fresh), y, ty))); | Rec(y, ty) => Rec(y, subst(s, x, ty)) | Forall(y, ty) when TypVar.eq(x, y) => Forall(y, ty) | Forall(y, ty) when List.mem(y, free_vars(s)) => - let fresh = fresh_var(); + let fresh = fresh_var(y); Forall(fresh, subst(s, x, subst(Var(fresh), y, ty))); | Forall(y, ty) => Forall(y, subst(s, x, ty)) | List(ty) => List(subst(s, x, ty)) From 663b719954576f20cfe09928e59527e197e58f0a Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Sat, 16 Sep 2023 21:05:50 -0400 Subject: [PATCH 48/56] Return forall delimiter to -> from . --- src/haz3lcore/lang/Form.re | 4 ++-- src/haz3lcore/statics/MakeTerm.re | 6 +++--- src/haz3lweb/Init.ml | 12 ++++++------ src/haz3lweb/LangDocMessages.re | 4 ++-- src/haz3lweb/view/Type.re | 4 ++-- 5 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/haz3lcore/lang/Form.re b/src/haz3lcore/lang/Form.re index 95be7b05d5..18f4c2061b 100644 --- a/src/haz3lcore/lang/Form.re +++ b/src/haz3lcore/lang/Form.re @@ -254,8 +254,8 @@ let forms: list((string, t)) = [ ("parens_typ", mk(ii, ["(", ")"], mk_op(Typ, [Typ]))), ("fun_", mk(ds, ["fun", "->"], mk_pre(P.fun_, Exp, [Pat]))), ("typfun", mk(ds, ["typfun", "->"], mk_pre(P.fun_, Exp, [TPat]))), - ("forall", mk(ds, ["forall", "."], mk_pre(P.fun_, Typ, [TPat]))), - ("rec", mk(ds, ["rec", "."], mk_pre(P.fun_, Typ, [TPat]))), + ("forall", mk(ds, ["forall", "->"], mk_pre(P.fun_, Typ, [TPat]))), + ("rec", mk(ds, ["rec", "->"], mk_pre(P.fun_, Typ, [TPat]))), ("if_", mk(ds, ["if", "then", "else"], mk_pre(P.if_, Exp, [Exp, Exp]))), ("ap_exp", mk(ii, ["(", ")"], mk_post(P.ap, Exp, [Exp]))), ("ap_pat", mk(ii, ["(", ")"], mk_post(P.ap, Pat, [Pat]))), diff --git a/src/haz3lcore/statics/MakeTerm.re b/src/haz3lcore/statics/MakeTerm.re index 778a6c4c3f..5c823f73b9 100644 --- a/src/haz3lcore/statics/MakeTerm.re +++ b/src/haz3lcore/statics/MakeTerm.re @@ -349,11 +349,11 @@ and typ_term: unsorted => (UTyp.term, list(Id.t)) = { | _ => ret(hole(tm)) } /* forall and rec have to be before sum so that they bind tighter. - * Thus `rec A . Left(A) + Right(B)` get parsed as `rec A . (Left(A) + Right(B))` + * Thus `rec A -> Left(A) + Right(B)` get parsed as `rec A -> (Left(A) + Right(B))` * If this is below the case for sum, then it gets parsed as an invalid form. */ - | Pre(([(_id, (["forall", "."], [TPat(tpat)]))], []), Typ(t)) => + | Pre(([(_id, (["forall", "->"], [TPat(tpat)]))], []), Typ(t)) => ret(Forall(tpat, t)) - | Pre(([(_id, (["rec", "."], [TPat(tpat)]))], []), Typ(t)) => + | Pre(([(_id, (["rec", "->"], [TPat(tpat)]))], []), Typ(t)) => ret(Rec(tpat, t)) | Pre(tiles, Typ({term: Sum(t0), ids})) as tm => /* Case for leading prefix + preceeding a sum */ diff --git a/src/haz3lweb/Init.ml b/src/haz3lweb/Init.ml index 49e8145694..5cdc5122b1 100644 --- a/src/haz3lweb/Init.ml +++ b/src/haz3lweb/Init.ml @@ -15013,21 +15013,21 @@ let startup : PersistentData.t = # Such functions are applied like so: #\n\ let ex1 = id@(1) in # 1 #\n\n\ # We can annotate the type of a type function with a forall. #\n\ - let const : forall A . forall B . A -> B -> A = \n\ + let const : forall A -> forall B -> A -> B -> A = \n\ typfun A -> typfun B -> fun x -> fun y -> x in\n\ let ex2 = const@@(2)(\"Hello World\") in # 2 #\n\n\ # We can go beyond rank 1 polymorphism: #\n\ - let apply_both : forall A . forall B . (forall D . D -> D) -> \ - (A , B) -> (A , B) =\n\ + let apply_both : forall A -> forall B -> (forall D -> D -> D) \ + -> (A , B) -> (A , B) =\n\ typfun A -> typfun B -> fun f -> fun (x, y) -> (f@(x), \ f@(y)) in \n\ let ex3 = apply_both@@(id)(3, \"Hello World\") \ in # (3, \"Hello World\") # \n\n\ # Finally, here is a more in-depth, yet applicable example: \ polymorphic map #\n\ - let emptylist : forall A . [A] = typfun A -> [] in # \ + let emptylist : forall A -> [A] = typfun A -> [] in # \ polymorphic constant #\n\ - let map : forall A . forall B . (A -> B) -> ([A] -> [B]) = \n\ + let map : forall A -> forall B -> (A -> B) -> ([A] -> [B]) = \n\ typfun A -> typfun B -> fun f : (A -> B) -> fun l : [A] -> \n\ case l\n\ | h :: t => f(h) :: map@@(f)(t)\n\ @@ -15038,7 +15038,7 @@ let startup : PersistentData.t = # Recursive types #\n\n\ # We can express types that are the least fixed point of #\n\ # some type function with the rec keyword. #\n\ - type MyList = rec A. (Nil + Cons(Int, A)) in\n\n\ + type MyList = rec A -> (Nil + Cons(Int, A)) in\n\n\ # Hazel does not (yet) support higher-kinded or existential \ types, #\n\ # So we cannot implement our own polymorphic lists. #\n\n\ diff --git a/src/haz3lweb/LangDocMessages.re b/src/haz3lweb/LangDocMessages.re index 02920127dc..b29f2bd625 100644 --- a/src/haz3lweb/LangDocMessages.re +++ b/src/haz3lweb/LangDocMessages.re @@ -379,14 +379,14 @@ let poly_id_ex = { sub_id: "poly_id_ex", term: mk_example( - "let id : \n forall X . (X -> X) = \n typfun X -> \n fun x : X -> x \n in id", + "let id : \n forall X -> (X -> X) = \n typfun X -> \n fun x : X -> x \n in id", ), message: "The polymorphic identity function. It may be instantiated at any type X, after which the function acts as type (X -> X).", feedback: Unselected, }; let peano_ex = { sub_id: "peano_ex", - term: mk_example("type Peano = \n rec P . Z + S(P) \n in S(S(S(Z)))"), + term: mk_example("type Peano = \n rec P -> Z + S(P) \n in S(S(S(Z)))"), message: "The type of the Peano numbers and the representation of the number 3.", feedback: Unselected, }; diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index 6e53ae5834..be05cfdae2 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -53,12 +53,12 @@ let rec view_ty = (~strip_outer_parens=false, ty: Haz3lcore.Typ.t): Node.t => | Rec(name, t) => div( ~attr=clss(["typ-view", "Rec"]), - [text("rec " ++ name ++ ". "), ...paren_view(t)], + [text("rec " ++ name ++ " -> "), ...ty_view(t)], ) | Forall(name, t) => div( ~attr=clss(["typ-view", "Forall"]), - [text("forall " ++ name ++ ". "), ...paren_view(t)], + [text("forall " ++ name ++ " -> "), ...ty_view(t)], ) | List(t) => div( From f8da1dc94c090479976dfb3f50fe2eea4594ad18 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Sat, 16 Sep 2023 21:10:38 -0400 Subject: [PATCH 49/56] Fix error. --- src/haz3lweb/view/Type.re | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/haz3lweb/view/Type.re b/src/haz3lweb/view/Type.re index be05cfdae2..eb0f198d38 100644 --- a/src/haz3lweb/view/Type.re +++ b/src/haz3lweb/view/Type.re @@ -53,12 +53,12 @@ let rec view_ty = (~strip_outer_parens=false, ty: Haz3lcore.Typ.t): Node.t => | Rec(name, t) => div( ~attr=clss(["typ-view", "Rec"]), - [text("rec " ++ name ++ " -> "), ...ty_view(t)], + [text("rec " ++ name ++ " -> "), view_ty(t)], ) | Forall(name, t) => div( ~attr=clss(["typ-view", "Forall"]), - [text("forall " ++ name ++ " -> "), ...ty_view(t)], + [text("forall " ++ name ++ " -> "), view_ty(t)], ) | List(t) => div( From d197606e50edcdb78e0d681d0c3ef466d056c6de Mon Sep 17 00:00:00 2001 From: ZhenXu Date: Mon, 25 Sep 2023 17:48:07 -0400 Subject: [PATCH 50/56] format error --- src/haz3lcore/statics/TypBase.re | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index c012a7d310..d813b8fd95 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -498,7 +498,7 @@ module rec Typ: { switch (ty) { | Sum(sm) => Some(sm) | _ => None - } + }; | Ap(Var(name), ty_arg) => switch (Ctx.lookup_higher_kind(ctx, name)) { | Some((arg, ty)) => get_sum_constructors(ctx, subst(ty_arg, arg, ty)) From 3f00366bd7380b9adbe1181ace1c2b89c5388d71 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Tue, 26 Sep 2023 14:32:05 -0400 Subject: [PATCH 51/56] Fix error in syntactix translation of types and address review comments. --- src/haz3lcore/statics/Info.re | 4 ++-- src/haz3lcore/statics/Kind.re | 1 + src/haz3lcore/statics/Mode.re | 9 +++++---- src/haz3lcore/statics/Statics.re | 8 ++++++-- src/haz3lcore/statics/Term.re | 13 ++++++------- src/haz3lcore/statics/TypBase.re | 24 ++++++++++++++---------- 6 files changed, 34 insertions(+), 25 deletions(-) create mode 100644 src/haz3lcore/statics/Kind.re diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index ec45060d40..59bb8d4be9 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -276,7 +276,7 @@ let rec status_common = } | (Just(ty), SynTypFun) => /* Use ty first to preserve name if it exists. */ - switch (Typ.join_fix(ctx, ty, Forall("_", Unknown(Internal)))) { + switch (Typ.join_fix(ctx, ty, Forall("?", Unknown(Internal)))) { | Some(_) => NotInHole(Syn(ty)) | None => InHole(Inconsistent(WithArrow(ty))) } @@ -366,7 +366,7 @@ let status_typ = | TypeExpected => switch (Ctx.is_alias(ctx, name)) { | false => - switch (Ctx.is_tvar(ctx, name)) { + switch (Ctx.is_abstract(ctx, name)) { | false => InHole(FreeTypeVariable(name)) | true => NotInHole(Type(Var(name))) } diff --git a/src/haz3lcore/statics/Kind.re b/src/haz3lcore/statics/Kind.re new file mode 100644 index 0000000000..8db5638e94 --- /dev/null +++ b/src/haz3lcore/statics/Kind.re @@ -0,0 +1 @@ +include TypBase.Kind; diff --git a/src/haz3lcore/statics/Mode.re b/src/haz3lcore/statics/Mode.re index ed4ad1978d..adb48881fd 100644 --- a/src/haz3lcore/statics/Mode.re +++ b/src/haz3lcore/statics/Mode.re @@ -48,10 +48,11 @@ let of_forall = (ctx: Ctx.t, name_opt: option(TypVar.t), mode: t): t => | SynFun | SynTypFun => Syn | Ana(ty) => - let (name_expected, item) = Typ.matched_forall(ctx, ty); - switch (name_opt) { - | Some(name) => Ana(Typ.subst(Var(name), name_expected, item)) - | None => Ana(item) + let (name_expected_opt, item) = Typ.matched_forall(ctx, ty); + switch (name_opt, name_expected_opt) { + | (Some(name), Some(name_expected)) => + Ana(Typ.subst(Var(name), name_expected, item)) + | _ => Ana(item) }; }; diff --git a/src/haz3lcore/statics/Statics.re b/src/haz3lcore/statics/Statics.re index 6d1006b7b6..dfe0214dc3 100644 --- a/src/haz3lcore/statics/Statics.re +++ b/src/haz3lcore/statics/Statics.re @@ -239,9 +239,13 @@ and uexp_to_info_map = | TypAp(fn, utyp) => let typfn_mode = Mode.typap_mode; let (fn, m_fn) = go(~mode=typfn_mode, fn, m); - let (name, ty_body) = Typ.matched_forall(ctx, fn.ty); + let (option_name, ty_body) = Typ.matched_forall(ctx, fn.ty); let ty = Term.UTyp.to_typ(ctx, utyp); - add(~self=Just(Typ.subst(ty, name, ty_body)), ~co_ctx=fn.co_ctx, m_fn); + switch (option_name) { + | Some(name) => + add(~self=Just(Typ.subst(ty, name, ty_body)), ~co_ctx=fn.co_ctx, m_fn) + | None => add(~self=Just(ty_body), ~co_ctx=fn.co_ctx, m_fn) /* invalid name matches with no free type variables. */ + }; | Fun(p, e) => let (mode_pat, mode_body) = Mode.of_arrow(ctx, mode); let (p, m) = go_pat(~is_synswitch=false, ~mode=mode_pat, p, m); diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index 90f1d1a7f6..1294eb55c7 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -207,8 +207,7 @@ module UTyp = { {name, id: UTPat.rep_id(utpat), kind: Abstract}, ); Forall(name, to_typ(ctx, tbody)); - | Forall(_, tbody) => to_typ(ctx, tbody) - // Forall is same as Rec + // Rec is same as Forall | Rec({term: Var(name), _} as utpat, tbody) => let ctx = Ctx.extend_tvar( @@ -216,7 +215,8 @@ module UTyp = { {name, id: UTPat.rep_id(utpat), kind: Abstract}, ); Rec(name, to_typ(ctx, tbody)); - | Rec(_, tbody) => to_typ(ctx, tbody) + | Forall(_, tbody) => Forall("?", to_typ(ctx, tbody)) + | Rec(_, tbody) => Rec("?", to_typ(ctx, tbody)) /* The below cases should occur only inside sums */ | Constructor(_) | Ap(_) => Unknown(Internal) @@ -620,7 +620,7 @@ module UExp = { | Let => "Let expression" | TyAlias => "Type Alias definition" | Ap => "Application" - | TypAp => "Type Application" + | TypAp => "Type application" | If => "If expression" | Seq => "Sequence expression" | Test => "Test" @@ -631,9 +631,8 @@ module UExp = { | UnOp(op) => show_unop(op) | Match => "Case expression"; - // TODO (poly): May need to create a separate is_typfun function, - // so that is_fun pairs with is_fun_var over Arrow - // and is_typfun pairs with is_typfun_var over Forall + // 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) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 8dc4162ee2..2d158051dc 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -53,7 +53,7 @@ module rec Typ: { let join_type_provenance: (type_provenance, type_provenance) => type_provenance; let matched_arrow: (Ctx.t, t) => (t, t); - let matched_forall: (Ctx.t, t) => (string, t); + let matched_forall: (Ctx.t, t) => (option(string), t); let matched_prod: (Ctx.t, int, t) => list(t); let matched_list: (Ctx.t, t) => t; let precedence: t => int; @@ -160,7 +160,6 @@ module rec Typ: { | Prod(tys) => ListUtil.flat_map(free_vars(~bound), tys) | Rec(x, ty) => free_vars(~bound=[x, ...bound], ty) | Forall(x, ty) => free_vars(~bound=[x, ...bound], ty) - /* TODO: check that these are correct. */ }; let var_count = ref(0); @@ -201,8 +200,8 @@ module rec Typ: { | _ => ty }; - /* Type Equality: At the moment, this coincides with alpha equivalence, - but this will change when polymorphic types are implemented */ + /* Type Equality: This coincides with alpha equivalence for normalized types. + Other types may be equivalent but this will not detect so if they are not normalized. */ let rec eq_internal = (n: int, t1: t, t2: t) => { switch (t1, t2) { | (Rec(x1, t1), Rec(x2, t2)) @@ -232,6 +231,7 @@ module rec Typ: { | (List(t1), List(t2)) => eq_internal(n, t1, t2) | (List(_), _) => false | (Sum(sm1), Sum(sm2)) => + /* Does not normalize the types. */ ConstructorMap.equal(Option.equal(eq_internal(n)), sm1, sm2) | (Sum(_), _) => false | (Var(n1), Var(n2)) => n1 == n2 @@ -284,6 +284,10 @@ module rec Typ: { let+ ty_body = join(~resolve, ~fix, ctx, ty1, subst(Var(x1), x2, ty2)); Forall(x1, ty_body); + /* Note for above: there is no danger of free variable capture as + subst itself performs capture avoiding substitution. However this + may generate internal type variable names that in corner cases can + be exposed to the user. */ | (Rec(_), _) => None | (Forall(_), _) => None | (Int, Int) => Some(Int) @@ -399,9 +403,9 @@ module rec Typ: { let matched_forall = (ctx, ty) => switch (weak_head_normalize(ctx, ty)) { - | Forall(t, ty) => (t, ty) - | Unknown(SynSwitch) => ("matched_forall", Unknown(SynSwitch)) - | _ => ("matched_forall", Unknown(Internal)) /* TODO: Might need to be fresh? */ + | Forall(t, ty) => (Some(t), ty) + | Unknown(SynSwitch) => (None, Unknown(SynSwitch)) + | _ => (None, Unknown(Internal)) }; let matched_prod = (ctx, length, ty) => @@ -482,7 +486,7 @@ and Ctx: { let lookup_var: (t, string) => option(var_entry); let lookup_ctr: (t, string) => option(var_entry); let is_alias: (t, TypVar.t) => bool; - let is_tvar: (t, TypVar.t) => bool; + let is_abstract: (t, TypVar.t) => bool; let add_ctrs: (t, TypVar.t, Id.t, Typ.sum_map) => t; let subtract_prefix: (t, t) => option(t); let added_bindings: (t, t) => t; @@ -566,7 +570,7 @@ and Ctx: { | None => false }; - let is_tvar = (ctx: t, name: TypVar.t): bool => + let is_abstract = (ctx: t, name: TypVar.t): bool => switch (lookup_tvar(ctx, name)) { | Some({kind: Abstract, _}) => true | _ => false @@ -636,7 +640,7 @@ and Ctx: { |> (((ctx, _, _)) => List.rev(ctx)); let shadows_typ = (ctx: t, name: TypVar.t): bool => - Form.is_base_typ(name) || is_alias(ctx, name) || is_tvar(ctx, name); + Form.is_base_typ(name) || is_alias(ctx, name) || is_abstract(ctx, name); } and Kind: { [@deriving (show({with_path: false}), sexp, yojson)] From 21d28f7398c6dca6d373ef3520b4018618945a2d Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Tue, 3 Oct 2023 15:28:55 -0400 Subject: [PATCH 52/56] Exhaust case matching over using _ in Term --- src/haz3lcore/statics/Term.re | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/haz3lcore/statics/Term.re b/src/haz3lcore/statics/Term.re index 1294eb55c7..6de5620eda 100644 --- a/src/haz3lcore/statics/Term.re +++ b/src/haz3lcore/statics/Term.re @@ -215,8 +215,13 @@ module UTyp = { {name, id: UTPat.rep_id(utpat), kind: Abstract}, ); Rec(name, to_typ(ctx, tbody)); - | Forall(_, tbody) => Forall("?", to_typ(ctx, tbody)) - | Rec(_, tbody) => Rec("?", to_typ(ctx, tbody)) + | Forall({term: Invalid(_), _}, tbody) + | Forall({term: EmptyHole, _}, tbody) + | Forall({term: MultiHole(_), _}, tbody) => + Forall("?", to_typ(ctx, tbody)) + | Rec({term: Invalid(_), _}, tbody) + | Rec({term: EmptyHole, _}, tbody) + | Rec({term: MultiHole(_), _}, tbody) => Rec("?", to_typ(ctx, tbody)) /* The below cases should occur only inside sums */ | Constructor(_) | Ap(_) => Unknown(Internal) From 7ab89b13a391ed68d9033269ba5800ef9697da3e Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Tue, 3 Oct 2023 15:30:29 -0400 Subject: [PATCH 53/56] Remove unused code. --- src/haz3lcore/statics/TypBase.re | 29 ----------------------------- 1 file changed, 29 deletions(-) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 2d158051dc..0a3c7ace31 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -652,33 +652,4 @@ and Kind: { type t = | Singleton(Typ.t) | Abstract; - /* Is not needed as not using debrujin indices */ - /* - let rec incr = (ty: t, i: int): t => { - switch (ty) { - | Var({item: Some(j), name}) => Var({item: Some(i + j), name}) - | Var(_) => ty - | List(ty) => List(incr(ty, i)) - | Arrow(ty1, ty2) => Arrow(incr(ty1, i), incr(ty2, i)) - | Sum(map) => - Sum( - VarMap.map( - ((_, ty)) => - switch (ty) { - | Some(ty) => Some(incr(ty, i)) - | None => None - }, - map, - ), - ) - | Prod(tys) => Prod(List.map(ty => incr(ty, i), tys)) - | Rec({item, name}) => Rec({item: incr(item, i), name}) - | Forall({item, name}) => Forall({item: incr(item, i), name}) - | Int => Int - | Float => Float - | Bool => Bool - | String => String - | Unknown(_) => ty - }; - */ }; From 714a54f7d81592c0d1031978e66e6f7502555210 Mon Sep 17 00:00:00 2001 From: Crazycolorz5 Date: Wed, 13 Dec 2023 01:08:09 -0500 Subject: [PATCH 54/56] Fix error with missing casts from inappropriate synthesis joining. --- src/haz3lcore/statics/Info.re | 13 +++++++++---- src/haz3lcore/statics/TypBase.re | 8 +++++--- 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/src/haz3lcore/statics/Info.re b/src/haz3lcore/statics/Info.re index 374a3164e2..10c1090bd4 100644 --- a/src/haz3lcore/statics/Info.re +++ b/src/haz3lcore/statics/Info.re @@ -303,13 +303,18 @@ let rec status_common = | None => InHole(Inconsistent(WithArrow(ty))) } | (Just(ty), SynTypFun) => - /* Use ty first to preserve name if it exists. */ - switch (Typ.join_fix(ctx, ty, Forall("?", Unknown(Internal)))) { + switch (Typ.join_fix(ctx, Forall("?", Unknown(Internal)), ty)) { | Some(_) => NotInHole(Syn(ty)) | None => InHole(Inconsistent(WithArrow(ty))) } | (Just(syn), Ana(ana)) => - switch (Typ.join_fix(ctx, syn, ana)) { + switch ( + Typ.join_fix( + ctx, + ana, + syn /* Note: the ordering of ana, syn matters */ + ) + ) { | None => InHole(Inconsistent(Expectation({syn, ana}))) | Some(join) => NotInHole(Ana(Consistent({ana, syn, join}))) } @@ -328,7 +333,7 @@ let rec status_common = | (IsMulti, _) => NotInHole(Syn(Unknown(Internal))) | (NoJoin(wrap, tys), Ana(ana)) => let syn: Typ.t = Self.join_of(wrap, Unknown(Internal)); - switch (Typ.join_fix(ctx, syn, ana)) { + switch (Typ.join_fix(ctx, ana, syn)) { | None => InHole(Inconsistent(Expectation({ana, syn}))) | Some(_) => NotInHole( diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index a340dc1e3c..72c8f4fab9 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -277,17 +277,19 @@ module rec Typ: { | (Rec(x1, ty1), Rec(x2, ty2)) => let ctx = Ctx.extend_dummy_tvar(ctx, x1); let+ ty_body = - join(~resolve, ~fix, ctx, ty1, subst(Var(x1), x2, ty2)); + join(~resolve, ~fix, ctx, subst(Var(x2), x1, ty1), ty2); Rec(x1, ty_body); | (Forall(x1, ty1), Forall(x2, ty2)) => let ctx = Ctx.extend_dummy_tvar(ctx, x1); let+ ty_body = - join(~resolve, ~fix, ctx, ty1, subst(Var(x1), x2, ty2)); + join(~resolve, ~fix, ctx, subst(Var(x2), x1, ty1), ty2); Forall(x1, ty_body); /* Note for above: there is no danger of free variable capture as subst itself performs capture avoiding substitution. However this may generate internal type variable names that in corner cases can - be exposed to the user. */ + be exposed to the user. We preserve the variable name of the + second type to preserve synthesized type variable names, which + come from user annotations. */ | (Rec(_), _) => None | (Forall(_), _) => None | (Int, Int) => Some(Int) From 010674d3a1570b817751c2cf4b3c606586f5b27f Mon Sep 17 00:00:00 2001 From: Cyrus Omar Date: Fri, 5 Jan 2024 16:47:57 -0500 Subject: [PATCH 55/56] regenerate Init.ml --- src/haz3lweb/Init.ml | 2162 +++++++++++++++++++++++++----------------- 1 file changed, 1281 insertions(+), 881 deletions(-) diff --git a/src/haz3lweb/Init.ml b/src/haz3lweb/Init.ml index 4824678929..22e485ee2c 100644 --- a/src/haz3lweb/Init.ml +++ b/src/haz3lweb/Init.ml @@ -13898,1183 +13898,1583 @@ let startup : PersistentData.t = ( "Polymorphism", { zipper = - "((selection((focus \ - Left)(content())))(backpack())(relatives((siblings(((Tile((id \ - 4778)(label(ex1))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 4779)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 14))(sort Exp))((shape(Concave 14))(sort \ - Exp))))))(shards(0))(children())))(Secondary((id \ - 4781)(content(Whitespace\" \"))))(Tile((id \ - 4788)(label(ex2))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 4789)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 14))(sort Exp))((shape(Concave 14))(sort \ - Exp))))))(shards(0))(children())))(Secondary((id \ - 4791)(content(Whitespace\" \")))))((Tile((id \ - 4794)(label(ex3))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 4795)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 14))(sort Exp))((shape(Concave 14))(sort \ - Exp))))))(shards(0))(children())))(Secondary((id \ - 4797)(content(Whitespace\" \"))))(Tile((id \ - 4800)(label(ex4))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 4801)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 14))(sort Exp))((shape(Concave 14))(sort \ - Exp))))))(shards(0))(children())))(Secondary((id \ - 4803)(content(Whitespace\" \"))))(Tile((id \ - 4806)(label(ex5))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children()))))))(ancestors((((id \ - 4808)(label(\"(\"\")\"))(mold((out \ - Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ - Convex)(sort \ - Exp))))))(shards((0)(1)))(children(()())))(((Secondary((id \ - 1497)(content(Comment\"# Polymorphism #\"))))(Secondary((id \ - 1465)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 1544)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 1675)(content(Comment\"# We can take types as parameters to \ - type functions, #\"))))(Secondary((id \ - 1676)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 1722)(content(Comment\"# and use them in annoatations in the \ - body: #\"))))(Secondary((id \ - 1466)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 1502)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 1503)(content(Whitespace\" \"))))(Tile((id \ - 1506)(label(id))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 1507)(content(Whitespace\" \")))))((Secondary((id \ - 1508)(content(Whitespace\" \"))))(Tile((id 1516)(label(typfun \ + "((selection((focus Left)(content())(mode \ + Normal)))(backpack())(relatives((siblings(((Secondary((id \ + ce06e01f-9b12-4ea1-8549-c5615ca7e52a)(content(Comment\"# \ + Polymorphism #\"))))(Secondary((id \ + 3b3f93ba-ca3c-4c1b-8346-2d68f5504958)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + abf1a875-4891-4386-8c1c-a77ad171a596)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + e8268e68-25db-4119-aaf2-c1e01ab024a0)(content(Comment\"# We \ + can take types as parameters to type functions, \ + #\"))))(Secondary((id \ + 70f57795-15c2-4826-b2d4-b1c2414b09fc)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 28bfb176-1ada-450a-9a2e-9ee4f68b9271)(content(Comment\"# and \ + use them in annoatations in the body: #\"))))(Secondary((id \ + 6c16f965-ddc2-4208-8161-9d17a4f71e84)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + dbc1d50f-0873-4a56-becd-184560be6a16)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 3265ecf6-f14c-4851-87bd-29b1c48ad60d)(content(Whitespace\" \ + \"))))(Tile((id \ + 2f057ddc-b7b4-4a90-8772-0f54a9e6a0f1)(label(id))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 9e9a0675-cf88-464e-a5b2-22ec197d871a)(content(Whitespace\" \ + \")))))((Secondary((id \ + 7c246b01-e879-4704-ab40-1ad600b6a05d)(content(Whitespace\" \ + \"))))(Tile((id \ + 357bc39e-7763-4d16-856a-30f2fdb89cd2)(label(typfun \ ->))(mold((out Exp)(in_(TPat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 1517)(content(Whitespace\" \ - \"))))(Tile((id 1518)(label(A))(mold((out \ + 1))(children(((Secondary((id \ + f9f6be49-c063-4799-a630-a15c13dc2416)(content(Whitespace\" \ + \"))))(Tile((id \ + d45a8f80-0658-42a7-bff7-6bfbf36e910d)(label(A))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 1520)(content(Whitespace\" \")))))))))(Secondary((id \ - 1522)(content(Whitespace\" \"))))(Tile((id 1527)(label(fun \ + 9f37693a-1d0d-4720-a547-0bde3a0cf043)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 0f5c9f28-98cf-4704-be01-3789b89325ad)(content(Whitespace\" \ + \"))))(Tile((id \ + c41ee313-ae0d-46e3-8763-3c0003823bf6)(label(fun \ ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 1528)(content(Whitespace\" \ - \"))))(Tile((id 1529)(label(x))(mold((out \ + 1))(children(((Secondary((id \ + 5a50ead3-2382-4702-8edc-82df727a9f98)(content(Whitespace\" \ + \"))))(Tile((id \ + 95012d29-d892-46f6-9d41-9d5b6a1991ea)(label(x))(mold((out \ Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ - 1531)(content(Whitespace\" \"))))(Tile((id \ - 1532)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 11))(sort Pat))((shape(Concave 11))(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 1533)(content(Whitespace\" \"))))(Tile((id \ - 1534)(label(A))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + 8134e2f9-624a-43ff-9e7e-f4f2fb3c44db)(content(Whitespace\" \ + \"))))(Tile((id \ + e9602009-d959-44c3-bae1-2fcca11436e0)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 11))(sort \ + Pat))((shape(Concave 11))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 1536)(content(Whitespace\" \")))))))))(Secondary((id \ - 1538)(content(Whitespace\" \"))))(Tile((id \ - 1539)(label(x))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Secondary((id \ - 1543)(content(Whitespace\" \")))))))))(Secondary((id \ - 1467)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 1723)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 1761)(content(Comment\"# Such functions are applied like so: \ - #\"))))(Secondary((id \ - 1468)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 4680)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 4681)(content(Whitespace\" \"))))(Tile((id \ - 4686)(label(ex1))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 4688)(content(Whitespace\" \")))))((Secondary((id \ - 4689)(content(Whitespace\" \"))))(Tile((id \ - 4685)(label(id))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id 1766)(label(@< \ - >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ - Exp))((shape Convex)(sort Exp))))))(shards(0 \ - 1))(children(((Tile((id 1770)(label(Int))(mold((out \ + d8b777e0-ebea-423b-99cd-6777245529d4)(content(Whitespace\" \ + \"))))(Tile((id \ + 1e025399-f3a3-40e9-b623-4269d2b4ee01)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 89d852f5-e16c-4b7c-af4b-064b73a7d0b0)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 56b281c4-857e-4223-b818-b33e503e6340)(content(Whitespace\" \ + \"))))(Tile((id \ + fc41c74e-bd60-4cf6-8400-aa6cd0b485d2)(label(x))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Secondary((id \ + b4b1ea56-6958-44fc-89bd-b6f22e6bade3)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 5c77f088-a1f3-4ba8-b7ef-efe73f27f855)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + d7c28f98-90c1-46ca-9827-7fb78625c981)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + a979ad79-2705-4ca1-9cf2-cccfec5e0086)(content(Comment\"# Such \ + functions are applied like so: #\"))))(Secondary((id \ + 5c84aefa-4652-4c4c-89ff-f05f4da85b58)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 2e888173-4ece-4010-a674-13a32957493e)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 32c1835b-c27f-4ccf-be61-a270b6e9c5ba)(content(Whitespace\" \ + \"))))(Tile((id \ + 1c2ef7e4-4439-4110-976e-41a1e8ff3d6b)(label(ex1))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 859ef193-f93b-4ae5-b070-4731bf77bc97)(content(Whitespace\" \ + \")))))((Secondary((id \ + ddb1f2b6-3fe6-4079-a75d-dcaebe48bc6f)(content(Whitespace\" \ + \"))))(Tile((id \ + 8439b029-0b7c-47cb-9867-c4c16ed4e733)(label(id))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + c5fe892a-4d64-4346-95bd-056a11c3f7ad)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 7079f97d-6950-4fd4-b76e-f6924cd0ed7e)(label(Int))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ - 2088)(label(\"(\"\")\"))(mold((out \ + 35b79c01-e4db-4671-a26a-ec0a7933c24f)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2090)(label(1))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ + 83c93244-e705-4189-a816-70dd13a963ec)(label(1))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ Exp))))))(shards(0))(children()))))))))(Secondary((id \ - 4694)(content(Whitespace\" \")))))))))(Secondary((id \ - 2023)(content(Whitespace\" \"))))(Secondary((id \ - 2085)(content(Comment\"# 1 #\"))))(Secondary((id \ - 1469)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 1470)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 1878)(content(Comment\"# We can annotate the type of a type \ - function with a forall. #\"))))(Secondary((id \ - 4690)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 1884)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 1885)(content(Whitespace\" \"))))(Tile((id \ - 1891)(label(const))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 1892)(content(Whitespace\" \"))))(Tile((id \ - 1893)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 11))(sort Pat))((shape(Concave 11))(sort \ + 7e153b1d-8ee5-4f89-a01a-1242f0565511)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 5d0ec35e-42f0-41e6-810c-b4163164e51e)(content(Whitespace\" \ + \"))))(Secondary((id \ + fdb7e231-ff3c-4d22-a8d2-308db57999e4)(content(Comment\"# 1 \ + #\"))))(Secondary((id \ + a4b7e97a-83dd-492f-ae20-a84b2a979e30)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 8c74bef9-7177-4774-89aa-805787cf673f)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 7309f6e2-2d49-45af-b7c6-0ec75a57fc2b)(content(Comment\"# We \ + can annotate the type of a type function with a forall. \ + #\"))))(Secondary((id \ + 4fda5632-5de3-4c5d-b424-bf16d704f35a)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + d1ace50b-2196-477e-aeda-e84f61901017)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + b1df318d-3e75-4630-8f19-d3cbc69bb8ee)(content(Whitespace\" \ + \"))))(Tile((id \ + 7a283681-40a7-483c-ab85-ab4916479faa)(label(const))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 69a7673c-e766-4409-852e-03c46fbbbf56)(content(Whitespace\" \ + \"))))(Tile((id \ + f5115707-8100-478a-bf56-748777fdd0c3)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 11))(sort \ + Pat))((shape(Concave 11))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 1894)(content(Whitespace\" \"))))(Tile((id 1902)(label(forall \ - .))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + 8bc19b04-eb77-4c2a-9668-4350e26a309d)(content(Whitespace\" \ + \"))))(Tile((id \ + a7889e83-9fe8-49ad-9bef-44e8ce448a64)(label(forall \ + ->))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ - 1))(children(((Secondary((id 1903)(content(Whitespace\" \ - \"))))(Tile((id 1904)(label(A))(mold((out \ + 1))(children(((Secondary((id \ + f70ea1f6-288e-407f-8594-1736b20cce67)(content(Whitespace\" \ + \"))))(Tile((id \ + 57bed8d9-e4fb-47da-b21b-fe51fb8ee9e6)(label(A))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 1914)(content(Whitespace\" \")))))))))(Secondary((id \ - 1915)(content(Whitespace\" \"))))(Tile((id 1929)(label(forall \ - .))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + 48e84944-6794-4ec4-9809-f8c9689fd797)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 0d8e46dc-456d-471e-9387-04fe16526ad6)(content(Whitespace\" \ + \"))))(Tile((id \ + 913ff727-11a1-4e0d-83fc-99e4de6e34f3)(label(forall \ + ->))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ - 1))(children(((Secondary((id 1930)(content(Whitespace\" \ - \"))))(Tile((id 1931)(label(B))(mold((out \ + 1))(children(((Secondary((id \ + fea1b479-fbd8-4564-8a3a-93e7e3d5374b)(content(Whitespace\" \ + \"))))(Tile((id \ + d97d38b4-0e17-4bb8-b342-50937dff5896)(label(B))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 1933)(content(Whitespace\" \")))))))))(Secondary((id \ - 1934)(content(Whitespace\" \"))))(Tile((id \ - 1935)(label(A))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 1937)(content(Whitespace\" \"))))(Tile((id \ - 1939)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 6))(sort Typ))((shape(Concave 6))(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 1940)(content(Whitespace\" \"))))(Tile((id \ - 1941)(label(B))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 1943)(content(Whitespace\" \"))))(Tile((id \ - 1945)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 6))(sort Typ))((shape(Concave 6))(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 1946)(content(Whitespace\" \"))))(Tile((id \ - 1947)(label(A))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 1948)(content(Whitespace\" \")))))((Secondary((id \ - 1953)(content(Whitespace\" \"))))(Secondary((id \ - 2008)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 1985)(label(typfun ->))(mold((out \ - Exp)(in_(TPat))(nibs(((shape Convex)(sort \ + e43565a7-cbb9-45aa-ab46-5cda424a47c5)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + f9ead65c-4436-4958-898c-a7ed360b5b46)(content(Whitespace\" \ + \"))))(Tile((id \ + d6a5887c-ef92-4773-9429-919995401912)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + c5801121-b4f8-4751-bca0-6b48d487a7e6)(content(Whitespace\" \ + \"))))(Tile((id \ + a3f602fe-03e9-4b18-8c75-2699369b969e)(label(->))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 6))(sort \ + Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + b59e20fa-3d31-411e-b242-a371c0e04d03)(content(Whitespace\" \ + \"))))(Tile((id \ + 20b8244e-580b-450c-9cd2-db7cc09f9171)(label(B))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 4e1ba90f-c253-4ea0-af95-d1fe89e671f6)(content(Whitespace\" \ + \"))))(Tile((id \ + 3263d74a-307a-4e5d-afc3-74a9344f4b0d)(label(->))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 6))(sort \ + Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + b3466ca7-a0f4-4aa2-a5a3-f9d1646f5033)(content(Whitespace\" \ + \"))))(Tile((id \ + 0c0fa783-0e0e-4c53-9dc6-ae591f4c9649)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + b5d049f6-643b-4a28-b9d0-8ebacdca3665)(content(Whitespace\" \ + \")))))((Secondary((id \ + 4cf96db7-3321-47be-bbc0-7c6df9c84aac)(content(Whitespace\" \ + \"))))(Secondary((id \ + 26600e0d-d6eb-40b6-9357-12b948bb85f8)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 1992686c-e8b9-4473-a1ae-d2c08a08bd83)(label(typfun \ + ->))(mold((out Exp)(in_(TPat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 1986)(content(Whitespace\" \ - \"))))(Tile((id 1989)(label(A))(mold((out \ + 1))(children(((Secondary((id \ + a13a91a2-4077-4cc3-9f3d-574983bc9b3a)(content(Whitespace\" \ + \"))))(Tile((id \ + 4a3d43e1-6d91-48f8-941f-fc2caa196468)(label(A))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 1991)(content(Whitespace\" \")))))))))(Secondary((id \ - 1993)(content(Whitespace\" \"))))(Tile((id 2001)(label(typfun \ + c26137e3-a766-4717-a269-2ba155800b8a)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 96004d3c-f493-4c07-bd6f-e717bd487554)(content(Whitespace\" \ + \"))))(Tile((id \ + ece966f5-4bfa-4f08-99ce-0a1f41c64f48)(label(typfun \ ->))(mold((out Exp)(in_(TPat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2002)(content(Whitespace\" \ - \"))))(Tile((id 2003)(label(B))(mold((out \ + 1))(children(((Secondary((id \ + d9a1daf2-50e7-413b-9254-395a44586281)(content(Whitespace\" \ + \"))))(Tile((id \ + f5d75275-fa16-42f3-ad3c-6c422427c84e)(label(B))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2005)(content(Whitespace\" \")))))))))(Secondary((id \ - 2007)(content(Whitespace\" \"))))(Tile((id 1957)(label(fun \ + da14e1ca-0903-4b7a-9f3d-e4d64ca651ed)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 3154b641-f630-4c85-a591-78d0ea4c6aa4)(content(Whitespace\" \ + \"))))(Tile((id \ + 4b5a8664-1772-4700-bad2-4b186a35dc5a)(label(fun \ ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 1958)(content(Whitespace\" \ - \"))))(Tile((id 1960)(label(x))(mold((out \ + 1))(children(((Secondary((id \ + 5f4ee7eb-858b-4375-8bae-ecb4688adca7)(content(Whitespace\" \ + \"))))(Tile((id \ + 4cb9bfb4-56f0-47a1-b6be-9f0a16c98e9d)(label(x))(mold((out \ Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ - 1961)(content(Whitespace\" \")))))))))(Secondary((id \ - 1964)(content(Whitespace\" \"))))(Tile((id 1968)(label(fun \ + 586ac15a-3af8-4b3f-99b0-0446efd5bd1c)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 5b0b25b1-b94b-45f8-9a89-3e9fe8cd1222)(content(Whitespace\" \ + \"))))(Tile((id \ + b1f6c96a-f3a7-43ea-b304-acf5a99b5d95)(label(fun \ ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 1969)(content(Whitespace\" \ - \"))))(Tile((id 1971)(label(y))(mold((out \ + 1))(children(((Secondary((id \ + 3cf3fd73-b0f4-4e68-8324-41f2c1a34db5)(content(Whitespace\" \ + \"))))(Tile((id \ + 0d9b9fbe-2609-4aeb-894a-e4d883971862)(label(y))(mold((out \ Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ - 1972)(content(Whitespace\" \")))))))))(Secondary((id \ - 1975)(content(Whitespace\" \"))))(Tile((id \ - 1976)(label(x))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Secondary((id \ - 1977)(content(Whitespace\" \")))))))))(Secondary((id \ - 1879)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 4700)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 4701)(content(Whitespace\" \"))))(Tile((id \ - 4706)(label(ex2))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 4708)(content(Whitespace\" \")))))((Secondary((id \ - 4709)(content(Whitespace\" \"))))(Tile((id \ - 4705)(label(const))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id 2025)(label(@< \ - >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ - Exp))((shape Convex)(sort Exp))))))(shards(0 \ - 1))(children(((Tile((id 2033)(label(Int))(mold((out \ + f9eacdec-ff0f-487f-b4e7-016b5eee0516)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 6dc0f10f-31b0-47f2-876c-973a06e137a6)(content(Whitespace\" \ + \"))))(Tile((id \ + 84678463-bd3d-495b-8787-5e15e9f2fb76)(label(x))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Secondary((id \ + 6b03a744-056f-4464-a52c-a0152aaa7165)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 378239c7-2535-4a78-8fb0-8d19433db26b)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + f686ce31-58f6-4e46-9c6c-7ee24a13619b)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 89f204f3-4bc8-4dc3-a31c-9e5d99cb1242)(content(Whitespace\" \ + \"))))(Tile((id \ + c0fd6ffc-1cb2-4d82-a6b4-798bc6251af7)(label(ex2))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 85333d35-a563-44eb-8102-a64226fc9c37)(content(Whitespace\" \ + \")))))((Secondary((id \ + 20d23ebb-f489-4103-a55f-0c6024c82896)(content(Whitespace\" \ + \"))))(Tile((id \ + 2e160900-ad22-4eb4-93f9-499a2179dc8d)(label(const))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + b64dd6ef-3a63-40ca-a9b3-85453bf6649f)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + c45a9241-5e40-42bb-9738-16984f9cced5)(label(Int))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ - 2049)(label(@< >))(mold((out \ + 6bb9e3d9-9127-4b3e-b129-63e461202adb)(label(@< >))(mold((out \ Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2056)(label(String))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children()))))))))(Tile((id \ - 2057)(label(\"(\"\")\"))(mold((out \ + 2fa8b7dd-6963-4688-a0d3-c4ea84e886dd)(label(String))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ + 137358f3-a48c-4169-a855-495f7fb95ba4)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2062)(label(2))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children()))))))))(Tile((id \ - 2064)(label(\"(\"\")\"))(mold((out \ + 36d3b274-ad9b-4057-aa23-b0481d7c6a59)(label(2))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children()))))))))(Tile((id \ + 42a0f2f0-96bd-4896-960f-2c5e623c5af1)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2077)(label(\"\\\"Hello World\\\"\"))(mold((out \ - Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ - Convex)(sort \ + f282d501-c0bd-434e-873e-30b7e520cf20)(label(\"\\\"Hello \ + World\\\"\"))(mold((out Exp)(in_())(nibs(((shape Convex)(sort \ + Exp))((shape Convex)(sort \ Exp))))))(shards(0))(children()))))))))(Secondary((id \ - 4713)(content(Whitespace\" \")))))))))(Secondary((id \ - 2079)(content(Whitespace\" \"))))(Secondary((id \ - 2083)(content(Comment\"# 2 #\"))))(Secondary((id \ - 2009)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 2091)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 2158)(content(Comment\"# We can go beyond rank 1 \ - polymorphism: #\"))))(Secondary((id \ - 2092)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 2164)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 2165)(content(Whitespace\" \"))))(Tile((id \ - 2187)(label(apply_both))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 2188)(content(Whitespace\" \"))))(Tile((id \ - 2191)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 11))(sort Pat))((shape(Concave 11))(sort \ + 084144f9-6c79-422a-96d8-1ab0db271dde)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + b7c097ca-897c-4549-85b1-a3aa34bd3e48)(content(Whitespace\" \ + \"))))(Secondary((id \ + 17b2ff69-f022-4365-9611-19e153ab3510)(content(Comment\"# 2 \ + #\"))))(Secondary((id \ + 8e6a1044-6ea7-481f-b35c-f5dc277406e7)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + d9204a7d-8903-426c-a2a3-e298948f6645)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 93e3db1d-a91f-4b86-9085-4907952180d9)(content(Comment\"# We \ + can go beyond rank 1 polymorphism: #\"))))(Secondary((id \ + b3a81efa-f007-4976-8864-f0a563e7efd7)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 5a144dcf-d9f2-402d-9556-b6e8ee0647e5)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + a3f3a127-a472-431b-a04d-20dfb03fee37)(content(Whitespace\" \ + \"))))(Tile((id \ + 7560359f-5145-4674-9e5d-0427f75cc171)(label(apply_both))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 2b179ba5-1578-439f-8899-d72c14f7780d)(content(Whitespace\" \ + \"))))(Tile((id \ + 453fb383-28b8-466a-ba99-063b848e02c2)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 11))(sort \ + Pat))((shape(Concave 11))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2218)(content(Whitespace\" \"))))(Tile((id 2227)(label(forall \ - .))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + 462a9b5f-e582-4d33-bbfa-791e557df360)(content(Whitespace\" \ + \"))))(Tile((id \ + 6c464286-72b3-49ad-b83f-571c66c1ade6)(label(forall \ + ->))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ - 1))(children(((Secondary((id 2228)(content(Whitespace\" \ - \"))))(Tile((id 2229)(label(A))(mold((out \ + 1))(children(((Secondary((id \ + 4885ff9c-656c-4cac-94d3-9946c87758d1)(content(Whitespace\" \ + \"))))(Tile((id \ + b1ef3819-7e49-4952-9b4d-4553df2c1b22)(label(A))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2231)(content(Whitespace\" \")))))))))(Secondary((id \ - 2232)(content(Whitespace\" \"))))(Tile((id 2240)(label(forall \ - .))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + 699dc9bb-69ee-4f0d-8eb8-4d08ca395ac0)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + fb4c51ac-dd80-4b42-b18a-3460c39ba250)(content(Whitespace\" \ + \"))))(Tile((id \ + a3a5af75-2734-473b-a402-3339b5a5aed3)(label(forall \ + ->))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ - 1))(children(((Secondary((id 2241)(content(Whitespace\" \ - \"))))(Tile((id 2242)(label(B))(mold((out \ + 1))(children(((Secondary((id \ + 14b786ee-56d3-4868-9048-38d18607b3ed)(content(Whitespace\" \ + \"))))(Tile((id \ + e3ad6862-da04-4d40-b14d-773a130d2a4f)(label(B))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2244)(content(Whitespace\" \")))))))))(Secondary((id \ - 2245)(content(Whitespace\" \"))))(Tile((id \ - 2274)(label(\"(\"\")\"))(mold((out \ + c3613e98-7473-49d7-9dcb-9e35f7d7b10d)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + e4f9136f-ecd7-497c-989d-dd9ba87a3d11)(content(Whitespace\" \ + \"))))(Tile((id \ + 9f0b4530-be66-4001-ad6d-5008ade448f5)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 2282)(label(forall .))(mold((out Typ)(in_(TPat))(nibs(((shape \ - Convex)(sort Typ))((shape(Concave 13))(sort \ - Typ))))))(shards(0 1))(children(((Secondary((id \ - 2283)(content(Whitespace\" \"))))(Tile((id \ - 2284)(label(D))(mold((out TPat)(in_())(nibs(((shape \ - Convex)(sort TPat))((shape Convex)(sort \ + ebeb7669-44b8-433a-9944-dc027f8f7003)(label(forall \ + ->))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ + 1))(children(((Secondary((id \ + 37725f50-74ae-4651-a13a-489eddb08955)(content(Whitespace\" \ + \"))))(Tile((id \ + 20a12d27-d6b5-4514-ad6f-1e951c2d0391)(label(D))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2286)(content(Whitespace\" \")))))))))(Secondary((id \ - 2287)(content(Whitespace\" \"))))(Tile((id \ - 2288)(label(D))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 2306)(content(Whitespace\" \"))))(Tile((id \ - 2304)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 6))(sort Typ))((shape(Concave 6))(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 2316)(content(Whitespace\" \"))))(Tile((id \ - 2317)(label(D))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + c70dd6ff-391d-4c7c-a73d-62b8af7a5c10)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 084c5f67-3772-473b-8121-b5593490d98d)(content(Whitespace\" \ + \"))))(Tile((id \ + 374c499d-fbaf-4a2c-8e95-a8c4aab55992)(label(D))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 636bf99a-c682-4a09-9bc3-02abf03a2a95)(content(Whitespace\" \ + \"))))(Tile((id \ + 8f3851f6-33da-415b-82bc-8d7734089747)(label(->))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 6))(sort \ + Typ))((shape(Concave 6))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + df4c4c83-a640-4b98-9992-cc466142b237)(content(Whitespace\" \ + \"))))(Tile((id \ + bc020cbc-2bee-4d21-aada-486e4657ca1a)(label(D))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ Typ))))))(shards(0))(children()))))))))(Secondary((id \ - 2324)(content(Whitespace\" \"))))(Tile((id \ - 2321)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 6))(sort Typ))((shape(Concave 6))(sort \ + 80178c33-42d1-40a8-9f89-6cd7257cec81)(content(Whitespace\" \ + \"))))(Tile((id \ + c028b69c-8544-40ce-bd46-b370f61b6050)(label(->))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 6))(sort \ + Typ))((shape(Concave 6))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2323)(content(Whitespace\" \"))))(Tile((id \ - 2327)(label(\"(\"\")\"))(mold((out \ + c7feb1ec-8ee4-4a45-852c-61dab26295d1)(content(Whitespace\" \ + \"))))(Tile((id \ + 69097f40-c4b8-40fc-8c3f-83320bb1c7f7)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 2329)(label(A))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 2330)(content(Whitespace\" \"))))(Tile((id \ - 2331)(label(,))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 14))(sort Typ))((shape(Concave 14))(sort \ + 9dfe9156-9cc5-4484-ad1b-6c2e1ba76e00)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 68821505-6886-4514-9cb7-ca680ef6f9fe)(content(Whitespace\" \ + \"))))(Tile((id \ + f0a182a8-44ea-4c80-b37e-26545127421e)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 14))(sort \ + Typ))((shape(Concave 14))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2333)(content(Whitespace\" \"))))(Tile((id \ - 2334)(label(B))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + ee9e3c98-29c3-4191-96f7-d759ba9831d0)(content(Whitespace\" \ + \"))))(Tile((id \ + 03c0b912-b205-4ee3-83f4-20654cef76a4)(label(B))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ Typ))))))(shards(0))(children()))))))))(Secondary((id \ - 2341)(content(Whitespace\" \"))))(Tile((id \ - 2338)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 6))(sort Typ))((shape(Concave 6))(sort \ + 704883ad-e1f1-4931-8c20-75137f6125bb)(content(Whitespace\" \ + \"))))(Tile((id \ + e57b4dfc-0ec1-4c60-9114-4db7ed161100)(label(->))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 6))(sort \ + Typ))((shape(Concave 6))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2345)(content(Whitespace\" \"))))(Tile((id \ - 2346)(label(\"(\"\")\"))(mold((out \ + 12d67f9f-300d-47d2-9456-b46834577095)(content(Whitespace\" \ + \"))))(Tile((id \ + 8f554256-0ab9-4c84-a1c2-63596877e225)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 2347)(label(A))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 2348)(content(Whitespace\" \"))))(Tile((id \ - 2349)(label(,))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 14))(sort Typ))((shape(Concave 14))(sort \ + b9860364-7fb8-4a87-9813-2bd5178200fd)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 6e303e7d-fe77-4b6d-80eb-674991ecebb2)(content(Whitespace\" \ + \"))))(Tile((id \ + f6db9b79-e371-44cd-acf3-18fd4f06770b)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 14))(sort \ + Typ))((shape(Concave 14))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2351)(content(Whitespace\" \"))))(Tile((id \ - 2352)(label(B))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + 8bdca6d8-d33a-4c35-9f51-021fc98c298e)(content(Whitespace\" \ + \"))))(Tile((id \ + 4fb9e567-2954-4690-b71e-8cc92ca17d13)(label(B))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ Typ))))))(shards(0))(children()))))))))(Secondary((id \ - 2353)(content(Whitespace\" \")))))((Secondary((id \ - 2355)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 2377)(label(typfun ->))(mold((out \ - Exp)(in_(TPat))(nibs(((shape Convex)(sort \ + 19eece83-ea6a-4e60-a5d6-4207048bc574)(content(Whitespace\" \ + \")))))((Secondary((id \ + 4b9fc364-d0a1-435e-a0d6-3a490349b143)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + b8c143a9-c3ee-41ad-81d4-53d28c0c861c)(label(typfun \ + ->))(mold((out Exp)(in_(TPat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2378)(content(Whitespace\" \ - \"))))(Tile((id 2380)(label(A))(mold((out \ + 1))(children(((Secondary((id \ + 2029fa53-3073-4967-87a8-b0869112189f)(content(Whitespace\" \ + \"))))(Tile((id \ + 454ea17c-4c69-456f-bf12-55d3e1142ab1)(label(A))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2381)(content(Whitespace\" \")))))))))(Secondary((id \ - 2384)(content(Whitespace\" \"))))(Tile((id 2391)(label(typfun \ + 23c91397-4f7f-4121-8e3b-bbdb2cf73612)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 60524143-0ca7-4857-8f40-cf6deea6407d)(content(Whitespace\" \ + \"))))(Tile((id \ + 24999367-7d4d-4a2f-888a-01caf8064af4)(label(typfun \ ->))(mold((out Exp)(in_(TPat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2392)(content(Whitespace\" \ - \"))))(Tile((id 2394)(label(B))(mold((out \ + 1))(children(((Secondary((id \ + 697b85eb-ebaa-4da2-b3ff-f8784abce982)(content(Whitespace\" \ + \"))))(Tile((id \ + 9268bf3d-d2ad-45b8-a656-4c5fc7da9a8e)(label(B))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2395)(content(Whitespace\" \")))))))))(Secondary((id \ - 2402)(content(Whitespace\" \"))))(Tile((id 2408)(label(fun \ + f7a80654-16be-46ef-84dc-cbbfe538eec1)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 4fac1b77-6181-4276-8df7-69ec0b498670)(content(Whitespace\" \ + \"))))(Tile((id \ + 14f05a85-9351-421d-8012-e644bee593b8)(label(fun \ ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2409)(content(Whitespace\" \ - \"))))(Tile((id 2411)(label(f))(mold((out \ + 1))(children(((Secondary((id \ + ec293b56-ef71-4d52-80e8-1dbf69fedf52)(content(Whitespace\" \ + \"))))(Tile((id \ + b3b4e67e-ec31-48d0-99c8-1fd0b776e3f3)(label(f))(mold((out \ Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ - 2412)(content(Whitespace\" \")))))))))(Secondary((id \ - 2415)(content(Whitespace\" \"))))(Tile((id 2419)(label(fun \ + 8e65f50b-e702-4a38-b590-d3a8aa14e619)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + e2228bb4-f45a-4e38-aff2-f1a03def3d5e)(content(Whitespace\" \ + \"))))(Tile((id \ + 7359ea14-3040-402e-89dc-74daf4cb2482)(label(fun \ ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2420)(content(Whitespace\" \ - \"))))(Tile((id 2422)(label(\"(\"\")\"))(mold((out \ + 1))(children(((Secondary((id \ + 6023ad37-b805-415b-954e-30ac1380b014)(content(Whitespace\" \ + \"))))(Tile((id \ + 1528bbe3-9456-4d4e-92d7-43b29196f1a7)(label(\"(\"\")\"))(mold((out \ Pat)(in_(Pat))(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0 1))(children(((Tile((id \ - 2423)(label(x))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Tile((id \ - 2424)(label(,))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 14))(sort Pat))((shape(Concave 14))(sort \ + c2919cb1-233a-4283-8b66-cf44fc4afef9)(label(x))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ + 409eb345-2d10-4fa9-aa11-126678ce05bc)(label(,))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 14))(sort \ + Pat))((shape(Concave 14))(sort \ Pat))))))(shards(0))(children())))(Secondary((id \ - 2426)(content(Whitespace\" \"))))(Tile((id \ - 2427)(label(y))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ + 8a2cb8b6-9d5a-4754-8dda-8d8fe0e94e09)(content(Whitespace\" \ + \"))))(Tile((id \ + d0bd6124-c271-46ed-9371-5ff172659e12)(label(y))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ Pat))))))(shards(0))(children()))))))))(Secondary((id \ - 2428)(content(Whitespace\" \")))))))))(Secondary((id \ - 2431)(content(Whitespace\" \"))))(Tile((id \ - 2432)(label(\"(\"\")\"))(mold((out \ + 1ede3347-889a-421e-ab9f-9a76bb89b547)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 025702d6-85bb-4492-b77a-fcd80ce5b1d9)(content(Whitespace\" \ + \"))))(Tile((id \ + 44d77c85-e077-410e-850c-ccc2c10fc818)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2433)(label(f))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id 2452)(label(@< \ - >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ - Exp))((shape Convex)(sort Exp))))))(shards(0 \ - 1))(children(((Tile((id 2453)(label(A))(mold((out \ - Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ - Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ - 2440)(label(\"(\"\")\"))(mold((out \ - Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + 22214cfb-eb83-4531-b73e-7aed1cbee876)(label(f))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 38c3df7e-a52e-488b-8153-cc0a0e400c81)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2442)(label(x))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children()))))))))(Tile((id \ - 2443)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 14))(sort Exp))((shape(Concave 14))(sort \ - Exp))))))(shards(0))(children())))(Secondary((id \ - 2445)(content(Whitespace\" \"))))(Tile((id \ - 2446)(label(f))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id 2455)(label(@< \ - >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ - Exp))((shape Convex)(sort Exp))))))(shards(0 \ - 1))(children(((Tile((id 2456)(label(B))(mold((out \ + 82ad7a3a-04a9-451b-aa97-19bc0c7ecb39)(label(A))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ - 2447)(label(\"(\"\")\"))(mold((out \ + d315a9cd-9383-456f-a0d1-9b96b08aed99)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2449)(label(y))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))))))))))))(Secondary((id \ - 2450)(content(Whitespace\" \")))))))))(Secondary((id \ - 2308)(content(Whitespace\" \"))))(Secondary((id \ - 2313)(content(Whitespace\" \"))))(Secondary((id \ - 2159)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 4719)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 4720)(content(Whitespace\" \"))))(Tile((id \ - 4725)(label(ex3))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 4727)(content(Whitespace\" \")))))((Secondary((id \ - 4728)(content(Whitespace\" \"))))(Tile((id \ - 4724)(label(apply_both))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id 2476)(label(@< \ - >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ - Exp))((shape Convex)(sort Exp))))))(shards(0 \ - 1))(children(((Tile((id 2481)(label(Int))(mold((out \ + ffdcd079-0c86-4fb9-9a32-a6f10114522f)(label(x))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children()))))))))(Tile((id \ + c343faf6-4aec-4789-a364-1c38747c0ede)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 14))(sort \ + Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 972f8813-9085-4dcf-8f65-91f4ccfff5f6)(content(Whitespace\" \ + \"))))(Tile((id \ + ad7b36cb-7b61-4988-af73-1751a7f90e5a)(label(f))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 35f5379e-f09a-4416-8881-b3e555caa977)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 8c539c0f-b853-4aa4-98bf-874aa0d5487d)(label(B))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ - 2483)(label(@< >))(mold((out \ + 0d94b84a-aba2-4fdd-bbeb-c6e96990f257)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 6346a4a7-211a-4b7b-af7a-8d3980f344b6)(label(y))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children())))))))))))))(Secondary((id \ + 1374a8af-7da6-432f-8448-bf31d19fa4a1)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 4bad67e9-e3ec-4331-9db9-85eb4d51c10d)(content(Whitespace\" \ + \"))))(Secondary((id \ + 8ff64639-9a3a-4439-8dd4-a3e15280dd33)(content(Whitespace\" \ + \"))))(Secondary((id \ + 694712fd-f999-48ff-93c7-fc33b9b77094)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + fef28f13-33fe-449b-8cdb-6ebfd5762e15)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + ac4c6231-9f82-4ade-b8c9-d91728bf8ad4)(content(Whitespace\" \ + \"))))(Tile((id \ + 5de84be0-f611-4281-a794-7a0b0ff1118c)(label(ex3))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 3cb05235-9882-4486-b265-1cc2556c796f)(content(Whitespace\" \ + \")))))((Secondary((id \ + 5d92ec2c-1d17-4c65-bca3-9f32260e8b3e)(content(Whitespace\" \ + \"))))(Tile((id \ + cf076596-5f1d-4628-8197-5a5fec90a125)(label(apply_both))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + e1f8fd16-f236-4fc9-bc9a-b9289a4112f5)(label(@< >))(mold((out \ Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2490)(label(String))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children()))))))))(Tile((id \ - 2491)(label(\"(\"\")\"))(mold((out \ + 09beab66-f457-4dad-8f46-8e195d6e5e65)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ + 98181850-6a50-4513-827b-4a9c90873912)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + cbf816ab-0f3a-47e0-8a6c-5d2394e0a427)(label(String))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ + f703fbc5-53b3-49db-8748-d10d150098c0)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2494)(label(id))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children()))))))))(Tile((id \ - 2495)(label(\"(\"\")\"))(mold((out \ + 797110e6-521d-4cbb-9941-19fccd65f36a)(label(id))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children()))))))))(Tile((id \ + 51783bd8-663f-4e46-b00a-a0296c8cd7ac)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2501)(label(3))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 2503)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 14))(sort Exp))((shape(Concave 14))(sort \ - Exp))))))(shards(0))(children())))(Secondary((id \ - 2504)(content(Whitespace\" \"))))(Tile((id \ - 2517)(label(\"\\\"Hello World\\\"\"))(mold((out \ + 8fc7176c-fa6c-4cd7-9245-83b8702a4428)(label(3))(mold((out \ Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ - Convex)(sort \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 8116ef96-1cab-42f4-81de-213ecf812970)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 14))(sort \ + Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 2f20f0f7-1675-4468-b2b6-cd7405f5aee4)(content(Whitespace\" \ + \"))))(Tile((id \ + 9f229a7b-bbad-4a9a-9e62-d9904862374c)(label(\"\\\"Hello \ + World\\\"\"))(mold((out Exp)(in_())(nibs(((shape Convex)(sort \ + Exp))((shape Convex)(sort \ Exp))))))(shards(0))(children()))))))))(Secondary((id \ - 4732)(content(Whitespace\" \")))))))))(Secondary((id \ - 2526)(content(Whitespace\" \"))))(Secondary((id \ - 2548)(content(Comment\"# (3, \\\"Hello World\\\") \ - #\"))))(Secondary((id 2521)(content(Whitespace\" \ - \"))))(Secondary((id \ - 2457)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 2549)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 2650)(content(Comment\"# Finally, here is a more in-depth, \ - yet applicable example: polymorphic map #\"))))(Secondary((id \ - 2550)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 2932)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 2933)(content(Whitespace\" \"))))(Tile((id \ - 2943)(label(emptylist))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 2944)(content(Whitespace\" \"))))(Tile((id \ - 2945)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 11))(sort Pat))((shape(Concave 11))(sort \ + 1906060c-28fe-4257-8be4-2fd05219ef29)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 63719044-8f1c-4920-ba4f-e4b2170077c4)(content(Whitespace\" \ + \"))))(Secondary((id \ + 06d1fe4e-1834-48c0-ba2d-71886eefb57a)(content(Comment\"# (3, \ + \\\"Hello World\\\") #\"))))(Secondary((id \ + 9a45a5ec-c346-4ba0-b534-37ee71f5fdd1)(content(Whitespace\" \ + \"))))(Secondary((id \ + edef7a1c-2899-4e18-8228-c750ceff7ec8)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + b700ee2a-c5eb-4ee1-bbab-c4539ed9d797)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + df508fd5-afc8-4de6-8261-7425fd25105b)(content(Comment\"# \ + Finally, here is a more in-depth, yet applicable example: \ + polymorphic map #\"))))(Secondary((id \ + e354e9fe-f5ad-4c87-be05-96335dffbe31)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 202cef82-1c4d-4655-b6b6-41f9e9f7a73b)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 78570e13-c5ca-49d9-b93b-fd18ffc9a429)(content(Whitespace\" \ + \"))))(Tile((id \ + e91519e6-a65e-491f-b9a4-18b547b30d3a)(label(emptylist))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 7a1b5f10-90ae-48e0-b0f9-36ca4d2d3107)(content(Whitespace\" \ + \"))))(Tile((id \ + a72887db-4aaf-49cc-8e67-0f7541880f76)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 11))(sort \ + Pat))((shape(Concave 11))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2946)(content(Whitespace\" \"))))(Tile((id 2954)(label(forall \ - .))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + ebfa5ee4-9fd0-4f8d-bc75-47444311729d)(content(Whitespace\" \ + \"))))(Tile((id \ + 592e5425-2459-41ff-9228-07f766f8ccf7)(label(forall \ + ->))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ - 1))(children(((Secondary((id 2955)(content(Whitespace\" \ - \"))))(Tile((id 2956)(label(A))(mold((out \ + 1))(children(((Secondary((id \ + 803a7b56-e0b3-4d80-ba8c-b65ff8517d93)(content(Whitespace\" \ + \"))))(Tile((id \ + 87240474-a39f-4923-85a5-2f102c7d0e32)(label(A))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2958)(content(Whitespace\" \")))))))))(Secondary((id \ - 2959)(content(Whitespace\" \"))))(Tile((id 2960)(label([ \ + 6e4a8b34-2119-4f41-a61a-463ef0198a04)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + b1ab0026-aae9-4be9-b36d-eb3dd781adb1)(content(Whitespace\" \ + \"))))(Tile((id 8085a4f3-a54a-4666-9242-6184af5353c0)(label([ \ ]))(mold((out Typ)(in_(Typ))(nibs(((shape Convex)(sort \ Typ))((shape Convex)(sort Typ))))))(shards(0 \ - 1))(children(((Tile((id 2961)(label(A))(mold((out \ + 1))(children(((Tile((id \ + 7559f86c-1c2c-4542-b97d-35f9fc803fe4)(label(A))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort \ Typ))))))(shards(0))(children()))))))))(Secondary((id \ - 2963)(content(Whitespace\" \")))))((Secondary((id \ - 2964)(content(Whitespace\" \"))))(Tile((id 2972)(label(typfun \ + a7d1783a-03d9-4a83-a20c-224d0591481f)(content(Whitespace\" \ + \")))))((Secondary((id \ + 8a9f101c-6584-44e7-99a3-e372048b7445)(content(Whitespace\" \ + \"))))(Tile((id \ + 68c3ed3d-f500-4bd3-bcaf-ea9bdf9451ae)(label(typfun \ ->))(mold((out Exp)(in_(TPat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2973)(content(Whitespace\" \ - \"))))(Tile((id 2974)(label(A))(mold((out \ + 1))(children(((Secondary((id \ + faa1695b-2e55-4667-8ec7-1558b3d85850)(content(Whitespace\" \ + \"))))(Tile((id \ + 38b03267-319e-4664-8372-efcdd79e85f4)(label(A))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2976)(content(Whitespace\" \")))))))))(Secondary((id \ - 2978)(content(Whitespace\" \"))))(Tile((id \ - 2980)(label([]))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Secondary((id \ - 2984)(content(Whitespace\" \")))))))))(Secondary((id \ - 2986)(content(Whitespace\" \"))))(Secondary((id \ - 3009)(content(Comment\"# polymorphic constant \ - #\"))))(Secondary((id \ - 2927)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 2656)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 2657)(content(Whitespace\" \"))))(Tile((id \ - 2661)(label(map))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 2662)(content(Whitespace\" \"))))(Tile((id \ - 2663)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 11))(sort Pat))((shape(Concave 11))(sort \ + 228c224a-afad-44f4-a22a-eddf73b8d974)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 5ca59d99-25f7-486d-ac51-f549cb0a91b3)(content(Whitespace\" \ + \"))))(Tile((id \ + 0981b8f1-b372-41ba-bf9d-9e13d779a5a3)(label([]))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Secondary((id \ + 9c58a1b5-6df1-4868-a078-9ee9a15baa7c)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + e188133e-4924-4f2e-be27-fcf311628729)(content(Whitespace\" \ + \"))))(Secondary((id \ + ee875eb7-54d4-4f95-886b-c49fe80ef2be)(content(Comment\"# \ + polymorphic constant #\"))))(Secondary((id \ + dd6f9538-a844-49fd-a02a-ac3a01e89512)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + eccaa669-c774-4a4d-bfdf-fc6f85153e3c)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + aa9c739b-6bf6-49fd-bd3b-40f2f9017ae4)(content(Whitespace\" \ + \"))))(Tile((id \ + 0f2b46f6-0a6f-4c5c-8682-3f59ad4b751f)(label(map))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 37696633-3cee-49a1-b614-1f87c67e2b70)(content(Whitespace\" \ + \"))))(Tile((id \ + 0dfd3441-ca14-4837-8b6e-152899e6d301)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 11))(sort \ + Pat))((shape(Concave 11))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2664)(content(Whitespace\" \"))))(Tile((id 2672)(label(forall \ - .))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + 4215c01a-0f39-4671-8210-aff41079081d)(content(Whitespace\" \ + \"))))(Tile((id \ + 88c46e29-1562-41bb-8c58-3a70ca2b7337)(label(forall \ + ->))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ - 1))(children(((Secondary((id 2673)(content(Whitespace\" \ - \"))))(Tile((id 2674)(label(A))(mold((out \ + 1))(children(((Secondary((id \ + c0d24d93-992b-40a9-8d3a-b16aa88a939c)(content(Whitespace\" \ + \"))))(Tile((id \ + 15ea1b72-ecb0-451c-91e5-e55c0283ff01)(label(A))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2676)(content(Whitespace\" \")))))))))(Secondary((id \ - 2677)(content(Whitespace\" \"))))(Tile((id 2685)(label(forall \ - .))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + ecfd54e9-8baa-4a1c-8f98-5f8657ba550d)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 6fe8a5a8-f3af-4a76-b03a-7843dca9f959)(content(Whitespace\" \ + \"))))(Tile((id \ + 155d7295-5673-4c5a-87b8-68d3053df95a)(label(forall \ + ->))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ - 1))(children(((Secondary((id 2686)(content(Whitespace\" \ - \"))))(Tile((id 2687)(label(B))(mold((out \ + 1))(children(((Secondary((id \ + d64b0ee3-fcce-40bb-976d-149ce33e0b05)(content(Whitespace\" \ + \"))))(Tile((id \ + 722893eb-79bf-4a75-9491-d5e696d80fe9)(label(B))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2689)(content(Whitespace\" \")))))))))(Secondary((id \ - 2690)(content(Whitespace\" \"))))(Tile((id \ - 2691)(label(\"(\"\")\"))(mold((out \ + 1fb2d0cc-1057-4c09-b0dc-eda66ca91edf)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + b491ae64-7e22-48fe-85f9-5c4c9fb6a864)(content(Whitespace\" \ + \"))))(Tile((id \ + 43465c96-ccf8-4251-aeb5-06f86e7a9ec0)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 2692)(label(A))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 2701)(content(Whitespace\" \"))))(Tile((id \ - 2697)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 6))(sort Typ))((shape(Concave 6))(sort \ + 8918e371-6bc8-4291-b8fc-92f0ac4afa4a)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 6164fe07-2c6f-4daf-9c3e-5ec6468e0c02)(content(Whitespace\" \ + \"))))(Tile((id \ + 8bc001b1-7710-4877-b8fd-6fb9eba7c39d)(label(->))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 6))(sort \ + Typ))((shape(Concave 6))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2698)(content(Whitespace\" \"))))(Tile((id \ - 2699)(label(B))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + 07510d7e-5ccc-46e7-9d96-456f01270a3e)(content(Whitespace\" \ + \"))))(Tile((id \ + a753c673-92ed-44c4-923b-8a95152174b2)(label(B))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ Typ))))))(shards(0))(children()))))))))(Secondary((id \ - 2702)(content(Whitespace\" \"))))(Tile((id \ - 2704)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 6))(sort Typ))((shape(Concave 6))(sort \ + 523f8d85-4fe6-494d-8699-a5438e0b960e)(content(Whitespace\" \ + \"))))(Tile((id \ + 66564dc5-1126-45b1-96b5-6e591777773b)(label(->))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 6))(sort \ + Typ))((shape(Concave 6))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2705)(content(Whitespace\" \"))))(Tile((id \ - 2706)(label(\"(\"\")\"))(mold((out \ + a43abf64-f5d9-4b52-85ff-d962bc2408bf)(content(Whitespace\" \ + \"))))(Tile((id \ + a0be16ac-54d0-4529-b9e6-6347996157a3)(label(\"(\"\")\"))(mold((out \ + Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ + 28a5752a-c74f-432c-99b5-aa7539198b49)(label([ ]))(mold((out \ Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 2707)(label([ ]))(mold((out Typ)(in_(Typ))(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort Typ))))))(shards(0 \ - 1))(children(((Tile((id 2708)(label(A))(mold((out \ + f393e48d-68a3-446d-befb-87f27012a0e3)(label(A))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort \ Typ))))))(shards(0))(children()))))))))(Secondary((id \ - 2719)(content(Whitespace\" \"))))(Tile((id \ - 2713)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 6))(sort Typ))((shape(Concave 6))(sort \ + 2e71f6dd-e285-47cf-b2a6-e1a4b9f45db3)(content(Whitespace\" \ + \"))))(Tile((id \ + e4f1cd33-3003-49be-98a4-ee4ad279b2b6)(label(->))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 6))(sort \ + Typ))((shape(Concave 6))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2714)(content(Whitespace\" \"))))(Tile((id 2715)(label([ \ + 0950551e-141b-4a64-8297-21259177b3bb)(content(Whitespace\" \ + \"))))(Tile((id 3e01b2d4-90ac-441e-aa07-eee0abf36091)(label([ \ ]))(mold((out Typ)(in_(Typ))(nibs(((shape Convex)(sort \ Typ))((shape Convex)(sort Typ))))))(shards(0 \ - 1))(children(((Tile((id 2716)(label(B))(mold((out \ + 1))(children(((Tile((id \ + c72fce8d-fade-423e-965c-fec2b626373f)(label(B))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort \ Typ))))))(shards(0))(children())))))))))))))(Secondary((id \ - 2720)(content(Whitespace\" \")))))((Secondary((id \ - 2721)(content(Whitespace\" \"))))(Secondary((id \ - 2722)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 2730)(label(typfun ->))(mold((out \ - Exp)(in_(TPat))(nibs(((shape Convex)(sort \ + e8f716f5-1b3f-4ee6-962e-4e078ce0bd37)(content(Whitespace\" \ + \")))))((Secondary((id \ + d067ebe8-0d92-451f-8093-5520bf5fb45d)(content(Whitespace\" \ + \"))))(Secondary((id \ + 419f3418-e474-41c3-ad4c-3b22a8dd9a61)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 0b4c829b-646e-4473-8d56-826d11fded2c)(label(typfun \ + ->))(mold((out Exp)(in_(TPat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2731)(content(Whitespace\" \ - \"))))(Tile((id 2732)(label(A))(mold((out \ + 1))(children(((Secondary((id \ + faaa1f96-c99c-4430-a432-32be33368118)(content(Whitespace\" \ + \"))))(Tile((id \ + 3167378f-47ff-4023-8c32-62977c64c1bc)(label(A))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2734)(content(Whitespace\" \")))))))))(Secondary((id \ - 2736)(content(Whitespace\" \"))))(Tile((id 2744)(label(typfun \ + 9b40799d-499e-4cf0-b5e1-c77c9db980e2)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 17cd6904-a1de-419b-bc8b-551ae07e88df)(content(Whitespace\" \ + \"))))(Tile((id \ + a74f4763-dd86-4124-840a-ac14797d15fa)(label(typfun \ ->))(mold((out Exp)(in_(TPat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2745)(content(Whitespace\" \ - \"))))(Tile((id 2746)(label(B))(mold((out \ + 1))(children(((Secondary((id \ + 30a14f5e-ca39-4f7d-bfb0-03e3f6281c58)(content(Whitespace\" \ + \"))))(Tile((id \ + 58c4bb9f-8a30-480e-a52b-38df655f9164)(label(B))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 2748)(content(Whitespace\" \")))))))))(Secondary((id \ - 2755)(content(Whitespace\" \"))))(Tile((id 2759)(label(fun \ + dfad2a33-2a2d-4df9-be18-2fe06e3548bb)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + f9b87bc9-1128-4dec-bf0c-014baff77334)(content(Whitespace\" \ + \"))))(Tile((id \ + 1fde687f-dfdb-4b5a-a8cc-9e81d9e6b522)(label(fun \ ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2760)(content(Whitespace\" \ - \"))))(Tile((id 2762)(label(f))(mold((out \ + 1))(children(((Secondary((id \ + dd314134-b69e-4426-b1a6-999a28f427fd)(content(Whitespace\" \ + \"))))(Tile((id \ + ae115273-4b54-46ce-a192-10047fe9e951)(label(f))(mold((out \ Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ - 2763)(content(Whitespace\" \"))))(Tile((id \ - 2764)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 11))(sort Pat))((shape(Concave 11))(sort \ + 11aa5133-b04f-4100-a2e3-9695c08e4e09)(content(Whitespace\" \ + \"))))(Tile((id \ + 1cb85726-ab00-4149-8246-c9440cde31c3)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 11))(sort \ + Pat))((shape(Concave 11))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2766)(content(Whitespace\" \"))))(Tile((id \ - 2775)(label(\"(\"\")\"))(mold((out \ + de0c889c-43ea-4f05-bf55-abf04c9d0d59)(content(Whitespace\" \ + \"))))(Tile((id \ + 4a5c3924-a66d-4067-8f6b-89ec8d7234ec)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 2776)(label(A))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 2788)(content(Whitespace\" \"))))(Tile((id \ - 2780)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 6))(sort Typ))((shape(Concave 6))(sort \ + f2a159b3-e8b9-40ff-9f79-5ca041c21a77)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 2c18b0d4-9eb0-430d-b72d-6d8c6e21be1e)(content(Whitespace\" \ + \"))))(Tile((id \ + 00a6aaf9-db5a-4aa1-9c65-b0d933a7553f)(label(->))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 6))(sort \ + Typ))((shape(Concave 6))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2782)(content(Whitespace\" \"))))(Tile((id \ - 2783)(label(B))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + ce1cc890-5fe0-4bbc-a55e-ec4d56cc7ef7)(content(Whitespace\" \ + \"))))(Tile((id \ + 2fa7a2b3-bb79-497b-b83f-e203a3d0abe3)(label(B))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ Typ))))))(shards(0))(children()))))))))(Secondary((id \ - 2784)(content(Whitespace\" \")))))))))(Secondary((id \ - 2787)(content(Whitespace\" \"))))(Tile((id 2792)(label(fun \ + ccad4dbb-bd06-4483-9828-276555d352de)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 336ec250-d844-403f-b23f-fa7753dc5068)(content(Whitespace\" \ + \"))))(Tile((id \ + 05929dbf-0f8d-4a96-83d1-3d993326c4e0)(label(fun \ ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2793)(content(Whitespace\" \ - \"))))(Tile((id 2795)(label(l))(mold((out \ + 1))(children(((Secondary((id \ + 8f63a82f-5f21-4948-8824-0346d46d1d46)(content(Whitespace\" \ + \"))))(Tile((id \ + 36ec28dd-5dfb-4745-9297-c026b99a54ed)(label(l))(mold((out \ Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ - 2797)(content(Whitespace\" \"))))(Tile((id \ - 2798)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 11))(sort Pat))((shape(Concave 11))(sort \ + ebeb2e6e-f6f2-4e00-b98a-640b41f05e5c)(content(Whitespace\" \ + \"))))(Tile((id \ + f4ad62e1-8361-4bcd-aaf7-b68fea88eac6)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 11))(sort \ + Pat))((shape(Concave 11))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 2800)(content(Whitespace\" \"))))(Tile((id 2801)(label([ \ + 776f0b9d-1e87-45a8-b2a8-c51a6d7551f4)(content(Whitespace\" \ + \"))))(Tile((id 0f555e5d-4c58-49a6-a83f-a02000e3a9b9)(label([ \ ]))(mold((out Typ)(in_(Typ))(nibs(((shape Convex)(sort \ Typ))((shape Convex)(sort Typ))))))(shards(0 \ - 1))(children(((Tile((id 2802)(label(A))(mold((out \ + 1))(children(((Tile((id \ + 0506c0fd-a136-45a0-9b58-8818281c6192)(label(A))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort \ Typ))))))(shards(0))(children()))))))))(Secondary((id \ - 2803)(content(Whitespace\" \")))))))))(Secondary((id \ - 2807)(content(Whitespace\" \"))))(Secondary((id \ - 4473)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 2826)(label(case end))(mold((out Exp)(in_(Rul))(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2827)(content(Whitespace\" \ - \"))))(Tile((id 2829)(label(l))(mold((out \ + fe663aa2-62a0-481c-8076-902ec6e80465)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + ac80020e-0679-444c-908a-664fd265d287)(content(Whitespace\" \ + \"))))(Secondary((id \ + 0532ce74-b1fd-47cd-afd8-536a76b56eac)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 5cb54d04-1620-4898-b5ee-171a13a55cb2)(label(case \ + end))(mold((out Exp)(in_(Rul))(nibs(((shape Convex)(sort \ + Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id \ + 826841f4-cbf3-4158-a661-b7915909567d)(content(Whitespace\" \ + \"))))(Tile((id \ + f2738d6c-44d1-4477-9320-98664a2abebf)(label(l))(mold((out \ Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0))(children())))(Secondary((id \ - 2838)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 2839)(label(| =>))(mold((out \ + 0f7ec861-3dd7-48c7-bb98-1068d6018711)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 666f3305-9623-472a-a8e5-4a4821bdac0c)(label(| =>))(mold((out \ Rul)(in_(Pat))(nibs(((shape(Concave 19))(sort \ Exp))((shape(Concave 19))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2841)(content(Whitespace\" \ - \"))))(Tile((id 2842)(label(h))(mold((out \ + 1))(children(((Secondary((id \ + d5a09c88-8fb8-4ea9-be8a-852be89e4f6c)(content(Whitespace\" \ + \"))))(Tile((id \ + 1417ddf8-e63c-463e-b541-e36920b01149)(label(h))(mold((out \ Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ - 2843)(content(Whitespace\" \"))))(Tile((id \ - 2846)(label(::))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 6))(sort Pat))((shape(Concave 6))(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 2847)(content(Whitespace\" \"))))(Tile((id \ - 2848)(label(t))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ + d2e0fe19-dd90-445e-bd58-cf97d46d9b9a)(content(Whitespace\" \ + \"))))(Tile((id \ + ff3d12e2-c357-42a7-8f3e-a21c9fb9d451)(label(::))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 6))(sort \ + Pat))((shape(Concave 6))(sort \ Pat))))))(shards(0))(children())))(Secondary((id \ - 2849)(content(Whitespace\" \")))))))))(Secondary((id \ - 2852)(content(Whitespace\" \"))))(Tile((id \ - 2863)(label(f))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 2864)(label(\"(\"\")\"))(mold((out \ + 2a6b7167-756b-4d3d-9f07-98e53f430cca)(content(Whitespace\" \ + \"))))(Tile((id \ + ea24b8b4-1664-4b46-b9ad-c74d7bb8b2c4)(label(t))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + dbf53a0c-d1df-4fcf-b833-2ca674b3118a)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + e5b78a12-bf5c-41b7-a607-81db98a7709c)(content(Whitespace\" \ + \"))))(Tile((id \ + bcb2ac89-9866-44b7-ac86-bfa367efb43e)(label(f))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 274061ca-2c5f-4cff-ab7f-e034d6165d6a)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2866)(label(h))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ + e1822bcd-8a53-428d-9568-08ce796791ba)(label(h))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ Exp))))))(shards(0))(children()))))))))(Secondary((id \ - 2867)(content(Whitespace\" \"))))(Tile((id \ - 2870)(label(::))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 6))(sort Exp))((shape(Concave 6))(sort \ + 8261c12e-167c-4b97-b895-076b16cb8956)(content(Whitespace\" \ + \"))))(Tile((id \ + 134da227-54ae-4138-bfd3-0ffd5bbb35bf)(label(::))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 6))(sort \ + Exp))((shape(Concave 6))(sort \ Exp))))))(shards(0))(children())))(Secondary((id \ - 2871)(content(Whitespace\" \"))))(Tile((id \ - 2874)(label(map))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id 2878)(label(@< \ - >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ - Exp))((shape Convex)(sort Exp))))))(shards(0 \ - 1))(children(((Tile((id 2879)(label(A))(mold((out \ + cde794e2-1514-4ee5-8722-b4d27751fc43)(content(Whitespace\" \ + \"))))(Tile((id \ + 48901d44-b0e6-4948-90d0-99d20334c456)(label(map))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 5f38a51a-94ff-4f13-ba3b-312e507ab73a)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 7539694b-4e31-49a6-a32d-dbdf0a55ef35)(label(A))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ - 2882)(label(@< >))(mold((out \ + 7f4d954d-2861-4c11-bec6-fb759b5a0ffe)(label(@< >))(mold((out \ Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2883)(label(B))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children()))))))))(Tile((id \ - 2884)(label(\"(\"\")\"))(mold((out \ + d67b39fa-c196-4262-9888-426de588572e)(label(B))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ + c51f52dc-b5ca-4bf4-a2ab-ed899b19cd24)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2886)(label(f))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children()))))))))(Tile((id \ - 2887)(label(\"(\"\")\"))(mold((out \ + af6d37cf-fc46-4007-90f3-60bce7e9157d)(label(f))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children()))))))))(Tile((id \ + 3c421466-068a-48d3-8367-5e9ecffdb962)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 2889)(label(t))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ + 33bdc742-e6a9-4f94-86c9-406c3aae5f29)(label(t))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ Exp))))))(shards(0))(children()))))))))(Secondary((id \ - 2890)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 2891)(label(| =>))(mold((out \ + aa7f11a8-0790-4b02-8466-3a3a9aa0c628)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 977253f6-0679-49a0-a5ae-bf8804d4d272)(label(| =>))(mold((out \ Rul)(in_(Pat))(nibs(((shape(Concave 19))(sort \ Exp))((shape(Concave 19))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 2893)(content(Whitespace\" \ - \"))))(Tile((id 2925)(label(_))(mold((out \ + 1))(children(((Secondary((id \ + c4956a98-232b-45c1-8ba7-5730e460512e)(content(Whitespace\" \ + \"))))(Tile((id \ + 4460a1f9-8f3e-4c6e-8ef9-50d18ff587eb)(label(_))(mold((out \ Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ - 2926)(content(Whitespace\" \")))))))))(Secondary((id \ - 2899)(content(Whitespace\" \"))))(Tile((id \ - 3020)(label(emptylist))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id 3023)(label(@< \ - >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ - Exp))((shape Convex)(sort Exp))))))(shards(0 \ - 1))(children(((Tile((id 3024)(label(B))(mold((out \ + 762cb02f-c9a4-4913-91f6-c3e63c1cdf08)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 44404719-7532-4ef8-a4e0-ef40b69eb8ac)(content(Whitespace\" \ + \"))))(Tile((id \ + bbe24e20-53c7-49a7-83e9-65f8ba722e51)(label(emptylist))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 321a3266-20dc-4471-a74f-a95a466e7e31)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 6c978a1d-d8a2-4ca6-8a8f-1d35c5fd21d5)(label(B))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort \ Typ))))))(shards(0))(children()))))))))(Secondary((id \ - 2836)(content(Whitespace\"\\226\\143\\142\")))))))))(Secondary((id \ - 2837)(content(Whitespace\" \")))))))))(Secondary((id \ - 2651)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 4740)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 4741)(content(Whitespace\" \"))))(Tile((id \ - 4746)(label(ex4))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 4748)(content(Whitespace\" \")))))((Secondary((id \ - 4749)(content(Whitespace\" \"))))(Tile((id \ - 4745)(label(map))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id 3033)(label(@< \ - >))(mold((out Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort \ - Exp))((shape Convex)(sort Exp))))))(shards(0 \ - 1))(children(((Tile((id 3037)(label(Int))(mold((out \ + d9bbddf3-7123-496d-ac83-8e7ceef5b6de)(content(Whitespace\" \ + \"))))(Secondary((id \ + 01684518-f444-4731-852b-69ef9a5d9b43)(content(Whitespace\"\\226\\143\\142\")))))))))(Secondary((id \ + 3edb8b70-1ae0-496b-ad02-eb3693fc8f56)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 36c28bc5-a5cf-4acc-985c-2c955c7d820e)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 97de8089-37ac-4509-acc9-39012a0fdf3e)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 80d05981-1920-44d8-b42e-f18175935f70)(content(Whitespace\" \ + \"))))(Tile((id \ + 72ae731d-de2f-4ad8-a2d6-356bceae5577)(label(ex4))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 7028d808-2b29-4ca9-a4d3-1a5dacd93fa0)(content(Whitespace\" \ + \")))))((Secondary((id \ + 77fd1b46-bf93-4844-8f57-b111ba33d8d3)(content(Whitespace\" \ + \"))))(Tile((id \ + d18a0774-cfc4-4907-b460-b469053a3c0c)(label(map))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 504e60fc-928d-4308-96ca-fd31df0da48a)(label(@< >))(mold((out \ + Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 4f0f6316-3dd0-4479-bbd4-762b82b7c37e)(label(Int))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ - 3039)(label(@< >))(mold((out \ + 14993ad8-445e-45b3-b828-e4c0b43c834b)(label(@< >))(mold((out \ Exp)(in_(Typ))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 3046)(label(String))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children()))))))))(Tile((id \ - 3051)(label(\"(\"\")\"))(mold((out \ + e91f5e5f-40db-4039-86de-833746dfac39)(label(String))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children()))))))))(Tile((id \ + ddbda949-29b7-4b34-8f11-05ed3fcd6f01)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 3068)(label(string_of_int))(mold((out \ + 6d6bee77-2fa1-478e-997c-3540a5e97174)(label(string_of_int))(mold((out \ Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0))(children()))))))))(Tile((id \ - 3073)(label(\"(\"\")\"))(mold((out \ + 42c0e873-c3f1-4106-80a6-a2ed60f806f5)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 3080)(label([ ]))(mold((out Exp)(in_(Exp))(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort Exp))))))(shards(0 \ - 1))(children(((Tile((id 3082)(label(1))(mold((out \ + 9cdabbd2-8198-4864-8f41-e855415362ea)(label([ ]))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 6484bcbc-b4cf-4c4c-b20f-7f554010051c)(label(1))(mold((out \ Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ - 3086)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 14))(sort Exp))((shape(Concave 14))(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 3089)(label(2))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ + 85ce0fb1-0fd5-4ec6-bd55-a32bf8920ff2)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 14))(sort \ + Exp))((shape(Concave 14))(sort \ Exp))))))(shards(0))(children())))(Tile((id \ - 3090)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 14))(sort Exp))((shape(Concave 14))(sort \ + fc87be7f-7ae8-495d-9beb-8a214a49f71c)(label(2))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 2dc60eb3-a968-4efd-9f71-36058601c0c7)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 14))(sort \ + Exp))((shape(Concave 14))(sort \ Exp))))))(shards(0))(children())))(Tile((id \ - 3092)(label(3))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ + 8c971b0e-ea6d-41df-b8c2-b5c3c2a4f908)(label(3))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ Exp))))))(shards(0))(children())))))))))))))(Secondary((id \ - 4753)(content(Whitespace\" \")))))))))(Secondary((id \ - 3101)(content(Whitespace\" \"))))(Secondary((id \ - 3125)(content(Comment\"# [\\\"1\\\", \\\"2\\\", \\\"3\\\"] \ + 935f2c82-7dc7-4899-b2aa-d473ad9e1cdc)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 7d0cb752-8863-4cf3-8b39-a859475c9eb5)(content(Whitespace\" \ + \"))))(Secondary((id \ + 1e8050d0-bbc2-467e-a83e-29856cace3c4)(content(Comment\"# \ + [\\\"1\\\", \\\"2\\\", \\\"3\\\"] #\"))))(Secondary((id \ + 8abda13b-ad37-4604-8f9a-d187bfd0c494)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + bf822fc1-bfad-46a5-970d-79a0d86ba99d)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 698e99c5-fbfc-467c-ac98-60fe4bb2ac9e)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 6de45367-5e16-4d4b-861c-e668d080fd94)(content(Comment\"# \ + Recursive types #\"))))(Secondary((id \ + 528d4204-ce5a-4d4d-8a65-499c165a93a6)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 22c11a80-9716-4d85-8478-84acbb2bb3e2)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 7c21acf4-f87c-4f87-96ed-9f3ce7854bee)(content(Comment\"# We \ + can express types that are the least fixed point of \ #\"))))(Secondary((id \ - 3126)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 3128)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 3129)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 3147)(content(Comment\"# Recursive types \ - #\"))))(Secondary((id \ - 3148)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 3149)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 3266)(content(Comment\"# We can express types that are the \ - least fixed point of #\"))))(Secondary((id \ - 3267)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 3319)(content(Comment\"# some type function with the rec \ - keyword. #\"))))(Secondary((id \ - 1472)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 681)(label(type = in))(mold((out Exp)(in_(TPat \ - Typ))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 682)(content(Whitespace\" \"))))(Tile((id \ - 970)(label(MyList))(mold((out TPat)(in_())(nibs(((shape \ - Convex)(sort TPat))((shape Convex)(sort \ + eb66d375-5bc4-4510-9213-406754f1b3ab)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 5bd07da0-2cdc-4bed-b10e-8afdf2d40ed4)(content(Comment\"# some \ + type function with the rec keyword. #\"))))(Secondary((id \ + d563fa59-b243-4ee7-87ef-3393d1850a36)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 0a9260b0-6cb1-4f99-bfa5-07bc929cdbc2)(label(type = \ + in))(mold((out Exp)(in_(TPat Typ))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 7ad3ae39-3be4-4998-86a7-9c94d619ba34)(content(Whitespace\" \ + \"))))(Tile((id \ + 49357b25-92c9-4cd3-b04c-fea7d3c2ee30)(label(MyList))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 975)(content(Whitespace\" \")))))((Secondary((id \ - 3332)(content(Whitespace\" \"))))(Tile((id 891)(label(rec \ - .))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ + b193ab38-767a-485a-9bda-27fe181a70fb)(content(Whitespace\" \ + \")))))((Secondary((id \ + cdadc496-6611-4ffc-b135-643b2b6e58fb)(content(Whitespace\" \ + \"))))(Tile((id \ + d8af8722-cf91-4f15-9c32-2eecdbb5d1dd)(label(rec \ + ->))(mold((out Typ)(in_(TPat))(nibs(((shape Convex)(sort \ Typ))((shape(Concave 13))(sort Typ))))))(shards(0 \ - 1))(children(((Secondary((id 989)(content(Whitespace\" \ - \"))))(Tile((id 4015)(label(A))(mold((out \ + 1))(children(((Secondary((id \ + 16ba3fd3-2845-490b-a056-b8379608f7c8)(content(Whitespace\" \ + \"))))(Tile((id \ + 35911a26-36a2-4755-a0d5-40663bd5e3e3)(label(A))(mold((out \ TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ Convex)(sort \ - TPat))))))(shards(0))(children()))))))))(Secondary((id \ - 4013)(content(Whitespace\" \"))))(Tile((id \ - 1075)(label(\"(\"\")\"))(mold((out \ + TPat))))))(shards(0))(children())))(Secondary((id \ + 32b2fb6f-0a3d-41bf-b4d7-90c0411c4a4f)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + a5c9177a-1a19-4bf5-968b-79dcd8a5f1ae)(content(Whitespace\" \ + \"))))(Tile((id \ + 21645f30-7293-4698-a5ef-c03a43418311)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 894)(label(Nil))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 851)(content(Whitespace\" \"))))(Tile((id \ - 849)(label(+))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 10))(sort Typ))((shape(Concave 10))(sort \ + 2236339d-9e54-45ca-b4f0-a2adcf62fdd4)(label(Nil))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 2eda9a70-f5e3-4430-8ac3-94060fd5b62a)(content(Whitespace\" \ + \"))))(Tile((id \ + 724193cc-c749-44c9-86c9-24c6d5f02b21)(label(+))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 10))(sort \ + Typ))((shape(Concave 10))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 852)(content(Whitespace\" \"))))(Tile((id \ - 856)(label(Cons))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Tile((id \ - 868)(label(\"(\"\")\"))(mold((out \ + 494ef4ee-7336-4d8a-991b-843e8e09e6a4)(content(Whitespace\" \ + \"))))(Tile((id \ + 36cbd19c-bd46-418c-ac05-7ca72e3efc03)(label(Cons))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + 4681bbb3-42ce-46c8-8a22-3259057a14a6)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape(Concave 1))(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 4021)(label(Int))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Tile((id \ - 873)(label(,))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 14))(sort Typ))((shape(Concave 14))(sort \ + 8213139c-073b-46ca-a434-e32ffd0d2388)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + fffa4b09-8032-4007-a8e9-c1b4c9b3e4cf)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 14))(sort \ + Typ))((shape(Concave 14))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 875)(content(Whitespace\" \"))))(Tile((id \ - 4017)(label(A))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + 61db4da2-294b-4285-96e3-718cb15577c8)(content(Whitespace\" \ + \"))))(Tile((id \ + 9692e5ad-a529-43ef-a693-413e0ab21a31)(label(A))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ Typ))))))(shards(0))(children())))))))))))))(Secondary((id \ - 885)(content(Whitespace\" \")))))))))(Secondary((id \ - 3562)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 4217)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 4356)(content(Comment\"# Hazel does not (yet) support \ - higher-kinded or existential types, #\"))))(Secondary((id \ - 4287)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 4357)(content(Comment\"# So we cannot implement our own \ - polymorphic lists. #\"))))(Secondary((id \ - 4218)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 3782)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 3899)(content(Comment\"# Now anything that returns an element \ - of the least fixed point matches MyList. \ + 990cc418-00f2-4c98-9395-ad95bca66884)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 3701484f-c796-4d38-bce7-4f25b4c3637d)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 193cfb02-bcdb-47e2-80c5-4775c7f11a82)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 8c0f2c04-fc2c-4fdf-8f0c-83644d1be509)(content(Comment\"# \ + Hazel does not (yet) support higher-kinded or existential \ + types, #\"))))(Secondary((id \ + 4810f7f2-213a-465d-9b61-81cf18482fa8)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 0eaf40c5-5a8b-4cbb-aa19-18ba099847eb)(content(Comment\"# So \ + we cannot implement our own polymorphic lists. \ #\"))))(Secondary((id \ - 3900)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 3905)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 3906)(content(Whitespace\" \"))))(Tile((id \ - 3907)(label(x))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 3909)(content(Whitespace\" \"))))(Tile((id \ - 3910)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 11))(sort Pat))((shape(Concave 11))(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 3911)(content(Whitespace\" \"))))(Tile((id \ - 3918)(label(MyList))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + 579ceeeb-258a-4089-a115-5627e2eaea58)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 7bfbd599-e516-45a7-a725-cb39be5c8729)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 887616c9-6707-4e70-ab3d-62996ce73e70)(content(Comment\"# Now \ + anything that returns an element of the least fixed point \ + matches MyList. #\"))))(Secondary((id \ + 6f06209e-4913-4da3-ae91-5bd283668594)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 33ed3a5b-0867-43d7-8cc2-2c8ca4c758e7)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 0370f42e-bd6c-490a-bb7d-920d2f8a8aae)(content(Whitespace\" \ + \"))))(Tile((id \ + 5bae080b-2019-4ffd-a2a9-2a972fcda28d)(label(x))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 4079c066-6ef0-4310-83c6-56fe7fd7670e)(content(Whitespace\" \ + \"))))(Tile((id \ + a0c477e1-9ef3-4b38-a67c-d5d22e96471d)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 11))(sort \ + Pat))((shape(Concave 11))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 3979)(content(Whitespace\" \")))))((Secondary((id \ - 3920)(content(Whitespace\" \"))))(Tile((id \ - 3995)(label(Cons))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 3926)(label(\"(\"\")\"))(mold((out \ + 93cd7df1-2b4d-4582-acf7-2cb0d46f6313)(content(Whitespace\" \ + \"))))(Tile((id \ + e62970f7-e979-49fb-bde6-c008d8d79a70)(label(MyList))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 1b69d275-5bd5-489b-a340-7aafdfd14d12)(content(Whitespace\" \ + \")))))((Secondary((id \ + 5c867417-e06d-4873-b84d-041e25dcb2d0)(content(Whitespace\" \ + \"))))(Tile((id \ + 2cf5af86-df22-4aba-a044-17d75a3ae989)(label(Cons))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 7e122a6b-5f64-4a7e-90ae-0878e0d82f03)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 3927)(label(1))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 3929)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 14))(sort Exp))((shape(Concave 14))(sort \ + 1d783d64-398f-4ad6-9eae-b3490775e34c)(label(1))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + df60de96-d925-4ca9-beca-a392fa9d3a33)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 14))(sort \ + Exp))((shape(Concave 14))(sort \ Exp))))))(shards(0))(children())))(Secondary((id \ - 3930)(content(Whitespace\" \"))))(Tile((id \ - 3935)(label(Cons))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 3936)(label(\"(\"\")\"))(mold((out \ + a798be71-5b99-4f2e-a8e2-e923f9609370)(content(Whitespace\" \ + \"))))(Tile((id \ + 8565ea1f-2353-458d-9439-7f379d71cebd)(label(Cons))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 7ece0aa1-030f-42ec-98ef-b2628aac965c)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 3937)(label(2))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 3939)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 14))(sort Exp))((shape(Concave 14))(sort \ + e755b115-0361-453e-b274-9f9cb8a0c262)(label(2))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 4459b0c1-70f4-4101-a896-21725d8c2a4e)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 14))(sort \ + Exp))((shape(Concave 14))(sort \ Exp))))))(shards(0))(children())))(Secondary((id \ - 3940)(content(Whitespace\" \"))))(Tile((id \ - 3945)(label(Cons))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 3946)(label(\"(\"\")\"))(mold((out \ + 9bc6d0d7-59d4-4cff-819a-6fa718e28414)(content(Whitespace\" \ + \"))))(Tile((id \ + 9bcc25fd-a616-49f1-9f53-f12a36e09354)(label(Cons))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + e5ad642e-1071-4a7b-ae6f-d6c8b4b34403)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 3947)(label(3))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Tile((id \ - 3949)(label(,))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 14))(sort Exp))((shape(Concave 14))(sort \ + fcd291b3-e052-402b-be90-a4a138f94cce)(label(3))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + bab8fe07-56b3-4a03-8a70-cad1d19c41ce)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 14))(sort \ + Exp))((shape(Concave 14))(sort \ Exp))))))(shards(0))(children())))(Secondary((id \ - 3950)(content(Whitespace\" \"))))(Tile((id \ - 3954)(label(Nil))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ + 952bc037-e9e7-42a4-9dd8-24f64cbaedd9)(content(Whitespace\" \ + \"))))(Tile((id \ + 63e70629-8a00-4987-adcc-d9b7edb62ecc)(label(Nil))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ Exp))))))(shards(0))(children()))))))))))))))))))(Secondary((id \ - 3957)(content(Whitespace\" \")))))))))(Secondary((id \ - 3783)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 3563)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 4216)(content(Comment\"# Note that if the sum is the top \ - level operator, #\"))))(Secondary((id \ - 3616)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 3701)(content(Comment\"# type aliases are implicitly least \ - fixed points on their own name: #\"))))(Secondary((id \ - 990)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 1002)(label(type = in))(mold((out Exp)(in_(TPat \ - Typ))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 1011)(content(Whitespace\" \"))))(Tile((id \ - 1091)(label(MyList2))(mold((out TPat)(in_())(nibs(((shape \ - Convex)(sort TPat))((shape Convex)(sort \ + 3c1a3bf1-ed31-4739-885e-ad254fc292f2)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + b75b8ab1-8759-45b5-ad5b-ed90197258da)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 935b835c-261d-47fc-bee8-068e25da32a8)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + fb36a038-d3c2-48ec-9310-1ccb658b327a)(content(Comment\"# Note \ + that if the sum is the top level operator, \ + #\"))))(Secondary((id \ + 3c729241-60ac-46a3-86db-92a070ffa4d5)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + f7670b91-4175-4a41-b92a-232fd61e8eec)(content(Comment\"# type \ + aliases are implicitly least fixed points on their own name: \ + #\"))))(Secondary((id \ + ff8533bf-ba1e-4237-8c1c-e3130b234e64)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + e940b831-775d-4d20-8c4e-cf380df7c704)(label(type = \ + in))(mold((out Exp)(in_(TPat Typ))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + fa4039e4-3ac6-4d02-9df8-449e895958cd)(content(Whitespace\" \ + \"))))(Tile((id \ + 05f24c94-0119-4bd5-b234-a1dbdaeab975)(label(MyList2))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 1141)(content(Whitespace\" \")))))((Secondary((id \ - 3513)(content(Whitespace\" \"))))(Tile((id \ - 3507)(label(Nil))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 3378)(content(Whitespace\" \"))))(Tile((id \ - 3379)(label(+))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 10))(sort Typ))((shape(Concave 10))(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 3381)(content(Whitespace\" \"))))(Tile((id \ - 3385)(label(Cons))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Tile((id \ - 3386)(label(\"(\"\")\"))(mold((out \ + a5939fcf-4a82-49d3-a9dc-8d899ad579f6)(content(Whitespace\" \ + \")))))((Secondary((id \ + 4e843e4a-0c21-4bd3-9163-bad05c819bc8)(content(Whitespace\" \ + \"))))(Tile((id \ + 8f4764bd-552d-47b3-a75f-8177eacbfad3)(label(Nil))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 2b1728e8-6ba7-4cbb-9064-aec652c83d87)(content(Whitespace\" \ + \"))))(Tile((id \ + 6585a36d-b5e9-4a63-8d45-bca7e5c38cf0)(label(+))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 10))(sort \ + Typ))((shape(Concave 10))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 77c58ade-ef24-46bd-8fad-1fe0dacbc953)(content(Whitespace\" \ + \"))))(Tile((id \ + a97829e0-ec9c-4941-affb-26a072f73fc5)(label(Cons))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + 12e14808-3cec-40de-88dc-d9d030c3e0a8)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape(Concave 1))(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 3705)(label(Int))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Tile((id \ - 3389)(label(,))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 14))(sort Typ))((shape(Concave 14))(sort \ + b501c4ea-e896-49a6-a03e-e15a8d8e9a51)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + e853b31d-1d90-47b0-a37c-9fbec3a18544)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 14))(sort \ + Typ))((shape(Concave 14))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 3391)(content(Whitespace\" \"))))(Tile((id \ - 3398)(label(MyList2))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + 6fa80101-ad62-45fb-b1a3-ebb1a1cfb16d)(content(Whitespace\" \ + \"))))(Tile((id \ + 22588755-b59d-4f05-9905-b901a1db3f30)(label(MyList2))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ Typ))))))(shards(0))(children()))))))))(Secondary((id \ - 3399)(content(Whitespace\" \")))))))))(Secondary((id \ - 3706)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 3715)(label(type = in))(mold((out Exp)(in_(TPat \ - Typ))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 3716)(content(Whitespace\" \"))))(Tile((id \ - 4079)(label(Broken))(mold((out TPat)(in_())(nibs(((shape \ - Convex)(sort TPat))((shape Convex)(sort \ + c8115f34-99e0-441c-9313-b15a577eb3eb)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 56e8a3e4-e828-44df-a3c8-e7b1f883e6fc)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + ecf2538d-f121-418b-b6ec-ffb5c0a67f70)(label(type = \ + in))(mold((out Exp)(in_(TPat Typ))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + de814c18-7e95-4f76-9ee7-d20266a3d78e)(content(Whitespace\" \ + \"))))(Tile((id \ + cd5bc989-4ae9-48fa-82fb-a5ab4e320674)(label(Broken))(mold((out \ + TPat)(in_())(nibs(((shape Convex)(sort TPat))((shape \ + Convex)(sort \ TPat))))))(shards(0))(children())))(Secondary((id \ - 3730)(content(Whitespace\" \")))))((Secondary((id \ - 3740)(content(Whitespace\" \"))))(Tile((id \ - 4111)(label(Int))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 4122)(content(Whitespace\" \"))))(Tile((id \ - 4121)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 6))(sort Typ))((shape(Concave 6))(sort \ + 8a26bf51-7c01-4f19-b61d-3f6cf0d623e7)(content(Whitespace\" \ + \")))))((Secondary((id \ + c8f6eebf-2e02-444f-b76a-e447af05ce9b)(content(Whitespace\" \ + \"))))(Tile((id \ + 0d01d510-b89e-44f8-b5fa-51b2ae3019d9)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + b7bf4f3b-2c80-48b8-9216-3ced31d7e2e7)(content(Whitespace\" \ + \"))))(Tile((id \ + 8e13455f-e289-48c1-9c66-c1d26e2092c7)(label(->))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 6))(sort \ + Typ))((shape(Concave 6))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 3744)(content(Whitespace\" \"))))(Tile((id \ - 4120)(label(\"(\"\")\"))(mold((out \ + c0577a87-5d87-4f80-861a-c1ef1406b627)(content(Whitespace\" \ + \"))))(Tile((id \ + af30d9ee-ba31-4634-aee7-8671323584d8)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 4134)(label(HasInt))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Tile((id \ - 4135)(label(\"(\"\")\"))(mold((out \ + 8026c0f4-2334-4d9e-beec-c84c887da32c)(label(HasInt))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + e6c62de9-7dbe-4551-b683-eafeb333cbf1)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape(Concave 1))(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 4138)(label(Int))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + 7cfa00aa-8ac0-428c-a4d8-3e1522f514d3)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ Typ))))))(shards(0))(children()))))))))(Secondary((id \ - 4062)(content(Whitespace\" \"))))(Tile((id \ - 4063)(label(+))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 10))(sort Typ))((shape(Concave 10))(sort \ + 1843b6d8-6591-45a8-b6d1-735229c0966a)(content(Whitespace\" \ + \"))))(Tile((id \ + ac02cd59-e2b2-4ddb-b3ed-34f055d805c6)(label(+))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 10))(sort \ + Typ))((shape(Concave 10))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 4065)(content(Whitespace\" \"))))(Tile((id \ - 4149)(label(HasMore))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Tile((id \ - 4098)(label(\"(\"\")\"))(mold((out \ + cac41e52-5cc4-46f3-bb90-a3abaaeee9ca)(content(Whitespace\" \ + \"))))(Tile((id \ + 389c16e0-7203-4142-9eca-b4246ce61c4c)(label(HasMore))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + 6624e15f-6510-40e3-b646-de90440393f8)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape(Concave 1))(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 4154)(label(Int))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Tile((id \ - 4155)(label(,))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 14))(sort Typ))((shape(Concave 14))(sort \ + e1076ac2-2a95-4a69-a62c-261ab97d6dde)(label(Int))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Tile((id \ + 1ba0a1ea-2382-4a3c-95d2-bca9f7ba6d79)(label(,))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 14))(sort \ + Typ))((shape(Concave 14))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 4156)(content(Whitespace\" \"))))(Tile((id \ - 4153)(label(Broken))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + 57b01c61-7ac0-4dfc-9ed4-6f5a6d38e57d)(content(Whitespace\" \ + \"))))(Tile((id \ + 45ddb6b3-449e-49f9-9ac7-0a65fe083166)(label(Broken))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort \ Typ))))))(shards(0))(children())))))))))))))(Secondary((id \ - 4106)(content(Whitespace\" \")))))))))(Secondary((id \ - 3779)(content(Whitespace\" \"))))(Secondary((id \ - 3780)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 3781)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 907)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 4566)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 4567)(content(Whitespace\" \"))))(Tile((id \ - 4585)(label(list_of_mylist))(mold((out \ - Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ - Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ - 921)(content(Whitespace\" \"))))(Tile((id \ - 4410)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 11))(sort Pat))((shape(Concave 11))(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 4412)(content(Whitespace\" \"))))(Tile((id \ - 4435)(label(\"(\"\")\"))(mold((out \ + 7849f81d-3ffc-45fb-8c6f-deca793f4340)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + e520d9d4-efc0-4050-9d28-9408015601f0)(content(Whitespace\" \ + \"))))(Secondary((id \ + 9d15c792-44f0-4b64-96b4-c01553f092ac)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + b5ac9def-818d-4cc9-a69e-b6c48bb3cf4a)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 16e84b97-6c21-457e-a9db-be37201ee08c)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + dcec6c2e-de60-4b66-a700-5ebe7a65b3cc)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 805fb44d-81bc-4f8e-b6d6-7fecccd366d6)(content(Whitespace\" \ + \"))))(Tile((id \ + 1b33ea74-291d-4177-a4cc-32150cc262c6)(label(list_of_mylist))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + fa5b0bfb-d0db-47f1-9248-36b4ca53105a)(content(Whitespace\" \ + \"))))(Tile((id \ + 0329d949-b67e-4f75-84c5-dac81ce19f53)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 11))(sort \ + Pat))((shape(Concave 11))(sort \ + Typ))))))(shards(0))(children())))(Secondary((id \ + 6fafb86c-61e0-4497-9b66-088252c58d00)(content(Whitespace\" \ + \"))))(Tile((id \ + eaf6d9b9-9e6f-4399-b3e5-208475e22a8a)(label(\"(\"\")\"))(mold((out \ Typ)(in_(Typ))(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort Typ))))))(shards(0 1))(children(((Tile((id \ - 4418)(label(MyList))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 4448)(content(Whitespace\" \"))))(Tile((id \ - 4439)(label(->))(mold((out Typ)(in_())(nibs(((shape(Concave \ - 6))(sort Typ))((shape(Concave 6))(sort \ + 0cc9f249-f565-4923-936a-423a5c420bba)(label(MyList))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 909fa81c-98c3-4b79-8995-efb831fb05a8)(content(Whitespace\" \ + \"))))(Tile((id \ + 9e28a68b-7554-4af2-a9be-942c1110024e)(label(->))(mold((out \ + Typ)(in_())(nibs(((shape(Concave 6))(sort \ + Typ))((shape(Concave 6))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 4441)(content(Whitespace\" \"))))(Tile((id 4603)(label([ \ + fb0b7814-07ee-4953-95d4-f30c5d1a28df)(content(Whitespace\" \ + \"))))(Tile((id 1d502020-0204-4ae8-8192-d1967f0631c0)(label([ \ ]))(mold((out Typ)(in_(Typ))(nibs(((shape Convex)(sort \ Typ))((shape Convex)(sort Typ))))))(shards(0 \ - 1))(children(((Tile((id 4444)(label(Int))(mold((out \ + 1))(children(((Tile((id \ + 11378050-b326-435e-8af8-6f42f2e49778)(label(Int))(mold((out \ Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ Convex)(sort \ Typ))))))(shards(0))(children())))))))))))))(Secondary((id \ - 4604)(content(Whitespace\" \")))))((Secondary((id \ - 4449)(content(Whitespace\" \"))))(Tile((id 4453)(label(fun \ + 1bf827f8-b572-4b9c-b34a-e1f5b0f0da30)(content(Whitespace\" \ + \")))))((Secondary((id \ + 66da49bf-a4d2-4e29-b778-b452a83e05e9)(content(Whitespace\" \ + \"))))(Tile((id \ + dce1d474-d747-4379-8ac6-f763c0983a91)(label(fun \ ->))(mold((out Exp)(in_(Pat))(nibs(((shape Convex)(sort \ Exp))((shape(Concave 13))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 4454)(content(Whitespace\" \ - \"))))(Tile((id 4458)(label(myl))(mold((out \ + 1))(children(((Secondary((id \ + 197cb6d3-e061-47d2-a835-ddb8f7a2d20e)(content(Whitespace\" \ + \"))))(Tile((id \ + acca15d8-ce9c-4705-9b01-752506a181a1)(label(myl))(mold((out \ Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ - 4459)(content(Whitespace\" \"))))(Tile((id \ - 4460)(label(:))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 11))(sort Pat))((shape(Concave 11))(sort \ - Typ))))))(shards(0))(children())))(Secondary((id \ - 4462)(content(Whitespace\" \"))))(Tile((id \ - 4468)(label(MyList))(mold((out Typ)(in_())(nibs(((shape \ - Convex)(sort Typ))((shape Convex)(sort \ + c284858d-33ee-41e8-bb6b-e7a3785347d5)(content(Whitespace\" \ + \"))))(Tile((id \ + b6b34912-9e5d-46db-8e71-da92a30d8530)(label(:))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 11))(sort \ + Pat))((shape(Concave 11))(sort \ Typ))))))(shards(0))(children())))(Secondary((id \ - 4469)(content(Whitespace\" \")))))))))(Secondary((id \ - 4472)(content(Whitespace\" \"))))(Secondary((id \ - 4479)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 4484)(label(case end))(mold((out Exp)(in_(Rul))(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 4485)(content(Whitespace\" \ - \"))))(Tile((id 4489)(label(myl))(mold((out \ + b6c140b8-77c7-4678-8600-86bf855f47dc)(content(Whitespace\" \ + \"))))(Tile((id \ + 335ac528-48d9-4e90-8d14-daf02bc2e744)(label(MyList))(mold((out \ + Typ)(in_())(nibs(((shape Convex)(sort Typ))((shape \ + Convex)(sort Typ))))))(shards(0))(children())))(Secondary((id \ + 9b635b29-dd86-41a5-afe5-98e20f056263)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 3da32ede-874a-49f7-992d-94a620f990e3)(content(Whitespace\" \ + \"))))(Secondary((id \ + 3ceacb87-72e8-4cef-8154-190452625783)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 56e4366c-41dc-4518-bfad-e088baae8ae1)(label(case \ + end))(mold((out Exp)(in_(Rul))(nibs(((shape Convex)(sort \ + Exp))((shape Convex)(sort Exp))))))(shards(0 \ + 1))(children(((Secondary((id \ + a35555f6-5351-4d16-a0bd-d1e18d7801ce)(content(Whitespace\" \ + \"))))(Tile((id \ + b17c5c27-7cbe-454e-b611-0d90f795189b)(label(myl))(mold((out \ Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0))(children())))(Secondary((id \ - 4490)(content(Whitespace\" \"))))(Secondary((id \ - 4491)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 4492)(label(| =>))(mold((out \ + afdb8805-7c66-4af2-873e-24813d6529ce)(content(Whitespace\" \ + \"))))(Secondary((id \ + 28d13098-67c5-4ed6-9526-099cd842b85c)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 07d15b6d-f0f4-4670-820a-0fbd56a208c7)(label(| =>))(mold((out \ Rul)(in_(Pat))(nibs(((shape(Concave 19))(sort \ Exp))((shape(Concave 19))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 4494)(content(Whitespace\" \ - \"))))(Tile((id 4497)(label(Nil))(mold((out \ + 1))(children(((Secondary((id \ + 94141f1d-753d-4ab9-a519-f781bdda56dd)(content(Whitespace\" \ + \"))))(Tile((id \ + e4a58087-c41a-4a12-a8da-c45bd917c0a1)(label(Nil))(mold((out \ Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ - 4498)(content(Whitespace\" \")))))))))(Secondary((id \ - 4506)(content(Whitespace\" \"))))(Tile((id \ - 4508)(label([]))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Secondary((id \ - 4509)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 4510)(label(| =>))(mold((out \ + 00902ec1-0666-4bb6-858b-db5295b6271e)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 4ab05820-b00e-422a-a998-5f14b49a46a9)(content(Whitespace\" \ + \"))))(Tile((id \ + b88b20fc-86fb-48e2-badf-06f6c0ad4a87)(label([]))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Secondary((id \ + b55be10d-dbce-43f5-a69b-64450d2f0eae)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + ca06d3d8-49e0-45ae-9fa3-c369c7d63deb)(label(| =>))(mold((out \ Rul)(in_(Pat))(nibs(((shape(Concave 19))(sort \ Exp))((shape(Concave 19))(sort Exp))))))(shards(0 \ - 1))(children(((Secondary((id 4512)(content(Whitespace\" \ - \"))))(Tile((id 4516)(label(Cons))(mold((out \ + 1))(children(((Secondary((id \ + ebc90337-9c9a-48f3-982e-78dd373c2af4)(content(Whitespace\" \ + \"))))(Tile((id \ + c94a1c23-2922-4b09-8c90-ab1859a2f652)(label(Cons))(mold((out \ Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ - 4517)(label(\"(\"\")\"))(mold((out \ + 280a5024-fe68-4508-919b-bc6072aa320c)(label(\"(\"\")\"))(mold((out \ Pat)(in_(Pat))(nibs(((shape(Concave 1))(sort Pat))((shape \ Convex)(sort Pat))))))(shards(0 1))(children(((Tile((id \ - 4519)(label(h))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Tile((id \ - 4520)(label(,))(mold((out Pat)(in_())(nibs(((shape(Concave \ - 14))(sort Pat))((shape(Concave 14))(sort \ + e1241ab0-e63e-46c0-bcb1-d5cf501c7d68)(label(h))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Tile((id \ + 7076e557-cff2-4587-99d8-7323b637eaa5)(label(,))(mold((out \ + Pat)(in_())(nibs(((shape(Concave 14))(sort \ + Pat))((shape(Concave 14))(sort \ Pat))))))(shards(0))(children())))(Secondary((id \ - 4522)(content(Whitespace\" \"))))(Tile((id \ - 4525)(label(t))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ + b15f353d-22a1-4f82-962b-21eeb1709a3b)(content(Whitespace\" \ + \"))))(Tile((id \ + 29908b41-4852-4fed-a2be-a8201b46b324)(label(t))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort \ Pat))))))(shards(0))(children()))))))))(Secondary((id \ - 4526)(content(Whitespace\" \")))))))))(Secondary((id \ - 4529)(content(Whitespace\" \"))))(Tile((id \ - 4530)(label(h))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ - Exp))))))(shards(0))(children())))(Secondary((id \ - 4531)(content(Whitespace\" \"))))(Tile((id \ - 4534)(label(::))(mold((out Exp)(in_())(nibs(((shape(Concave \ - 6))(sort Exp))((shape(Concave 6))(sort \ + 282a4121-76db-46b2-92f2-c0b3bea39dab)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + d2bace67-f8aa-4fb7-b767-ff056b2db439)(content(Whitespace\" \ + \"))))(Tile((id \ + 52d40c83-e37a-4e99-a9f9-cce2a9bee532)(label(h))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Secondary((id \ + 726272aa-84f1-4832-bce7-abf746dd38ac)(content(Whitespace\" \ + \"))))(Tile((id \ + cdc66ee5-157b-46bd-bd7b-1f5adf1eaf00)(label(::))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 6))(sort \ + Exp))((shape(Concave 6))(sort \ Exp))))))(shards(0))(children())))(Secondary((id \ - 4535)(content(Whitespace\" \"))))(Tile((id \ - 4549)(label(list_of_mylist))(mold((out \ + 6a2d26fd-953a-4bd7-96af-01a5e67c5164)(content(Whitespace\" \ + \"))))(Tile((id \ + 3d383ccc-98af-43c0-811c-71cf543f3560)(label(list_of_mylist))(mold((out \ Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ - 4550)(label(\"(\"\")\"))(mold((out \ + 34f0131a-6046-42b7-acc3-0e9b115598e9)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 4552)(label(t))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ + 7644fb73-3d7b-4647-89a1-17ac8db02acf)(label(t))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ Exp))))))(shards(0))(children()))))))))(Secondary((id \ - 4560)(content(Whitespace\" \"))))(Secondary((id \ - 4554)(content(Whitespace\"\\226\\143\\142\")))))))))(Secondary((id \ - 4601)(content(Whitespace\" \")))))))))(Secondary((id \ - 4606)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ - 4759)(label(let = in))(mold((out Exp)(in_(Pat \ - Exp))(nibs(((shape Convex)(sort Exp))((shape(Concave \ - 16))(sort Exp))))))(shards(0 1 2))(children(((Secondary((id \ - 4760)(content(Whitespace\" \"))))(Tile((id \ - 4765)(label(ex5))(mold((out Pat)(in_())(nibs(((shape \ - Convex)(sort Pat))((shape Convex)(sort \ - Pat))))))(shards(0))(children())))(Secondary((id \ - 4767)(content(Whitespace\" \")))))((Secondary((id \ - 4768)(content(Whitespace\" \"))))(Tile((id \ - 4764)(label(list_of_mylist))(mold((out \ + 4c34a3ca-0ad2-4452-8353-edc564632dd3)(content(Whitespace\" \ + \"))))(Secondary((id \ + b46b62aa-f261-440b-a185-d0d676172b7e)(content(Whitespace\" \ + \"))))(Secondary((id \ + a48cde36-a585-4160-9422-90e3f070e845)(content(Whitespace\"\\226\\143\\142\")))))))))(Secondary((id \ + cd5ed745-ec98-409e-ac1f-234b381dce78)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 6dece3b9-a529-490e-91f2-12e76091b87f)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 287d9620-78ca-4128-9b32-8f9cb6b58760)(label(let = \ + in))(mold((out Exp)(in_(Pat Exp))(nibs(((shape Convex)(sort \ + Exp))((shape(Concave 16))(sort Exp))))))(shards(0 1 \ + 2))(children(((Secondary((id \ + 80255e8c-d69c-49e8-a4da-becb2c97c9a6)(content(Whitespace\" \ + \"))))(Tile((id \ + 5e33ed39-557f-4503-a948-ffc0a793cd4d)(label(ex5))(mold((out \ + Pat)(in_())(nibs(((shape Convex)(sort Pat))((shape \ + Convex)(sort Pat))))))(shards(0))(children())))(Secondary((id \ + 9fbd2e14-8f09-4035-8020-e8f44fba8526)(content(Whitespace\" \ + \")))))((Secondary((id \ + f767e5a7-54ab-44d3-a224-fffdadf9da4a)(content(Whitespace\" \ + \"))))(Tile((id \ + ad84dbab-bb06-43c8-8920-1b9e5e8c9cd8)(label(list_of_mylist))(mold((out \ Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ - 4621)(label(\"(\"\")\"))(mold((out \ + cefbaa1c-b1dc-4728-a64d-1663b18eec41)(label(\"(\"\")\"))(mold((out \ Exp)(in_(Exp))(nibs(((shape(Concave 1))(sort Exp))((shape \ Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ - 4623)(label(x))(mold((out Exp)(in_())(nibs(((shape \ - Convex)(sort Exp))((shape Convex)(sort \ + 8dd0ee06-28a5-424b-93b3-2c269447b2fa)(label(x))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ Exp))))))(shards(0))(children()))))))))(Secondary((id \ - 4771)(content(Whitespace\" \")))))))))(Secondary((id \ - 4773)(content(Whitespace\" \"))))(Secondary((id \ - 4640)(content(Comment\"# [1, 2, 3] #\"))))(Secondary((id \ - 4643)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 4644)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 4645)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ - 4673)(content(Comment\"# All output from examples: \ - #\"))))(Secondary((id \ - 4674)(content(Whitespace\"\\226\\143\\142\")))))()))))))(caret \ + c24e59ed-e80f-4816-afcc-d222b126c80a)(content(Whitespace\" \ + \")))))))))(Secondary((id \ + 140a3fe3-246f-4a21-bf2d-aac3c7ea1eab)(content(Whitespace\" \ + \"))))(Secondary((id \ + d006bb40-713e-4973-9d8b-34ff0316612c)(content(Comment\"# [1, \ + 2, 3] #\"))))(Secondary((id \ + 2fff78bc-2182-4db7-bfa8-33fe02a69a5b)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 1096a58b-888f-47e9-9318-313d0f728a9c)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + 26bec031-02af-4b4d-967f-a3b8fa91866b)(content(Whitespace\"\\226\\143\\142\"))))(Secondary((id \ + ec44021a-5905-4176-8a43-e4b18ecee191)(content(Comment\"# All \ + output from examples: #\"))))(Secondary((id \ + a54fbe78-5b70-4bff-a1b0-f75d699e2d17)(content(Whitespace\"\\226\\143\\142\"))))(Tile((id \ + 7f3190eb-b200-4e27-b89e-64483682f7cb)(label(\"(\"\")\"))(mold((out \ + Exp)(in_(Exp))(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0 1))(children(((Tile((id \ + 8a74a004-7d34-4e27-8fa7-bc1464a894d7)(label(ex1))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 4ecc4b06-6a0d-449d-a7a9-507babe76cf8)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 14))(sort \ + Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + a14aabb1-2f9e-405f-a6b1-49e947e6f8f0)(content(Whitespace\" \ + \"))))(Tile((id \ + bb8c31bc-af07-43ea-aa54-cebe3b7fe4c7)(label(ex2))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + e365c1ab-868b-419e-96e8-c11185577df8)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 14))(sort \ + Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + adc45428-7b5c-4e79-9f5d-a70170063fc5)(content(Whitespace\" \ + \"))))(Tile((id \ + f25fdd38-87ca-44b2-bd55-3b1c13e31c51)(label(ex3))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 848d336b-5c6a-4c2f-848d-474fdb03b8d7)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 14))(sort \ + Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + 6dfa74ec-c592-42a4-a583-96e241120cef)(content(Whitespace\" \ + \"))))(Tile((id \ + 521e9214-e5ca-4c1d-995c-1d0b12a4aa20)(label(ex4))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort Exp))))))(shards(0))(children())))(Tile((id \ + 4a995d1a-3021-45dd-a4d7-13cff4af4385)(label(,))(mold((out \ + Exp)(in_())(nibs(((shape(Concave 14))(sort \ + Exp))((shape(Concave 14))(sort \ + Exp))))))(shards(0))(children())))(Secondary((id \ + f335f93b-9ff4-47f8-8043-301b1f88d1f7)(content(Whitespace\" \ + \"))))(Tile((id \ + 6d11e3ff-91bd-4a63-8233-0f2ff4c37428)(label(ex5))(mold((out \ + Exp)(in_())(nibs(((shape Convex)(sort Exp))((shape \ + Convex)(sort \ + Exp))))))(shards(0))(children())))))))))()))(ancestors())))(caret \ Outer))"; backup_text = "# Polymorphism #\n\n\ @@ -15102,7 +15502,7 @@ let startup : PersistentData.t = typfun A -> typfun B -> fun f : (A -> B) -> fun l : [A] -> \n\ case l\n\ | h :: t => f(h) :: map@@(f)(t)\n\ - | _ => emptylist@\n\ + | _ => emptylist@ \n\ end in\n\ let ex4 = map@@(string_of_int)([1,2,3]) in # \ [\"1\", \"2\", \"3\"] #\n\n\n\ @@ -15125,7 +15525,7 @@ let startup : PersistentData.t = let list_of_mylist : (MyList -> [Int]) = fun myl : MyList -> \n\ case myl \n\ | Nil => []\n\ - | Cons(h, t) => h :: list_of_mylist(t) \n\ + | Cons(h, t) => h :: list_of_mylist(t) \n\ end in\n\ let ex5 = list_of_mylist(x) in # [1, 2, 3] #\n\n\n\ # All output from examples: #\n\ From 233f55ae853f7623ce10575838a47dc8fe92a816 Mon Sep 17 00:00:00 2001 From: Zhen Xu Date: Thu, 7 Mar 2024 15:11:52 -0500 Subject: [PATCH 56/56] Fix and merge ploy-adt-after2 --- src/haz3lcore/dynamics/Transition.re | 3 +++ src/haz3lcore/lang/Form.re | 8 ++++---- src/haz3lcore/statics/MakeTerm.re | 3 ++- src/haz3lcore/statics/TypBase.re | 4 +++- 4 files changed, 12 insertions(+), 6 deletions(-) diff --git a/src/haz3lcore/dynamics/Transition.re b/src/haz3lcore/dynamics/Transition.re index 46b35fa6e1..b615344d6c 100644 --- a/src/haz3lcore/dynamics/Transition.re +++ b/src/haz3lcore/dynamics/Transition.re @@ -279,6 +279,9 @@ module Transition = (EV: EV_MODE) => { /* Treat a hole or invalid tyvar name as a unique type variable that doesn't appear anywhere else. Thus instantiating it at anything doesn't produce any substitutions. */ Step({apply: () => tfbody, kind: TypFunAp, value: false}) } + | Constructor(name) => + /* Rule ITTCon */ + Step({apply: () => Constructor(name), kind: TypFunAp, value: false}) | Cast(d'', Forall(x, t), Forall(x', t')) => /* Rule ITTApCast */ Step({ diff --git a/src/haz3lcore/lang/Form.re b/src/haz3lcore/lang/Form.re index 5a93de22ba..88ac697305 100644 --- a/src/haz3lcore/lang/Form.re +++ b/src/haz3lcore/lang/Form.re @@ -217,10 +217,10 @@ let bad_token_cls: string => bad_token_cls = Order in this list determines relative remolding priority for forms with overlapping regexps */ let atomic_forms: list((string, (string => bool, list(Mold.t)))) = [ - //("ty_var", (is_typ_var, [mk_op(Typ, [])])), - //("ty_var_p", (is_typ_var, [mk_op(TPat, [])])), - //("ctr", (is_ctr, [mk_op(Exp, []), mk_op(Pat, [])])), - //("type", (is_base_typ, [mk_op(Typ, [])])), + ("ty_var", (is_typ_var, [mk_op(Typ, [])])), + ("ty_var_p", (is_typ_var, [mk_op(TPat, [])])), + ("ctr", (is_ctr, [mk_op(Exp, []), mk_op(Pat, [])])), + ("type", (is_base_typ, [mk_op(Typ, [])])), ("var", (is_var, [mk_op(Exp, []), mk_op(Pat, [])])), ( "explicit_hole", diff --git a/src/haz3lcore/statics/MakeTerm.re b/src/haz3lcore/statics/MakeTerm.re index 5ba15a19ff..bdcdcc55b8 100644 --- a/src/haz3lcore/statics/MakeTerm.re +++ b/src/haz3lcore/statics/MakeTerm.re @@ -408,6 +408,7 @@ and tpat = unsorted => { return(ty => TPat(ty), ids, {ids, term}); } and tpat_term = (unsorted: unsorted): UTPat.term => { + Printf.printf("tpat_term: %s\n", show_unsorted(unsorted)); let ret = (term: UTPat.term) => term; let hole = unsorted => Term.UTPat.hole(kids_of_unsorted(unsorted)); switch (unsorted) { @@ -431,7 +432,7 @@ and tpat_term = (unsorted: unsorted): UTPat.term => { switch (tile) { | (["(", ")"], [TPat(arg)]) => switch (arg.term) { - | Invalid(s) when Form.is_type_input(s) => + | Var(s) when Form.is_type_input(s) => Ap(l, {ids: arg.ids, term: Var(s)}) | _ => ret(hole(tm)) } diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 6f4154201d..a31204e65c 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -366,7 +366,9 @@ module rec Typ: { | (ty2, Ap(Var(name), ty)) | (Ap(Var(name), ty), ty2) => switch (Ctx.lookup_higher_kind(ctx, name)) { - | Some((arg, ty_out)) => join'(subst(ty, arg, ty_out), ty2) + | Some((arg, ty_out)) => + Printf.printf("ty2: %s\n", show(ty2)); + join'(subst(ty, arg, ty_out), ty2); | _ => None } | (ty, Ap(Forall(name, t1), t2))