|
definition:
|
transformProgram :: TransState -> String -> IO ()
transformProgram ts pname = do
let progname = dropExtension pname
fffile = optFailFuncs ts
ts1 <- if null fffile
then return ts
else do
exff <- doesFileExist fffile
unless exff $ error $ "File '" ++ fffile ++ "' does not exist"
ffs <- fmap (concatMap readQNameLine . lines) (readFile fffile)
return (ts { failFuncs = ffs })
pp <- readPrologFile (progname ++ ".pl")
when (optVerb ts > 2) $ putStrLn $ encloseInLines $
"Prolog program '" ++ pname ++ "':\n\n" ++ showPlProg pp
let (cprog,ts2) = prolog2Curry (setModName progname ts1) pp
ucprog = unlines (filter (not . (":: ()" `isSuffixOf`))
(lines (showCProg cprog)))
outfile = case optOutput ts of "-" -> ""
"" -> modName ts2 ++ ".curry"
f -> f
when (optVerb ts > 0 && not (null (ignoredCls ts2))) $ putStrLn $
"The following queries/directives/clauses are ignored:\n" ++
unlines (map showPlClause (ignoredCls ts2))
when (optVerb ts > 2 && useAnalysis ts) $ putStrLn $
"Inductively sequential arguments of predicates:\n" ++ showIndSeqArgs ts2
when (optVerb ts > 2) $ putStrLn $
"Function information used in the transformation:\n" ++ showResultArgs ts2
when (optVerb ts > 2 && not (null (optFailFuncs ts))) $ putStrLn $
"Possibly failing functions:\n" ++
unlines (map (\(mn,fn) -> mn ++ "." ++ fn) (failFuncs ts2))
when (optVerb ts > 1 || optOutput ts == "-") $ putStrLn $ encloseInLines $
"Generated Curry module:\n\n" ++ ucprog
unless (null outfile) $ do
writeFile outfile $
(if optNoWarn ts then noWarnings else missSigOpt) ++ ucprog
when (optVerb ts > 0) $ putStrLn $
"Generated Curry module written into '" ++ outfile ++ "'"
when (optLoad ts && null (optOutput ts)) $ do
let cmd = installDir </> "bin" </> "pakcs --nocypm :load " ++ modName ts2
when (optVerb ts > 1) $ putStrLn $ "Executing: " ++ cmd
ec <- system cmd
exitWith ec
where
hline = take 78 (repeat '-')
encloseInLines s = unlines [hline, s, hline]
missSigOpt = "{-# OPTIONS_FRONTEND -Wno-missing-signatures #-}\n\n"
noWarnings = "{-# OPTIONS_FRONTEND -Wnone #-}\n\n"
-- reads a line containing a module and a function name separated by a space:
readQNameLine s = let (mn,fn) = break (==' ') s
in if null fn then [] else [(mn, tail fn)]
|