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

Bug of missing arity removed

parent c379b538
...@@ -104,8 +104,8 @@ allow the usage of the qualified list constructor \texttt{(prelude.:)}. ...@@ -104,8 +104,8 @@ allow the usage of the qualified list constructor \texttt{(prelude.:)}.
> data RenameInfo = Constr Int > data RenameInfo = Constr Int
> | GlobalVar Int QualIdent > | GlobalVar Int QualIdent
> | LocalVar Int Ident > | LocalVar Int Ident
> | RecordLabel QualIdent [Ident] > | RecordLabel QualIdent [Ident]
> deriving (Eq,Show) > deriving (Eq,Show)
> globalKey :: Int > globalKey :: Int
> globalKey = uniqueId (mkIdent "") > globalKey = uniqueId (mkIdent "")
...@@ -118,23 +118,20 @@ allow the usage of the qualified list constructor \texttt{(prelude.:)}. ...@@ -118,23 +118,20 @@ allow the usage of the qualified list constructor \texttt{(prelude.:)}.
> renameInfo _ iEnv aEnv (Value qid _) > renameInfo _ iEnv aEnv (Value qid _)
> = let (mmid, ident) = (qualidMod qid, qualidId qid) > = let (mmid, ident) = (qualidMod qid, qualidId qid)
> qid' = maybe qid > qid' = maybe qid
> (\mid -> maybe qid > (\mid -> maybe qid
> (\mid' -> qualifyWith mid' ident) > (\mid' -> qualifyWith mid' ident)
> (lookupAlias mid iEnv)) > (lookupAlias mid iEnv))
> mmid > mmid
> in case (lookupArity ident aEnv) of > in case lookupArity ident aEnv of
> [ArityInfo _ arity'] -> GlobalVar arity' qid > [ArityInfo _ arity'] -> GlobalVar arity' qid
> rs -> case (qualLookupArity qid' aEnv) of > rs -> case qualLookupArity qid' aEnv of
> [ArityInfo _ arity''] -> GlobalVar arity'' qid > [ArityInfo _ arity''] -> GlobalVar arity'' qid
> _ -> maybe (internalError "renameInfo: missing arity") > _ -> maybe (internalError $ "renameInfo: missing arity for " ++ show qid)
> (\ (ArityInfo _ arity'') -> GlobalVar arity'' qid) > (\ (ArityInfo _ arity'') -> GlobalVar arity'' qid)
> (find (\ (ArityInfo qid'' _) > (find (\ (ArityInfo qid'' _) -> qid'' == qid) rs)
> -> qid'' == qid) rs) > renameInfo tcEnv _ _ (Label _ r _) = case (qualLookupTC r tcEnv) of
> renameInfo tcEnv _ _ (Label _ r _) > [AliasType _ _ (TypeRecord fs _)] -> RecordLabel r (map fst fs)
> = case (qualLookupTC r tcEnv) of > _ -> internalError "renameInfo: no record"
> [AliasType _ _ (TypeRecord fs _)] ->
> RecordLabel r (map fst fs)
> _ -> internalError "renameInfo: no record"
\end{verbatim} \end{verbatim}
Since record types are currently translated into data types, it is Since record types are currently translated into data types, it is
......
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
September 2005, Martin Engelke (men@informatik.uni-kiel.de) September 2005, Martin Engelke (men@informatik.uni-kiel.de)
March 2007, extensions by Sebastian Fischer (sebf@informatik.uni-kiel.de) March 2007, extensions by Sebastian Fischer (sebf@informatik.uni-kiel.de)
May 2011, refinements by Bjoern Peemoeller (bjp@informatik.uni-kiel.de) June 2011, refinements by Bjoern Peemoeller (bjp@informatik.uni-kiel.de)
-} -}
module CompilerOpts module CompilerOpts
( Options (..), Verbosity (..), TargetType (..), Extension (..) ( Options (..), Verbosity (..), TargetType (..), Extension (..)
......
% $Id: TopEnv.lhs,v 1.20 2003/10/04 17:04:32 wlux Exp $ % $Id: TopEnv.lhs,v 1.20 2003/10/04 17:04:32 wlux Exp $
% %
% Copyright (c) 1999-2003, Wolfgang Lux % Copyright (c) 1999-2003, Wolfgang Lux
......
...@@ -93,9 +93,9 @@ partitionDecl parts decl@(ImportDecl _ _ _ _ _) ...@@ -93,9 +93,9 @@ partitionDecl parts decl@(ImportDecl _ _ _ _ _)
= parts {importDecls = decl : importDecls parts } = parts {importDecls = decl : importDecls parts }
-- type decls -- type decls
partitionDecl parts decl@(DataDecl _ _ _ _) partitionDecl parts decl@(DataDecl _ _ _ _)
= parts {importDecls = decl : typeDecls parts } = parts {typeDecls = decl : typeDecls parts }
partitionDecl parts decl@(TypeDecl _ _ _ _) partitionDecl parts decl@(TypeDecl _ _ _ _)
= parts {importDecls = decl : typeDecls parts } = parts {typeDecls = decl : typeDecls parts }
-- func decls -- func decls
partitionDecl parts (TypeSig pos ids tyexpr) partitionDecl parts (TypeSig pos ids tyexpr)
= partitionFuncDecls (\ident -> TypeSig pos [ident] tyexpr) parts ids = partitionFuncDecls (\ident -> TypeSig pos [ident] tyexpr) parts ids
......
% $Id: Imports.lhs,v 1.25 2004/02/13 19:24:00 wlux Exp $ % $Id: Imports.lhs,v 1.25 2004/02/13 19:24:00 wlux Exp $
% %
% Copyright (c) 2000-2003, Wolfgang Lux % Copyright (c) 2000-2003, Wolfgang Lux
...@@ -39,8 +38,8 @@ entities defined in the imported module are qualified appropriately. ...@@ -39,8 +38,8 @@ entities defined in the imported module are qualified appropriately.
The same is true for type expressions. The same is true for type expressions.
\begin{verbatim} \begin{verbatim}
> type ExpPEnv = Map.Map Ident PrecInfo > type ExpPEnv = Map.Map Ident PrecInfo
> type ExpTCEnv = Map.Map Ident TypeInfo > type ExpTCEnv = Map.Map Ident TypeInfo
> type ExpValueEnv = Map.Map Ident ValueInfo > type ExpValueEnv = Map.Map Ident ValueInfo
> type ExpArityEnv = Map.Map Ident ArityInfo > type ExpArityEnv = Map.Map Ident ArityInfo
...@@ -54,27 +53,28 @@ using either a qualified import or both a qualified and an unqualified ...@@ -54,27 +53,28 @@ using either a qualified import or both a qualified and an unqualified
import. import.
\begin{verbatim} \begin{verbatim}
> importInterface :: Position -> ModuleIdent -> Bool -> Maybe ImportSpec > importInterface :: ModuleIdent -> Bool -> Maybe ImportSpec
> -> Interface -> PEnv -> TCEnv -> ValueEnv -> ArityEnv > -> Interface -> PEnv -> TCEnv -> ValueEnv -> ArityEnv
> -> (PEnv,TCEnv,ValueEnv,ArityEnv) > -> (PEnv, TCEnv, ValueEnv, ArityEnv)
> importInterface _ m q is i pEnv tcEnv tyEnv aEnv = > importInterface m q is i pEnv tcEnv tyEnv aEnv =
> (importEntities m q vs id mPEnv pEnv, > ( importEntities m q vs id mPEnv pEnv
> importEntities m q ts (importData vs) mTCEnv tcEnv, > , importEntities m q ts (importData vs) mTCEnv tcEnv
> importEntities m q vs id mTyEnv tyEnv, > , importEntities m q vs id mTyEnv tyEnv
> importEntities m q as id mAEnv aEnv) > , importEntities m q as id mAEnv aEnv
> )
> where mPEnv = intfEnv bindPrec i > where mPEnv = intfEnv bindPrec i
> mTCEnv = intfEnv bindTC i > mTCEnv = intfEnv bindTC i
> mTyEnv = intfEnv bindTy i > mTyEnv = intfEnv bindTy i
> mAEnv = intfEnv bindA i > mAEnv = intfEnv bindA i
> is' = maybe [] (expandSpecs m mTCEnv mTyEnv) is > is' = maybe [] (expandSpecs m mTCEnv mTyEnv) is
> ts = isVisible is (Set.fromList (foldr addType [] is')) > ts = isVisible is (Set.fromList (foldr addType [] is'))
> vs = isVisible is (Set.fromList (foldr addValue [] is')) > vs = isVisible is (Set.fromList (foldr addValue [] is'))
> as = isVisible is (Set.fromList (foldr addArity [] is')) > as = isVisible is (Set.fromList (foldr addArity [] is'))
> isVisible :: Maybe ImportSpec -> Set.Set Ident -> Ident -> Bool > isVisible :: Maybe ImportSpec -> Set.Set Ident -> Ident -> Bool
> isVisible (Just (Importing _ _)) xs = (`Set.member` xs) > isVisible (Just (Importing _ _)) xs = (`Set.member` xs)
> isVisible (Just (Hiding _ _)) xs = (`Set.notMember` xs) > isVisible (Just (Hiding _ _)) xs = (`Set.notMember` xs)
> isVisible _ _ = const True > isVisible _ _ = const True
> importEntities :: Entity a => ModuleIdent -> Bool -> (Ident -> Bool) > importEntities :: Entity a => ModuleIdent -> Bool -> (Ident -> Bool)
> -> (a -> a) -> Map.Map Ident a -> TopEnv a -> TopEnv a > -> (a -> a) -> Map.Map Ident a -> TopEnv a -> TopEnv a
......
...@@ -18,7 +18,7 @@ This module controls the compilation of modules. ...@@ -18,7 +18,7 @@ This module controls the compilation of modules.
> import Control.Monad (foldM, liftM, unless, when) > import Control.Monad (foldM, liftM, unless, when)
> import Data.List (find, isPrefixOf, partition) > import Data.List (find, isPrefixOf, partition)
> import qualified Data.Map as Map (Map, empty, insert, insertWith, lookup, toList) > import qualified Data.Map as Map (Map, empty, insert, insertWith, lookup, toList, member)
> import Data.Maybe (fromMaybe) > import Data.Maybe (fromMaybe)
> import Text.PrettyPrint.HughesPJ (Doc, ($$), text, vcat) > import Text.PrettyPrint.HughesPJ (Doc, ($$), text, vcat)
...@@ -108,10 +108,10 @@ code are obsolete and commented out. ...@@ -108,10 +108,10 @@ code are obsolete and commented out.
> if not withFlat > if not withFlat
> then do > then do
> (tyEnv, tcEnv, _, m', _, _) <- simpleCheckModule opts mEnv m > (tyEnv, tcEnv, _, m', _, _) <- simpleCheckModule opts mEnv m
> -- generate untyped AbstractCurry > -- generate AbstractCurry
> when uacy $ genAbstract opts fn tyEnv tcEnv m' > genAbstract opts fn tyEnv tcEnv m'
> -- output the parsed source > -- output the parsed source
> when src $ genParsed opts fn m' > genParsed opts fn m'
> else do > else do
> -- checkModule checks types, and then transModule introduces new > -- checkModule checks types, and then transModule introduces new
> -- functions (by lambda lifting in 'desugar'). Consequence: The > -- functions (by lambda lifting in 'desugar'). Consequence: The
...@@ -122,18 +122,39 @@ code are obsolete and commented out. ...@@ -122,18 +122,39 @@ code are obsolete and commented out.
> -- dump intermediate results > -- dump intermediate results
> mapM_ (doDump opts) dumps > mapM_ (doDump opts) dumps
> -- generate target code > -- generate target code
> when (acy || uacy) $ genAbstract opts fn tyEnv tcEnv m' > genAbstract opts fn tyEnv tcEnv m'
> when (fcy || xml) $ genFlat opts fn mEnv tyEnv tcEnv aEnv' intf m' il > genFlat opts fn mEnv tyEnv tcEnv aEnv' intf m' il
> when src $ genParsed opts fn m' > genParsed opts fn m'
> where > where
> acy = AbstractCurry `elem` optTargetTypes opts
> uacy = UntypedAbstractCurry `elem` optTargetTypes opts
> fcy = FlatCurry `elem` optTargetTypes opts > fcy = FlatCurry `elem` optTargetTypes opts
> xml = FlatXml `elem` optTargetTypes opts > xml = FlatXml `elem` optTargetTypes opts
> src = Parsed `elem` optTargetTypes opts
> extended = ExtendedFlatCurry `elem` optTargetTypes opts
> withFlat = or [fcy, xml] > withFlat = or [fcy, xml]
> likeFlat = not extended > likeFlat = ExtendedFlatCurry `notElem` optTargetTypes opts
\end{verbatim}
An implicit import of the prelude is added to the declarations of
every module, except for the prelude itself, or when the import is disabled
by a compiler option. If no explicit import for the prelude is present,
the prelude is imported unqualified, otherwise a qualified import is added.
\begin{verbatim}
> importPrelude :: Options -> FilePath -> Module -> Module
> importPrelude opts fn m@(Module mid es ds)
> -- the Prelude itself
> | mid == preludeMIdent = m
> -- disabled by compiler option
> | noImpPrelude = m
> -- already imported
> | preludeMIdent `elem` imported = m
> -- let's add it!
> | otherwise = Module mid es (preludeImp : ds)
> where
> noImpPrelude = NoImplicitPrelude `elem` optExtensions opts
> preludeImp = ImportDecl (first fn) preludeMIdent
> False -- qualified?
> Nothing -- no alias
> Nothing -- no selection of types, functions, etc.
> imported = [imp | (ImportDecl _ imp _ _ _) <- ds]
\end{verbatim} \end{verbatim}
A module which doesn't contain a \texttt{module ... where} declaration A module which doesn't contain a \texttt{module ... where} declaration
...@@ -159,31 +180,58 @@ Haskell and original MCC where a module obtains \texttt{main}). ...@@ -159,31 +180,58 @@ Haskell and original MCC where a module obtains \texttt{main}).
> ++ ".curry\"" > ++ ".curry\""
\end{verbatim} \end{verbatim}
An implicit import of the prelude is added to the declarations of If an import declaration for a module is found, the compiler first
every module, except for the prelude itself, or when the import is disabled checks whether an import for the module is already pending. In this
by a compiler option. If no explicit import for the prelude is present, case the module imports are cyclic which is not allowed in Curry. The
the prelude is imported unqualified, otherwise compilation will therefore be aborted. Next, the compiler checks
only a qualified import is added. whether the module has been imported already. If so, nothing needs to
be done, otherwise the interface will be searched for in the import paths
and compiled.
\begin{verbatim} \begin{verbatim}
> importPrelude :: Options -> FilePath -> Module -> Module > -- |Load the interface files into the 'ModuleEnv'
> importPrelude opts fn m@(Module mid es ds) > loadInterfaces :: [FilePath] -> Module -> IO ModuleEnv
> -- the Prelude itself > loadInterfaces paths (Module m _ ds) =
> | mid == preludeMIdent = m > foldM (loadInterface paths [m]) Map.empty
> -- disabled by option > [(p, m') | ImportDecl p m' _ _ _ <- ds]
> | noImpPrelude = m
> -- already imported
> | preludeMIdent `elem` imported = m
> -- let's add it!
> | otherwise = Module mid es (preludeImp : ds)
> where
> noImpPrelude = NoImplicitPrelude `elem` optExtensions opts
> preludeImp = ImportDecl (first fn) preludeMIdent
> False -- qualified
> Nothing -- no alias
> Nothing -- no selection of types, functions, etc.
> imported = [imp | (ImportDecl _ imp _ _ _) <- ds]
> loadInterface :: [FilePath] -> [ModuleIdent] -> ModuleEnv ->
> (Position, ModuleIdent) -> IO ModuleEnv
> loadInterface paths ctxt mEnv (p, m)
> | m `elem` ctxt = errorAt p (cyclicImport m (takeWhile (/= m) ctxt))
> | m `Map.member` mEnv = return mEnv
> | otherwise = lookupInterface paths m >>=
> maybe (errorAt p (interfaceNotFound m))
> (compileInterface paths ctxt mEnv m)
\end{verbatim}
After reading an interface, all imported interfaces are recursively
loaded and entered into the interface's environment. There is no need
to check FlatCurry-Interfaces, since these files contain automatically
generated FlatCurry terms (type \texttt{Prog}).
\begin{verbatim}
> compileInterface :: [FilePath] -> [ModuleIdent] -> ModuleEnv -> ModuleIdent
> -> FilePath -> IO ModuleEnv
> compileInterface paths ctxt mEnv m fn = do
> mintf <- readFlatInterface fn
> let intf = fromMaybe (errorAt (first fn) (interfaceNotFound m)) mintf
> (Prog modul _ _ _ _) = intf
> m' = mkMIdent [modul]
> unless (m' == m) (errorAt (first fn) (wrongInterface m m'))
> mEnv' <- loadFlatInterfaces paths ctxt mEnv intf
> return $ bindFlatInterface intf mEnv'
> loadFlatInterfaces :: [FilePath] -> [ModuleIdent] -> ModuleEnv -> Prog
> -> IO ModuleEnv
> loadFlatInterfaces paths ctxt mEnv (Prog m is _ _ _) =
> foldM (loadInterface paths ((mkMIdent [m]):ctxt))
> mEnv
> (map (\i -> (p, mkMIdent [i])) is)
> where p = first m
Interface files are updated by the Curry builder when necessary.
(see module \texttt{CurryBuilder}).
> -- | > -- |
> simpleCheckModule :: Options -> ModuleEnv -> Module > simpleCheckModule :: Options -> ModuleEnv -> Module
...@@ -192,11 +240,11 @@ only a qualified import is added. ...@@ -192,11 +240,11 @@ only a qualified import is added.
> showWarnings opts warnMsgs > showWarnings opts warnMsgs
> return (tyEnv'', tcEnv, aEnv'', modul, intf, warnMsgs) > return (tyEnv'', tcEnv, aEnv'', modul, intf, warnMsgs)
> where > where
> -- split import declarations > -- split import/other declarations
> (impDs, topDs) = partition isImportDecl ds > (impDs, topDs) = partition isImportDecl ds
> -- build import environment > -- build import environment
> importEnv = fromDeclList impDs > importEnv = fromDeclList impDs
> -- ? > -- add information of imported modules
> (pEnv, tcEnv, tyEnv, aEnv) = importModules mEnv impDs > (pEnv, tcEnv, tyEnv, aEnv) = importModules mEnv impDs
> -- check for warnings > -- check for warnings
> warnMsgs = warnCheck m tyEnv impDs topDs > warnMsgs = warnCheck m tyEnv impDs topDs
...@@ -207,15 +255,14 @@ only a qualified import is added. ...@@ -207,15 +255,14 @@ only a qualified import is added.
> withExt = BerndExtension `elem` optExtensions opts > withExt = BerndExtension `elem` optExtensions opts
> ds' = impDs ++ qual m tyEnv topDs' > ds' = impDs ++ qual m tyEnv topDs'
> modul = (Module m es ds') --expandInterface (Module m es ds') tcEnv tyEnv > modul = (Module m es ds') --expandInterface (Module m es ds') tcEnv tyEnv
> (_, tcEnv'', tyEnv'', aEnv'') > (_, tcEnv'', tyEnv'', aEnv'') = qualifyEnv mEnv pEnv' tcEnv tyEnv aEnv
> = qualifyEnv mEnv pEnv' tcEnv tyEnv aEnv
> intf = exportInterface modul pEnv' tcEnv'' tyEnv'' > intf = exportInterface modul pEnv' tcEnv'' tyEnv''
> checkModule :: Options -> ModuleEnv -> Module > checkModule :: Options -> ModuleEnv -> Module
> -> IO (ValueEnv, TCEnv, ArityEnv, Module, Interface, [WarnMsg]) > -> IO (ValueEnv, TCEnv, ArityEnv, Module, Interface, [WarnMsg])
> checkModule opts mEnv (Module m es ds) = do > checkModule opts mEnv (Module m es ds) = do
> showWarnings opts warnMsgs > showWarnings opts warnMsgs
> when (m == mkMIdent ["field114..."]) (error (show es)) > when (m == mkMIdent ["field114..."]) (error (show es)) -- TODO hack?
> return (tyEnv''', tcEnv', aEnv'', modul, intf, warnMsgs) > return (tyEnv''', tcEnv', aEnv'', modul, intf, warnMsgs)
> where > where
> (impDs, topDs) = partition isImportDecl ds > (impDs, topDs) = partition isImportDecl ds
...@@ -237,8 +284,10 @@ only a qualified import is added. ...@@ -237,8 +284,10 @@ only a qualified import is added.
> -- exported a function from another module. > -- exported a function from another module.
> -- However, there is now a cyclic dependecy > -- However, there is now a cyclic dependecy
> -- but tests didn't show any problems. > -- but tests didn't show any problems.
> -- bjp: Removed the fix of fre because it introduced
> -- missing arities
> (pEnv', topDs') = precCheck m pEnv > (pEnv', topDs') = precCheck m pEnv
> $ syntaxCheck withExt m iEnv aEnv'' tyEnv tcEnv > $ syntaxCheck withExt m iEnv aEnv tyEnv tcEnv
> $ kindCheck m tcEnv topDs > $ kindCheck m tcEnv topDs
> (tcEnv', tyEnv') = typeCheck m tcEnv tyEnv topDs' > (tcEnv', tyEnv') = typeCheck m tcEnv tyEnv topDs'
> ds' = impDs ++ qual m tyEnv' topDs' > ds' = impDs ++ qual m tyEnv' topDs'
...@@ -298,13 +347,13 @@ The function \texttt{importModules} brings the declarations of all ...@@ -298,13 +347,13 @@ The function \texttt{importModules} brings the declarations of all
imported modules into scope for the current module. imported modules into scope for the current module.
\begin{verbatim} \begin{verbatim}
> importModules :: ModuleEnv -> [Decl] -> (PEnv,TCEnv,ValueEnv,ArityEnv) > importModules :: ModuleEnv -> [Decl] -> (PEnv, TCEnv, ValueEnv, ArityEnv)
> importModules mEnv ds = (pEnv, importUnifyData tcEnv, tyEnv, aEnv) > importModules mEnv ds = (pEnv, importUnifyData tcEnv, tyEnv, aEnv)
> where > where
> (pEnv,tcEnv,tyEnv,aEnv) = foldl importModule initEnvs ds > (pEnv,tcEnv,tyEnv,aEnv) = foldl importModule initEnvs ds
> importModule (pEnv',tcEnv',tyEnv',aEnv') (ImportDecl p m q asM is) = > importModule (pEnv', tcEnv', tyEnv', aEnv') (ImportDecl _ m q asM is) =
> case Map.lookup m mEnv of > case Map.lookup m mEnv of
> Just ds1 -> importInterface p (fromMaybe m asM) q is > Just ds1 -> importInterface (fromMaybe m asM) q is
> (Interface m ds1) pEnv' tcEnv' tyEnv' aEnv' > (Interface m ds1) pEnv' tcEnv' tyEnv' aEnv'
> Nothing -> internalError "importModule" > Nothing -> internalError "importModule"
> importModule t _ = t > importModule t _ = t
...@@ -407,62 +456,7 @@ type check. ...@@ -407,62 +456,7 @@ type check.
> TypeRecord (map (\ (l,ty) -> (l,expandRecords tcEnv ty)) fs) rv > TypeRecord (map (\ (l,ty) -> (l,expandRecords tcEnv ty)) fs) rv
> expandRecords _ ty = ty > expandRecords _ ty = ty
\end{verbatim}
If an import declaration for a module is found, the compiler first
checks whether an import for the module is already pending. In this
case the module imports are cyclic which is not allowed in Curry. The
compilation will therefore be aborted. Next, the compiler checks
whether the module has been imported already. If so, nothing needs to
be done, otherwise the interface will be searched in the import paths
and compiled.
\begin{verbatim}
> loadInterface :: [FilePath] -> [ModuleIdent] -> ModuleEnv ->
> (Position, ModuleIdent) -> IO ModuleEnv
> loadInterface paths ctxt mEnv (p,m)
> | m `elem` ctxt = errorAt p (cyclicImport m (takeWhile (/= m) ctxt))
> | isLoaded m mEnv = return mEnv
> | otherwise =
> lookupInterface paths m >>=
> maybe (errorAt p (interfaceNotFound m))
> (compileInterface paths ctxt mEnv m)
> where isLoaded m' mEnv' = maybe False (const True) (Map.lookup m' mEnv')
\end{verbatim}
After reading an interface, all imported interfaces are recursively
loaded and entered into the interface's environment. There is no need
to check FlatCurry-Interfaces, since these files contain automaticaly
generated FlatCurry terms (type \texttt{Prog}).
\begin{verbatim}
> compileInterface :: [FilePath] -> [ModuleIdent] -> ModuleEnv -> ModuleIdent
> -> FilePath -> IO ModuleEnv
> compileInterface paths ctxt mEnv m fn =
> do
> mintf <- readFlatInterface fn
> let intf = fromMaybe (errorAt (first fn) (interfaceNotFound m)) mintf
> (Prog modul _ _ _ _) = intf
> m' = mkMIdent [modul]
> unless (m' == m) (errorAt (first fn) (wrongInterface m m'))
> mEnv' <- loadFlatInterfaces paths ctxt mEnv intf
> return (bindFlatInterface intf mEnv')
> -- |Load the interface files into the 'ModuleEnv'
> loadInterfaces :: [FilePath] -> Module -> IO ModuleEnv
> loadInterfaces paths (Module m _ ds) =
> foldM (loadInterface paths [m]) Map.empty
> [(p, m') | ImportDecl p m' _ _ _ <- ds]
> loadFlatInterfaces :: [FilePath] -> [ModuleIdent] -> ModuleEnv -> Prog
> -> IO ModuleEnv
> loadFlatInterfaces paths ctxt mEnv (Prog m is _ _ _) =
> foldM (loadInterface paths ((mkMIdent [m]):ctxt))
> mEnv
> (map (\i -> (p, mkMIdent [i])) is)
> where p = first m
Interface files are updated by the Curry builder when necessary.
(see module \texttt{CurryBuilder}).
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- File Output -- File Output
...@@ -570,9 +564,10 @@ be dependent on it any longer. ...@@ -570,9 +564,10 @@ be dependent on it any longer.
> genParsed :: Options -> FilePath -> Module -> IO () > genParsed :: Options -> FilePath -> Module -> IO ()
> genParsed opts fn modul = writeModule intoSubdir outputFile modString > genParsed opts fn modul = when src $ writeModule subdir outputFile modString
> where > where
> intoSubdir = optUseSubdir opts > src = Parsed `elem` optTargetTypes opts
> subdir = optUseSubdir opts
> outputFile = fromMaybe (sourceRepName fn) (optOutput opts) > outputFile = fromMaybe (sourceRepName fn) (optOutput opts)
> modString = showModule modul > modString = showModule modul
......
Supports Markdown
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