Commit 59c8e139 authored by Michael Hanus 's avatar Michael Hanus

Add option --output and refactor option processing

parent 763aa1a8
......@@ -53,6 +53,10 @@ In the following, we describe various uses of the `icurry` tool.
switches to the directory `DIR` so that the generated file
is placed in the intermediate files in directory `DIR`.
The option `-o` can be used to specify an explicit output file
different from the intermediate file for the ICurry program.
With the option `-o -`, the ICurry program is printed in stdout.
In order to see a human-readable presentation of the generated program,
use option `-v`, i.e.,
......
......@@ -25,7 +25,8 @@
"kics2": ">= 3.0.0, < 4.0.0"
},
"exportedModules": [ "ICurry.Types", "ICurry.Files", "ICurry.Pretty",
"ICurry.Compiler", "ICurry.Interpreter" ],
"ICurry.Compiler", "ICurry.Interpreter",
"ICurry.Options" ],
"executable": {
"name" : "icurry",
"main" : "ICurry.Main"
......
......@@ -6,7 +6,7 @@
--- * remove declarations/assignments of unused variables in ICurry code
---
--- @author Michael Hanus
--- @version November 2020
--- @version January 2021
------------------------------------------------------------------------------
module ICurry.Compiler
......@@ -27,8 +27,9 @@ import Text.Pretty ( pPrint )
import FlatCurry.CaseCompletion
import FlatCurry.CaseLifting ( defaultLiftOpts, defaultNoLiftOpts, liftProg )
import ICurry.Files ( iCurryFileName, writeICurryFile )
import ICurry.Pretty ( ppIProg )
import ICurry.Files ( iCurryFileName, writeICurryFile )
import ICurry.Options
import ICurry.Pretty ( ppIProg )
import ICurry.Types
test :: String -> IO ()
......@@ -94,62 +95,6 @@ flatCurry2ICurry opts prog = do
textWithLines s = unlines [l, s, l]
where l = take 78 (repeat '-')
------------------------------------------------------------------------------
--- Options for the ICurry compiler.
--- Contains mappings from constructor and functions names
--- into locally unique integers and other stuff.
data ICOptions = ICOptions
{ optVerb :: Int -- verbosity
-- (0: quiet, 1: status, 2: intermediate, 3: all)
, optHelp :: Bool -- if help info should be printed
, optLift :: Bool -- should nested cases/lets be lifted to top-level?
, optMain :: String -- name of main function
, optShowGraph :: Bool -- visualize graph during execution?
, optViewPDF :: String -- command to view graph PDF
, optInteractive :: Bool -- interactive execution?
, optVarDecls :: Bool -- optimize variable declarations?
-- internal options
, optConsMap :: [(QName,(IArity,Int))] -- map: cons. names to arity/position
, optFunMap :: [(QName,Int)] -- map: function names to module indices
, optFun :: QName -- currently compiled function
}
defaultICOptions :: ICOptions
defaultICOptions =
ICOptions 1 False True "" False "evince" False False [] [] ("","")
-- Lookup arity and position index of a constructor.
arityPosOfCons :: ICOptions -> QName -> (IArity,Int)
arityPosOfCons opts qn =
maybe (error $ "Internal error in ICurry.Compiler: arity of " ++
showQName qn ++ " is unknown")
id
(lookup qn (optConsMap opts))
-- Lookup position index of a constructor.
posOfCons :: ICOptions -> QName -> Int
posOfCons opts qn = snd (arityPosOfCons opts qn)
posOfFun :: ICOptions -> QName -> Int
posOfFun opts qn =
maybe (error $ "Internal error in ICurry.Compiler: arity of " ++
showQName qn ++ " is unknown")
id
(lookup qn (optFunMap opts))
printStatus :: ICOptions -> String -> IO ()
printStatus opts s = when (optVerb opts > 0) $ putStrLn s
printIntermediate :: ICOptions -> String -> IO ()
printIntermediate opts s = when (optVerb opts > 1) $ putStrLn s
printDetails :: ICOptions -> String -> IO ()
printDetails opts s = when (optVerb opts > 2) $ putStrLn s
funError :: ICOptions -> String -> _
funError opts err = error $ "Function '" ++ snd (optFun opts) ++ "': " ++ err
------------------------------------------------------------------------------
--- Translation from FlatCurry to ICurry according to the transformation
--- specified in the ICurry paper.
......@@ -304,9 +249,6 @@ showIProg (IProg mn imps types funs) = unlines $
------------------------------------------------------------------------------
-- Auxiliaries:
showQName :: QName -> String
showQName (mn,fn) = mn ++ "." ++ fn
pre :: String -> QName
pre s = ("Prelude", s)
......
......@@ -8,10 +8,10 @@
module ICurry.Main where
import Control.Monad ( when, unless )
import Numeric ( readNat )
import System.Environment ( getArgs )
import System.Console.GetOpt
import ReadShowTerm ( showTerm )
import System.CurryPath ( runModuleAction )
import System.Path ( fileInPath )
import System.Process ( exitWith )
......@@ -19,27 +19,20 @@ import System.Process ( exitWith )
import ICurry.Compiler
import ICurry.Files
import ICurry.Interpreter
import ICurry.Options
import ICurry.Types
test :: String -> IO ()
test = icurryOnModule defaultICOptions { optVerb = 3, optMain = "main" }
testI :: String -> IO ()
testI =
icurryOnModule defaultICOptions { optVerb = 3, optMain = "main"
, optShowGraph = True, optInteractive = True }
------------------------------------------------------------------------------
banner :: String
banner = unlines [bannerLine, bannerText, bannerLine]
where
bannerText = "ICurry Compiler (Version of 11/01/21)"
bannerText = "ICurry Compiler (Version of 13/01/21)"
bannerLine = take (length bannerText) (repeat '=')
main :: IO ()
main = do
args <- getArgs
(opts,progs) <- processOptions args
(opts,progs) <- processOptions banner args
case progs of
[] -> error "Module name missing"
[p] -> runModuleAction (icurryOnModule opts) p
......@@ -64,10 +57,14 @@ icurryOnModule opts modname = do
iprog <- icCompile opts modname
let imain = optMain opts
if null imain
then do
icyname <- iCurryFilePath modname
writeICurryFile icyname iprog
printStatus opts $ "ICurry program written to '" ++ icyname ++ "'"
then
if optOutput opts == "-"
then putStrLn (showTerm iprog)
else do
icyname <- if null (optOutput opts) then iCurryFilePath modname
else return $ optOutput opts
writeICurryFile icyname iprog
printStatus opts $ "ICurry program written to '" ++ icyname ++ "'"
else do
printStatus opts $ "Executing main function '" ++ imain ++ "'..."
let opts1 = if optShowGraph opts
......@@ -81,63 +78,4 @@ icurryOnModule opts modname = do
else opts1
execIProg opts2 iprog imain
--- Process the actual command line argument and return the options
--- and the name of the main program.
processOptions :: [String] -> IO (ICOptions,[String])
processOptions argv = do
let (funopts, args, opterrors) = getOpt Permute options argv
opts = foldl (flip id) defaultICOptions funopts
unless (null opterrors)
(putStr (unlines opterrors) >> printUsage >> exitWith 1)
when (optHelp opts) (printUsage >> exitWith 0)
when (not (null (optMain opts)) && not (optLift opts)) $ error
"Incompatible options: interpreter requires case/let lifting!"
return (opts, args)
where
printUsage = putStrLn (banner ++ "\n" ++ usageText)
-- Help text
usageText :: String
usageText = usageInfo ("Usage: icurry [options] <module name>\n") options
-- Definition of actual command line options.
options :: [OptDescr (ICOptions -> ICOptions)]
options =
[ Option "h?" ["help"]
(NoArg (\opts -> opts { optHelp = True }))
"print help and exit"
, Option "q" ["quiet"]
(NoArg (\opts -> opts { optVerb = 0 }))
"run quietly (no output, only exit code)"
, Option "v" ["verbosity"]
(OptArg (maybe (checkVerb 2) (safeReadNat checkVerb)) "<n>")
"verbosity level:\n0: quiet (same as `-q')\n1: show status messages (default)\n2: show generated program (same as `-v')\n3: show all details"
, Option "m" ["main"]
(ReqArg (\s opts -> opts { optMain = s }) "<f>")
"name of the main function to be interpreted\n(otherwise the ICurry program is stored)"
, Option "g" ["graph"]
(NoArg (\opts -> opts { optShowGraph = True }))
"show the term graph during execution\n(requires 'dot' and 'evince')"
, Option "" ["viewer"]
(ReqArg (\s opts -> opts { optViewPDF = s }) "<c>")
"command to view PDF files (default: 'evince')"
, Option "i" ["interactive"]
(NoArg (\opts -> opts { optInteractive = True }))
"interactive execution (ask after each step/result)"
, Option "" ["nolifting"]
(NoArg (\opts -> opts { optLift = False }))
"do not lift nested case/let expressions"
, Option "" ["optvardecls"]
(NoArg (\opts -> opts { optVarDecls = True }))
"do not generate variable declarations when\nvariables are introduced by assignments"
]
where
safeReadNat opttrans s opts = case readNat s of
[(n,"")] -> opttrans n opts
_ -> error "Illegal number argument (try `-h' for help)"
checkVerb n opts = if n>=0 && n<4
then opts { optVerb = n }
else error "Illegal verbosity level (try `-h' for help)"
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--- Definition and processing of options for the ICurry compiler.
---
--- @author Michael Hanus
--- @version January 2021
------------------------------------------------------------------------------
module ICurry.Options
where
import Control.Monad ( when, unless )
import Numeric ( readNat )
import System.Console.GetOpt
import FlatCurry.Types ( QName )
import ICurry.Types ( IArity )
import System.CurryPath ( currySubdir )
import System.Directory ( getAbsolutePath )
import System.Process ( exitWith )
------------------------------------------------------------------------------
--- Options for the ICurry compiler.
--- Contains mappings from constructor and functions names
--- into locally unique integers and other stuff.
data ICOptions = ICOptions
{ optVerb :: Int -- verbosity
-- (0: quiet, 1: status, 2: intermediate, 3: all)
, optHelp :: Bool -- if help info should be printed
, optLift :: Bool -- should nested cases/lets be lifted to top-level?
, optOutput :: String -- name of output file (or null)
, optMain :: String -- name of main function
, optShowGraph :: Bool -- visualize graph during execution?
, optViewPDF :: String -- command to view graph PDF
, optInteractive :: Bool -- interactive execution?
, optVarDecls :: Bool -- optimize variable declarations?
-- internal options
, optConsMap :: [(QName,(IArity,Int))] -- map: cons names to arity/position
, optFunMap :: [(QName,Int)] -- map: func names to module indices
, optFun :: QName -- currently compiled function
}
defaultICOptions :: ICOptions
defaultICOptions =
ICOptions 1 False True "" "" False "evince" False False [] [] ("","")
-- Lookup arity and position index of a constructor.
arityPosOfCons :: ICOptions -> QName -> (IArity,Int)
arityPosOfCons opts qn =
maybe (error $ "Internal error in ICurry.Compiler: arity of " ++
showQName qn ++ " is unknown")
id
(lookup qn (optConsMap opts))
-- Lookup position index of a constructor.
posOfCons :: ICOptions -> QName -> Int
posOfCons opts qn = snd (arityPosOfCons opts qn)
posOfFun :: ICOptions -> QName -> Int
posOfFun opts qn =
maybe (error $ "Internal error in ICurry.Compiler: arity of " ++
showQName qn ++ " is unknown")
id
(lookup qn (optFunMap opts))
printStatus :: ICOptions -> String -> IO ()
printStatus opts s = when (optVerb opts > 0) $ putStrLn s
printIntermediate :: ICOptions -> String -> IO ()
printIntermediate opts s = when (optVerb opts > 1) $ putStrLn s
printDetails :: ICOptions -> String -> IO ()
printDetails opts s = when (optVerb opts > 2) $ putStrLn s
funError :: ICOptions -> String -> _
funError opts err = error $ "Function '" ++ snd (optFun opts) ++ "': " ++ err
------------------------------------------------------------------------------
--- Process the actual command line argument and return the options
--- and the name of the main program.
processOptions :: String -> [String] -> IO (ICOptions,[String])
processOptions banner argv = do
let (funopts, args, opterrors) = getOpt Permute options argv
opts = foldl (flip id) defaultICOptions funopts
unless (null opterrors)
(putStr (unlines opterrors) >> printUsage >> exitWith 1)
when (optHelp opts) (printUsage >> exitWith 0)
when (not (null (optMain opts)) && not (optLift opts)) $ error
"Incompatible options: interpreter requires case/let lifting!"
let out = optOutput opts
opts1 <- if null out || out == "-" then return opts
else do aout <- getAbsolutePath out
return opts { optOutput = aout }
return (opts1, args)
where
printUsage = putStrLn (banner ++ "\n" ++ usageText)
-- Help text
usageText :: String
usageText = usageInfo ("Usage: icurry [options] <module name>\n") options
-- Definition of actual command line options.
options :: [OptDescr (ICOptions -> ICOptions)]
options =
[ Option "h?" ["help"]
(NoArg (\opts -> opts { optHelp = True }))
"print help and exit"
, Option "q" ["quiet"]
(NoArg (\opts -> opts { optVerb = 0 }))
"run quietly (no output, only exit code)"
, Option "v" ["verbosity"]
(OptArg (maybe (checkVerb 2) (safeReadNat checkVerb)) "<n>")
"verbosity level:\n0: quiet (same as `-q')\n1: show status messages (default)\n2: show generated program (same as `-v')\n3: show all details"
, Option "o" ["output"]
(ReqArg (\s opts -> opts { optOutput = s }) "<f>")
("output file for ICurry program (or '-')\n(otherwise: store in " ++
currySubdir ++ "/MOD.icy)")
, Option "m" ["main"]
(ReqArg (\s opts -> opts { optMain = s }) "<f>")
"name of the main function to be interpreted\n(otherwise the ICurry program is stored)"
, Option "g" ["graph"]
(NoArg (\opts -> opts { optShowGraph = True }))
"show the term graph during execution\n(requires 'dot' and 'evince')"
, Option "" ["viewer"]
(ReqArg (\s opts -> opts { optViewPDF = s }) "<c>")
"command to view PDF files (default: 'evince')"
, Option "i" ["interactive"]
(NoArg (\opts -> opts { optInteractive = True }))
"interactive execution (ask after each step/result)"
, Option "" ["nolifting"]
(NoArg (\opts -> opts { optLift = False }))
"do not lift nested case/let expressions"
, Option "" ["optvardecls"]
(NoArg (\opts -> opts { optVarDecls = True }))
"do not generate variable declarations when\nvariables are introduced by assignments"
]
where
safeReadNat opttrans s opts = case readNat s of
[(n,"")] -> opttrans n opts
_ -> error "Illegal number argument (try `-h' for help)"
checkVerb n opts = if n>=0 && n<4
then opts { optVerb = n }
else error "Illegal verbosity level (try `-h' for help)"
------------------------------------------------------------------------------
-- Auxiliaries:
showQName :: QName -> String
showQName (mn,fn) = mn ++ "." ++ fn
------------------------------------------------------------------------------
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