Adapted new behaviour in Curry file retrieval to allow hierarchical modules

src/CompilerOpts.hs

@@ -26,7 +26,8 @@ import Data.List             (intercalate, nub)
 import Data.Maybe            (isJust)
 import System.Console.GetOpt
 import System.Environment    (getArgs, getProgName)
-import System.FilePath       (splitSearchPath)
+import System.FilePath
+  (addTrailingPathSeparator, normalise, splitSearchPath)
 
 import Curry.Files.Filenames (currySubdir)
 import Curry.Syntax.Extension
@@ -324,7 +325,9 @@ options =
       "search for libraries in dir[:dir]"
   , Option "i"  ["import-dir"]
       (ReqArg (withArg onOpts $ \ arg opts -> opts { optImportPaths =
-        nub $ optImportPaths opts ++ splitSearchPath arg}) "dir[:dir]")
+        nub $ optImportPaths opts ++
+              map (normalise . addTrailingPathSeparator) (splitSearchPath arg)
+              }) "dir[:dir]")
       "search for imports in dir[:dir]"
   , Option []  ["htmldir"]
       (ReqArg (withArg onOpts $ \ arg opts -> opts { optHtmlDir =

src/CurryBuilder.hs

@@ -57,7 +57,7 @@ findCurry opts s = do
   canBeFile    = isCurryFilePath s
   canBeModule  = isValidModuleName s
   moduleFile   = moduleNameToFile $ fromModuleName s
-  paths        = optImportPaths opts
+  paths        = "." : optImportPaths opts
   findFile     = if canBeFile
                     then liftIO $ lookupCurryFile paths s
                     else return Nothing
@@ -79,7 +79,8 @@ findCurry opts s = do
 makeCurry :: Options -> [(ModuleIdent, Source)] ->  CYIO ()
 makeCurry opts srcs = mapM_ process' (zip [1 ..] srcs)
   where
-  total = length srcs
+  total    = length srcs
+  tgtDir m = addCurrySubdirModule (optUseSubdir opts) m
 
   process' :: (Int, (ModuleIdent, Source)) -> CYIO ()
   process' (n, (m, Source fn ps is)) = do
@@ -89,8 +90,8 @@ makeCurry opts srcs = mapM_ process' (zip [1 ..] srcs)
     deps = fn : mapMaybe curryInterface is
 
     curryInterface i = case lookup i srcs of
-      Just (Source    fn' _ _) -> Just $ interfName fn'
-      Just (Interface fn'    ) -> Just $ interfName fn'
+      Just (Source    fn' _ _) -> Just $ tgtDir i $ interfName fn'
+      Just (Interface fn'    ) -> Just $ tgtDir i $ interfName fn'
       _                        -> Nothing
 
   process' _ = return ()
@@ -147,14 +148,16 @@ process :: Options -> (Int, Int)
         -> ModuleIdent -> FilePath -> [FilePath] -> CYIO ()
 process opts idx m fn deps
   | optForce opts = compile
-  | otherwise     = smake (interfName fn : destFiles) deps compile skip
+  | otherwise     = smake (tgtDir (interfName fn) : destFiles) deps compile skip
   where
   skip    = status opts $ compMessage idx "Skipping" m (fn, head destFiles)
   compile = do
     status opts $ compMessage idx "Compiling" m (fn, head destFiles)
     compileModule opts fn
 
-  destFiles = [ addCurrySubdir (optUseSubdir opts) (gen fn)
+  tgtDir = addCurrySubdirModule (optUseSubdir opts) m
+
+  destFiles = [ tgtDir (gen fn)
               | (tgt, gen) <- nameGens, tgt `elem` optTargetTypes opts]
   nameGens  =
     [ (FlatCurry            , flatName     )

src/CurryDeps.hs

@@ -115,7 +115,7 @@ moduleIdentDeps :: Options -> SourceEnv -> ModuleIdent -> CYIO SourceEnv
 moduleIdentDeps opts sEnv m = case Map.lookup m sEnv of
   Just _  -> return sEnv
   Nothing -> do
-    mFile <- liftIO $ lookupCurryModule (optImportPaths opts)
+    mFile <- liftIO $ lookupCurryModule ("." : optImportPaths opts)
                                         (optLibraryPaths opts) m
     case mFile of
       Nothing -> return $ Map.insert m Unknown sEnv

src/Html/CurryHtml.hs

@@ -39,9 +39,9 @@ source2html opts f = do
   let baseName   = takeBaseName f
       outDir     = fromMaybe (dropFileName f) $ optHtmlDir opts
       outFile    = outDir </> baseName ++ "_curry.html"
-  srcFile <- liftIO $ lookupCurryFile (optImportPaths opts) f
   program <- filename2program opts (fromMaybe f srcFile)
   liftIO $ writeFile outFile (program2html baseName program)
+  srcFile <- liftIO $ lookupCurryFile ("." : optImportPaths opts) f
 
 -- @param importpaths
 -- @param filename

src/Modules.hs

@@ -96,7 +96,9 @@ loadModule opts fn = do
   -- check module header
   mdl    <- checkModuleHeader opts fn parsed
   -- load the imported interfaces into an InterfaceEnv
-  iEnv   <- loadInterfaces (optImportPaths opts) mdl
+  let paths = map (addCurrySubdir (optUseSubdir opts))
+                  ("." : optImportPaths opts)
+  iEnv   <- loadInterfaces paths mdl
   checkInterfaces opts iEnv
   -- add information of imported modules
   cEnv   <- importModules opts mdl iEnv
@@ -267,15 +269,15 @@ writeOutput opts fn (env, modul) = do
 
 -- |Output the parsed 'Module' on request
 writeParsed :: Options -> FilePath -> CS.Module -> IO ()
-writeParsed opts fn modul = when srcTarget $
-  writeModule useSubDir (sourceRepName fn) source
+writeParsed opts fn modul@(CS.Module _ m _ _ _) = when srcTarget $
+  writeModule (useSubDir $ sourceRepName fn) source
   where
   srcTarget  = Parsed `elem` optTargetTypes opts
-  useSubDir  = optUseSubdir opts
+  useSubDir  = addCurrySubdirModule (optUseSubdir opts) m
   source     = CS.showModule modul
 
 writeInterface :: Options -> FilePath -> CS.Interface -> IO ()
-writeInterface opts fn intf
+writeInterface opts fn intf@(CS.Interface m _ _)
   | optForce opts = outputInterface
   | otherwise     = do
       equal <- C.catch (matchInterface interfaceFile intf) ignoreIOException
@@ -285,7 +287,8 @@ writeInterface opts fn intf
   ignoreIOException _ = return False
 
   interfaceFile   = interfName fn
-  outputInterface = writeModule (optUseSubdir opts) interfaceFile
+  outputInterface = writeModule
+                    (addCurrySubdirModule (optUseSubdir opts) m interfaceFile)
                     (show $ CS.ppInterface intf)
 
 matchInterface :: FilePath -> CS.Interface -> IO Bool
@@ -303,19 +306,19 @@ writeFlat opts fn env modSum il = do
     writeFlatCurry opts fn env modSum il
     writeFlatIntf  opts fn env modSum il
   where
-  extTarget    = ExtendedFlatCurry `elem` optTargetTypes opts
-  fcyTarget    = FlatCurry         `elem` optTargetTypes opts
+  extTarget = ExtendedFlatCurry `elem` optTargetTypes opts
+  fcyTarget = FlatCurry         `elem` optTargetTypes opts
 
 -- |Export an 'IL.Module' into a FlatCurry file
 writeFlatCurry :: Options -> FilePath -> CompilerEnv -> ModuleSummary
                -> IL.Module -> IO ()
 writeFlatCurry opts fn env modSum il = do
-  when extTarget $ EF.writeExtendedFlat useSubDir (extFlatName fn) prog
-  when fcyTarget $ EF.writeFlatCurry    useSubDir (flatName    fn) prog
+  when extTarget $ EF.writeExtendedFlat (useSubDir $ extFlatName fn) prog
+  when fcyTarget $ EF.writeFlatCurry    (useSubDir $ flatName    fn) prog
   where
   extTarget = ExtendedFlatCurry `elem` optTargetTypes opts
   fcyTarget = FlatCurry         `elem` optTargetTypes opts
-  useSubDir = optUseSubdir opts
+  useSubDir = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
   prog      = genFlatCurry modSum env il
 
 writeFlatIntf :: Options -> FilePath -> CompilerEnv -> ModuleSummary
@@ -329,21 +332,22 @@ writeFlatIntf opts fn env modSum il
       when (mfint == mfint) $ return () -- necessary to close file -- TODO
       unless (oldInterface `eqInterface` intf) $ outputInterface
   where
-  targetFile = flatIntName fn
-  emptyIntf = EF.Prog "" [] [] [] []
-  intf = genFlatInterface modSum env il
-  outputInterface = EF.writeFlatCurry (optUseSubdir opts) targetFile intf
+  targetFile      = flatIntName fn
+  emptyIntf       = EF.Prog "" [] [] [] []
+  intf            = genFlatInterface modSum env il
+  useSubDir       = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
+  outputInterface = EF.writeFlatCurry (useSubDir targetFile) intf
 
 writeAbstractCurry :: Options -> FilePath -> CompilerEnv -> CS.Module -> IO ()
 writeAbstractCurry opts fname env modul = do
-  when  acyTarget $ AC.writeCurry useSubDir (acyName fname)
+  when  acyTarget $ AC.writeCurry (useSubDir $  acyName fname)
                   $ genTypedAbstractCurry env modul
-  when uacyTarget $ AC.writeCurry useSubDir (uacyName fname)
+  when uacyTarget $ AC.writeCurry (useSubDir $ uacyName fname)
                   $ genUntypedAbstractCurry env modul
   where
   acyTarget  = AbstractCurry        `elem` optTargetTypes opts
   uacyTarget = UntypedAbstractCurry `elem` optTargetTypes opts
-  useSubDir  = optUseSubdir opts
+  useSubDir  = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
 
 type Dump = (DumpLevel, CompilerEnv, String)