Commit 5ddf47dd authored by Michael Hanus 's avatar Michael Hanus
Browse files

CPM updated

parent 9b8103da
......@@ -13,10 +13,14 @@ module CPM.AbstractCurry
, tcArgsOfType
) where
import Char (toUpper)
import Distribution (FrontendTarget (..), FrontendParams (..), defaultParams
, callFrontendWithParams, setQuiet, setFullPath
, callFrontendWithParams
, setQuiet, setFullPath, setDefinitions
, sysLibPath, inCurrySubdir, modNameToPath
, inCurrySubdirModule, lookupModuleSource)
, inCurrySubdirModule, lookupModuleSource
, curryCompiler, curryCompilerMajorVersion
, curryCompilerMinorVersion )
import List (intercalate, nub)
import FilePath ((</>), (<.>), takeFileName, replaceExtension)
import AbstractCurry.Files (readAbstractCurryFile, writeAbstractCurryFile)
......@@ -62,13 +66,19 @@ readAbstractCurryFromPackagePath :: Package -> String -> [Package] -> String
-> IO CurryProg
readAbstractCurryFromPackagePath pkg pkgDir deps modname = do
let loadPath = fullLoadPathForPackage pkg pkgDir deps
params <- return $ setQuiet True (setFullPath loadPath defaultParams)
callFrontendWithParams ACY params modname
params <- return $ setQuiet True
$ setFullPath loadPath
$ setDefinitions defs
$ defaultParams
callFrontendWithParams ACY params modname
src <- lookupModuleSource loadPath modname
acyName <- return $ case src of
Nothing -> error $ "Module not found: " ++ modname
Just (_, file) -> replaceExtension (inCurrySubdirModule modname file) ".acy"
readAbstractCurryFile acyName
where
defs = [( "__" ++ map toUpper curryCompiler ++ "__"
, curryCompilerMajorVersion * 100 + curryCompilerMinorVersion )]
--- Reads an AbstractCurry module from a package or one of its dependencies.
---
......@@ -78,14 +88,7 @@ readAbstractCurryFromPackagePath pkg pkgDir deps modname = do
readAbstractCurryFromDeps :: String -> [Package] -> String -> IO CurryProg
readAbstractCurryFromDeps pkgDir deps modname = do
pkg <- fromErrorLogger (loadPackageSpec pkgDir)
let loadPath = fullLoadPathForPackage pkg pkgDir deps
params <- return $ setQuiet True (setFullPath loadPath defaultParams)
src <- lookupModuleSource loadPath modname
sourceFile <- return $ case src of
Nothing -> error $ "Module not found: " ++ modname
Just (_, file) -> replaceExtension (inCurrySubdirModule modname file) ".acy"
callFrontendWithParams ACY params modname
readAbstractCurryFile sourceFile
readAbstractCurryFromPackagePath pkg pkgDir deps modname
--- Applies a transformation function to a module from a package or one of its
--- dependencies and writes the modified module to a file in Curry form.
......@@ -95,18 +98,10 @@ readAbstractCurryFromDeps pkgDir deps modname = do
--- @param f - the transformation function
--- @param mod - the module to transform
--- @param dest - the destination file for the transformed module
transformAbstractCurryInDeps :: String -> [Package] -> (CurryProg -> CurryProg)
transformAbstractCurryInDeps :: String -> [Package] -> (CurryProg -> CurryProg)
-> String -> String -> IO ()
transformAbstractCurryInDeps pkgDir deps transform modname destFile = do
pkg <- fromErrorLogger (loadPackageSpec pkgDir)
let loadPath = fullLoadPathForPackage pkg pkgDir deps
params <- return $ setQuiet True (setFullPath loadPath defaultParams)
src <- lookupModuleSource loadPath modname
sourceFile <- return $ case src of
Nothing -> error $ "Module not found: " ++ modname
Just (_, file) -> replaceExtension (inCurrySubdirModule modname file) ".acy"
callFrontendWithParams ACY params modname
acy <- readAbstractCurryFile sourceFile
acy <- readAbstractCurryFromDeps pkgDir deps modname
writeFile destFile $ showCProg (transform acy)
--- Renames all references to some modules in a Curry program.
......
......@@ -15,10 +15,13 @@ module FlatCurry.Read
, readFlatCurryIntWithImportsInPath
) where
import Char (toUpper)
import Directory (getModificationTime)
import Distribution ( getLoadPathForModule, lookupModuleSource
, FrontendTarget (FCY), callFrontendWithParams
, defaultParams, setQuiet, setFullPath
, defaultParams, setQuiet, setFullPath, setDefinitions
, curryCompiler, curryCompilerMajorVersion
, curryCompilerMinorVersion
)
import FileGoodies (baseName, lookupFileInPath, stripSuffix)
import FilePath (normalise)
......@@ -94,11 +97,14 @@ parseFlatCurryFile withImp verb loadpath modname suffixes = do
putStrLn $ ">>>>> FlatCurry files not up-to-date, parsing module \""
++ modname ++ "\"..."
callFrontendWithParams FCY
(setQuiet True (setFullPath loadpath defaultParams)) modname
(setQuiet True (setFullPath loadpath (setDefinitions defs defaultParams)))
modname
when verb $ putStr "Reading FlatCurry files "
eiMods <- tryReadFlatCurryFile withImp verb loadpath modname suffixes
return (either (error . notFound) id eiMods)
where notFound mods = "FlatCurry file not found for the following module(s): "
where defs = [( "__" ++ map toUpper curryCompiler ++ "__"
, curryCompilerMajorVersion * 100 + curryCompilerMinorVersion )]
notFound mods = "FlatCurry file not found for the following module(s): "
++ unwords mods
-- Read a FlatCurry file (with all its imports if first argument is true).
......
......@@ -15,10 +15,13 @@ module FlatCurry.Read
, readFlatCurryIntWithImportsInPath
) where
import Char (toUpper)
import Directory (getModificationTime)
import Distribution ( getLoadPathForModule, lookupModuleSource
, FrontendTarget (FCY), callFrontendWithParams
, defaultParams, setQuiet, setFullPath
, defaultParams, setQuiet, setFullPath, setDefinitions
, curryCompiler, curryCompilerMajorVersion
, curryCompilerMinorVersion
)
import FileGoodies (baseName, lookupFileInPath, stripSuffix)
import FilePath (normalise)
......@@ -94,11 +97,14 @@ parseFlatCurryFile withImp verb loadpath modname suffixes = do
putStrLn $ ">>>>> FlatCurry files not up-to-date, parsing module \""
++ modname ++ "\"..."
callFrontendWithParams FCY
(setQuiet True (setFullPath loadpath defaultParams)) modname
(setQuiet True (setFullPath loadpath (setDefinitions defs defaultParams)))
modname
when verb $ putStr "Reading FlatCurry files "
eiMods <- tryReadFlatCurryFile withImp verb loadpath modname suffixes
return (either (error . notFound) id eiMods)
where notFound mods = "FlatCurry file not found for the following module(s): "
where defs = [( "__" ++ map toUpper curryCompiler ++ "__"
, curryCompilerMajorVersion * 100 + curryCompilerMinorVersion )]
notFound mods = "FlatCurry file not found for the following module(s): "
++ unwords mods
-- Read a FlatCurry file (with all its imports if first argument is true).
......
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