-----------------------------------------------------------------------------
-- |
-- Module : Writer.Formats.Unbeast
-- License : MIT (see the LICENSE file)
-- Maintainer : Felix Klein (klein@react.uni-saarland.de)
--
-- Transforms a specification to the Unbeast format.
--
-----------------------------------------------------------------------------
module Writer.Formats.Unbeast where
-----------------------------------------------------------------------------
import Config
import Simplify
import Data.LTL
import Data.Error
import Data.Specification
import Writer.Eval
import Control.Exception
-----------------------------------------------------------------------------
-- | Unbeast format writer.
writeFormat
:: Configuration -> Specification -> Either Error String
writeFormat c s = do
(es,ss,rs,as,is,gs) <- eval c s
us <- mapM (simplify' (c { noRelease = True, noWeak = True })) $
case ss of
[] -> filter (/= FFalse) $ es ++ map fGlobally rs ++ as
_ -> filter (/= FFalse) $ es ++
map (\f -> fOr [fNot $ fAnd ss, f])
(map fGlobally rs ++ as)
vs <- mapM (simplify' (c { noRelease = True, noWeak = True })) $
filter (/= TTrue) $ ss ++ [fGlobally $ fAnd is] ++ gs
(si,so) <- signals c s
return $ main si so us vs
where
main si so as vs =
""
++ "\n" ++ ""
++ "\n"
++ "\n" ++ ""
++ "\n"
++ "\n" ++ ""
++ "\n" ++ " " ++ title s ++ ""
++ "\n" ++ " "
++ "\n" ++ fixedIndent (description s)
++ "\n" ++ " "
++ "\n" ++ " " ++ compiler
++ ""
++ "\n" ++ " "
++ concatMap printSignal si
++ "\n" ++ " "
++ "\n" ++ " "
++ concatMap printSignal so
++ "\n" ++ " "
++ (if null as then ""
else "\n" ++ " " ++
concatMap (\x -> "\n \n" ++ printFormula 6 x
++ " \n") as ++
" ")
++ "\n" ++ " "
++ concatMap (\x -> "\n \n" ++ printFormula 6 x
++ " \n") vs
++ " "
++ "\n" ++ ""
++ "\n"
specfile = "SynSpec.dtd"
compiler = "ltl2ba -f"
fixedIndent str = case str of
[] -> []
(' ':xr) -> fixedIndent xr
('\t':xr) -> fixedIndent xr
('\n':xr) -> fixedIndent xr
_ -> " " ++
concatMap ident (rmLeadingSpace [] False str)
ident chr = case chr of
'\n' -> "\n "
_ -> [chr]
rmLeadingSpace a b str = case str of
[] -> reverse a
('\n':xr) -> rmLeadingSpace ('\n':a) True xr
('\t':xr) ->
if b
then rmLeadingSpace a b xr
else rmLeadingSpace (' ':a) b xr
(' ':xr) ->
if b
then rmLeadingSpace a b xr
else rmLeadingSpace (' ':a) b xr
(x:xr) -> rmLeadingSpace (x:a) False xr
printSignal sig =
"\n " ++ sig ++ ""
printFormula n f = replicate n ' ' ++ printFormula' (n + 2) f
printFormula' n f = case f of
TTrue -> "\n"
FFalse -> "\n"
Atomic x -> "" ++ show x ++ "\n"
Not x -> "\n" ++ printFormula n x ++ replicate (n - 2) ' ' ++ "\n"
Next x -> "\n" ++ printFormula n x ++ replicate (n - 2) ' ' ++ "\n"
Globally x -> "\n" ++ printFormula n x ++ replicate (n - 2) ' ' ++ "\n"
Finally x -> "\n" ++ printFormula n x ++ replicate (n - 2) ' ' ++ "\n"
Or xs -> "\n" ++ concatMap (printFormula n) xs ++ replicate (n - 2) ' ' ++ "\n"
And xs -> "\n" ++ concatMap (printFormula n) xs ++ replicate (n - 2) ' ' ++ "\n"
Equiv x y -> "\n" ++ printFormula n x ++ printFormula n y ++ replicate (n - 2) ' ' ++ "\n"
Until x y -> "\n" ++ printFormula n x ++ printFormula n y ++ replicate (n - 2) ' ' ++ "\n"
_ -> assert False undefined
noImpl fml = case fml of
Implies x y -> Or [Not $ noImpl x, noImpl y]
_ -> applySub noImpl fml
simplify' cc f = do
f' <- simplify cc $ noImpl f
if f' == f then return f else simplify' cc f'
-----------------------------------------------------------------------------