Commit 60b22b52 authored by Michael Hanus 's avatar Michael Hanus

Faster reading of intermediate files, option -p for pretty-printing icurry files

parent 4a2b46c8
......@@ -17,7 +17,7 @@ Assumption:
(in `.curry/Rev.tfcy`) and the prelude (if PAKCS is used,
replace `kics2` by `pakcs`):
> $CURRYHOME/bin/kics2-frontend -i $CURRYHOME/lib --typed-flat Rev
> $CURRYHOME/bin/kics2-frontend --extended -i $CURRYHOME/lib --typed-flat Rev
2. Generate `Prelude.icy` (the ICurry representation of the Prelude,
which also generates the ICurry type dependency file `Prelude.ictdeps`):
......@@ -32,6 +32,11 @@ Assumption:
> icurry f2i -I .curry -I $CURRYHOME/lib/.curry .curry/Rev.tfcy .curry/Rev.icy
With the additional option `-p`, the a pretty-printed version of the
generated ICurry program is shown on the terminal:
> icurry f2i -p -I .curry -I $CURRYHOME/lib/.curry .curry/Rev.tfcy .curry/Rev.icy
4. If desired, generate the Extended ICurry representation of `Rev`
(in `.curry/Rev.eicy`):
......
......@@ -5,6 +5,7 @@ module ICurry.Extended.Files where
import FileGoodies
import FilePath
import ReadShowTerm ( readUnqualifiedTerm ) -- for faster reading
import System.CurryPath
......@@ -37,10 +38,25 @@ getIECurryFile = lookupToGet lookupIECurryFile
--- @param modname the module name
--- @return the Extended ICurry abstract representation
readIECurry :: [String] -> String -> IO (IEProg)
readIECurry paths modname = do
fname <- getIECurryFile paths modname
contents <- readFile fname
return $ read contents
readIECurry paths modname =
getIECurryFile paths modname >>= readIECurryFile
--- Reads a file containing an Extended ICurry term.
--- @param filename the file name
--- @return the Extended ICurry abstract representation
readIECurryFile :: String -> IO IProg
readIECurryFile filename = do
exfile <- doesFileExist filename
if exfile
then do contents <- readFile filename
-- ...with generated Read class instances (slow!):
-- return (read contents)
-- ...with built-in generic read operation (faster):
return (readUnqualifiedTerm ["ICurry.Extended.Types", "ICurry.Types",
"FlatCurry.Types", "Prelude"]
contents)
else error $ "EXISTENCE ERROR: Extended ICurry file '" ++ filename ++
"' does not exist"
--- Write an Extended ICurry file. Find target directory based on source file
--- @param paths the search paths
......
--- Types for representing ICurry programs
--- Types for representing Extended ICurry programs
--- @author Marc Andre Wittorf
module ICurry.Extended.Types where
......
......@@ -3,6 +3,10 @@
module ICurry.Files where
import Directory ( doesFileExist )
import ReadShowTerm ( readUnqualifiedTerm ) -- for faster reading
import System
import ICurry.Types
import FlatCurry.Types
import FlatCurry.Annotated.Types
......@@ -15,12 +19,10 @@ import Distribution
import System.CurryPath
import System.FrontendExec
import System
import Unsafe
--- Default search paths (obtained from CURRYPATH environment variable)
defaultPaths :: [String]
defaultPaths = unsafePerformIO $ do
defaultPaths :: IO [String]
defaultPaths = do
currypath <- getEnviron "CURRYPATH"
return $ if null currypath
then []
......@@ -200,22 +202,6 @@ getPathForModule paths modname = do
path = joinPath $ pathParts ++ currySubdir : modIds
return path
--- Read a FlatCurry file. Error if not found
--- @param paths the search paths
--- @param modname the module name
--- @return the source file's abstract representation
readFlat :: [String] -> String -> IO (AProg TypeExpr)
readFlat paths modname = do
fname <- getFlatFile paths modname
contents <- readFile fname
workaround (inferProg (read contents)
>>= either
(\e -> putStrLn ("Error during FlatCurry type \
\inference:\n" ++ e)
>> exitWith 1)
return)
(return $ read contents)
--- Read a Type Dependency file. Error if not found
--- @param paths the search paths
--- @param modname the module name
......@@ -224,27 +210,45 @@ readTypeDeps :: [String] -> String -> IO [NeededMapping]
readTypeDeps paths modname = do
fname <- getTypeDepsFile paths modname
contents <- readFile fname
return $ read contents
-- ...with generated Read class instances (slow!):
-- return $ read contents
-- ...with built-in generic read operation (faster):
return (readUnqualifiedTerm ["ICurry.Types", "FlatCurry.Types",
"Prelude"]
contents)
--- Read an ICurry file. Error if not found
--- @param paths the search paths
--- @param modname the module name
--- @return the ICurry abstract representation
readICurry :: [String] -> String -> IO (IProg)
readICurry paths modname = do
fname <- getICurryFile paths modname
contents <- readFile fname
return $ read contents
readICurry :: [String] -> String -> IO IProg
readICurry paths modname =
getICurryFile paths modname >>= readICurryFile
--- Read an ICurry file. Don't append .curry subdir. Error if not found
--- @param paths the search paths
--- @param modname the module name
--- @return the ICurry abstract representation
readICurryRaw :: [String] -> String -> IO (IProg)
readICurryRaw paths modname = do
fname <- getICurryFileRaw paths modname
contents <- readFile fname
return $ read contents
readICurryRaw :: [String] -> String -> IO IProg
readICurryRaw paths modname =
getICurryFileRaw paths modname >>= readICurryFile
--- Reads a file containing an ICurry term.
--- @param filename the file name
--- @return the ICurry abstract representation
readICurryFile :: String -> IO IProg
readICurryFile filename = do
exfile <- doesFileExist filename
if exfile
then do contents <- readFile filename
-- ...with generated Read class instances (slow!):
-- return (read contents)
-- ...with built-in generic read operation (faster):
return (readUnqualifiedTerm ["ICurry.Types", "FlatCurry.Types",
"Prelude"]
contents)
else error $ "EXISTENCE ERROR: ICurry file '" ++ filename ++
"' does not exist"
--- Write a Type Dependency file. Find target directory based on source file
--- @param paths the search paths
......
......@@ -154,12 +154,22 @@ data IExpr
[IExpr] -- the possibilities
deriving (Show, Read)
-- This is not part of ICurry format
-- It is needed to convert Typed FlatCurry to ICurry
--- A mapping from functions to its signature and a number of type variables it
--- needs to be completely defined
------------------------------------------------------------------------------
-- This is not part of the ICurry format.
-- It is needed to convert Typed FlatCurry to ICurry where
-- type information about imported modules is required.
--- A mapping from qualified function names to its signature and
--- a list of type variables it needs to be completely defined.
--- The type variables occur in the types of free variables used
--- in the function definition. Most implementations require
--- generators for logic variables. If these variables have
--- polymorphic types, generators must be passed as additional
--- arguments to implement such functions.
type NeededMapping = (
QName, -- a function's name
(TypeExpr, -- the function's signature
[TVarIndex])) -- type variables (relating to the signature) which must
-- be specified
[TVarIndex])) -- type variables (from the signature) for which
-- generators are required
------------------------------------------------------------------------------
......@@ -34,6 +34,7 @@ usage = do
, " .curry subdirectory"
, " -I includeDir specify a directory to look for ictdeps files in this"
, " subdirectory"
, " -p show pretty-printed ICurry program"
, " infile the Typed FlatCurry input file"
, " outfile the ICurry output file"
, ""
......
module Main.Flat2I where
import System
import FilePath ( replaceExtension )
import GetOpt
import FilePath (replaceExtension)
import ReadShowTerm ( readUnqualifiedTerm ) -- for faster reading
import System
import FlatCurry.Annotated.Files
import FlatCurry.Annotated.Goodies
import FlatCurry.Annotated.Types
import Text.Pretty
import ICurry.Types
import ICurry.C2I
import ICurry.Files
import ICurry.InferNeededTypeArgs
import ICurry.Pretty
main :: IO ()
main = getArgs >>= pmain
......@@ -21,44 +24,73 @@ main = getArgs >>= pmain
pmain :: [String] -> IO ()
pmain args = do
let (libdirs', files, errors') = getOpt RequireOrder optDescrs args
let errors = if length files < 2
then "Need inputfile and outputfile" : errors'
else errors'
if not $ null errors
then
mapM_ putStrLn errors
else do
let curryStyleLibdirs = (map fst $ filter snd libdirs') ++ defaultPaths
let directStyleLibdirs = (map fst $ filter (not . snd) libdirs')
fileContents <- readFile $ files !! 0
let tfcy = read fileContents
let imports = progImports tfcy
typeDeps <- mapM (rtd curryStyleLibdirs directStyleLibdirs) imports
>>= (return . concat)
let modNeeded = findNeededImports typeDeps tfcy
let icurry = flatToI (modNeeded ++ typeDeps) tfcy
let icurryPath = files !! 1
let typeDepsPath = icurryPath `replaceExtension` "ictdeps"
writeFile icurryPath $ show icurry
writeFile typeDepsPath $ show modNeeded
where
rtd :: [String] -> [String] -> String -> IO [NeededMapping]
rtd curryStylePaths rawPaths modname = do
rawRes <- lookupTypeDepsFileRaw rawPaths modname
filename <- maybe (do
cres <- lookupTypeDepsFile curryStylePaths modname
maybe (error $ "Cannot find ICurry type dependencies file of " ++
modname)
return
cres)
return rawRes
readFile filename >>= return . read
let (funopts, files, opterrors) = getOpt RequireOrder f2ioptDescrs args
opts = foldl (flip id) defaultF2IOptions funopts
errors = if length files < 2
then "Need input file and output file" : opterrors
else opterrors
if not $ null errors
then
mapM_ putStrLn (errors ++ [usageText])
else do
defpath <- defaultPaths
let curryStyleLibdirs = curryLibDirs opts ++ defpath
directStyleLibdirs = libDirs opts
tfcy <- readTypedFlatCurryFile $ files !! 0
let imports = progImports tfcy
typeDeps <- mapM (rtd curryStyleLibdirs directStyleLibdirs) imports
>>= (return . concat)
let modNeeded = findNeededImports typeDeps tfcy
icurry = flatToI (modNeeded ++ typeDeps) tfcy
icurryPath = files !! 1
typeDepsPath = icurryPath `replaceExtension` "ictdeps"
writeFile icurryPath $ show icurry
writeFile typeDepsPath $ show modNeeded
when (optPretty opts) $ putStrLn (pPrint (ppIProg icurry))
where
rtd :: [String] -> [String] -> String -> IO [NeededMapping]
rtd curryStylePaths rawPaths modname = do
rawRes <- lookupTypeDepsFileRaw rawPaths modname
filename <- maybe (do
cres <- lookupTypeDepsFile curryStylePaths modname
maybe (error $ "Cannot find ICurry type dependencies file of " ++
modname)
return
cres)
return rawRes
contents <- readFile filename
-- ...with generated Read class instances (slow!):
-- return (read contents)
-- ...with built-in generic read operation (faster):
return (readUnqualifiedTerm ["ICurry.Types", "FlatCurry.Types",
"Prelude"]
contents)
data F2IOptions = F2IOptions
{ curryLibDirs :: [String]
, libDirs :: [String]
, optPretty :: Bool -- show the pretty-printed ICurry program?
}
defaultF2IOptions :: F2IOptions
defaultF2IOptions = F2IOptions [] [] False
f2ioptDescrs :: [OptDescr (F2IOptions -> F2IOptions)]
f2ioptDescrs =
[ Option "i" []
(ReqArg (\d opts -> opts { curryLibDirs = curryLibDirs opts ++ [d] }) "DIR")
"Look for imported modules here, using .curry directory"
, Option "I" []
(ReqArg (\d opts -> opts { libDirs = libDirs opts ++ [d] }) "DIR")
"Look for imported modules here"
, Option "p" ["pretty"]
(NoArg (\opts -> opts { optPretty = True }))
"show pretty-printed ICurry program"
]
-- Help text
usageText :: String
usageText =
usageInfo ("Usage: icurry f2i [options] <infile> <outfile>\n") f2ioptDescrs
optDescrs :: [OptDescr (String, Bool)]
optDescrs = [
Option "i" [] (ReqArg (\x-> (x,True)) "DIR")
"Look for imported modules here, using .curry directory",
Option "I" [] (ReqArg (\x-> (x,False)) "DIR")
"Look for imported modules here"]
......@@ -21,8 +21,7 @@ pmain args = do
else do
let infile = files !! 0
let outfile = files !! 1
fileContents <- readFile infile
let icy@(IProg modname deps _ _) = read fileContents
icy@(IProg modname deps _ _) <- readICurryFile infile
let libdirs = libdirs' ++ [moduleRoot modname infile]
depInfo <- mapM ((liftIO extractDepInfoFromI) .
(readICurryRaw libdirs))
......
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