Make it more convenient to add built-in types

src/main/accelerate.mc

@@ -79,7 +79,7 @@ lang MExprCudaCompile =
 end
 
 let keywordsSymEnv =
-  {symEnvEmpty with varEnv =
+  {symEnvDefault with varEnv =
     mapFromSeq
       cmpString
       (map (lam s. (s, nameSym s)) mexprExtendedKeywords)}

stdlib/c/compile.mc

@@ -1387,7 +1387,7 @@ use Test in
 let compile: CompileCOptions -> Expr -> CProg = lam opts. lam prog.
 
   -- Symbolize with empty environment
-  let prog = symbolizeExpr symEnvEmpty prog in
+  let prog = symbolizeExpr symEnvDefault prog in
 
   -- Type check and annotate
   let prog = typeCheck prog in

stdlib/mexpr/symbolize.mc

@@ -35,15 +35,20 @@ let symEnvEmpty = {
   varEnv = mapEmpty cmpString,
   conEnv = mapEmpty cmpString,
   tyVarEnv = mapEmpty cmpString,
-
-  -- Built-in type constructors
-  tyConEnv =
-  mapFromSeq cmpString (map (lam t. (t.0, nameNoSym t.0)) builtinTypes),
-
+  tyConEnv = mapEmpty cmpString,
   allowFree = false,
   ignoreExternals = false
 }
 
+let symEnvAddBuiltinTypes : all a. SymEnv -> [(String, a)] -> SymEnv
+  = lam env. lam tys. {
+    env with tyConEnv =
+      foldl (lam env. lam t. mapInsert t.0 (nameNoSym t.0) env) env.tyConEnv tys
+  }
+
+let symEnvDefault =
+  symEnvAddBuiltinTypes symEnvEmpty builtinTypes
+
 lang SymLookup
   type LookupParams = {kind : String, info : [Info], allowFree : Bool}
 
@@ -125,13 +130,13 @@ lang Sym = Ast + SymLookup
   -- Symbolize with builtin environment
   sem symbolize =
   | expr ->
-    let env = symEnvEmpty in
+    let env = symEnvDefault in
     symbolizeExpr env expr
 
   -- Symbolize with builtin environment and ignore errors
   sem symbolizeAllowFree =
   | expr ->
-    let env = { symEnvEmpty with allowFree = true } in
+    let env = { symEnvDefault with allowFree = true } in
     symbolizeExpr env expr
 
   -- Add top-level identifiers (along the spine of the program) in `t`
@@ -509,7 +514,7 @@ utest isFullySymbolized (nulam_ x (nvar_ x)) with true in
 let testSymbolize = lam ast. lam testEqStr.
   let symbolizeCalls =
     [ symbolize
-    , symbolizeExpr {symEnvEmpty with allowFree = true}] in
+    , symbolizeExpr {symEnvDefault with allowFree = true}] in
   foldl
     (lam acc. lam symb.
       if acc then

stdlib/mexpr/type-check.mc

@@ -38,19 +38,28 @@ type TCEnv = {
   disableRecordPolymorphism: Bool
 }
 
-let _tcEnvEmpty = {
+let typcheckEnvEmpty = {
   varEnv = mapEmpty nameCmp,
   conEnv = mapEmpty nameCmp,
   tyVarEnv = mapEmpty nameCmp,
-  tyConEnv =
-  mapFromSeq nameCmp
-    (map (lam t: (String, [String]).
-      (nameNoSym t.0, (0, map nameSym t.1, tyvariant_ []))) builtinTypes),
-
+  tyConEnv = mapEmpty nameCmp,
   currentLvl = 0,
   disableRecordPolymorphism = true
 }
 
+let typecheckEnvAddBuiltinTypes : TCEnv -> [(String, [String])] -> TCEnv
+  = lam env. lam tys. {
+    env with
+    tyConEnv =
+      foldl
+        (lam env. lam t.
+          mapInsert (nameNoSym t.0) (0, map nameSym t.1, tyvariant_ []) env)
+        env.tyConEnv tys
+  }
+
+let typcheckEnvDefault =
+  typecheckEnvAddBuiltinTypes typcheckEnvEmpty builtinTypes
+
 let _insertVar = lam name. lam ty. lam env : TCEnv.
   {env with varEnv = mapInsert name ty env.varEnv}
 
@@ -444,7 +453,7 @@ lang TypeCheck = TCUnify + Generalize + RemoveMetaVar
   sem typeCheck : Expr -> Expr
   sem typeCheck =
   | tm ->
-    removeMetaVarExpr (typeCheckExpr _tcEnvEmpty tm)
+    removeMetaVarExpr (typeCheckExpr typcheckEnvDefault tm)
 
   -- Type check `expr' under the type environment `env'. The resulting
   -- type may contain unification variables and links.
@@ -994,8 +1003,8 @@ let typeOf = lam test : TypeTest.
   let tyEnv = mapFromSeq nameCmp bindings in
   unwrapTypes
     (tyTm
-       (typeCheckExpr {_tcEnvEmpty with varEnv = tyEnv}
-          (symbolizeExpr {symEnvEmpty with varEnv = symEnv} test.tm)))
+       (typeCheckExpr {typcheckEnvDefault with varEnv = tyEnv}
+          (symbolizeExpr {symEnvDefault with varEnv = symEnv} test.tm)))
 in
 
 let runTest =

stdlib/pmexpr/utils.mc

@@ -77,7 +77,7 @@ let typeCheckEnv = lam env : [(Name, Type)]. lam expr.
       (lam env. lam x : (Name, Type).
         match x with (id, ty) in
         _insertVar id ty env)
-      _tcEnvEmpty env in
+      typcheckEnvDefault env in
   removeMetaVarExpr (typeCheckExpr tcEnv expr)
 in