Add option --output and refactor option processing

README.md

@@ -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.,
    

package.json

@@ -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"

src/ICurry/Compiler.curry

@@ -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)
 

src/ICurry/Main.curry

@@ -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)"
-
 ------------------------------------------------------------------------------

src/ICurry/Options.curry

+------------------------------------------------------------------------------
+--- 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
+
+------------------------------------------------------------------------------