{-
 *  SAD / Alice / Main -- speaks for itself :)
 *  Copyright (C) 2001-2004  SAD Development Team (see ../README)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License along
 *  with this program; if not, write to the Free Software Foundation, Inc.,
 *  59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 -}

module Main where

import Data.IORef
import Data.List (union)
import System.Console.GetOpt
import System.Environment (getArgs,getEnv)
import System.Exit
import System.IO
import System.Time

import Text
import Parser
import State
import TPTP
import FOL
import ForTheL
import Explore
import Reason

{- and what is the use of a book without pictures or conversation? -}

main :: IO ()
main  =
  do  hSetBuffering stdout LineBuffering
      tt <- newIORef noTimeDiff; gl <- newIORef 0
      (flags, files, argp) <- readOpts; time0 <- getClockTime
      let ref  = (setRV flags) { prva = argp, totl = tt }
      let file = if (null files) then "stdin" else head files
      input <- if (null files) then hGetContents stdin
                  else  catch (openFile file ReadMode >>= hGetContents)
                          $ \ e ->  dieLn $ "[Main] can't read " ++ file ++
                                              ": " ++ ioeGetErrorString e
      let inp = (tokenize input, 0, 1, "")
          [r] = runPM forthel init_state inp ; pnf = "[ForTheL] "
          [s] = runPM fol init_state inp ; pns = "[FOL] "
          [t] = runPM tptp init_state inp ; pnt = "[TPTP] "

      (res, pn) <-  case t of
          Res x _ _ ->  return (x, pnt)
          Err e _ q ->  case s of
            Res x _ _ ->  return (x, pns)
            Err d _ p ->  case r of
              Res x _ _ ->  return (x, pnf)
              Err c _ o ->  if (pos o >= pos p && pos o >= pos q)
                then  er pnt c o file else  if (pos p >= pos q)
                then  er pnf d p file else  er pns e q file

      putStrLn $ pn ++ "parsing successful"; time1 <- getClockTime

      if (Trans `elem` flags)
        then  putStrLn "" >> mapM_ (putStr . show) (pproc flags res)
        else  mCycle ref (Verbose `elem` flags) (IgnFail `elem` flags) pn
          (job (pn == "[ForTheL] ") (TPM `elem` flags)) gl (pproc flags res)

      tdprove <- readIORef $ totl ref; time2 <- getClockTime

      let tdtotal = diffClockTimes time2 time0
          tdparse = diffClockTimes time1 time0
          tdreasn = tdreas' { tdPicosec = tdPicosec tdreas' - tdppsec }
          tdreas' = diffClockTimes time2 (addToClockTime tdprov' time1)
          tdprov' = tdprove { tdPicosec = 0 }
          tdppsec = tdPicosec tdprove

      putStrLn $ "[Main] session finished in " ++ tdShow tdtotal
      putStrLn $ "[Main] " ++ tdShow tdparse ++ " in " ++ pn
                    ++ "-- " ++ tdShow tdreasn ++ " in [Reason] -- "
                    ++ tdShow tdprove ++ " in [" ++ (prvn ref) ++ "]"
  where
    pos (_, p, _, _) = p

    er pn e (_, p, l, z) _  =
      dieLn $ pn ++ "line " ++ show l ++ ": " ++ e ++
                if (p <= 1) then "" else "\n in text: " ++ reverse z

    job False _ = "inference search"
    job _ True  = "proof search"
    job _ _     = "verification"


-- Options

data Flag =   Verbose     | Help          | Trans
            | TLM String  | PPath String  | PName String
            | ModS        | ModT          | ModP
            | IgnFail     | TPM
            deriving (Eq, Show)

readOpts :: IO ([Flag], [String], [String])
readOpts =
  do  argv <- getArgs; let (args, argp) = splitArgs argv
      case (getOpt Permute options args) of
        (o, n, [])  | Help `notElem` o  ->  return (o,n,argp)
                    | otherwise ->
                        do  putStr $ usageInfo header options
                            exitWith ExitSuccess
        (_, _, es)  ->  die $ concatMap ("[Main] " ++) es
  where
    header  = "Usage: alice [OPTION]... [FILE] [-- <prover args>...]"
    options =
      [ Option "p" ["ppath"] (ReqArg PPath "FILE") "path to prover",
        Option "n" ["pname"] (ReqArg PName "NAME") "name of prover",
        Option "t" ["time"] (ReqArg TLM "N") "time limit per goal in seconds (def: 180)",
        Option "i" ["ignore"] (NoArg IgnFail) "don't stop on failed goals",
        Option "T" ["trans"] (NoArg Trans) "translation only",
        Option "v" ["verbose"] (NoArg Verbose) "verbose output",
        Option "h" ["help"] (NoArg Help) "usage info",
        Option ""  ["tpm"]  (NoArg TPM)  "theorem proving mode (prove last proposition)",
        Option ""  ["mods"] (NoArg ModS) "add symmetry axiom of equality",
        Option ""  ["modt"] (NoArg ModT) "add transitivity axiom of equality",
        Option ""  ["modp"] (NoArg ModP) "add predicate substitutivity axiom of equality" ]

    splitArgs ("--":as) = ([], as)
    splitArgs (a:as)    = let (av, ap) = splitArgs as in (a:av, ap)
    splitArgs _         = ([], [])

setRV (TLM n : fs)    = (setRV fs) { tlim = n }
setRV (PName n : fs)  = (setRV fs) { prvn = n }
setRV (PPath p : fs)  = (setRV fs) { prvp = p }
setRV (_ : fs)        = setRV fs
setRV _ = RVars "" undefined "Explore" "180" undefined


-- Show time statistics

tdShow t
  | th == 0 = dsh mn ++ ':' : dsh sc ++ '.' : dsh ss
  | True    = dsh th ++ ':' : dsh mn ++ ':' : dsh sc
  where
    TimeDiff ye mo da hr mn sc ss = normalizeTimeDiff
      $ nrm $ t { tdPicosec = tdPicosec t `div` 10^10 }

    nrm ot@(TimeDiff { tdSec = sc, tdPicosec = ss })
      | ss < 0    = nrm $ ot { tdPicosec = ss + 100, tdSec = pred sc }
      | ss >= 100 = nrm $ ot { tdPicosec = ss - 100, tdSec = succ sc }
      | True      = ot

    th  = hr + (da * 24) + (mo * 31 * 24) + (ye * 365 * 24)

    dsh n = (if n < 10 then "0" else "") ++ show n


-- Adding equality axioms and preparing for theorem proving mode

pproc flags res = rs0
  where
    vx = Var "x" ; vy = Var "y" ; vz = Var "z"
    ax = All vx ; ay = All vy ; az = All vz
    exy = zEqu vx vy ; eyz = zEqu vy vz
    exz = zEqu vx vz ; eyx = zEqu vy vx
    sym = ax $ ay $ Iff exy eyx
    trn = ax $ ay $ az $ Imp exy $ Imp eyz exz

    prd (All v f) = prd f ; prd (Exi v f) = prd f
    prd (Not f)   = prd f ; prd (Ann a f) = prd f
    prd (Iff f g) = union (prd f) (prd g)
    prd (Imp f g) = union (prd f) (prd g)
    prd (Or  f g) = union (prd f) (prd g)
    prd (And f g) = union (prd f) (prd g)
    prd (Trm "=" _) = [] ; prd (Trm _ []) = []
    prd (Trm t s) = [(t, length s)]
    prb b = foldr (union . prb) (prd (blForm b)) (blProf b)

    vxu n = map (Var . (:) 'u' . show) [1..n]
    vxv n = map (Var . (:) 'v' . show) [1..n]
    pzp n = zipWith zEqu (vxu n) (vxv n)
    pim p n = Imp (Trm p $ vxu n) (Trm p $ vxv n)
    pbs p n = foldr Imp (pim p n) (pzp n)
    pra (p,n) = foldr All (pbs p n) (vxu n ++ vxv n)
    prax  = map pra (foldr (union . prb) [] res)

    axm f = Block f [] [] Affi None 0 "_Eq" [] 0 ""

    tlcut (b@(Block { blType = Affi }) : bs) = flcut b : map prcut bs
    tlcut (b : bs) = tlcut bs

    flcut b@(Block { blForm = f })
      | hole f  = b { blProf = rtlcut (blProf b) }
      | True    = b { blTask = Full, blProf = [] }

    rtlcut = reverse . tlcut . reverse

    prcut b@(Block { blType = Affi }) = plcut b
    prcut b = b

    plcut b@(Block { blForm = f })
      | hole f  = b { blProf = map prcut (blProf b) }
      | True    = b { blTask = Chck, blProf = [] }

    rs3 = if (TPM  `elem` flags) then rtlcut res else res
    rs2 = if (ModP `elem` flags) then foldr ((:).axm) rs3 prax else rs3
    rs1 = if (ModT `elem` flags) then axm trn : rs2 else rs2
    rs0 = if (ModS `elem` flags) then axm sym : rs1 else rs1

