Many different changes

curry-frontend.cabal

@@ -63,16 +63,16 @@ Executable cymake
     , Base.TypeSubst
     , Base.Typing
     , Base.Utils
-    , Check.KindCheck
-    , Check.PrecCheck
-    , Check.SyntaxCheck
-    , Check.TypeCheck
-    , Check.WarnCheck
+    , Checks.KindCheck
+    , Checks.PrecCheck
+    , Checks.SyntaxCheck
+    , Checks.TypeCheck
+    , Checks.WarnCheck
     , Env.Arity
     , Env.Eval
-    , Env.Interfaces
+    , Env.Interface
     , Env.Label
-    , Env.ModuleAliases
+    , Env.ModuleAlias
     , Env.NestEnv
     , Env.OldScopeEnv
     , Env.OpPrec
@@ -80,19 +80,19 @@ Executable cymake
     , Env.TopEnv
     , Env.TypeConstructors
     , Env.Value
-    , Gen.GenAbstractCurry
-    , Gen.GenFlatCurry
+    , Generators.GenAbstractCurry
+    , Generators.GenFlatCurry
     , Html.CurryHtml
     , Html.SyntaxColoring
     , IL.Pretty
     , IL.Type
     , IL.XML
-    , Transform.CaseCompletion
-    , Transform.CurryToIL
-    , Transform.Desugar
-    , Transform.Lift
-    , Transform.Qual
-    , Transform.Simplify
+    , Transformations.CaseCompletion
+    , Transformations.CurryToIL
+    , Transformations.Desugar
+    , Transformations.Lift
+    , Transformations.Qual
+    , Transformations.Simplify
 Library
   hs-source-dirs:  src
   Build-Depends:   filepath

src/Base/Expr.hs

@@ -16,7 +16,6 @@ import qualified Data.Set as Set (fromList, notMember)
 
 import Curry.Base.Ident
 import Curry.Syntax
-import qualified IL
 
 class Expr e where
   fv :: e -> [Ident]
@@ -200,21 +199,3 @@ bvFuncPatt = bvfp []
  bvfp bvs (InfixFuncPattern t1 _ t2) = foldl bvfp bvs [t1, t2]
  bvfp bvs (RecordPattern fs r)
     = foldl bvfp (maybe bvs (bvfp bvs) r) (map fieldTerm fs)
-    
--- intermediate language
-
-instance Expr IL.Expression where
-  fv (IL.Variable v) = [v]
-  fv (IL.Apply e1 e2) = fv e1 ++ fv e2
-  fv (IL.Case _ _ e alts) = fv e ++ fv alts
-  fv (IL.Or e1 e2) = fv e1 ++ fv e2
-  fv (IL.Exist v e) = filter (/= v) (fv e)
-  fv (IL.Let (IL.Binding v e1) e2) = fv e1 ++ filter (/= v) (fv e2)
-  fv (IL.Letrec bds e) = filter (`notElem` vs) (fv es ++ fv e)
-    where (vs,es) = unzip [(v,e') | IL.Binding v e' <- bds]
-  fv _ = []
-
-instance Expr IL.Alt where
-  fv (IL.Alt (IL.ConstructorPattern _ vs) e) = filter (`notElem` vs) (fv e)
-  fv (IL.Alt (IL.VariablePattern v) e) = filter (v /=) (fv e)
-  fv (IL.Alt _ e) = fv e

src/Base/TypeSubst.lhs

@@ -16,12 +16,11 @@ This module implements substitutions on types.
 > import Data.List (nub)
 > import Data.Maybe (fromJust, isJust)
 
-> import Env.TopEnv
-> import Env.Value (ValueInfo (..))
-
 > import Base.Subst
 > import Base.Types
 
+> import Env.TopEnv
+> import Env.Value (ValueInfo (..))
 
 > type TypeSubst = Subst Int Type
 

src/Checks.hs

+{- |
+    Module      :  $Header$
+    Description :  Different checks on a Curry module
+    Copyright   :  (c) 2011, Björn Peemöller (bjp@informatik.uni-kiel.de)
+    License     :  OtherLicense
+
+    Maintainer  :  bjp@informatik.uni-kiel.de
+    Stability   :  experimental
+    Portability :  portable
+
+    This module subsumes the different checks to be performed on a Curry
+    module during compilation, e.g. type checking.
+-}
 module Checks where
 
 import Curry.Base.MessageMonad (Message)
 import Curry.Syntax
 
-import qualified Check.KindCheck as KC (kindCheck)
-import qualified Check.PrecCheck as PC (precCheck)
-import qualified Check.SyntaxCheck as SC (syntaxCheck)
-import qualified Check.TypeCheck as TC (typeCheck)
-import qualified Check.WarnCheck as WC (warnCheck)
+import qualified Checks.KindCheck   as KC (kindCheck)
+import qualified Checks.PrecCheck   as PC (precCheck)
+import qualified Checks.SyntaxCheck as SC (syntaxCheck)
+import qualified Checks.TypeCheck   as TC (typeCheck)
+import qualified Checks.WarnCheck   as WC (warnCheck)
 
 import CompilerEnv
 import CompilerOpts
 
+-- TODO: More documentation
+
+-- |Check the kinds of type definitions and signatures.
+-- In addition, nullary type constructors and type variables are dinstiguished
 kindCheck :: [Decl] -> CompilerEnv -> ([Decl], CompilerEnv)
 kindCheck decls env = (decls', env)
   where decls' = KC.kindCheck (moduleIdent env) (tyConsEnv env) decls
 
+-- |Apply the precendences of infix operators.
+-- This function reanrranges the AST.
 precCheck :: [Decl] -> CompilerEnv -> ([Decl], CompilerEnv)
 precCheck decls env = (decls', env { opPrecEnv = pEnv' })
   where (pEnv', decls') = PC.precCheck (moduleIdent env) (opPrecEnv env) decls
 
+-- |Apply the syntax check.
 syntaxCheck :: Options -> [Decl] -> CompilerEnv -> ([Decl], CompilerEnv)
 syntaxCheck opts decls env = (decls', env)
   where decls' = SC.syntaxCheck withExt (moduleIdent env) (aliasEnv env)
                    (arityEnv env) (valueEnv env) (tyConsEnv env) decls
         withExt = BerndExtension `elem` optExtensions opts
 
+-- |Apply the type check.
 typeCheck :: [Decl] -> CompilerEnv -> ([Decl], CompilerEnv)
 typeCheck decls env = (decls, env { tyConsEnv = tcEnv', valueEnv = tyEnv' })
   where (tcEnv', tyEnv') = TC.typeCheck (moduleIdent env)
                               (tyConsEnv env) (valueEnv env) decls
 
+-- TODO: Which one?
+
+-- |Check for warnings.
 warnCheck :: CompilerEnv -> ([Decl], [Decl]) -> [Message]
 warnCheck env = uncurry $ WC.warnCheck (moduleIdent env) (valueEnv env)

src/Check/KindCheck.lhs → src/Checks/KindCheck.lhs

@@ -22,7 +22,7 @@ hand side of a type declaration are actually defined and no identifier
 is defined more than once.
 \begin{verbatim}
 
-> module Check.KindCheck (kindCheck) where
+> module Checks.KindCheck (kindCheck) where
 
 > import Curry.Base.Position
 > import Curry.Base.Ident

src/Check/PrecCheck.lhs → src/Checks/PrecCheck.lhs

@@ -15,7 +15,7 @@ and rearrange infix applications according to the relative precedences
 of the operators involved.
 \begin{verbatim}
 
-> module Check.PrecCheck (precCheck) where
+> module Checks.PrecCheck (precCheck) where
 
 > import Data.List (partition, mapAccumL)
 

src/Check/SyntaxCheck.lhs → src/Checks/SyntaxCheck.lhs

@@ -19,7 +19,7 @@ the same key.} Finally, all (adjacent) equations of a function are
 merged into a single definition.
 \begin{verbatim}
 
-> module Check.SyntaxCheck (syntaxCheck) where
+> module Checks.SyntaxCheck (syntaxCheck) where
 
 > import Control.Monad.State as S (State, evalState, get, liftM, modify)
 > import Data.List ((\\), find, insertBy, partition)
@@ -36,7 +36,7 @@ merged into a single definition.
 > import Base.Utils ((++!), findDouble, mapAccumM)
 
 > import Env.Arity (ArityEnv, ArityInfo (..), lookupArity, qualLookupArity)
-> import Env.ModuleAliases (AliasEnv, lookupAlias)
+> import Env.ModuleAlias (AliasEnv, lookupAlias)
 > import Env.NestEnv
 > import Env.TypeConstructors (TCEnv, TypeInfo (..), qualLookupTC)
 > import Env.Value (ValueEnv, ValueInfo (..))
@@ -72,12 +72,12 @@ A global state transformer is used for generating fresh integer keys
 by which the variables get renamed.
 \begin{verbatim}
 
-> type RenameState a = S.State Int a
+> type RenameState a = S.State Integer a
 
 > run :: RenameState a -> a
 > run m = S.evalState m (globalKey + 1)
 
-> newId :: RenameState Int
+> newId :: RenameState Integer
 > newId = S.modify succ >> S.get
 
 \end{verbatim}
@@ -108,7 +108,7 @@ allow the usage of the qualified list constructor \texttt{(prelude.:)}.
 >                 | RecordLabel QualIdent [Ident]
 >                   deriving (Eq, Show)
 
-> globalKey :: Int
+> globalKey :: Integer
 > globalKey = uniqueId (mkIdent "")
 
 > renameInfo :: TCEnv -> AliasEnv -> ArityEnv -> ValueInfo -> RenameInfo
@@ -253,7 +253,7 @@ local declarations.
 > checkModule withExt m env ds = liftM snd (checkTopDecls withExt m env ds)
 
 > checkTopDecls :: Bool -> ModuleIdent -> RenameEnv -> [Decl]
->               -> RenameState (RenameEnv,[Decl])
+>               -> RenameState (RenameEnv, [Decl])
 > checkTopDecls withExt m env ds =
 >   checkDeclGroup (bindFuncDecl m) withExt m globalKey env ds
 
@@ -288,14 +288,14 @@ top-level.
 >   newId >>= \k -> checkDeclGroup bindVarDecl withExt m k (nestEnv env) ds
 
 > checkDeclGroup :: (Decl -> RenameEnv -> RenameEnv) -> Bool -> ModuleIdent
->                 -> Int -> RenameEnv -> [Decl]
+>                 -> Integer -> RenameEnv -> [Decl]
 >                 -> RenameState (RenameEnv,[Decl])
 > checkDeclGroup bindDecl withExt m k env ds =
 >   mapM (checkDeclLhs withExt k m env) ds' >>=
 >   checkDecls bindDecl withExt m env . joinEquations
 >  where ds' = sortFuncDecls ds
 
-> checkDeclLhs :: Bool -> Int -> ModuleIdent -> RenameEnv -> Decl -> RenameState Decl
+> checkDeclLhs :: Bool -> Integer -> ModuleIdent -> RenameEnv -> Decl -> RenameState Decl
 > checkDeclLhs _       k _ _ (InfixDecl p fix' pr ops) =
 >   return (InfixDecl p fix' pr (map (flip renameIdent k) ops))
 > checkDeclLhs _       k _ env (TypeSig p vs ty) =
@@ -318,7 +318,7 @@ top-level.
 >             (map (checkVar "free variables declaration" k env) vs))
 > checkDeclLhs _ _ _ _ d = return d
 
-> checkEquationLhs :: Bool -> Int -> ModuleIdent -> RenameEnv -> Position
+> checkEquationLhs :: Bool -> Integer -> ModuleIdent -> RenameEnv -> Position
 >	           -> [Equation] -> RenameState Decl
 > checkEquationLhs withExt k m env p [Equation p' lhs rhs] =
 >   either (return . funDecl) (checkDeclLhs withExt k m env . patDecl)
@@ -329,7 +329,7 @@ top-level.
 >           | otherwise = PatternDecl p' t rhs
 > checkEquationLhs _ _ _ _ _ _ = internalError "checkEquationLhs"
 
-> checkEqLhs :: ModuleIdent -> Int -> RenameEnv -> Position -> Lhs
+> checkEqLhs :: ModuleIdent -> Integer -> RenameEnv -> Position -> Lhs
 >            -> Either (Ident,Lhs) ConstrTerm
 > checkEqLhs m k env _ (FunLhs f ts)
 >   | isDataConstr f env
@@ -358,7 +358,7 @@ top-level.
 >     Right _ -> errorAt' $ nonVariable "curried definition" f
 >   where (f,_) = flatLhs lhs
 
-> checkOpLhs :: Int -> RenameEnv -> (ConstrTerm -> ConstrTerm) -> ConstrTerm
+> checkOpLhs :: Integer -> RenameEnv -> (ConstrTerm -> ConstrTerm) -> ConstrTerm
 >            -> Either (Ident,Lhs) ConstrTerm
 > checkOpLhs k env f (InfixPattern t1 op t2)
 >   | isJust m || isDataConstr op' env =
@@ -368,14 +368,14 @@ top-level.
 >         op'' = renameIdent op' k
 > checkOpLhs _ _ f t = Right (f t)
 
-> checkVar :: String -> Int -> RenameEnv -> Ident -> Ident
+> checkVar :: String -> Integer -> RenameEnv -> Ident -> Ident
 > checkVar what k env v
 >   | False && isDataConstr v env = errorAt' (nonVariable what v)---------------
 >   | otherwise = renameIdent v k
 
 
 > checkDecls :: (Decl -> RenameEnv -> RenameEnv) -> Bool -> ModuleIdent
->	        -> RenameEnv -> [Decl] -> RenameState (RenameEnv,[Decl])
+>	        -> RenameEnv -> [Decl] -> RenameState (RenameEnv, [Decl])
 > checkDecls bindDecl withExt m env ds =
 >   case findDouble bvs of
 >     Nothing ->
@@ -441,7 +441,7 @@ top-level.
 >   checkLhsTerm withExt k p m env lhs >>=
 >   return . checkConstrTerms withExt (nestEnv env)
 
-> checkLhsTerm :: Bool -> Int -> Position -> ModuleIdent -> RenameEnv -> Lhs
+> checkLhsTerm :: Bool -> Integer -> Position -> ModuleIdent -> RenameEnv -> Lhs
 >                 -> RenameState Lhs
 > checkLhsTerm withExt k p m env (FunLhs f ts) =
 >   do
@@ -479,7 +479,7 @@ top-level.
 >     Just v -> errorAt' (duplicateVariable v)
 >   where bvs = bv ts
 
-> checkConstrTerm :: Bool -> Int -> Position -> ModuleIdent -> RenameEnv
+> checkConstrTerm :: Bool -> Integer -> Position -> ModuleIdent -> RenameEnv
 >	             -> ConstrTerm -> RenameState ConstrTerm
 > checkConstrTerm _ _ _ _ _ (LiteralPattern l) =
 >   liftM LiteralPattern (renameLiteral l)
@@ -613,7 +613,7 @@ top-level.
 > checkConstrTerm _ _ _ _ _ (InfixFuncPattern _ _ _) = error $
 >   "SyntaxCheck.checkConstrTerm: infix function pattern not defined"
 
-> checkFieldPatt :: Bool -> Int -> ModuleIdent -> QualIdent -> RenameEnv
+> checkFieldPatt :: Bool -> Integer -> ModuleIdent -> QualIdent -> RenameEnv
 >	            -> Field ConstrTerm -> RenameState (Field ConstrTerm)
 > checkFieldPatt withExt k m r env (Field p l t)
 >    = case (lookupVar l env) of

src/Check/TypeCheck.lhs → src/Checks/TypeCheck.lhs

@@ -21,7 +21,7 @@ unannotated declarations, but allows for polymorphic recursion when a
 type annotation is present.
 \begin{verbatim}
 
-> module Check.TypeCheck (typeCheck) where
+> module Checks.TypeCheck (typeCheck) where
 
 > import Control.Monad.State as S
 > import Data.List (nub, partition)

src/Check/WarnCheck.hs → src/Checks/WarnCheck.hs

@@ -4,7 +4,7 @@
     February 2006,
     Martin Engelke (men@informatik.uni-kiel.de)
 -}
-module Check.WarnCheck (warnCheck) where
+module Checks.WarnCheck (warnCheck) where
 
 import Control.Monad.State (State, execState, filterM, gets, modify, unless, when)
 import qualified Data.Map as Map (empty, insert, lookup)

src/CompilerEnv.hs

+{- |
+    Module      :  $Header$
+    Description :  Environment containing the module's information
+    Copyright   :  (c) 2011, Björn Peemöller (bjp@informatik.uni-kiel.de)
+    License     :  OtherLicense
+
+    Maintainer  :  bjp@informatik.uni-kiel.de
+    Stability   :  experimental
+    Portability :  portable
+
+    This module defines an environment for a module containing the information
+    needed throughout the compilation of the module.
+-}
+
+-- TODO: rename to Base.ModuleEnv ?
+
 module CompilerEnv where
 
 import Curry.Base.Ident (ModuleIdent)
 
 import Env.Arity
 import Env.Eval
-import Env.Interfaces
+import Env.Interface
 import Env.Label
-import Env.ModuleAliases
+import Env.ModuleAlias
 import Env.OpPrec
 import Env.TypeConstructors
 import Env.Value
 
--- |A compiler environment
+-- |A compiler environment contains information about the module currently
+--  compiled. The information is updated during the different stages of
+--  compilation.
 data CompilerEnv = CompilerEnv
-  { moduleIdent  :: ModuleIdent
-  , aliasEnv     :: AliasEnv
-  , arityEnv     :: ArityEnv
-  , evalAnnotEnv :: EvalEnv
-  , interfaceEnv :: InterfaceEnv
-  , labelEnv     :: LabelEnv
-  , opPrecEnv    :: PEnv
-  , tyConsEnv    :: TCEnv
-  , valueEnv     :: ValueEnv
+  { moduleIdent  :: ModuleIdent  -- ^ identifier of the module
+  , aliasEnv     :: AliasEnv     -- ^ aliases for imported modules
+  , arityEnv     :: ArityEnv     -- ^ arity of functions and data constructors
+  , evalAnnotEnv :: EvalEnv      -- ^ evaluation annotations
+  , interfaceEnv :: InterfaceEnv -- ^ declarations of imported interfaces
+  , labelEnv     :: LabelEnv     -- ^ record labels
+  , opPrecEnv    :: PEnv         -- ^ operator precedences
+  , tyConsEnv    :: TCEnv        -- ^ type constructors
+  , valueEnv     :: ValueEnv     -- ^ functions, ...
   }
 
 initCompilerEnv :: ModuleIdent -> CompilerEnv
@@ -31,7 +49,7 @@ initCompilerEnv mid = CompilerEnv
   , arityEnv     = initAEnv
   , evalAnnotEnv = initEEnv
   , interfaceEnv = initInterfaceEnv
-  , labelEnv     = initLEnv
+  , labelEnv     = initLabelEnv
   , opPrecEnv    = initPEnv
   , tyConsEnv    = initTCEnv
   , valueEnv     = initDCEnv

src/CompilerOpts.hs

@@ -37,13 +37,13 @@ data Options = Options
   , optImportPaths :: [FilePath]     -- ^ directories for imports
   , optOutput      :: Maybe FilePath -- ^ name of output file
   , optUseSubdir   :: Bool           -- ^ use subdir for output?
-  , optInterface   :: Bool           -- ^ do not create an interface file
-  , optWarn        :: Bool           -- ^ warnings on/off
-  , optOverlapWarn :: Bool           -- ^ "overlap" warnings on/off
+  , optInterface   :: Bool           -- ^ create an interface file
+  , optWarn        :: Bool           -- ^ show warnings
+  , optOverlapWarn :: Bool           -- ^ show "overlap" warnings
   , optTargetTypes :: [TargetType]   -- ^ what to generate
-  , optExtensions  :: [Extension]    -- ^ language extensions
+  , optExtensions  :: [Extension]    -- ^ enabled language extensions
   , optDumps       :: [DumpLevel]    -- ^ dumps
-  } -- deriving Show
+  }
 
 -- | Default compiler options
 defaultOptions :: Options
@@ -64,14 +64,14 @@ defaultOptions = Options
   , optDumps       = []
   }
 
--- |Data type representing the type of the target file
+-- |Type of the target file
 data TargetType
-  = Parsed
-  | FlatCurry
-  | ExtendedFlatCurry
-  | FlatXml
-  | AbstractCurry
-  | UntypedAbstractCurry
+  = Parsed                -- ^ Parsed source code
+  | FlatCurry             -- ^ FlatCurry
+  | ExtendedFlatCurry     -- ^ Extended FlatCurry
+  | FlatXml               -- ^ FlatCurry as XML
+  | AbstractCurry         -- ^ AbstractCurry
+  | UntypedAbstractCurry  -- ^ UntypedAbstractCurry
     deriving Eq
 
 -- |Data type representing the verbosity level
@@ -90,11 +90,11 @@ classifyVerbosity _   = Verbose
 
 -- |Data type for representing code dumps
 data DumpLevel
-  = DumpRenamed      -- ^ dump source after renaming
-  | DumpTypes        -- ^ dump types after typechecking
-  | DumpDesugared    -- ^ dump source after desugaring
-  | DumpSimplified   -- ^ dump source after simplification
-  | DumpLifted       -- ^ dump source after lambda-lifting
+  = DumpRenamed      -- ^ dump source  after renaming
+  | DumpTypes        -- ^ dump types   after typechecking
+  | DumpDesugared    -- ^ dump source  after desugaring
+  | DumpSimplified   -- ^ dump source  after simplification
+  | DumpLifted       -- ^ dump source  after lambda-lifting
   | DumpIL           -- ^ dump IL code after translation
   | DumpCase         -- ^ dump IL code after case elimination
     deriving (Eq, Bounded, Enum, Show)

src/CurryBuilder.hs

-{- |CurryBuilder - Generates Curry representations for a Curry source file
-                   including all imported modules.
-
-    September 2005, Martin Engelke (men@informatik.uni-kiel.de)
-    March 2007, extensions by Sebastian Fischer (sebf@informatik.uni-kiel.de)
-    May 2011, refinements b Bjoern Peemoeller  (bjp@informatik.uni-kiel.de)
+{- |
+    Module      :  $Header$
+    Description :  Build tool for compiling multiple Curry modules
+    Copyright   :  (c) 2005, Martin Engelke (men@informatik.uni-kiel.de)
+                       2007, Sebastian Fischer (sebf@informatik.uni-kiel.de)
+                       2011, Björn Peemöller (bjp@informatik.uni-kiel.de)
+    License     :  OtherLicense
+
+    Maintainer  :  bjp@informatik.uni-kiel.de
+    Stability   :  experimental
+    Portability :  portable
+
+    This module contains functions to generate Curry representations for a
+    Curry source file including all imported modules.
 -}
 module CurryBuilder (buildCurry, smake) where
 
@@ -23,45 +31,53 @@ import CompilerOpts (Options (..), TargetType (..))
 import CurryDeps (Source (..), flatDeps)
 import Modules (compileModule)
 
-{- |Compile the Curry program 'file' including all imported modules,
-    depending on the 'Options'. The compilation was successful if the
-    returned list is empty, otherwise it contains error messages.
--}
+-- |Compile the Curry module in the given source file including all imported
+-- modules, depending on the 'Options'.
 buildCurry :: Options -> FilePath -> IO ()
 buildCurry opts file = do
   mbFile <- lookupCurryFile (optImportPaths opts) file
   case mbFile of
     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 defaultToFlatCurry opt
-          | null $ optTargetTypes opt = opt { optTargetTypes = [FlatCurry] }
-          | otherwise                 = opt
+    Just fn -> do
+      (srcs, depErrs) <- flatDeps opts fn
+      if not $ null depErrs
+        then abortWith depErrs
+        else makeCurry (defaultToFlatCurry opts) srcs fn
+  where
+    defaultToFlatCurry opt
+      | null $ optTargetTypes opt = opt { optTargetTypes = [FlatCurry] }
+      | otherwise                 = opt
 
+-- |Compiles the given source modules, which must be in topological order
 makeCurry :: Options -> [(ModuleIdent, Source)] -> FilePath -> IO ()
-makeCurry opts mods targetFile = mapM_ (compile . snd) mods where
-  compile (Source file deps) = do
-    interfaceExists <- doesModuleExist $ flatIntName file
-    if dropExtension targetFile == dropExtension 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 interfaceExists
-              then smake [flatName' file]
-                         (file : mapMaybe flatInterface deps)
-                         (compileFile file)
-                         (skipFile file)
-              else compileFile file
+makeCurry opts srcs targetFile = mapM_ (compile . snd) srcs where
+  compile (Source fn deps) = do
+    interfaceExists <- doesModuleExist $ flatIntName fn
+
+    let isFinalFile = dropExtension targetFile == dropExtension fn
+        isEnforced  = optForce opts || (not $ null $ optDumps opts)
+        destFiles   = if isFinalFile then destNames fn else [flatName' fn]
+        depFiles    = fn : mapMaybe flatInterface deps
+        actOutdated = if isFinalFile then generateFile fn else compileFile fn
+        actUpToDate = skipFile fn
+
+    if interfaceExists && not (isEnforced && isFinalFile)
+       then smake destFiles depFiles actOutdated actUpToDate
+       else actOutdated
   compile _ = return ()
 
-  targetNames fn = [ gen fn | (tgt, gen) <- nameGens
-                   , tgt `elem` optTargetTypes opts]
+  compileFile f = do
+    status opts $ "compiling " ++ f
+    compileModule (opts { optTargetTypes = [FlatCurry], optDumps = [] }) f
+
+  skipFile f = status opts $ "skipping " ++ f
+
+  generateFile f = do
+    status opts $ "generating " ++ head (destNames f)
+    compileModule opts f
+
+  destNames fn = [ gen fn | (tgt, gen) <- nameGens
+               , tgt `elem` optTargetTypes opts]
     where nameGens =
             [ (FlatCurry            , flatName     )
             , (ExtendedFlatCurry    , extFlatName  )
@@ -72,52 +88,38 @@ makeCurry opts mods targetFile = mapM_ (compile . snd) mods where
             , (FlatXml              , xmlName      )
             ]
 
-  flatInterface mod1 = case lookup mod1 mods of
-    Just (Source file _)  -> Just $ flatIntName file
-    Just (Interface file) -> Just $ flatIntName file
-    _                     -> Nothing
-
-  flatName'
-    | ExtendedFlatCurry `elem` optTargetTypes opts = extFlatName
-    | otherwise                                    = flatName
-
-  compileFile f = do
-    status opts $ "compiling " ++ f
-    compileModule (opts { optTargetTypes = [FlatCurry], optDumps = [] }) f
-
-  generateFile f = do
-    status opts $ "generating " ++ head (targetNames f)
-    compileModule opts f
-
-  skipFile f = status opts $ "skipping " ++ f
-
-{- |A simple make function
-
-    smake <destination files>
-          <dependencies>
-          <io action, if dependencies are newer than destination files>
-          <io action, if destination files are newer than dependencies>
--}
-smake :: [FilePath] -> [FilePath] -> IO a -> IO a -> IO a
-smake dests deps cmd alt = do
+  flatInterface m = case lookup m srcs of
+    Just (Source fn  _) -> Just $ flatIntName fn
+    Just (Interface fn) -> Just $ flatIntName fn
+    _                   -> Nothing
+
+  extTarget = ExtendedFlatCurry `elem` optTargetTypes opts
+  flatName' = if extTarget then extFlatName else flatName
+
+-- |A simple make function
+smake :: [FilePath] -- ^ destination files
+      -> [FilePath] -- ^ dependency files
+      -> IO a       -- ^ action to perform if depedency files are newer
+      -> IO a       -- ^ action to perform if destination files are newer
+      -> IO a