import System
import System.Cmd
import System.Console.GetOpt
import System.Posix.Files
import Data.Maybe ( fromMaybe )
import qualified Text.PrettyPrint.HughesPJ as Pretty(Doc, render)
import Control.Monad
import Prelude hiding (catch)
import Control.Exception (catch)
import IO (writeFile, hPutStr, stderr)
import Char
import ExternalCore (Module)
import ParserExternalCore(parseCore, ParseResult(OkP,FailP))
--import PprExternalCore()
import LambdaLifting (lambdaLift)
import CaseAbstraction (caseAbstract, KeepKind(AllTopLevel, VarTopLevel))
import BNFC_Show_Doc ()
import Cl.Abs as Cl (Module)
import Core2Cl (core2cl)
import qualified Cl.Print(printTree, prt)
import Cl2Fol (cl2fol)
import Fol (ProofObl, Id(Qname), Library, Def, Prop)
import FolPP (otterPrinter, tptpPrinter, debugPrinter)
import FoFrontEnd (splitAndSlice)
import Core2Agda (core2agda)
import Agda.Abs as Agda (Module)
import Agda.Print (printTree)
dump :: Show a => String -> a -> IO ()
dump label x = writeFile (label++".debug_CoverTranslator") (show x) `catch` \err->
hPutStr stderr ("Ignoring this problem: "++show err)
data Options = Options {
optVerbosity :: Int,
optPrintOtter :: Bool,
optPrintTptp :: Bool,
optPrintAgda :: Bool,
optLoadFiles :: [String]
}
defaultOptions :: Options
defaultOptions = Options {
optVerbosity = 0,
optPrintOtter = False,
optPrintTptp = False,
optPrintAgda = False,
optLoadFiles = []
}
options :: [ OptDescr (Options -> IO Options) ]
options =
[ Option "v" ["verbose"]
(ReqArg (\d -> \opt -> return opt { optVerbosity = read d })
"VERBOSITY")
"set VERBOSITY to 0=none, 1=some, 2=more, ..."
, Option "l" ["load"]
(ReqArg (\f -> \opt -> return opt { optLoadFiles = f:(optLoadFiles opt) })
"FILE")
"load FILE as library"
, Option "o" ["otter"]
(NoArg (\opt -> return opt { optPrintOtter = True }))
"output Otter code"
, Option "t" ["tptp"]
(NoArg (\opt -> return opt { optPrintTptp = True }))
"output tptp code"
, Option "a" ["agda"]
(NoArg (\opt -> return opt { optPrintAgda = True }))
"output Agda code"
]
-- | Parse input flags, do main job (using loadFile), splitAndSlice, write output files
main :: IO ()
main = do
args <- getArgs
let (actions, nonOptions, errors) = getOpt RequireOrder options args
filename <- case nonOptions of
[x] -> return x
[] -> do putStrLn (usageInfo "cfop [options] file" options)
error "No input file specified"
_ -> do putStrLn (usageInfo "cfop [options] file" options)
error "Only one input file allowed"
opts <- foldl (>>=) (return defaultOptions) actions
let prAgda = optPrintAgda opts
if prAgda then agda_main opts filename
else fol_main opts filename
agda_main opts filename = do
(name, agda) <- loadFile2Agda opts filename
when (optPrintAgda opts) (writeFile (name++".agda") (printTree agda))
-- shoule catch IO errors
fol_main opts filename = do
let Options { optPrintOtter = prOtter,
optPrintTptp = prTptp,
optLoadFiles = files2load
} = opts
(name, fCode, fProp) <- loadFile opts filename
libraries <- mapM (loadFile opts) files2load
let mName = toUpper (head name) : tail name
lProofOb = splitAndSlice libraries (mName, fCode, fProp)
when prOtter (outputProofObligations otterPrinter name lProofOb)
when prTptp (outputProofObligations tptpPrinter name lProofOb)
outputProofObligations :: (ProofObl -> Pretty.Doc) -> String -> [ProofObl] -> IO ()
outputProofObligations printer baseName lProofOb = mapM_ outputOne lProofOb
where filename v = baseName ++ "_" ++ v ++ ".otter"
outputOne proofOb@(Qname _m v, _code, _prop) =
writeFile (filename v) (Pretty.render (printer proofOb))
-- | parseCore, caseAbstract, lambdaLift, core2cl, cl2fol
loadFile :: Options -> String -> IO Fol.Library
loadFile opts filename =
do (name, lifted) <- loadFile_ opts filename
let cl :: Cl.Module
cl = core2cl lifted
let verbose :: Int
verbose = optVerbosity opts
when (verbose>1) (dump (name++".cl") (Cl.Print.prt 0 cl))
let fCode :: [Fol.Def]
fProp :: [Fol.Prop]
fol@(fCode, fProp) = cl2fol cl
-- when (verbose>0) (dump (name++".fol") (fol))
return (name, fCode, fProp)
-- | parseCore, caseAbstract, lambdaLift
loadFile_ :: Options -> String -> IO (String, ExternalCore.Module)
loadFile_ opts filename =
do s <- readFile filename
let (name, _ext) = splitName filename
let core :: ExternalCore.Module
core = case parseCore s 1 of
OkP m -> m
FailP s -> error ("Parse error: " ++ s)
caseA :: ExternalCore.Module
-- caseA = caseAbstract AllTopLevel core
caseA = caseAbstract VarTopLevel core
let verbose :: Int
verbose = optVerbosity opts
when (verbose>0) (dump (name++".caseA.hcr") caseA)
let lifted :: ExternalCore.Module
lifted = lambdaLift caseA
when (verbose>0) (dump (name++".lifted.hcr") lifted)
return (name, lifted)
loadFile2Agda :: Options -> String -> IO (String, Agda.Module)
loadFile2Agda opts filename =
do (name, lifted) <- loadFile_ opts filename
let agda = core2agda lifted
return (name, agda)
splitName :: String -> (String, String)
splitName filename = splitN filename
where splitN s = searchDot ([],[]) (reverse filename)
searchDot (f,e) [] = (e, [])
searchDot (f,e) (x:xs)
| x == '.' = (reverse xs, e)
| x == '/' = (reverse (x:xs) ++ e, [])
| otherwise = searchDot (f, x:e) xs