Add standalone resymbolization pass (#962)

* Add resymolize as standalone pass

* Add tests for resymbolization

Author: larshum

src/stdlib/mexpr/monomorphize.mc

@@ -17,6 +17,7 @@ include "mexpr/cmp.mc"
 include "mexpr/eq.mc"
 include "mexpr/eval.mc"
 include "mexpr/pprint.mc"
+include "mexpr/resymbolize.mc"
 include "mexpr/symbolize.mc"
 include "mexpr/type.mc"
 include "mexpr/type-check.mc"
@@ -207,129 +208,6 @@ lang MonomorphizeInstantiate = Monomorphize
   | ty -> smap_Type_Type (instantiatePolymorphicType inst) ty
 end
 
-lang MonomorphizeResymbolize = Monomorphize
-  -- Resymbolizes all variables bound inside the provided expression. We use
-  -- this to ensure function definitions duplicated due to monomorphization end
-  -- up with distinct symbols.
-  sem resymbolizeBindings : Expr -> Expr
-  sem resymbolizeBindings =
-  | ast -> resymbolizeBindingsExpr (mapEmpty nameCmp) ast
-
-  sem resymbolizeBindingsDecl : Map Name Name -> Decl -> (Map Name Name, Decl)
-  sem resymbolizeBindingsDecl nameMap =
-  | d -> (nameMap, smap_Decl_Expr (resymbolizeBindingsExpr nameMap) d)
-  | DeclLet t ->
-    let body = resymbolizeBindingsExpr nameMap t.body in
-    let newId = nameSetNewSym t.ident in
-    let nameMap = mapInsert t.ident newId nameMap in
-    ( nameMap
-    , DeclLet
-      { t with ident = newId
-      , tyAnnot = resymbolizeBindingsType nameMap t.tyAnnot
-      , tyBody = resymbolizeBindingsType nameMap t.tyBody
-      , body = body
-      }
-    )
-  | DeclRecLets t ->
-    let addNewIdBinding = lam nameMap. lam bind.
-      let newId = nameSetNewSym bind.ident in
-      (mapInsert bind.ident newId nameMap, {bind with ident = newId})
-    in
-    match mapAccumL addNewIdBinding nameMap t.bindings with (nameMap, bindings) in
-    let resymbolizeBind = lam bind.
-      {bind with tyAnnot = resymbolizeBindingsType nameMap bind.tyAnnot,
-                 tyBody = resymbolizeBindingsType nameMap bind.tyBody,
-                 body = resymbolizeBindingsExpr nameMap bind.body}
-    in
-    let bindings = map resymbolizeBind bindings in
-    (nameMap, DeclRecLets {t with bindings = bindings})
-  | DeclType t ->
-    let newId = nameSetNewSym t.ident in
-    let nameMap = mapInsert t.ident newId nameMap in
-    ( nameMap
-    , DeclType
-      { t with ident = newId
-      , tyIdent = resymbolizeBindingsType nameMap t.tyIdent
-      }
-    )
-  | DeclConDef t ->
-    let newId = nameSetNewSym t.ident in
-    let nameMap = mapInsert t.ident newId nameMap in
-    (nameMap, DeclConDef {t with ident = newId, tyIdent = resymbolizeBindingsType nameMap t.tyIdent})
-
-  sem resymbolizeBindingsExpr : Map Name Name -> Expr -> Expr
-  sem resymbolizeBindingsExpr nameMap =
-  | TmVar t ->
-    let newId =
-      match mapLookup t.ident nameMap with Some newId then newId
-      else t.ident
-    in
-    TmVar {t with ident = newId, ty = resymbolizeBindingsType nameMap t.ty}
-  | TmLam t ->
-    let newId = nameSetNewSym t.ident in
-    let nameMap = mapInsert t.ident newId nameMap in
-    TmLam {t with ident = newId,
-                  tyAnnot = resymbolizeBindingsType nameMap t.tyAnnot,
-                  tyParam = resymbolizeBindingsType nameMap t.tyParam,
-                  body = resymbolizeBindingsExpr nameMap t.body,
-                  ty = resymbolizeBindingsType nameMap t.ty}
-  | TmDecl t ->
-    match resymbolizeBindingsDecl nameMap t.decl with (nameMap, decl) in
-    let inexpr = resymbolizeBindingsExpr nameMap t.inexpr in
-    TmDecl {t with decl = decl, inexpr = inexpr}
-  | TmConApp t ->
-    let newId =
-      match mapLookup t.ident nameMap with Some newId then newId
-      else t.ident
-    in
-    TmConApp {t with ident = newId,
-                     body = resymbolizeBindingsExpr nameMap t.body,
-                     ty = resymbolizeBindingsType nameMap t.ty}
-  | TmMatch t ->
-    let target = resymbolizeBindingsExpr nameMap t.target in
-    match resymbolizeBindingsPat nameMap t.pat with (thnNameMap, pat) in
-    TmMatch {t with target = target, pat = pat,
-                    thn = resymbolizeBindingsExpr thnNameMap t.thn,
-                    els = resymbolizeBindingsExpr nameMap t.els,
-                    ty = resymbolizeBindingsType nameMap t.ty}
-  | t ->
-    let t = smap_Expr_Expr (resymbolizeBindingsExpr nameMap) t in
-    let t = smap_Expr_Type (resymbolizeBindingsType nameMap) t in
-    let t = smap_Expr_TypeLabel (resymbolizeBindingsType nameMap) t in
-    withType (resymbolizeBindingsType nameMap (tyTm t)) t
-
-  sem resymbolizeBindingsPat : Map Name Name -> Pat -> (Map Name Name, Pat)
-  sem resymbolizeBindingsPat nameMap =
-  | PatNamed (t & {ident = PName id}) ->
-    let newId = nameSetNewSym id in
-    (mapInsert id newId nameMap, PatNamed {t with ident = PName newId})
-  | PatSeqEdge (t & {middle = PName id}) ->
-    let newId = nameSetNewSym id in
-    (mapInsert id newId nameMap, PatSeqEdge {t with middle = PName newId})
-  | PatCon t ->
-    match mapLookup t.ident nameMap with Some newId then
-      (nameMap, PatCon {t with ident = newId})
-    else (nameMap, PatCon t)
-  | p -> smapAccumL_Pat_Pat resymbolizeBindingsPat nameMap p
-
-  sem resymbolizeBindingsType : Map Name Name -> Type -> Type
-  sem resymbolizeBindingsType nameMap =
-  | TyCon t ->
-    match mapLookup t.ident nameMap with Some newId then
-      TyCon {t with ident = newId}
-    else TyCon t
-  | TyVar t ->
-    match mapLookup t.ident nameMap with Some newId then
-      TyVar {t with ident = newId}
-    else TyVar t
-  | TyAll t ->
-    let newId = nameSetNewSym t.ident in
-    let nameMap = mapInsert t.ident newId nameMap in
-    TyAll {t with ident = newId,
-                  ty = resymbolizeBindingsType nameMap t.ty}
-  | ty -> smap_Type_Type (resymbolizeBindingsType nameMap) ty
-end
-
 lang MonomorphizeCollect =
   MonomorphizeValidate + MonomorphizeInstantiate + MExprCallGraph + AppTypeUtils
 
@@ -618,7 +496,7 @@ lang MonomorphizeCollect =
   | ty -> monoError [infoTy ty] "Constructor type does not refer to a known variant type"
 end
 
-lang MonomorphizeApply = MonomorphizeInstantiate + MonomorphizeResymbolize + AppTypeUtils
+lang MonomorphizeApply = MonomorphizeInstantiate + MExprResymbolize + AppTypeUtils
   -- Replaces polymorphic constructs with their monomorphic bindings
   -- based on the provided monomorphization environment (bottom-up).
   sem applyMonomorphization : MonoEnv -> Expr -> Expr