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

Adapted new behaviour in Curry file retrieval to allow hierarchical modules

parent a701c13f
......@@ -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 =
......
......@@ -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 )
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
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