Allow type synonyms inside other type synonyms

Instantiate the body of a type synonym declaration with the existing
type synonym map before adding it to the map, so that the map never
contains any uninstantiated type synonyms.

src/SAWScript/MGU.hs

@@ -17,6 +17,7 @@ Stability   : provisional
 module SAWScript.MGU
        ( checkDecl
        , checkDeclGroup
+       , instantiateType
        ) where
 
 import SAWScript.AST
@@ -264,8 +265,12 @@ bindPatternSchema pat s@(Forall vs t) m =
 
 bindTypedef :: LName -> Type -> TI a -> TI a
 bindTypedef n t m =
-  TI $ local (\ro -> ro { typedefEnv = M.insert (getVal n) t $ typedefEnv ro })
-  $ unTI m
+  TI $
+  local
+    (\ro ->
+      let t' = instantiateType (typedefEnv ro) t
+      in  ro { typedefEnv = M.insert (getVal n) t' $ typedefEnv ro })
+    $ unTI m
 
 -- FIXME: This function may miss type variables that occur in the type
 -- of a binding that has been shadowed by another value with the same
@@ -382,10 +387,13 @@ instance Instantiate Type where
     TySkolemVar _ _ -> ty
     LType pos ty'   -> LType pos (instantiate nts ty')
 
+instantiateType :: Instantiate t => Map Name Type -> t -> t
+instantiateType tenv = instantiate (M.assocs tenv)
+
 instantiateM :: Instantiate t => t -> TI t
 instantiateM t = do
   s <- TI $ asks typedefEnv
-  return $ instantiate (M.assocs s) t
+  return $ instantiateType s t
 
 -- }}}
 

src/SAWScript/Value.hs

@@ -77,6 +77,7 @@ import qualified Text.LLVM.AST as LLVM (Type)
 import qualified Text.LLVM.PP as LLVM (ppType)
 import SAWScript.JavaExpr (JavaType(..))
 import SAWScript.JavaPretty (prettyClass)
+import SAWScript.MGU (instantiateType)
 import SAWScript.Options (Options(printOutFn),printOutLn,Verbosity(..))
 import SAWScript.Proof
 import SAWScript.Prover.SolverStats
@@ -504,7 +505,8 @@ extendLocal :: SS.LName -> Maybe SS.Schema -> Maybe String -> Value -> LocalEnv
 extendLocal x mt md v env = LocalLet x mt md v : env
 
 addTypedef :: SS.Name -> SS.Type -> TopLevelRW -> TopLevelRW
-addTypedef name ty rw = rw { rwTypedef = M.insert name ty (rwTypedef rw) }
+addTypedef name ty rw = rw { rwTypedef = M.insert name ty' (rwTypedef rw) }
+  where ty' = instantiateType (rwTypedef rw) ty
 
 mergeLocalEnv :: SharedContext -> LocalEnv -> TopLevelRW -> IO TopLevelRW
 mergeLocalEnv sc env rw = foldrM addBinding rw env