Skip to content

GitLab

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

More refactorings

parent 34fddcdd
Hide whitespace changes
Inline Side-by-side
Showing with 447 additions and 454 deletions
curry-frontend.cabal
View file @ 90c3383e
......@@ -71,8 +71,8 @@ Executable cymake
, Env.Arity
, Env.Eval
, Env.Import
, Env.Interfaces
, Env.Label
, Env.Module
, Env.NestEnv
, Env.OldScopeEnv
, Env.OpPrec
......
src/Base/CurryTypes.lhs
View file @ 90c3383e
......@@ -44,7 +44,7 @@ order of type variables in the left hand side of a type declaration.
> toType' tvs (CS.ConstructorType tc tys) =
> TypeConstructor tc (map (toType' tvs) tys)
> toType' tvs (CS.VariableType tv) =
> maybe (internalError ("toType " ++ show tv)) TypeVariable (Map.lookup tv tvs)
> maybe (internalError $ "toType " ++ show tv) TypeVariable (Map.lookup tv tvs)
> toType' tvs (CS.TupleType tys)
> | null tys = TypeConstructor (qualify unitId) []
> | otherwise = TypeConstructor (qualify (tupleId (length tys'))) tys'
......
src/Base/ErrorMessages.hs 0 → 100644
View file @ 90c3383e
module Base.ErrorMessages where
import Data.List (intercalate)
import Curry.Base.Ident
errCyclicImport :: [ModuleIdent] -> String
errCyclicImport [] = error "Base.ErrorMessages.errCyclicImport: empty list"
errCyclicImport [m] = "Recursive import for module " ++ moduleName m
errCyclicImport ms = "Cylic import dependency between modules "
++ intercalate ", " inits ++ " and " ++ lastm
where
(inits, lastm) = splitLast $ map moduleName ms
splitLast [] = error "Base.ErrorMessages.splitLast: empty list"
splitLast (x : []) = ([] , x)
splitLast (x : y : ys) = (x : xs, z) where (xs, z) = splitLast (y : ys)
errMissingFile :: FilePath -> String
errMissingFile f = "Missing file \"" ++ f ++ "\""
errFileModuleMismatch :: FilePath -> ModuleIdent -> String
errFileModuleMismatch f m = "File name '" ++ f
++ "' does not match module name '" ++ moduleName m ++ "'"
errModuleFileMismatch :: ModuleIdent -> String
errModuleFileMismatch mid = "module \"" ++ moduleName mid
++ "\" must be in a file \"" ++ moduleName mid ++ ".(l)curry\""
errWrongInterface :: ModuleIdent -> ModuleIdent -> String
errWrongInterface m m' =
"Expected interface for " ++ show m ++ " but found " ++ show m'
++ show (moduleQualifiers m, moduleQualifiers m')
errWrongModule :: ModuleIdent -> ModuleIdent -> String
errWrongModule m m' =
"Expected module for " ++ show m ++ " but found " ++ show m'
++ show (moduleQualifiers m, moduleQualifiers m')
errInterfaceNotFound :: ModuleIdent -> String
errInterfaceNotFound m = "Interface for module " ++ moduleName m ++ " not found"
errInterfaceModuleMismatch :: ModuleIdent -> ModuleIdent -> String
errInterfaceModuleMismatch mi mm =
"Interface " ++ show mi ++ " does not match module " ++ show mm
src/Base/Subst.lhs
View file @ 90c3383e
......@@ -14,8 +14,8 @@ marked with a boolean flag (see below).
> module Base.Subst
> ( Subst (..), IntSubst (..), idSubst, substToList, bindSubst, unbindSubst
> , compose, substVar', isubstVar, restrictSubstTo
> )where
> , compose, substVar', isubstVar, restrictSubstTo
> ) where
> import qualified Data.Map as Map
......
src/Base/TypeSubst.lhs
View file @ 90c3383e
......@@ -9,7 +9,9 @@
This module implements substitutions on types.
\begin{verbatim}
> module Base.TypeSubst (module Base.TypeSubst, idSubst, bindSubst, compose) where
> module Base.TypeSubst
> ( module Base.TypeSubst, idSubst, bindSubst, compose
> ) where
> import Data.List (nub)
> import Data.Maybe (fromJust, isJust)
......
src/Base/Typing.lhs
View file @ 90c3383e
......@@ -19,7 +19,7 @@
> import Base.Messages (internalError)
> import Base.Types
> import Base.TypeSubst
> import Base.Utils
> import Base.Utils (foldr2)
> import Env.TopEnv
> import Env.Value (ValueEnv, ValueInfo (..), lookupValue, qualLookupValue)
......
src/Base/Utils.lhs
View file @ 90c3383e
......@@ -11,8 +11,7 @@ commonly used in the compiler, but not implemented in the Haskell
\begin{verbatim}
> module Base.Utils
> ( fst3, snd3, thd3, apFst3, apSnd3, apThd3, curry3, uncurry3
> , (++!), foldl2, foldr2, mapAccumM, findDouble
> ( thd3, (++!), foldr2, mapAccumM, findDouble
> ) where
> infixr 5 ++!
......@@ -24,29 +23,29 @@ triples. We provide projection, (un-)currying, and mapping for triples
here.
\begin{verbatim}
> fst3 :: (a, b, c) -> a
> fst3 (x, _, _) = x
fst3 :: (a, b, c) -> a
fst3 (x, _, _) = x
> snd3 :: (a, b, c) -> b
> snd3 (_, y, _) = y
snd3 :: (a, b, c) -> b
snd3 (_, y, _) = y
> thd3 :: (a, b, c) -> c
> thd3 (_, _, z) = z
> apFst3 :: (a -> d) -> (a, b, c) -> (d, b, c)
> apFst3 f (x, y, z) = (f x, y, z)
apFst3 :: (a -> d) -> (a, b, c) -> (d, b, c)
apFst3 f (x, y, z) = (f x, y, z)
> apSnd3 :: (b -> d) -> (a, b, c) -> (a, d, c)
> apSnd3 f (x, y, z) = (x, f y, z)
apSnd3 :: (b -> d) -> (a, b, c) -> (a, d, c)
apSnd3 f (x, y, z) = (x, f y, z)
> apThd3 :: (c -> d) -> (a, b, c) -> (a, b, d)
> apThd3 f (x, y, z) = (x, y, f z)
apThd3 :: (c -> d) -> (a, b, c) -> (a, b, d)
apThd3 f (x, y, z) = (x, y, f z)
> curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
> curry3 f x y z = f (x, y, z)
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 f x y z = f (x, y, z)
> uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
> uncurry3 f (x, y, z) = f x y z
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f (x, y, z) = f x y z
\end{verbatim}
\paragraph{Lists}
......@@ -79,10 +78,10 @@ Fold operations with two arguments lists can be defined using
definitions are unfolded for efficiency reasons.
\begin{verbatim}
> foldl2 :: (a -> b -> c -> a) -> a -> [b] -> [c] -> a
> foldl2 _ z [] _ = z
> foldl2 _ z _ [] = z
> foldl2 f z (x : xs) (y : ys) = foldl2 f (f z x y) xs ys
foldl2 :: (a -> b -> c -> a) -> a -> [b] -> [c] -> a
foldl2 _ z [] _ = z
foldl2 _ z _ [] = z
foldl2 f z (x : xs) (y : ys) = foldl2 f (f z x y) xs ys
> foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
> foldr2 _ z [] _ = z
......
src/Check/TypeCheck.lhs
View file @ 90c3383e
......@@ -41,7 +41,7 @@ type annotation is present.
> import Base.SCC
> import Base.Types
> import Base.TypeSubst
> import Base.Utils
> import Base.Utils (foldr2)
> import Env.TopEnv
> import Env.TypeConstructors (TCEnv, TypeInfo (..), bindTypeInfo, qualLookupTC)
......
src/Check/WarnCheck.hs
View file @ 90c3383e
......@@ -211,7 +211,7 @@ checkExpression mid (Tuple _ exprs)
checkExpression mid (List _ exprs)
= foldM' (checkExpression mid ) exprs
checkExpression mid (ListCompr _ expr stmts) = withScope $ do
foldM' (CheckMment mid ) stmts
foldM' (checkStatement mid) stmts
checkExpression mid expr
idents' <- returnUnrefVars
when (not $ null idents') $ foldM' genWarning' $ map unrefVar idents'
......@@ -249,7 +249,7 @@ checkExpression mid (Let decls expr) = withScope $ do
idents' <- returnUnrefVars
when (not $ null idents') $ foldM' genWarning' $ map unrefVar idents'
checkExpression mid (Do stmts expr) = withScope $ do
foldM' (CheckMment mid ) stmts
foldM' (checkStatement mid ) stmts
checkExpression mid expr
idents' <- returnUnrefVars
when (not $ null idents') $ foldM' genWarning' $ map unrefVar idents'
......@@ -269,15 +269,15 @@ checkExpression mid (RecordUpdate fields expr) = do
checkExpression _ _ = checked
--
CheckMment :: ModuleIdent -> Statement -> CheckM ()
CheckMment mid (StmtExpr _ expr)
checkStatement :: ModuleIdent -> Statement -> CheckM ()
checkStatement mid (StmtExpr _ expr)
= checkExpression mid expr
CheckMment mid (StmtDecl decls) = do
checkStatement mid (StmtDecl decls) = do
foldM' checkLocalDecl decls
foldM' insertDecl decls
foldM' (checkDecl mid) decls
checkDeclOccurrences decls
CheckMment mid (StmtBind _ cterm expr) = do
checkStatement mid (StmtBind _ cterm expr) = do
checkConstrTerm mid cterm
insertConstrTerm False cterm
checkExpression mid expr
......@@ -372,7 +372,7 @@ checkDeclOccurrences decls = checkDO (mkIdent "") Map.empty decls
>> checkDO ident env decls')
(Map.lookup ident env))
else checkDO ident env decls'
checkDO _ env (_ : decls') = checkDO (mkIdent "") env decls'
checkDO _ env (_ : decls') = checkDO (mkIdent "") env decls'
-- check import declarations for multiply imported modules
......@@ -556,7 +556,7 @@ genWarning pos msg
where warnMsg = Message (Just pos) msg
genWarning' :: (Position, String) -> CheckM ()
genWarning' = uncury genWarning
genWarning' = uncurry genWarning
--
insertVar :: Ident -> CheckM ()
......
src/CompilerEnv.hs
View file @ 90c3383e
......@@ -5,8 +5,8 @@ import Curry.Base.Ident (ModuleIdent)
import Env.Arity
import Env.Eval
import Env.Import
import Env.Interfaces
import Env.Label
import Env.Module
import Env.OpPrec
import Env.TypeConstructors
import Env.Value
......@@ -17,8 +17,8 @@ data CompilerEnv = CompilerEnv
, arityEnv :: ArityEnv
, evalAnnotEnv :: EvalEnv
, importEnv :: ImportEnv
, interfaceEnv :: InterfaceEnv
, labelEnv :: LabelEnv
, moduleEnv :: ModuleEnv
, opPrecEnv :: PEnv
, tyConsEnv :: TCEnv
, valueEnv :: ValueEnv
......@@ -30,8 +30,8 @@ initCompilerEnv mid = CompilerEnv
, arityEnv = initAEnv
, evalAnnotEnv = initEEnv
, importEnv = initIEnv
, interfaceEnv = initInterfaceEnv
, labelEnv = initLEnv
, moduleEnv = initMEnv
, opPrecEnv = initPEnv
, tyConsEnv = initTCEnv
, valueEnv = initDCEnv
......
src/CurryBuilder.hs
View file @ 90c3383e
......@@ -8,7 +8,7 @@
module CurryBuilder (buildCurry, smake) where
import Control.Monad (liftM)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Data.Maybe (catMaybes, mapMaybe)
import System.Time (ClockTime)
import Curry.Base.Ident
......@@ -16,6 +16,7 @@ import Curry.Files.Filenames
import Curry.Files.PathUtils ( dropExtension, doesModuleExist, lookupCurryFile
, getModuleModTime, tryGetModuleModTime)
import Base.ErrorMessages (errMissingFile)
import Base.Messages (status, abortWith)
import CompilerOpts (Options (..), TargetType (..))
......@@ -30,48 +31,45 @@ buildCurry :: Options -> FilePath -> IO ()
buildCurry opts file = do
mbFile <- lookupCurryFile (optImportPaths opts) file
case mbFile of
Nothing -> abortWith [missingModule file]
Nothing -> abortWith [errMissingFile file]
Just f -> do
(mods, errs) <- flatDeps opts f
if null errs
then makeCurry (defaultToFlatCurry opts) mods f
else abortWith errs
where
missingModule f = "Error: missing module \"" ++ f ++ "\""
defaultToFlatCurry opt
| null $ optTargetTypes opt = opt { optTargetTypes = [FlatCurry] }
| otherwise = opt
where defaultToFlatCurry opt
| null $ optTargetTypes opt = opt { optTargetTypes = [FlatCurry] }
| otherwise = opt
makeCurry :: Options -> [(ModuleIdent, Source)] -> FilePath -> IO ()
makeCurry opts mods targetFile = mapM_ (compile . snd) mods where
compile (Interface _) = return ()
compile Unknown = return ()
compile (Source file deps) = do
flatIntfExists <- doesModuleExist $ flatIntName file
interfaceExists <- doesModuleExist $ flatIntName file
if dropExtension targetFile == dropExtension file
then if flatIntfExists && not (optForce opts) && null (optDumps opts)
then smake (targetNames file)
(targetFile : mapMaybe flatInterface deps)
(generateFile file)
(skipFile file)
then if interfaceExists && not (optForce opts) && null (optDumps opts)
then smake (targetNames file) -- dest files
(file : mapMaybe flatInterface deps) -- dep files
(generateFile file) -- action on changed
(skipFile file) -- action on unchanged
else generateFile file
else if flatIntfExists
then smake [flatName' opts file]
(file : mapMaybe flatInterface deps)
(compileFile file)
(skipFile file)
else if interfaceExists
then smake [flatName' file]
(file : mapMaybe flatInterface deps)
(compileFile file)
(skipFile file)
else compileFile file
compile _ = return ()
targetNames fn = [ gen fn | (tgt, gen) <- nameGens, tgt `elem` optTargetTypes opts]
targetNames fn = [ gen fn | (tgt, gen) <- nameGens
, tgt `elem` optTargetTypes opts]
where nameGens =
[ (FlatCurry , flatName )
, (ExtendedFlatCurry , extFlatName)
, (FlatXml , xmlName )
, (AbstractCurry , acyName )
, (UntypedAbstractCurry , uacyName )
, (Parsed , \ f -> fromMaybe (sourceRepName f)
(optOutput opts))
, (FlatXml , xmlName )
[ (FlatCurry , flatName )
, (ExtendedFlatCurry , extFlatName )
, (FlatXml , xmlName )
, (AbstractCurry , acyName )
, (UntypedAbstractCurry , uacyName )
, (Parsed , sourceRepName)
, (FlatXml , xmlName )
]
flatInterface mod1 = case lookup mod1 mods of
......@@ -79,25 +77,19 @@ makeCurry opts mods targetFile = mapM_ (compile . snd) mods where
Just (Interface file) -> Just $ flatIntName file
_ -> Nothing
flatName'
| ExtendedFlatCurry `elem` optTargetTypes opts = extFlatName
| otherwise = flatName
compileFile f = do
status opts $ "compiling " ++ f
compileModule (compOpts True) f
skipFile f = status opts $ "skipping " ++ f
compileModule (opts { optTargetTypes = [FlatCurry], optDumps = [] }) f
generateFile f = do
status opts $ "generating " ++ head (targetNames f)
compileModule (compOpts False) f
compileModule opts f
compOpts isImport
| isImport = opts { optTargetTypes = [FlatCurry], optDumps = [] }
| otherwise = opts
flatName' :: Options -> FilePath -> FilePath
flatName' opts
| ExtendedFlatCurry `elem` optTargetTypes opts = extFlatName
| otherwise = flatName
skipFile f = status opts $ "skipping " ++ f
{- |A simple make function
......
src/CurryDeps.lhs
View file @ 90c3383e
......@@ -15,18 +15,19 @@ dependencies and to update programs composed of multiple modules.
\begin{verbatim}
> module CurryDeps
> ( Source (..), deps, flatDeps, flattenDeps, sourceDeps, moduleDeps ) where
> ( Source (..), flatDeps, deps, flattenDeps, sourceDeps, moduleDeps ) where
> import Control.Monad (foldM)
> import Data.List (intercalate, isSuffixOf, nub)
> import Control.Monad (foldM, liftM, unless)
> import Data.List (isSuffixOf, nub)
> import qualified Data.Map as Map (Map, empty, insert, lookup, toList)
> import Curry.Base.Ident
> import Curry.Base.MessageMonad
> import Curry.Files.Filenames
> import Curry.Files.PathUtils
> import Curry.Syntax hiding (Interface (..))
> import Curry.Syntax (Module (..), Decl (..), parseHeader)
> import Base.ErrorMessages (errCyclicImport, errWrongModule)
> import Base.SCC (scc)
> import CompilerOpts (Options (..), Extension (..))
......@@ -39,34 +40,14 @@ dependencies and to update programs composed of multiple modules.
> type SourceEnv = Map.Map ModuleIdent Source
> flatDeps :: Options -> FilePath -> IO ([(ModuleIdent, Source)], [String])
> flatDeps opts fn = do
> mEnv <- deps implicitPrelude [] libPaths Map.empty fn
> return $ flattenDeps mEnv
> where
> implicitPrelude = NoImplicitPrelude `notElem` optExtensions opts
> libPaths = optImportPaths opts
> deps :: Bool -> [FilePath] -> [FilePath] -> SourceEnv -> FilePath
> -> IO SourceEnv
> deps implicitPrelude paths libPaths mEnv fn
> | e `elem` sourceExts
> = sourceDeps implicitPrelude paths libPaths (mkMIdent [r]) mEnv fn
> | e == icurryExt
> = return Map.empty
> | e `elem` objectExts
> = targetDeps implicitPrelude paths libPaths mEnv r
> | otherwise
> = targetDeps implicitPrelude paths libPaths mEnv fn
> where r = dropExtension fn
> e = takeExtension fn
> targetDeps :: Bool -> [FilePath] -> [FilePath] -> SourceEnv -> FilePath
> -> IO SourceEnv
> targetDeps implicitPrelude paths libraryPaths mEnv fn =
> lookupFile [""] sourceExts fn >>=
> maybe (return (Map.insert m Unknown mEnv))
> (sourceDeps implicitPrelude paths libraryPaths m mEnv)
> where m = mkMIdent [fn]
> flatDeps opts fn = flattenDeps `liftM` deps opts [] Map.empty fn
> deps :: Options -> [FilePath] -> SourceEnv -> FilePath -> IO SourceEnv
> deps opts paths sEnv fn
> | ext == icurryExt = return Map.empty
> | ext `elem` sourceExts = sourceDeps opts paths sEnv fn
> | otherwise = targetDeps opts paths sEnv fn
> where ext = takeExtension fn
\end{verbatim}
The following functions are used to lookup files related to a given
......@@ -76,13 +57,36 @@ imported modules, the first is used to find source modules, whereas
the library path is used only for finding matching interface files. As
the compiler does not distinguish these paths, we actually check for
interface files in the source paths as well.
Note that the functions \texttt{buildScript} and \texttt{makeDepend}
already remove all directories that are included in the both search
paths from the library paths in order to avoid scanning such
directories more than twice.
\begin{verbatim}
> sourceDeps :: Options -> [FilePath] -> SourceEnv -> FilePath -> IO SourceEnv
> sourceDeps opts paths sEnv fn = do
> hdr <- (ok . parseHeader fn) `liftM` readModule fn
> moduleDeps opts paths sEnv fn hdr
> targetDeps :: Options -> [FilePath] -> SourceEnv -> FilePath -> IO SourceEnv
> targetDeps opts paths sEnv fn = do
> mFile <- lookupFile [""] sourceExts fn
> case mFile of
> Nothing -> return $ Map.insert (mkMIdent [fn]) Unknown sEnv
> Just file -> sourceDeps opts paths sEnv file
> moduleDeps :: Options -> [FilePath] -> SourceEnv -> FilePath -> Module -> IO SourceEnv
> moduleDeps opts paths sEnv fn (Module m _ ds) = case Map.lookup m sEnv of
> Just _ -> return sEnv
> Nothing -> do
> let imps = imports opts m ds
> sEnv' = Map.insert m (Source fn imps) sEnv
> foldM (moduleIdentDeps opts paths) sEnv' imps
> -- |Retrieve the imported modules and add the import of the Prelude
> -- according to the compiler options.
> imports :: Options -> ModuleIdent -> [Decl] -> [ModuleIdent]
> imports opts m ds = nub $
> [preludeMIdent | m /= preludeMIdent && implicitPrelude]
> ++ [m' | ImportDecl _ m' _ _ _ <- ds]
> where implicitPrelude = NoImplicitPrelude `notElem` optExtensions opts
\end{verbatim}
In order to compute the dependency graph, source files for each module
need to be looked up. When a source module is found, its header is
......@@ -92,44 +96,31 @@ is added implicitly to the list of imported modules except for the
prelude itself. Any errors reported by the parser are ignored.
\begin{verbatim}
> moduleDeps :: Bool -> [FilePath] -> [FilePath] -> SourceEnv -> ModuleIdent
> -> IO SourceEnv
> moduleDeps implicitPrelude paths libraryPaths mEnv m =
> case Map.lookup m mEnv of
> Just _ -> return mEnv
> Nothing -> do
> mbFn <- lookupModule paths libraryPaths m
> case mbFn of
> Just fn
> | icurryExt `isSuffixOf` fn ->
> return (Map.insert m (Interface fn) mEnv)
> | otherwise -> sourceDeps implicitPrelude paths libraryPaths m mEnv fn
> Nothing -> return (Map.insert m Unknown mEnv)
> sourceDeps :: Bool -> [FilePath] -> [FilePath] -> ModuleIdent -> SourceEnv
> -> FilePath -> IO SourceEnv
> sourceDeps implicitPrelude paths libraryPaths m mEnv fn = do
> s <- readModule fn
> case fst $ runMsg $ parseHeader fn s of
> Right (Module m' _ ds) ->
> let ms = imports implicitPrelude m' ds in
> foldM (moduleDeps implicitPrelude paths libraryPaths)
> (Map.insert m (Source fn ms) mEnv) ms
> Left _ -> return (Map.insert m (Source fn []) mEnv)
> -- |Retrieve the imported modules and add the import of the Prelude
> -- according to the flag.
> imports :: Bool -> ModuleIdent -> [Decl] -> [ModuleIdent]
> imports implicitPrelude m ds = nub $
> [preludeMIdent | m /= preludeMIdent && implicitPrelude]
> ++ [m' | ImportDecl _ m' _ _ _ <- ds]
> moduleIdentDeps :: Options -> [FilePath] -> SourceEnv -> ModuleIdent -> IO SourceEnv
> moduleIdentDeps opts paths sEnv m = case Map.lookup m sEnv of
> Just _ -> return sEnv
> Nothing -> do
> mFile <- lookupModule paths libraryPaths m
> case mFile of
> Nothing -> return $ Map.insert m Unknown sEnv
> Just fn
> | icurryExt `isSuffixOf` fn -> return $ Map.insert m (Interface fn) sEnv
> | otherwise -> checkModuleHeader fn
> where libraryPaths = optImportPaths opts
> checkModuleHeader fn = do
> hdr@(Module m' _ _) <- (ok . parseHeader fn) `liftM` readModule fn
> unless (m == m') $ error $ errWrongModule m m'
> moduleDeps opts paths sEnv fn hdr
\end{verbatim}
If we want to compile the program instead of generating Makefile
dependencies the environment has to be sorted topologically. Note
that the dependency graph should not contain any cycles.
\begin{verbatim}
> flattenDeps :: SourceEnv -> ([(ModuleIdent, Source)], [String])
> flattenDeps = fdeps . sortDeps where
> flattenDeps = fdeps . sortDeps
> where
> sortDeps :: SourceEnv -> [[(ModuleIdent, Source)]]
> sortDeps = scc modules imports' . Map.toList
>
......@@ -145,13 +136,6 @@ that the dependency graph should not contain any cycles.
> checkdep [] (srcs, errs) = (srcs , errs )
> checkdep [src] (srcs, errs) = (src : srcs, errs )
> checkdep dep (srcs, errs) = (srcs , err : errs)
> where err = cyclicError (map fst dep)
> cyclicError :: [ModuleIdent] -> String
> cyclicError ms = "Cylic import dependency between modules " ++
> intercalate ", " inits ++ " and " ++ lastm where
> (inits, lastm) = splitLast $ map moduleName ms
> splitLast [] = error "CurryDeps.splitLast: empty list"
> splitLast (x : []) = ([] , x)
> splitLast (x : y : ys) = (x : xs, z)
> where (xs, z) = splitLast (y : ys)
> where err = errCyclicImport (map fst dep)
\end{verbatim}
src/Env/Module.hs → src/Env/Interfaces.hs
View file @ 90c3383e
module Env.Module where
module Env.Interfaces where
import qualified Data.Map as Map (Map, empty, lookup)
import Curry.Base.Ident (ModuleIdent)
import Curry.Syntax (IDecl)
type ModuleEnv = Map.Map ModuleIdent [IDecl]
type InterfaceEnv = Map.Map ModuleIdent [IDecl]
lookupModule :: ModuleIdent -> ModuleEnv -> Maybe [IDecl]
lookupModule = Map.lookup
lookupInterface :: ModuleIdent -> InterfaceEnv -> Maybe [IDecl]
lookupInterface = Map.lookup
initMEnv :: ModuleEnv
initMEnv = Map.empty
initInterfaceEnv :: InterfaceEnv
initInterfaceEnv = Map.empty