Commit 503ec099 authored by Bernd Brassel's avatar Bernd Brassel
Browse files

make now with quiet parameter

parent a54cd6d4
......@@ -208,7 +208,7 @@ depend : $(SRC)MyReadline.hs
ghc -M $(HC_OPTS) $(SRCS)
%.hi: %.o %.hs
ghc -c $(HC_OPTS) $*.hs
ghc --make $(HC_OPTS) $*.hs
# DO NOT DELETE: Beginning of Haskell dependencies
src/MyReadline.o : src/MyReadline.hs
......
......@@ -239,11 +239,15 @@ stricthsCall opts =
++ ("-s"++mainModule opts++" ")
++ (if make opts then "-m " else "")
++ (if force opts then "-f " else "")
++ (if verbosity opts < 2 then "-q " else "")
++ filename opts)
mkStrictCall opts =
callnorm (installDir++"/bin/mkstrict "
++ filename opts++" "
++ (if verbosity opts < 2 then "--quiet " else "")
++ filename opts++" "
{-++ (if make opts then "-m " else "")
++ (if force opts then "-f " else "")
++ filename opts-})
......@@ -262,6 +266,7 @@ prophecy opts = safeSystem (verbosity opts >= 4) $
installDir++"/bin/prophecy "
++ (if make opts then " -m " else "")
++ (if force opts then " -f " else "")
++ (if verbosity opts < 2 then " -q " else "")
++ show (dropExtension $ filename opts)
++ if verbosity opts >= 4 then "" else " 1>/dev/null "
......
......@@ -9,7 +9,7 @@ import Config
import List
import System.Environment
import System.IO
import System.Console.SimpleLineEditor
--import System.Console.SimpleLineEditor
import Char
import Monad
import PreTrans (isIOType)
......@@ -159,7 +159,7 @@ imps = ["Curry","CurryPrelude"]
-----------------
readAnswer :: String -> Safe IO Char
readAnswer w = safeIO $ do
readAnswer w = safeIO (putStr w >> getLine >>= return . head){-safeIO $ do
hSetBuffering stdin NoBuffering
hSetEcho stdin False
putStr w
......@@ -168,4 +168,4 @@ readAnswer w = safeIO $ do
delChars w
hSetBuffering stdin LineBuffering
hSetEcho stdin True
return c
\ No newline at end of file
return c-}
\ No newline at end of file
......@@ -370,8 +370,8 @@ genDebugModule Opts{debugger=Just tool,mainModule=mod} fs line = do
modCont = modImports ++
"\n\nmain = do\n\
\ run (eval S.strict_"++mainExpr++") \""++mod++"\""
safeIO $ putStrLn modName
safeIO $ putStrLn modCont
--safeIO $ putStrLn modName
--safeIO $ putStrLn modCont
safeIO (writeKicsFile modName modCont)
......
......@@ -62,10 +62,8 @@ instance Data.Generics.Data (IO dm a)
return :: DM.DM dm => a -> dm a
return = Prelude.return
(?) :: DM.DM dm => a -> a -> dm a
x ? _ = return x
--_ ? y = Prelude.return y
(?) :: (DM.DM dm, DI.GenTerm a) => a -> a -> dm a
x ? y = x DM.? y
-- implementation just returns () representation
strict_prim_putChar ::
......
......@@ -9,7 +9,7 @@ module Make (
ModuleName,
Path,
FileName,
make, obsolete) where
make, obsolete, unless) where
import FlatCurry
import FlatCurryGoodies (progImports)
......@@ -32,11 +32,13 @@ type Done a = IORef (FM String a)
--- calls act on each imported module transitively
--- if test returns Nothing.
make :: ModuleName -> TestAct a -> ProgAct a -> IO ()
make modu test act = do
putStrLn "ensuring existence of fcy/fint files..."
callFrontend FCY modu
putStrLn "...ensured"
make :: Bool -> ModuleName -> TestAct a -> ProgAct a -> IO ()
make quiet modu test act = do
print 1
unless quiet $ putStrLn "ensuring existence of fcy/fint files..."
callFrontendWithParams FCY (setQuiet True defaultParams) modu
unless quiet $ putStrLn "...ensured"
print 2
done <- newIORef (emptyFM (\ x y -> not (leqString x y)))
workUpDependence done test act modu
return ()
......@@ -59,8 +61,9 @@ process done test act modu = do
--- a standard test if a given file is newer than a list of other files
--- if other files do not exist, the given file is assumed to be up-to-date
--- on up-to-date files a given action is performed
obsolete :: (String -> String) -> [String -> String] -> ([String] -> IO a) -> TestAct a
obsolete f fs action dir modu = do
obsolete :: Bool -> (String -> String) -> [String -> String]
-> ([String] -> IO a) -> TestAct a
obsolete quiet f fs action dir modu = do
let fn = dir++f modu
fns = map ((dir++).($modu)) fs
ex <- doesFileExist fn
......@@ -69,13 +72,13 @@ obsolete f fs action dir modu = do
ns <- mapIO (isNewerThan t) fns
if or ns
then do
putStrLn $ "obsolete : " ++ f modu
unless quiet $ putStrLn $ "obsolete : " ++ f modu
return Nothing
else do
putStrLn $ "up-to-date: " ++ f modu
unless quiet $ putStrLn $ "up-to-date: " ++ f modu
action fns >>= return . Just
else putStrLn ("missing : "++ f modu) >>
return Nothing
else do unless quiet $ putStrLn ("missing : "++ f modu)
return Nothing
where
isNewerThan t file = do
ex <- doesFileExist file
......@@ -99,6 +102,10 @@ updateIORef ref f = do
x <- readIORef ref
writeIORef ref (f x)
unless :: Bool -> IO () -> IO ()
unless True _ = return ()
unless False act = act
......@@ -23,25 +23,29 @@ import LiftCases (liftCases)
main :: IO ()
main = do
putStrLn "this is the curry prophecy generator"
(force,mk,modName) <- parseArgs
transform force mk modName
(force,mk,quiet,modName) <- parseArgs
transform force mk quiet modName
putStrLn "curry prophecy generator finished"
isForce s = s=="-f" || s=="--forced"
isMake s = s=="-m" || s=="--make"
isQuit s = s=="-q" || s=="--quiet"
parseArgs :: IO (Bool,Bool,String) -- name of module,
parseArgs :: IO (Bool,Bool,Bool,String) -- name of module,
parseArgs = do args <- getArgs
if null args
then error "usage: prophecy <-f/--force> <-m/--make> modulename"
else return (any isForce args,any isMake args,args !! (length args - 1))
else return (any isForce args,
any isMake args,
any isQuit args,
args !! (length args - 1))
transform :: Bool -> Bool -> String -> IO ()
transform :: Bool -> Bool -> Bool -> String -> IO ()
--transform _ False mod = readFlatCurry mod >>= writeTrans "" [] >> return ()
transform force _ mod = make mod tester writeTrans
transform force _ quiet mod = make quiet mod tester writeTrans
where
tester = if force then (\ fn _ -> readTypes [fn] >>= return . Just)
else obsolete (addFcy . addOrc) [addFcy] readTypes
else obsolete quiet (addFcy . addOrc) [addFcy] readTypes
readTypes fns = do
prog <- readFile (head fns)
let typeString = dropWhile (/='[') $ dropWhile (/=']') $ dropWhile (/='[') prog
......
......@@ -71,15 +71,17 @@ addFcy = (++".fcy")
main :: IO ()
main = do
(force, stFile, progName) <- parseArgs
transform stFile force progName
(force, quiet, stFile, progName) <- parseArgs
transform quiet stFile force progName
type Args = (Bool, -- force transformation,
Bool,
String, -- name of stepfile
String) -- name of module)
isForce s = s=="-f" || s=="--forced"
isQuiet s = s=="-q" || s=="--quiet"
mStepFile s = case s of
'-':'s':fn -> Just fn
'-':'-':'s':'t':'e':'p':'f':'i':'l':'e':fn -> Just fn
......@@ -92,16 +94,18 @@ parseArgs = do
then error "usage: stricths [-f|--force] \
\[-s<filename>|--stepfile<filename>] <modulename>"
else return (any isForce args,
any isQuiet args,
maybe (last args) id
(listToMaybe (catMaybes (map mStepFile args))),
last args)
where last xs = xs !! (length xs-1)
transform :: String -> Bool -> String -> IO ()
transform stFile force progName = make progName tester (writeTrans stFile)
transform :: Bool -> String -> Bool -> String -> IO ()
transform quiet stFile force progName =
make quiet progName tester (writeTrans stFile)
where
tester = if force then (\ _ _ -> return Nothing)
else obsolete targetName [addFcy,incName,trustName] readTypes
else obsolete quiet targetName [addFcy,incName,trustName] readTypes
readTypes fns = do
prog <- readFile (head fns)
let typeString = dropWhile (/='[') $ dropWhile (/=']') $ dropWhile (/='[') prog
......
......@@ -4,6 +4,6 @@ import System (getArgs)
main = do
[m] <- getArgs
make m (\ _ m' -> putStr "ensure existence of acy file for " >> putStrLn m'
make True m (\ _ m' -> putStr "ensure existence of acy file for " >> putStrLn m'
>> readCurry m' >> return Nothing)
(\ _ _ _ -> return ())
\ No newline at end of file
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