Commit c1cbe379 authored by bbr's avatar bbr
Browse files

verbosity levels

- option  -q equals -v0 no welcome, no messages
- options are read from command line in kicsi (only one file)
- different levels of compiler messages
parent 065df0c8
......@@ -6,7 +6,7 @@ THIS = ../kics/
KGHC = ghc --make -fglasgow-exts -i$(LIBS) -H500m
GHC = ghc --make -fglasgow-exts -i$(SRC) -H500m
LIBS = $(shell $(BIN)kicslib)
KICS = $(BIN)kics -v -make
KICS = $(BIN)kics -v 5 -make
ORACLE = $(SRC)oracle/
all: $(SRC)InstallDir.hs $(BIN)generate $(BIN)kicslib $(BIN)kics $(BIN)kicsi libs
......
......@@ -10,16 +10,14 @@ import List
import FlatCurry(readFlatCurry)
import Names
getOptions :: IO Options
getOptions :: IO (Options,State)
getOptions = do
(opts,_) <- readConfig
(opts,state) <- readConfig
args <- getArgs
let newOpts = parseOptions opts args
either usage return newOpts
either usage (\ o -> return (o,state)) newOpts
parseOptions :: Options -> [String] -> Either String Options
parseOptions opts [] = Left "no file name given"
parseOptions opts [x] = Right (opts{filename=x,mainModule=x})
parseOptions opts ("-or":xs) = parseOptions (opts{cm=OrBased}) xs
parseOptions opts ("-ctc":xs) = parseOptions (opts{cm=CTC}) xs
parseOptions opts ("-main":x:xs) = parseOptions (opts{mainFunc=x}) xs
......@@ -32,8 +30,8 @@ parseOptions opts ("-make":xs) = parseOptions (opts{make=True}) xs
parseOptions opts ("-nomake":xs) = parseOptions (opts{make=False}) xs
parseOptions opts ("-executable":xs) = parseOptions (opts{executable=True}) xs
parseOptions opts ("-noexecutable":xs) = parseOptions (opts{executable=False}) xs
parseOptions opts ("-q":xs) = parseOptions (opts{verbose=False}) xs
parseOptions opts ("-v":xs) = parseOptions (opts{verbose=True}) xs
parseOptions opts ("-q":xs) = parseOptions (opts{verbosity=0}) xs
parseOptions opts ("-v":i:xs) = parseOptions (opts{verbosity=read i}) xs
parseOptions opts ("-noforce":xs) = parseOptions (opts{force=False}) xs
parseOptions opts ("-force":xs) = parseOptions (opts{force=True}) xs
parseOptions opts ("-all":"df":xs) = parseOptions (opts{pm=All DF}) xs
......@@ -42,6 +40,8 @@ parseOptions opts ("-st":xs) = parseOptions (opts{pm=ST}) xs
parseOptions opts ("-i":"df":xs) = parseOptions (opts{pm=Interactive DF}) xs
parseOptions opts ("-i":"bf":xs) = parseOptions (opts{pm=Interactive BF}) xs
parseOptions opts ("-o":x:xs) = parseOptions (opts{target=x}) xs
parseOptions opts [] = Right opts
parseOptions opts [x] = Right (opts{filename=x,mainModule=x})
parseOptions _ (x:_) = Left ("unrecognized option: "++x)
usage problem = do
......@@ -60,7 +60,7 @@ usage problem = do
putStrLn "-nomake | do not chase imported modules"
putStrLn "-executable | create executable"
putStrLn "-noexecutable | do not create executable"
putStrLn "-v | verbose output"
putStrLn "-v <n> | set verbosity level to n, e.g., -v 3"
putStrLn "-q | scarce output"
putStrLn "-force | force recompilation"
putStrLn "-noforce | do not force recompilation"
......@@ -78,7 +78,8 @@ data Options = Opts{ cm :: ChoiceMode,
frontend, kicspath, userlibpath,
ghc, frontendCall :: String,
done :: [String],
make, executable, verbose, eval,
verbosity :: Int,
make, executable, eval,
force, debug :: Bool,
consUse :: ConsUse,
extCons,hasData :: Bool,
......@@ -120,7 +121,7 @@ defaultOpts curDir = Opts {cm=CTC,filename="", mainFunc= "main", mainModule="Mai
done=[],
make=True,
executable=False,
verbose=False,
verbosity=1,
eval=True,
force=False,
debug=False,
......@@ -172,7 +173,7 @@ ghcCall opts =
callnorm (ghc opts++makeGhc (make opts)
++" -i"++installDir++"/src:"
++installDir++"/src/oracle/:"
++libpath opts++" "++verboseGhc (verbose opts))
++libpath opts++" "++verboseGhc (verbosity opts >= 2))
stricthsCall opts =
callnorm ("stricths --hs "
......@@ -192,16 +193,16 @@ cyCall opts = callnorm $ (frontend opts++"/bin/" ++ frontendCall opts) ++ " " ++
callnorm s = unwords (words s) ++ " "
cymake opts = safeSystem (verbose opts)
cymake opts = safeSystem (verbosity opts >= 3)
(cyCall opts ++ filename opts
++ if verbose opts then "" else " 1>/dev/null ")
++ if verbosity opts >= 3 then "" else " 1>/dev/null ")
prophecy opts = safeSystem (verbose opts) $
prophecy opts = safeSystem (verbosity opts >= 4) $
"prophecy "
++ (if make opts then " -m " else "")
++ (if force opts then " -f " else "")
++ filename opts
++ if verbose opts then "" else " 1>/dev/null "
++ if verbosity opts >= 4 then "" else " 1>/dev/null "
readConfig = do
......@@ -349,9 +350,9 @@ data Provided = ForType String (Maybe [ProvidedInstance])
-- fortype <typename> [definition|nodef] instances <instname>*
-- extfunc <funcname>
put :: Options -> String -> Safe IO ()
put Opts{verbose=False} _ = return ()
put Opts{verbose=True} s = safeIO (putStrLn s)
put :: Int -> Options -> String -> Safe IO ()
put i Opts{verbosity=j} s | i>j = return ()
| i<=j = safeIO (putStrLn s)
readExternalSpec :: Options -> String -> Safe IO Options
readExternalSpec opts p = do
......@@ -360,10 +361,10 @@ readExternalSpec opts p = do
then return opts
else do
spec <- warning "" "" specs >>= safeIO . readFile
put opts "reading external specification"
put 5 opts "reading external specification"
let newOpts = foldr insertP opts (read spec)
safeIO (seq newOpts (return ()))
put opts "external specification read"
put 5 opts "external specification read"
return newOpts
where
insertP SomeFunctions opts = opts{extFuncs = "" : extFuncs opts}
......
......@@ -45,10 +45,10 @@ compilations (f:fs) opts =
startCompilation :: Options -> Safe IO Options
startCompilation opts = do
safeIO (putStrLn "calling frontend")
put 2 opts "calling frontend"
newOpts <- callFrontend opts
visited <- compile newOpts >>= return . done
safeIO (putStrLn "calling ghc")
put 2 opts "calling ghc"
ghcProgram False newOpts (funcHsName (filename newOpts))
return newOpts{done=visited}
......@@ -67,12 +67,12 @@ compile opts = do
process :: Options -> Safe IO (String,[String],Options)
process opts0@(Opts{filename=fn}) = do
prog <- safeReadFlat opts0 (fn++".fcy")
unless (executable opts0 && not (verbose opts0))
(safeIO (putStrLn ("processing: "++progName prog)))
unless (executable opts0)
(put 1 opts0 ("processing: "++progName prog))
opts <- readExternalSpec opts0 fn
unless (null $ extData opts) (put opts "external data declarations found")
unless (null $ extInsts opts) (put opts "external instance declarations found")
unless (null $ extFuncs opts) (put opts "external function declarations found")
unless (null $ extData opts) (put 5 opts "external data declarations found")
unless (null $ extInsts opts) (put 5 opts "external instance declarations found")
unless (null $ extFuncs opts) (put 5 opts "external function declarations found")
applyFlatTransformations opts prog >>= generateHaskellFiles opts
return (progName prog,progImports prog,opts0)
......@@ -85,7 +85,7 @@ skip opts = do
let [("Prog",rest)] = lex cont
[(name,rest')] = reads rest
[(imps,_)] = reads rest'
safeIO (putStrLn ("up-to-date: "++name))
put 3 opts ("up-to-date: "++name)
return (name,imps,opts)
makeImports :: (String,[String],Options) -> Safe IO Options
......@@ -133,14 +133,14 @@ applyFlatTransformations opts prog = do
generateHaskellFiles opts (prog,interfaces,auxNames) = do
let typeMapping = makeTypeMap (prog:interfaces)
put opts "generating Haskell"
put 3 opts "generating Haskell"
mapM (writeProgram opts) (transform typeMapping auxNames opts prog)
return (haskellFiles opts (progName prog))
writeProgram opts (fn,printOpts,prog) = do
put opts ("writing "++fn)
put 3 opts ("writing "++fn)
safeIO (writeFile fn (showProgOpt printOpts prog))
put opts (fn++" written")
put 3 opts (fn++" written")
return fn
......@@ -148,7 +148,7 @@ ghcProgram skipping opts fn =
unless (eval opts && executable opts) $ do
found <- safeIO (findFileInPath fn (libpath opts))
let hsFile = head found
ghc = safeSystem (verbose opts)
ghc = safeSystem (verbosity opts >= 2)
(ghcCall opts{make=True}++" "++hsFile)
shFile = drop 2 (reverse hsFile)
oFile = reverse ('o':shFile)
......
......@@ -9,13 +9,16 @@ import System
main :: IO ()
main = do
opts <- getOptions
safe (startCompilation opts)
let call = ghcCall opts ++ " -o "++target opts++" Main.hs"
if executable opts
then do
putStrLn ("compiling executable "++target opts)
if (verbose opts) then putStrLn call else return ()
system call
else return undefined
return ()
(opts,_) <- getOptions
if null (filename opts)
then putStrLn "no file to compile"
else do
safe (startCompilation opts)
let call = ghcCall opts ++ " -o "++target opts++" Main.hs"
if executable opts
then do
putStrLn ("compiling executable "++target opts)
if verbosity opts >= 3 then putStrLn call else return ()
system call
else return undefined
return ()
......@@ -42,10 +42,12 @@ compileCall OrBased = "kics -or -make "
compileModule file choiceMode = system (compileCall choiceMode++file)
main = do
mapM_ putStrLn welcome
home <- getEnv "HOME"
(options,state) <- readConfig
files <- getArgs
(options,state) <- getOptions
mapM_ (safe . put 1 options) welcome
let files = if null (filename options)
then []
else [filename options]
load files state options
interactive state opts = do
......@@ -90,8 +92,7 @@ setMenue [] state opts = do
putStrLn $ "debug: " ++ if debug opts then "on" else "off"
putStrLn $ "evaluation mode: " ++ if eval opts then "interpreted (+e)"
else "compiled (-e)"
putStrLn $ "messages: " ++ if verbose opts then "verbose (+v)"
else "silent (-v)"
putStrLn $ "verbosity level: " ++ show (verbosity opts)
putStrLn $ "make: " ++ if make opts then "on (+m)" else "off (-m)"
putStrLn $ "recompilation: " ++ if force opts then "always (+f)"
else "only if older (-f)"
......@@ -126,6 +127,7 @@ setMenue (opt:vals) state opts = do
["st"] -> interactive state opts{pm=ST}
["path",path] -> let (thisDir,oldPath)=break (==':') (userlibpath opts)
in interactive state opts{userlibpath=thisDir++':':path++oldPath}
["v",i] | all isDigit i -> interactive state opts{verbosity=read i}
['+':'+':setting] -> longSetting True state opts setting
['-':'-':setting] -> longSetting False state opts setting
['+':settings] -> shortSettings True state opts settings
......@@ -133,13 +135,12 @@ setMenue (opt:vals) state opts = do
_ -> putStrLn ("invalid setting. Example \":set ctc\" to " ++
"set choice mode to call-time choice") >> interactive state opts
longSetting flag state opts "debug" = interactive state opts{debug=flag}
longSetting flag state opts "time" = interactive state{time=flag} opts
longSetting flag state opts "verbose" = interactive state opts{verbose=flag}
longSetting flag state opts "eval" = interactive state opts{eval=flag}
longSetting flag state opts "make" = interactive state opts{make=flag}
longSetting flag state opts "force" = interactive state opts{force=flag}
longSetting _ state opts _ = putStrLn "invalid setting." >> interactive state opts
longSetting flag state opts "debug" = interactive state opts{debug=flag}
longSetting flag state opts "time" = interactive state{time=flag} opts
longSetting flag state opts "eval" = interactive state opts{eval=flag}
longSetting flag state opts "make" = interactive state opts{make=flag}
longSetting flag state opts "force" = interactive state opts{force=flag}
longSetting _ state opts _ = putStrLn "invalid setting." >> interactive state opts
shortSettings _ state opts [] = interactive state opts
shortSettings flag state opts ('t':settings) =
......@@ -152,7 +153,6 @@ shortSettings flag state opts (c:settings) =
shortSettings flag state (newOpts c) settings
where
newOpts 'd' = opts{debug=flag}
newOpts 'v' = opts{verbose=flag}
newOpts 'e' = opts{eval=flag}
newOpts 'm' = opts{make=flag}
newOpts 'f' = opts{force=flag}
......@@ -227,7 +227,7 @@ toMode m _ = m
requestExpr state opts line = do
(safe $ do
let ls = loadedFiles state
safeSystem (verbose opts) ("rm -f request Request.fcy "++reqMod ++".o ")
safeSystem (verbosity opts >= 5) ("rm -f request Request.fcy "++reqMod ++".o ")
genReqModule (loadedFiles state) line
let compileOpts = (opts{executable=True,filename="Request",
mainFunc="expression",
......@@ -237,17 +237,17 @@ requestExpr state opts line = do
let call = timing state (requestCall state opts)
if eval opts
then return ()
else safeSystem (verbose opts) (ghcCall opts ++ " -o request Main.hs")
if verbose opts || not (eval opts)
then safeIO (putStrLn ("starting evaluation of "++line))
else safeSystem (verbosity opts >= 3) (ghcCall opts ++ " -o request Main.hs")
if verbosity opts >= 2 || not (eval opts)
then put 1 opts ("starting evaluation of "++line)
else return ()
safeSystem (verbose opts) call
safeSystem (verbosity opts >= 3) call
if not (debug opts)
then return ()
else do
safeSystem (verbose opts) (stricthsCall compileOpts{make=True})
safeSystem (verbose opts) (ghcCall opts{make=True} ++ " StrictRequest")
safeSystem (verbose opts) (ghcCall opts{make=False} ++ " StrictRequest -e expression")
safeSystem (verbosity opts >= 5) (stricthsCall compileOpts{make=True})
safeSystem (verbosity opts >= 5) (ghcCall opts{make=True} ++ " StrictRequest")
safeSystem (verbosity opts >= 5) (ghcCall opts{make=False} ++ " StrictRequest -e expression")
)
interactive state opts
......
Supports Markdown
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