Commit d63b8fd7 authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

renamed Env.Import to Env.ModuleAliases

parent 90c3383e
......@@ -70,9 +70,9 @@ Executable cymake
, Check.WarnCheck
, Env.Arity
, Env.Eval
, Env.Import
, Env.Interfaces
, Env.Label
, Env.ModuleAliases
, Env.NestEnv
, Env.OldScopeEnv
, Env.OpPrec
......
......@@ -36,7 +36,7 @@ merged into a single definition.
> import Base.Utils ((++!), findDouble, mapAccumM)
> import Env.Arity (ArityEnv, ArityInfo (..), lookupArity, qualLookupArity)
> import Env.Import (ImportEnv, lookupAlias)
> import Env.ModuleAliases (AliasEnv, lookupAlias)
> import Env.NestEnv
> import Env.TypeConstructors (TCEnv, TypeInfo (..), qualLookupTC)
> import Env.Value (ValueEnv, ValueInfo (..))
......@@ -53,7 +53,7 @@ declarations are checked within the resulting environment. In
addition, this process will also rename the local variables.
\begin{verbatim}
> syntaxCheck :: Bool -> ModuleIdent -> ImportEnv -> ArityEnv -> ValueEnv -> TCEnv -> [Decl] -> [Decl]
> syntaxCheck :: Bool -> ModuleIdent -> AliasEnv -> ArityEnv -> ValueEnv -> TCEnv -> [Decl] -> [Decl]
> syntaxCheck withExt m iEnv aEnv tyEnv tcEnv ds =
> case findDouble (concatMap constrs tds) of
> --Nothing -> tds ++ run (checkModule withExt m env vds)
......@@ -106,12 +106,12 @@ allow the usage of the qualified list constructor \texttt{(prelude.:)}.
> | GlobalVar Int QualIdent
> | LocalVar Int Ident
> | RecordLabel QualIdent [Ident]
> deriving (Eq,Show)
> deriving (Eq, Show)
> globalKey :: Int
> globalKey = uniqueId (mkIdent "")
> renameInfo :: TCEnv -> ImportEnv -> ArityEnv -> ValueInfo -> RenameInfo
> renameInfo :: TCEnv -> AliasEnv -> ArityEnv -> ValueInfo -> RenameInfo
> renameInfo _ _ _ (DataConstructor _ (ForAllExist _ _ ty))
> = Constr (arrowArity ty)
> renameInfo _ _ _ (NewtypeConstructor _ _)
......
......@@ -22,7 +22,7 @@ precCheck decls env = (decls', env { opPrecEnv = pEnv' })
syntaxCheck :: Options -> [Decl] -> CompilerEnv -> ([Decl], CompilerEnv)
syntaxCheck opts decls env = (decls', env)
where decls' = SC.syntaxCheck withExt (moduleIdent env) (importEnv env)
where decls' = SC.syntaxCheck withExt (moduleIdent env) (aliasEnv env)
(arityEnv env) (valueEnv env) (tyConsEnv env) decls
withExt = BerndExtension `elem` optExtensions opts
......
......@@ -4,9 +4,9 @@ import Curry.Base.Ident (ModuleIdent)
import Env.Arity
import Env.Eval
import Env.Import
import Env.Interfaces
import Env.Label
import Env.ModuleAliases
import Env.OpPrec
import Env.TypeConstructors
import Env.Value
......@@ -14,9 +14,9 @@ import Env.Value
-- |A compiler environment
data CompilerEnv = CompilerEnv
{ moduleIdent :: ModuleIdent
, aliasEnv :: AliasEnv
, arityEnv :: ArityEnv
, evalAnnotEnv :: EvalEnv
, importEnv :: ImportEnv
, interfaceEnv :: InterfaceEnv
, labelEnv :: LabelEnv
, opPrecEnv :: PEnv
......@@ -27,9 +27,9 @@ data CompilerEnv = CompilerEnv
initCompilerEnv :: ModuleIdent -> CompilerEnv
initCompilerEnv mid = CompilerEnv
{ moduleIdent = mid
, aliasEnv = initAliasEnv
, arityEnv = initAEnv
, evalAnnotEnv = initEEnv
, importEnv = initIEnv
, interfaceEnv = initInterfaceEnv
, labelEnv = initLEnv
, opPrecEnv = initPEnv
......
......@@ -9,8 +9,9 @@
then @N@ is an alias for @M@, and @M@ is aliased by @N@.
-}
module Env.Import
( ImportEnv, initIEnv, fromDeclList, bindAlias, lookupAlias, sureLookupAlias
module Env.ModuleAliases
( AliasEnv, initAliasEnv, fromImportDecls
, bindAlias, lookupAlias, sureLookupAlias
) where
import qualified Data.Map as Map (Map, empty, insert, lookup)
......@@ -19,25 +20,24 @@ import Data.Maybe (fromMaybe)
import Curry.Base.Ident (ModuleIdent)
import Curry.Syntax (Decl (..))
type ImportEnv = Map.Map ModuleIdent ModuleIdent
type AliasEnv = Map.Map ModuleIdent ModuleIdent
-- |Initial import environment
initIEnv :: ImportEnv
initIEnv = Map.empty
-- |Initial alias environment
initAliasEnv :: AliasEnv
initAliasEnv = Map.empty
-- |Bind an alias for a module from a single import declaration
bindAlias :: Decl -> ImportEnv -> ImportEnv
bindAlias (ImportDecl _ mid _ alias _)
= Map.insert mid $ fromMaybe mid alias
bindAlias _ = id -- error "Base.bindAlias: no import declaration"
-- |Create an alias environment from a list of import declarations
fromImportDecls :: [Decl] -> AliasEnv
fromImportDecls = foldr bindAlias initAliasEnv
-- |Create an import environment from a list of import declarations
fromDeclList :: [Decl] -> ImportEnv
fromDeclList = foldr bindAlias initIEnv
-- |Bind an alias for a module from a single import declaration
bindAlias :: Decl -> AliasEnv -> AliasEnv
bindAlias (ImportDecl _ mid _ alias _) = Map.insert mid $ fromMaybe mid alias
bindAlias _ = id
-- |
lookupAlias :: ModuleIdent -> ImportEnv -> Maybe ModuleIdent
lookupAlias :: ModuleIdent -> AliasEnv -> Maybe ModuleIdent
lookupAlias = Map.lookup
sureLookupAlias :: ModuleIdent -> ImportEnv -> ModuleIdent
sureLookupAlias :: ModuleIdent -> AliasEnv -> ModuleIdent
sureLookupAlias m = fromMaybe m . lookupAlias m
......@@ -11,7 +11,7 @@ This section describes how the exported interface of a compiled module
is computed.
\begin{verbatim}
> module Exports (expandInterface, exportInterface, expandInterface', exportInterface') where
> module Exports (expandInterface, exportInterface) where
> import Data.List
> import qualified Data.Map as Map
......@@ -46,11 +46,11 @@ specifications and the corresponding environments in order to compute
the interface of the module.
\begin{verbatim}
> expandInterface' :: CompilerEnv -> Module -> Module
> expandInterface' env mdl = expandInterface mdl (tyConsEnv env) (valueEnv env)
> expandInterface :: CompilerEnv -> Module -> Module
> expandInterface env mdl = expandInterface' mdl (tyConsEnv env) (valueEnv env)
> expandInterface :: Module -> TCEnv -> ValueEnv -> Module
> expandInterface (Module m es ds) tcEnv tyEnv =
> expandInterface' :: Module -> TCEnv -> ValueEnv -> Module
> expandInterface' (Module m es ds) tcEnv tyEnv =
> case findDouble [unqualify tc | ExportTypeWith tc _ <- es'] of
> Nothing ->
> case findDouble ([c | ExportTypeWith _ cs <- es', c <- cs] ++
......@@ -211,18 +211,18 @@ the name of the module where it is defined. The same applies to an
exported function.
\begin{verbatim}
> exportInterface' :: CompilerEnv -> Module -> Interface
> exportInterface' env mdl = exportInterface mdl
> exportInterface :: CompilerEnv -> Module -> Interface
> exportInterface env mdl = exportInterface' mdl
> (opPrecEnv env) (tyConsEnv env) (valueEnv env)
> exportInterface :: Module -> PEnv -> TCEnv -> ValueEnv -> Interface
> exportInterface (Module m (Just (Exporting _ es)) _) pEnv tcEnv tyEnv =
> exportInterface' :: Module -> PEnv -> TCEnv -> ValueEnv -> Interface
> exportInterface' (Module m (Just (Exporting _ es)) _) pEnv tcEnv tyEnv =
> Interface m (imports ++ precs ++ hidden ++ ds)
> where imports = map (IImportDecl NoPos) (usedModules ds)
> precs = foldr (infixDecl m pEnv) [] es
> hidden = map (hiddenTypeDecl m tcEnv) (hiddenTypes ds)
> ds = foldr (typeDecl m tcEnv) (foldr (funDecl m tyEnv) [] es) es
> exportInterface (Module _ Nothing _) _ _ _ = internalError "exportInterface"
> exportInterface' (Module _ Nothing _) _ _ _ = internalError "exportInterface"
> infixDecl :: ModuleIdent -> PEnv -> Export -> [IDecl] -> [IDecl]
> infixDecl m pEnv (Export f) ds = iInfixDecl m pEnv f ds
......
......@@ -10,8 +10,7 @@ interfaces into the current module.
\begin{verbatim}
> module Imports
> ( importInterface, importInterfaceIntf, importUnifyData
> , importModules, importModulesExt, qualifyEnv, qualifyEnvExt
> ( importModules, importModulesExt, qualifyEnv, qualifyEnvExt
> ) where
> import qualified Data.Map as Map
......@@ -27,8 +26,8 @@ interfaces into the current module.
> import Base.Types
> import Env.Arity
> import Env.Import
> import Env.Interfaces
> import Env.ModuleAliases
> import Env.OpPrec
> import Env.TopEnv
> import Env.TypeConstructors
......@@ -45,45 +44,22 @@ imported interfaces into scope for the current module.
> importModulesExt :: Options -> ModuleIdent -> InterfaceEnv -> [Decl] -> CompilerEnv
> importModulesExt opts mid iEnv decls = recordExpansion1 opts
> $ importModules mid iEnv decls
> qualifyEnvExt :: Options -> InterfaceEnv -> CompilerEnv -> CompilerEnv
> qualifyEnvExt opts iEnv cEnv = recordExpansion2 opts
> $ qualifyEnv iEnv cEnv
> $ importModules mid iEnv decls
> importModules :: ModuleIdent -> InterfaceEnv -> [Decl] -> CompilerEnv
> importModules mid mEnv decls = env { tyConsEnv = importUnifyData $ tyConsEnv env }
> importModules mid iEnv decls = env { tyConsEnv = importUnifyData $ tyConsEnv env }
> where
> env = foldl importModule initEnv decls
> initEnv = (initCompilerEnv mid)
> { importEnv = fromDeclList decls
> , labelEnv = importLabels mEnv decls
> , interfaceEnv = mEnv
> { aliasEnv = fromImportDecls decls -- module aliases
> , labelEnv = importLabels iEnv decls -- record labels
> , interfaceEnv = iEnv -- imported interfaces
> }
> importModule env' (ImportDecl _ m q asM is) =
> case Map.lookup m mEnv of
> Just ds1 -> importInterface (fromMaybe m asM) q is
> (Interface m ds1) env'
> Nothing -> internalError $ "importModule: Map.lookup " ++ show m ++ " " ++ show mEnv
> importModule env' (ImportDecl _ m q asM is) = case Map.lookup m iEnv of
> Just ds -> importInterface (fromMaybe m asM) q is (Interface m ds) env'
> Nothing -> internalError $ "Imports.importModules: no interface for " ++ show m
> importModule env' _ = env'
> qualifyEnv :: InterfaceEnv -> CompilerEnv -> CompilerEnv
> qualifyEnv mEnv env = env
> { opPrecEnv = foldr bindQual pEnv' (localBindings $ opPrecEnv env)
> , tyConsEnv = foldr bindQual tcEnv' (localBindings $ tyConsEnv env)
> , valueEnv = foldr bindGlobal tyEnv' (localBindings $ valueEnv env)
> , arityEnv = foldr bindQual aEnv' (localBindings $ arityEnv env)
> }
> where
> CompilerEnv { opPrecEnv = pEnv', tyConsEnv = tcEnv', valueEnv = tyEnv', arityEnv = aEnv'} =
> foldl importInterface' (initCompilerEnv $ moduleIdent env) (Map.toList mEnv)
> importInterface' cEnv1 (m,ds) = importInterfaceIntf (Interface m ds) cEnv1
> bindQual (_, y) = qualBindTopEnv "Modules.qualifyEnv" (origName y) y
> bindGlobal (x, y)
> | uniqueId x == 0 = bindQual (x, y)
> | otherwise = bindTopEnv "Modules.qualifyEnv" x y
\end{verbatim}
Four kinds of environments are computed from the interface, one
containing the operator precedences, another for the type
......@@ -111,10 +87,10 @@ import.
> importInterface :: ModuleIdent -> Bool -> Maybe ImportSpec -> Interface -> CompilerEnv -> CompilerEnv
> importInterface m q is i env = env
> { opPrecEnv = importEntities m q vs id mPEnv (opPrecEnv env)
> { opPrecEnv = importEntities m q vs id mPEnv (opPrecEnv env)
> , tyConsEnv = importEntities m q ts (importData vs) mTCEnv (tyConsEnv env)
> , valueEnv = importEntities m q vs id mTyEnv (valueEnv env)
> , arityEnv = importEntities m q as id mAEnv (arityEnv env)
> , valueEnv = importEntities m q vs id mTyEnv (valueEnv env)
> , arityEnv = importEntities m q as id mAEnv (arityEnv env)
> }
> where mPEnv = intfEnv bindPrec i
> mTCEnv = intfEnv bindTC i
......@@ -436,3 +412,23 @@ Error messages:
> "Explicit import for data constructor " ++ name c)
\end{verbatim}
> qualifyEnvExt :: Options -> InterfaceEnv -> CompilerEnv -> CompilerEnv
> qualifyEnvExt opts iEnv cEnv = recordExpansion2 opts
> $ qualifyEnv iEnv cEnv
> qualifyEnv :: InterfaceEnv -> CompilerEnv -> CompilerEnv
> qualifyEnv mEnv env = env
> { opPrecEnv = foldr bindQual pEnv' (localBindings $ opPrecEnv env)
> , tyConsEnv = foldr bindQual tcEnv' (localBindings $ tyConsEnv env)
> , valueEnv = foldr bindGlobal tyEnv' (localBindings $ valueEnv env)
> , arityEnv = foldr bindQual aEnv' (localBindings $ arityEnv env)
> }
> where
> CompilerEnv { opPrecEnv = pEnv', tyConsEnv = tcEnv', valueEnv = tyEnv', arityEnv = aEnv'} =
> foldl importInterface' (initCompilerEnv $ moduleIdent env) (Map.toList mEnv)
> importInterface' cEnv1 (m,ds) = importInterfaceIntf (Interface m ds) cEnv1
> bindQual (_, y) = qualBindTopEnv "Modules.qualifyEnv" (origName y) y
> bindGlobal (x, y)
> | uniqueId x == 0 = bindQual (x, y)
> | otherwise = bindTopEnv "Modules.qualifyEnv" x y
......@@ -43,7 +43,7 @@ This module controls the compilation of modules.
> import Checks
> import CompilerEnv
> import CompilerOpts
> import Exports (expandInterface', exportInterface')
> import Exports (expandInterface, exportInterface)
> import qualified Generators as Gen
> import qualified IL as IL
> import Imports (importModules, importModulesExt, qualifyEnv, qualifyEnvExt)
......@@ -181,9 +181,9 @@ Haskell and original MCC where a module obtains \texttt{main}).
> $ uncurry (syntaxCheck opts)
> $ uncurry kindCheck
> (topDs, env)
> modul = Module m es (impDs ++ topDs') -- expandInterface' env2 (Module m es (impDs ++ topDs'))
> modul = Module m es (impDs ++ topDs') -- expandInterface env2 (Module m es (impDs ++ topDs'))
> cEnv = qualifyEnv mEnv env2
> intf = exportInterface' cEnv modul
> intf = exportInterface cEnv modul
> checkModule :: Options -> InterfaceEnv -> Module
> -> (CompilerEnv, Module, Interface, [Message])
......@@ -202,9 +202,9 @@ Haskell and original MCC where a module obtains \texttt{main}).
> $ uncurry (syntaxCheck opts)
> $ uncurry kindCheck
> (topDs, env)
> modul = expandInterface' env2 (Module m es (impDs ++ topDs'))
> modul = expandInterface env2 (Module m es (impDs ++ topDs'))
> cEnv = qualifyEnvExt opts mEnv env2
> intf = exportInterface' cEnv modul
> intf = exportInterface cEnv modul
> -- |Translate FlatCurry into the intermediate language 'IL'
> transModule :: Bool -> CompilerEnv -> Module
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment