From cd7e8030c040766d3f58aa011d7c897ba866c37e Mon Sep 17 00:00:00 2001 From: Ben Lerner Date: Thu, 28 Jun 2018 20:54:26 -0400 Subject: [PATCH 1/4] New algorithm to merge methods that are uniform but individual across all variants of a data definition, into a single shared method using a cases -- and then replacing all references to `self.foo` with the variables from the cases --- src/arr/compiler/anf.arr | 4 +- src/arr/compiler/ast-util.arr | 10 +- src/arr/compiler/compile-lib.arr | 6 +- src/arr/compiler/desugar-post-tc.arr | 176 ++++++++++++++++++++++++++- src/arr/compiler/desugar.arr | 4 +- src/arr/compiler/resolve-scope.arr | 20 +-- src/arr/compiler/type-check.arr | 16 +-- src/arr/compiler/well-formed.arr | 4 +- src/arr/trove/ast.arr | 22 ++-- 9 files changed, 224 insertions(+), 38 deletions(-) diff --git a/src/arr/compiler/anf.arr b/src/arr/compiler/anf.arr index 96c3e70878..cddb9840db 100644 --- a/src/arr/compiler/anf.arr +++ b/src/arr/compiler/anf.arr @@ -222,7 +222,7 @@ fun anf(e :: A.Expr, k :: ANFCont) -> N.AExpr: end anf(A.s-let-expr(l, let-binds, A.s-block(l, assigns + [list: body]), true), k) - | s-data-expr(l, data-name, data-name-t, params, mixins, variants, shared, _check-loc, _check) => + | s-data-expr(l, data-name, data-name-type, data-name-ann, params, mixins, variants, shared, _check-loc, _check) => fun anf-member(member :: A.VariantMember): cases(A.VariantMember) member: | s-variant-member(l2, typ, b) => @@ -271,7 +271,7 @@ fun anf(e :: A.Expr, k :: ANFCont) -> N.AExpr: N.a-field(f.l, f.name, t) end anf-variants(variants, lam(new-variants): - k(N.a-data-expr(l, data-name, data-name-t, new-variants, new-shared)) + k(N.a-data-expr(l, data-name, data-name-type, new-variants, new-shared)) end) end) diff --git a/src/arr/compiler/ast-util.arr b/src/arr/compiler/ast-util.arr index 310bd2d5e7..1d0b1d1c70 100644 --- a/src/arr/compiler/ast-util.arr +++ b/src/arr/compiler/ast-util.arr @@ -246,12 +246,12 @@ fun default-env-map-visitor( method s-singleton-cases-branch(self, l, pat-loc, name, body): A.s-singleton-cases-branch(l, pat-loc, name, body.visit(self)) end, - method s-data-expr(self, l, name, namet, params, mixins, variants, shared-members, _check-loc, _check): + method s-data-expr(self, l, name, name-type, name-ann, params, mixins, variants, shared-members, _check-loc, _check): new-type-env = for lists.fold(acc from self.type-env, param from params): bind-handlers.s-param-bind(l, param, acc) end with-params = self.{type-env: new-type-env} - A.s-data-expr(l, name, namet.visit(with-params), params, + A.s-data-expr(l, name, name-type.visit(with-params), name-ann.visit(with-params), params, mixins.map(_.visit(with-params)), variants.map(_.visit(with-params)), shared-members.map(_.visit(with-params)), _check-loc, with-params.option(_check)) end, @@ -366,12 +366,12 @@ fun default-env-iter-visitor( and body.visit(self.{env: args-env}) end, # s-singleton-cases-branch introduces no new bindings, so default visitor is fine - method s-data-expr(self, l, name, namet, params, mixins, variants, shared-members, _check-loc, _check): + method s-data-expr(self, l, name, name-type, name-ann, params, mixins, variants, shared-members, _check-loc, _check): new-type-env = for lists.fold(acc from self.type-env, param from params): bind-handlers.s-param-bind(l, param, acc) end with-params = self.{type-env: new-type-env} - namet.visit(with-params) + name-type.visit(with-params) and name-ann.visit(with-params) and lists.all(_.visit(with-params), mixins) and lists.all(_.visit(with-params), variants) and lists.all(_.visit(with-params), shared-members) @@ -1078,7 +1078,7 @@ fun get-named-provides(resolved :: CS.NameResolution, uri :: URI, compile-env :: end fun data-expr-to-datatype(exp :: A.Expr % (is-s-data-expr)) -> T.DataType: cases(A.Expr) exp: - | s-data-expr(l, name, _, params, _, variants, shared-members, _, _) => + | s-data-expr(l, name, _, _, params, _, variants, shared-members, _, _) => tvars = for map(tvar from params): T.t-var(tvar, l, false) diff --git a/src/arr/compiler/compile-lib.arr b/src/arr/compiler/compile-lib.arr index 602a3cc1d2..39a9a2823b 100644 --- a/src/arr/compiler/compile-lib.arr +++ b/src/arr/compiler/compile-lib.arr @@ -430,8 +430,12 @@ fun compile-module(locator :: Locator, provide-map :: SD.StringDict | ok(_) => var tc-ast = type-checked.code type-checked := nothing - var dp-ast = DP.desugar-post-tc(tc-ast, env) + var merged = DP.merge-methods(tc-ast) tc-ast := nothing + add-phase("Merged methods", merged.ast) + var dp-ast = DP.desugar-post-tc(merged.ast, env) + named-result.bindings.merge-now(merged.new-binds) + merged := nothing var cleaned = dp-ast dp-ast := nothing cleaned := cleaned.visit(AU.letrec-visitor) diff --git a/src/arr/compiler/desugar-post-tc.arr b/src/arr/compiler/desugar-post-tc.arr index a39f2da880..d370de30b4 100644 --- a/src/arr/compiler/desugar-post-tc.arr +++ b/src/arr/compiler/desugar-post-tc.arr @@ -3,11 +3,15 @@ provide * provide-types * import ast as A +import string-dict as SD +import file("list-aux.arr") as LA import file("desugar.arr") as D import file("compile-structs.arr") as C -mk-id = D.mk-id +names = A.global-names + no-branches-exn = D.no-branches-exn +is-s-method = A.is-s-method fun no-cases-exn(l, val): A.s-prim-app(l, "throwNoCasesMatched", [list: A.s-srcloc(l, l), val]) @@ -37,6 +41,176 @@ desugar-visitor = A.default-map-visitor.{ end } +fun no-method-exn(l, obj, name): + A.s-prim-app(l, "throwFieldNotFound", [list: A.s-srcloc(l, l), obj, name]) +end + +var generated-binds = SD.make-mutable-string-dict() +fun merge-methods(program :: A.Program): + doc: ``` + Tries to merge methods on data definitions where possible + Preconditions on program: + - well-formed + - has been type-checked + - contains no s-data + Requirements: + - all variants have method of the same name + - ... with the same arity, + - ... and same argument annotations + ``` + cases(A.Program) program block: + | s-program(l, _provide, provided-types, imports, body) => + generated-binds := SD.make-mutable-string-dict() + { ast: A.s-program(l, _provide, provided-types, imports, + if false: body + else: + body.visit(A.default-map-visitor.{ + method s-data-expr(self, shadow l, name, name-type, name-ann, params, mixins, variants, shared, _check-loc, _check): + merge-data-methods(l, name, name-type, name-ann, params, mixins, variants, shared, _check-loc, _check) + end + }) + end), + new-binds: generated-binds } + | else => raise("Attempt to desugar non-program: " + torepr(program)) + end +end +fun same-ann(a1 :: A.Ann, a2 :: A.Ann) -> Boolean: + a1.visit(A.dummy-loc-visitor) == a2.visit(A.dummy-loc-visitor) +end +fun same-sig(s1 :: A.Expr%(is-s-method), s2 :: A.Expr%(is-s-method)): + (s1.params.length() == s2.params.length()) + and for LA.all2-strict(a1 from s1.args, a2 from s2.args): + same-ann(a1.ann, a2.ann) + end + and same-ann(s1.ann, s2.ann) +end +fun mk-id-ann(loc, base, ann) block: + a = names.make-atom(base) + generated-binds.set-now(a.key(), C.value-bind(C.bo-local(loc), C.vb-let, a, ann, none)) + { id: a, id-b: A.s-bind(loc, false, a, ann), id-e: A.s-id(loc, a) } +end +fun make-renamer(): + renames = SD.make-mutable-string-dict() + fields = SD.make-mutable-string-dict() + { renames; + fields; + A.default-map-visitor.{ + method s-atom(self, base, serial): + n = A.s-atom(base, serial) + renames.get-now(n.key()).or-else(n) + end, + method s-dot(self, l, obj, field) block: + cases(A.Expr) obj block: + | s-id(_, name) => + print("Trying to replace " + name.key() + "\n") + cases(Option>) fields.get-now(name.key()) block: + | some(field-ids) => + cases(Option) field-ids.get-now(field) block: + | some(id) => + print("Replacing " + name.key() + "." + field + " with " + id.id.key() + "\n") + id + | none => + # print("Couldn't find " + field + " in " + name.key() + ", so recurring\n") + # print(torepr(obj) + "\n") + # print(torepr(obj.visit(self)) + "\n") + # print(torepr(renames.keys-now()) + "\n") + A.s-dot(l, obj.visit(self), field) + end + | none => + # print("Couldn't find " + name.key() + " at all, so recurring\n") + A.s-dot(l, obj.visit(self), field) + end + | else => + # print("Wasn't a simple s-dot: " + obj.tosource().pretty(10000).first + "." + field + "\n") + A.s-dot(l, obj.visit(self), field) + end + end + } + } +end +fun merge-data-methods(l, name, name-type, name-ann, params, mixins, variants, shared, _check-loc, _check) block: + print("Merging for " + name + "\n") + shared-names = SD.make-mutable-string-dict() + for each(s from shared) block: + shared-names.set-now(s.name, true) + end + method-sigs = SD.make-mutable-string-dict() + method-bodies = SD.make-mutable-string-dict() + {renames; fields; renamer} = make-renamer() + variants-map = SD.make-mutable-string-dict() + needed = variants.length() + for each(v from variants) block: + variants-map.set-now(v.name, v) + for each(w from v.with-members) block: + when A.is-s-data-field(w) and A.is-s-method(w.value) block: + when not(method-sigs.has-key-now(w.name)) block: + method-sigs.set-now(w.name, w.value) + method-bodies.set-now(w.name, SD.make-mutable-string-dict()) + end + when same-sig(w.value, method-sigs.get-value-now(w.name)) and not(shared-names.has-key-now(w.name)) block: + #print("Candidate for merging type " + name + " : variant " + v.name + " : method " + w.name + "\n") + method-bodies.get-value-now(w.name).set-now(v.name, w.value) + end + end + end + end + shared-methods = SD.make-mutable-string-dict() + for SD.each-key-now(m from method-bodies): + sig = method-sigs.get-value-now(m) + bodies = method-bodies.get-value-now(m) + when bodies.count-now() == needed block: + print("Merging type " + name + " : method " + m + "\n") + new-params = sig.params.map(lam(n): names.make-atom(n.toname()) end) + new-args = sig.args.map(lam(b): mk-id-ann(l, b.id.toname(), b.ann) end) + case-bodies = for SD.map-keys-now(vname from bodies) block: + vmeth = bodies.get-value-now(vname) + for each2(a from vmeth.args, na from new-args): + renames.set-now(a.id.key(), na.id) + end + cases(A.Variant) variants-map.get-value-now(vname) block: + | s-variant(lv, constr-loc, _, members, with-members) => + field-exps = SD.make-mutable-string-dict() + # print("First arg name for " + vname + " is " + vmeth.args.first.id.key() + "\n") + fields.set-now(vmeth.args.first.id.key(), field-exps) + arg-fields = members.map(lam(member): + cases(A.VariantMember) member block: + | s-variant-member(mloc, mt, b) => + new-b = mk-id-ann(mloc, b.id.toname(), A.a-blank) + field-exps.set-now(b.id.toname(), new-b.id-e) + cases(A.VariantMemberType) mt: + | s-normal => A.s-cases-bind(mloc, A.s-cases-bind-normal, new-b.id-b) + | s-mutable => A.s-cases-bind(mloc, A.s-cases-bind-ref, new-b.id-b) + end + end + end) + A.s-cases-branch(vmeth.l, constr-loc, vname, arg-fields, vmeth.body.visit(renamer)) + | s-singleton-variant(lv, _, with-members) => + A.s-singleton-cases-branch(vmeth.l, lv, vname, vmeth.body.visit(renamer)) + end + end + else-case = no-method-exn(l, new-args.first.id-e, A.s-str(l, m)) + ann-name = A.a-name(l, name-ann) + shared-method = A.s-data-field(l, m, A.s-method(l, m, new-params, new-args.map(_.id-b), sig.ann, "", + A.s-cases-else(l, ann-name, new-args.first.id-e, case-bodies, else-case, true), + none, none, true)) + shared-methods.set-now(m, shared-method) + end + end + new-variants = for map(v from variants): + cases(A.Variant) v block: + | s-variant(lv, constr-loc, vname, members, with-members) => + A.s-variant(lv, constr-loc, vname, members, + with-members.filter(lam(m): not(shared-methods.has-key-now(m.name)) end)) + | s-singleton-variant(lv, vname, with-members) => + A.s-singleton-variant(lv, vname, with-members.filter(lam(m): not(shared-methods.has-key-now(m.name)) end)) + end + end + A.s-data-expr(l, name, name-type, name-ann, params, mixins, + new-variants, + shared-methods.map-keys-now(lam(mname): shared-methods.get-value-now(mname) end) + shared, + _check-loc, _check) +end + fun desugar-post-tc(program :: A.Program, compile-env :: C.CompileEnvironment): doc: ``` Desugar non-scope and non-check based constructs. diff --git a/src/arr/compiler/desugar.arr b/src/arr/compiler/desugar.arr index 77f5c80718..a25b04208e 100644 --- a/src/arr/compiler/desugar.arr +++ b/src/arr/compiler/desugar.arr @@ -385,7 +385,7 @@ fun desugar-expr(expr :: A.Expr): A.s-let-expr(l, new-binds, desugar-expr(body), blocky) | s-letrec(l, binds, body, blocky) => A.s-letrec(l, desugar-letrec-binds(binds), desugar-expr(body), blocky) - | s-data-expr(l, name, namet, params, mixins, variants, shared, _check-loc, _check) => + | s-data-expr(l, name, name-type, name-ann, params, mixins, variants, shared, _check-loc, _check) => fun extend-variant(v): cases(A.Variant) v: | s-variant(l2, constr-loc, vname, members, with-members) => @@ -402,7 +402,7 @@ fun desugar-expr(expr :: A.Expr): with-members.map(desugar-member)) end end - A.s-data-expr(l, name, namet, params, mixins.map(desugar-expr), variants.map(extend-variant), + A.s-data-expr(l, name, name-type, name-ann, params, mixins.map(desugar-expr), variants.map(extend-variant), shared.map(desugar-member), _check-loc, desugar-opt(desugar-expr, _check)) | s-when(l, test, body, blocky) => ds-test = desugar-expr(test) diff --git a/src/arr/compiler/resolve-scope.arr b/src/arr/compiler/resolve-scope.arr index a2f6c80a37..24c8440b60 100644 --- a/src/arr/compiler/resolve-scope.arr +++ b/src/arr/compiler/resolve-scope.arr @@ -102,9 +102,10 @@ fun desugar-toplevel-types(stmts :: List) -> List block: | s-newtype(l, name, namet) => rev-type-binds := link(A.s-newtype-bind(l, name, namet), rev-type-binds) | s-data(l, name, params, mixins, variants, shared, _check-loc, _check) => - namet = names.make-atom(name) - rev-type-binds := link(A.s-newtype-bind(l, A.s-name(l, name), namet), rev-type-binds) - rev-stmts := link(A.s-data-expr(l, name, namet, params, mixins, variants, shared, _check-loc, _check), rev-stmts) + name-type = names.make-atom(name) + name-ann = A.s-name(l, name) # placeholder until name resolution happens + rev-type-binds := link(A.s-newtype-bind(l, A.s-name(l, name), name-type), rev-type-binds) + rev-stmts := link(A.s-data-expr(l, name, name-type, name-ann, params, mixins, variants, shared, _check-loc, _check), rev-stmts) | else => rev-stmts := link(s, rev-stmts) end @@ -391,7 +392,7 @@ fun desugar-scope-block(stmts :: List, binding-group :: BindingGroup) -> # it'll get turned into an s-lam in weave-contracts f ), rest-stmts) - | s-data-expr(l, name, namet, params, mixins, variants, shared, _check-loc, _check) => + | s-data-expr(l, name, name-type, name-ann, params, mixins, variants, shared, _check-loc, _check) => fun b(loc, id :: String): A.s-bind(loc, false, A.s-name(loc, id), A.a-blank) end fun bn(loc, n :: A.Name): A.s-bind(loc, false, n, A.a-blank) end fun variant-binds(data-blob-id, v): @@ -404,7 +405,7 @@ fun desugar-scope-block(stmts :: List, binding-group :: BindingGroup) -> ] end blob-id = names.make-atom(name) - data-expr = A.s-data-expr(l, name, namet, params, mixins, variants, shared, _check-loc, _check) + data-expr = A.s-data-expr(l, name, name-type, name-ann, params, mixins, variants, shared, _check-loc, _check) bind-data = A.s-letrec-bind(l, bn(l, blob-id), data-expr) bind-data-pred = A.s-letrec-bind(l, b(l, A.make-checker-name(name)), A.s-dot(l, A.s-id-letrec(l, blob-id, true), name)) all-binds = for fold(acc from [list: bind-data-pred, bind-data], v from variants): @@ -994,7 +995,7 @@ fun resolve-names(p :: A.Program, initial-env :: C.CompileEnvironment): data-defs = for lists.filter-map(ddk from datatypes.keys-list-now()): dd = datatypes.get-value-now(ddk) if provide-types-dict.has-key(dd.name): - some(A.p-data(dd.l, dd.namet, none)) + some(A.p-data(dd.l, dd.name-type, none)) else: none end @@ -1122,7 +1123,7 @@ fun resolve-names(p :: A.Program, initial-env :: C.CompileEnvironment): A.s-cases-branch(l, pat-loc, name, new-args, new-body) end, # s-singleton-cases-branch introduces no new bindings - method s-data-expr(self, l, name, namet, params, mixins, variants, shared-members, _check-loc, _check) block: + method s-data-expr(self, l, name, name-type, _, params, mixins, variants, shared-members, _check-loc, _check) block: {env; atoms} = for fold(acc from { self.type-env; empty }, param from params): {env; atoms} = acc atom-env = make-atom-for(param, false, env, type-bindings, @@ -1130,10 +1131,11 @@ fun resolve-names(p :: A.Program, initial-env :: C.CompileEnvironment): { atom-env.env; link(atom-env.atom, atoms) } end with-params = self.{type-env: env} - result = A.s-data-expr(l, name, namet, atoms.reverse(), + name-ann = self.type-env.get-value(name).atom + result = A.s-data-expr(l, name, name-type, name-ann, atoms.reverse(), mixins.map(_.visit(with-params)), variants.map(_.visit(with-params)), shared-members.map(_.visit(with-params)), _check-loc, with-params.option(_check)) - datatypes.set-now(namet.key(), result) + datatypes.set-now(name-type.key(), result) result end, method s-lam(self, l, name, params, args, ann, doc, body, _check-loc, _check, blocky) block: diff --git a/src/arr/compiler/type-check.arr b/src/arr/compiler/type-check.arr index 4d115c52d9..77c2e99701 100644 --- a/src/arr/compiler/type-check.arr +++ b/src/arr/compiler/type-check.arr @@ -584,7 +584,7 @@ fun _checking(e :: Expr, expect-type :: Type, top-level :: Boolean, context :: C raise("checking for s-bracket not implemented") | s-data(l, name, params, mixins, variants, shared-members, _check-loc, _check) => raise("s-data should have already been desugared") - | s-data-expr(l, name, namet, params, mixins, variants, shared-members, _check-loc, _check) => + | s-data-expr(l, name, name-type, name-ann, params, mixins, variants, shared-members, _check-loc, _check) => raise("s-data-expr should have been handled by s-letrec") | s-for(l, iterator, bindings, ann, body) => raise("s-for should have already been desugared") @@ -857,7 +857,7 @@ fun _synthesis(e :: Expr, top-level :: Boolean, context :: Context) -> TypingRes raise("synthesis for s-bracket not implemented") | s-data(l, name, params, mixins, variants, shared-members, _check-loc, _check) => raise("s-data should have already been desugared") - | s-data-expr(l, name, namet, params, mixins, variants, shared-members, _check-loc, _check) => + | s-data-expr(l, name, name-type, name-ann, params, mixins, variants, shared-members, _check-loc, _check) => raise("s-data-expr should have been handled by s-letrec") | s-for(l, iterator, bindings, ann, body, blocky) => raise("s-for should have already been desugared") @@ -947,9 +947,9 @@ fun handle-datatype(data-type-bind :: A.LetrecBind, bindings :: List FoldResult>: data-expr = data-type-bind.value cases(Expr) data-expr: - | s-data-expr(l, name, namet, params, mixins, variants, fields, _check-loc, _check) => + | s-data-expr(l, name, name-type, name-ann, params, mixins, variants, fields, _check-loc, _check) => shadow context = context.add-level() - brander-type = t-name(local, namet, l, false) + brander-type = t-name(local, name-type, l, false) t-vars = params.map(t-var(_, l, false)) applied-brander-type = if is-empty(t-vars): brander-type else: t-app(brander-type, t-vars, l, false) end @@ -975,7 +975,7 @@ context :: Context) -> FoldResult>: map-fold-result(collect-variant, variants, context).bind(lam(shadow initial-variant-types, shadow context): collect-members(fields, true, context).bind(lam(initial-shared-field-types, shadow context): initial-data-type = t-data(name, t-vars, initial-variant-types, initial-shared-field-types, l) - shadow context = context.set-data-types(context.data-types.set(namet.key(), initial-data-type)) + shadow context = context.set-data-types(context.data-types.set(name-type.key(), initial-data-type)) shadow context = merge-common-fields(initial-variant-types, l, context) map-fold-result(lam(variant, shadow context): check-variant(variant, initial-data-type.get-variant-value(variant.name), brander-type, t-vars, context) @@ -998,7 +998,7 @@ context :: Context) -> FoldResult>: extended-shared-field-types.set(key, variants-meet.get-value(key)) end, initial-shared-field-types) shared-data-type = t-data(name, t-vars, new-variant-types, extended-shared-field-types, l) - shadow context = context.set-data-types(context.data-types.set(namet.key(), shared-data-type)) + shadow context = context.set-data-types(context.data-types.set(name-type.key(), shared-data-type)) foldr-fold-result(lam(field, shadow context, new-shared-field-types): check-shared-field(field, initial-shared-field-types, applied-brander-type, context).bind(lam(field-type, shadow context): fold-result(new-shared-field-types.set(field.name, field-type), context) @@ -1010,7 +1010,7 @@ context :: Context) -> FoldResult>: final-data-type = t-data(name, t-vars, new-variant-types, final-shared-field-types, l) context.solve-level().bind(lam(solution, shadow context): solved-data-type = solution.apply-data-type(final-data-type) - shadow context = context.set-data-types(context.data-types.set(namet.key(), solved-data-type)) + shadow context = context.set-data-types(context.data-types.set(name-type.key(), solved-data-type)) fold-result(link(data-type-bind, new-bindings), context) end) end) @@ -1658,7 +1658,7 @@ fun collect-letrec-bindings(binds :: List, top-level :: Boolean, c | link(first-bind, rest-binds) => first-value = first-bind.value cases(Expr) first-value: - | s-data-expr(_, _, _, _, _, variants, _, _, _) => + | s-data-expr(_, _, _, _, _, _, variants, _, _, _) => num-data-binds = (2 * variants.length()) + 1 split-list = split-at(num-data-binds, rest-binds) data-binds = split-list.prefix diff --git a/src/arr/compiler/well-formed.arr b/src/arr/compiler/well-formed.arr index 8a45adc78f..196f80a4fb 100644 --- a/src/arr/compiler/well-formed.arr +++ b/src/arr/compiler/well-formed.arr @@ -399,7 +399,7 @@ well-formed-visitor = A.default-iter-visitor.{ add-error(C.non-toplevel("data declaration", l, parent-block-loc)) true end, - method s-data-expr(self, l, name, namet, params, mixins, variants, shared, _check-loc, _check) block: + method s-data-expr(self, l, name, name-type, name-ann, params, mixins, variants, shared, _check-loc, _check) block: add-error(C.non-toplevel("data declaration", l, parent-block-loc)) true end, @@ -977,7 +977,7 @@ top-level-visitor = A.default-iter-visitor.{ parent-block-loc := old-pbl true end, - method s-data-expr(self, l, name, namet, params, mixins, variants, shared, _check-loc, _check) block: + method s-data-expr(self, l, name, name-type, name-ann, params, mixins, variants, shared, _check-loc, _check) block: old-pbl = parent-block-loc parent-block-loc := cases(Option) _check-loc: | none => l diff --git a/src/arr/trove/ast.arr b/src/arr/trove/ast.arr index 2463fc4f3a..df4391490e 100644 --- a/src/arr/trove/ast.arr +++ b/src/arr/trove/ast.arr @@ -1003,7 +1003,8 @@ data Expr: | s-data-expr( l :: Loc, name :: String, - namet :: Name, + name-type :: Name, + name-ann :: Name, params :: List, # type params mixins :: List, variants :: List, @@ -1020,7 +1021,7 @@ data Expr: end tys = PP.surround-separate(2 * INDENT, 0, PP.mt-doc, PP.langle, PP.commabreak, PP.rangle, self.params.map(_.tosource())) - header = str-data-expr + PP.str(self.name) + PP.comma + self.namet.tosource() + tys + str-colon + header = str-data-expr + PP.str(self.name) + PP.comma + self.name-type.tosource() + tys + str-colon _deriving = PP.surround-separate(INDENT, 0, PP.mt-doc, break-one + str-deriving, PP.commabreak, PP.mt-doc, self.mixins.map(lam(m): m.tosource() end)) variants = PP.separate(break-one + str-pipespace, @@ -2178,7 +2179,8 @@ default-map-visitor = { self, l :: Loc, name :: String, - namet :: Name, + name-type :: Name, + name-ann :: Name, params :: List, # type params mixins :: List, variants :: List, @@ -2189,7 +2191,8 @@ default-map-visitor = { s-data-expr( l, name, - namet.visit(self), + name-type.visit(self), + name-ann.visit(self), params.map(_.visit(self)), mixins.map(_.visit(self)), variants.map(_.visit(self)), @@ -2733,7 +2736,8 @@ default-iter-visitor = { self, l :: Loc, name :: String, - namet :: Name, + name-type :: Name, + name-ann :: Name, params :: List, # type params mixins :: List, variants :: List, @@ -2741,7 +2745,7 @@ default-iter-visitor = { _check-loc :: Option, _check :: Option ): - namet.visit(self) + name-type.visit(self) and name-ann.visit(self) and lists.all(_.visit(self), params) and lists.all(_.visit(self), mixins) and lists.all(_.visit(self), variants) @@ -3275,7 +3279,8 @@ dummy-loc-visitor = { self, l :: Loc, name :: String, - namet :: String, + name-type :: Name, + name-ann :: Name, params :: List, # type params mixins :: List, variants :: List, @@ -3286,7 +3291,8 @@ dummy-loc-visitor = { s-data-expr( dummy-loc, name, - namet.visit(self), + name-type.visit(self), + name-ann.visit(self), params.map(_.visit(self)), mixins.map(_.visit(self)), variants.map(_.visit(self)), From d79ee890d88337f2aad1ee83dfc739dc04122c52 Mon Sep 17 00:00:00 2001 From: Joe Politz Date: Fri, 6 Jul 2018 09:28:36 -0700 Subject: [PATCH 2/4] Update desugar-post-tc.arr --- src/arr/compiler/desugar-post-tc.arr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/arr/compiler/desugar-post-tc.arr b/src/arr/compiler/desugar-post-tc.arr index 44cdf0ff5f..e5a50593e5 100644 --- a/src/arr/compiler/desugar-post-tc.arr +++ b/src/arr/compiler/desugar-post-tc.arr @@ -43,7 +43,7 @@ desugar-visitor = A.default-map-visitor.{ } fun no-method-exn(l, obj, name): - A.s-prim-app(l, "throwFieldNotFound", [list: A.s-srcloc(l, l), obj, name]) + A.s-prim-app(l, "throwFieldNotFound", [list: A.s-srcloc(l, l), obj, name], flat-prim-app) end var generated-binds = SD.make-mutable-string-dict() From d1410230f1ec3b3447eb4075a0014aea8f871f05 Mon Sep 17 00:00:00 2001 From: Ben Lerner Date: Fri, 6 Jul 2018 13:08:11 -0400 Subject: [PATCH 3/4] Cleanup stray prints --- src/arr/compiler/desugar-post-tc.arr | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/arr/compiler/desugar-post-tc.arr b/src/arr/compiler/desugar-post-tc.arr index e5a50593e5..6d156e26d2 100644 --- a/src/arr/compiler/desugar-post-tc.arr +++ b/src/arr/compiler/desugar-post-tc.arr @@ -103,7 +103,7 @@ fun make-renamer(): method s-dot(self, l, obj, field) block: cases(A.Expr) obj block: | s-id(_, name) => - print("Trying to replace " + name.key() + "\n") + # print("Trying to replace " + name.key() + "\n") cases(Option>) fields.get-now(name.key()) block: | some(field-ids) => cases(Option) field-ids.get-now(field) block: @@ -130,7 +130,7 @@ fun make-renamer(): } end fun merge-data-methods(l, name, name-type, name-ann, params, mixins, variants, shared, _check-loc, _check) block: - print("Merging for " + name + "\n") + # print("Merging for " + name + "\n") shared-names = SD.make-mutable-string-dict() for each(s from shared) block: shared-names.set-now(s.name, true) From e89de3c7ac9e43ccb1de102e08a32d74c835fdf6 Mon Sep 17 00:00:00 2001 From: Ben Lerner Date: Fri, 6 Jul 2018 13:31:44 -0400 Subject: [PATCH 4/4] Few more stray prints, and one broken signature --- src/arr/compiler/desugar-post-tc.arr | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/arr/compiler/desugar-post-tc.arr b/src/arr/compiler/desugar-post-tc.arr index 6d156e26d2..ea9bab09eb 100644 --- a/src/arr/compiler/desugar-post-tc.arr +++ b/src/arr/compiler/desugar-post-tc.arr @@ -87,7 +87,7 @@ fun same-sig(s1 :: A.Expr%(is-s-method), s2 :: A.Expr%(is-s-method)): end fun mk-id-ann(loc, base, ann) block: a = names.make-atom(base) - generated-binds.set-now(a.key(), C.value-bind(C.bo-local(loc), C.vb-let, a, ann, none)) + generated-binds.set-now(a.key(), C.value-bind(C.bo-local(loc), C.vb-let, a, ann)) { id: a, id-b: A.s-bind(loc, false, a, ann), id-e: A.s-id(loc, a) } end fun make-renamer(): @@ -108,7 +108,7 @@ fun make-renamer(): | some(field-ids) => cases(Option) field-ids.get-now(field) block: | some(id) => - print("Replacing " + name.key() + "." + field + " with " + id.id.key() + "\n") + # print("Replacing " + name.key() + "." + field + " with " + id.id.key() + "\n") id | none => # print("Couldn't find " + field + " in " + name.key() + ", so recurring\n") @@ -160,7 +160,7 @@ fun merge-data-methods(l, name, name-type, name-ann, params, mixins, variants, s sig = method-sigs.get-value-now(m) bodies = method-bodies.get-value-now(m) when bodies.count-now() == needed block: - print("Merging type " + name + " : method " + m + "\n") + # print("Merging type " + name + " : method " + m + "\n") new-params = sig.params.map(lam(n): names.make-atom(n.toname()) end) new-args = sig.args.map(lam(b): mk-id-ann(l, b.id.toname(), b.ann) end) case-bodies = for SD.map-keys-now(vname from bodies) block: