module Camfort.Specification.Stencils.Synthesis
( formatSpec
, formatSpecNoComment
, offsetToIx
) where
import Data.List
import Camfort.Specification.Stencils.Syntax
import Camfort.Analysis.Annotations
import qualified Language.Fortran.AST as F
import qualified Language.Fortran.Analysis as FA
import qualified Language.Fortran.Util.Position as FU
import Language.Fortran.Util.Position
formatSpec :: F.MetaInfo -> Int -> Char
-> (FU.SrcSpan, Either [([Variable], Specification)] (String,Variable))
-> String
formatSpec mi indent marker (span, Right (evalInfo, name)) =
buildCommentText mi indent $
marker : " "
++ evalInfo
++ (if name /= "" then " :: " ++ name else "") ++ "\n"
formatSpec _ _ _ (_, Left []) = ""
formatSpec mi indent marker (span, Left specs) =
intercalate "\n" $ map commentText specs
where
commentText s = buildCommentText mi indent (marker : " " ++ doSpec s)
commaSep = intercalate ", "
doSpec (arrayVar, spec) =
show (fixSpec spec) ++ " :: " ++ commaSep arrayVar
fixSpec s = s
formatSpecNoComment ::
(FU.SrcSpan, Either [([Variable], Specification)] (String,Variable))
-> String
formatSpecNoComment (span, Right (evalInfo, name)) =
show span ++ " " ++ evalInfo ++ (if name /= "" then " :: " ++ name else "") ++ "\n"
formatSpecNoComment (_, Left []) = ""
formatSpecNoComment (span, Left specs) =
intercalate "\n" . map (\s -> show span ++ " " ++ doSpec s) $ specs
where
commaSep = intercalate ", "
doSpec (arrayVar, spec) =
show (fixSpec spec) ++ " :: " ++ commaSep arrayVar
fixSpec s = s
a = (head $ FA.initAnalysis [unitAnnotation]) { FA.insLabel = Just 0 }
s = SrcSpan (Position 0 0 0) (Position 0 0 0)
offsetToIx :: F.Name -> Int -> F.Index (FA.Analysis A)
offsetToIx v o
| o == absoluteRep
= F.IxSingle a s Nothing (F.ExpValue a s (F.ValInteger "0"))
| o == 0 = F.IxSingle a s Nothing (F.ExpValue a s (F.ValVariable v))
| o > 0 = F.IxSingle a s Nothing (F.ExpBinary a s F.Addition
(F.ExpValue a s (F.ValVariable v))
(F.ExpValue a s (F.ValInteger $ show o)))
| otherwise = F.IxSingle a s Nothing (F.ExpBinary a s F.Subtraction
(F.ExpValue a s (F.ValVariable v))
(F.ExpValue a s (F.ValInteger $ show (abs o))))