As.hs revision 918c36f05614a959f186fe02bd4f943e0a1d91e3
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederModule : $Header$
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederDescription : abstract syntax of VSE programs and dynamic logic
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederCopyright : (c) C. Maeder, DFKI 2008
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederMaintainer : Christian.Maeder@dfki.de
413db961f13e112716509b6d61d7a7bbf50c98b2Christian MaederStability : provisional
f3a94a197960e548ecd6520bb768cb0d547457bbChristian MaederPortability : portable
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian MaederCASL extention to VSE programs and dynamic logic
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maederas described on page 4-7 (Sec 2.3.1, 2.5.2, 2.5.4, 2.6) of
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian MaederBruno Langenstein's API description
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder-- | further VSE signature entries
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian Maederdata Sigentry = Procedure Id [Procparam ()] Range deriving (Show, Eq)
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian Maeder-- | a procedure parameter
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian Maederdata Procparam a = Procparam a Paramkind SORT deriving (Show, Eq, Ord)
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder-- | input or output procedure parameter kind
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maederdata Paramkind = In | Out deriving (Show, Eq, Ord)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder-- | wrapper for positions
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederdata Ranged a = Ranged a Range deriving (Show, Eq, Ord)
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder-- | programs with ranges
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maedertype Program = Ranged PlainProgram
ce3928e71520030ad0275b72050a8f4377f9313cChristian Maeder-- | programs based on restricted terms and formulas
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederdata PlainProgram =
e997f1724fcc2c5bb49f44e9f45e8354e0f3a2d6Christian Maeder | Assign VAR (TERM ())
eab576044505ba1fbc64610323053490fbd9e82cChristian Maeder | Call Id [TERM ()] -- ^ a procedure call
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder | Return (TERM ())
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maeder | Block [VAR_DECL] Program
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder | Seq Program Program
eab576044505ba1fbc64610323053490fbd9e82cChristian Maeder | If (FORMULA ()) Program Program
eab576044505ba1fbc64610323053490fbd9e82cChristian Maeder | While (FORMULA ()) Program
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder deriving (Show, Eq, Ord)
120efeede54a5f7650cda8e91363bd6832eac9a9Christian Maeder{- For functions a return is needed, but functions could be emulated
120efeede54a5f7650cda8e91363bd6832eac9a9Christian Maederby an extra out parameter -}
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder{- vardecls do not consider initialization terms here as these may be
df33a9af92444f63ad545da6bb326aac9284318eChristian Maederseens as initial assignments of the program block -}
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder-- | extend CASL formulas by box or diamond formulas
df33a9af92444f63ad545da6bb326aac9284318eChristian Maederdata Dlformula = Dlformula BoxOrDiamond Program (FORMULA Dlformula) Range
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder deriving (Show, Eq, Ord)
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder-- | box or diamond indicator
df33a9af92444f63ad545da6bb326aac9284318eChristian Maederdata BoxOrDiamond = Box | Diamond deriving (Show, Eq, Ord)
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder-- | procedure definitions as basic items becoming sentences
df33a9af92444f63ad545da6bb326aac9284318eChristian Maederdata Defproc = Defproc Id [Procparam VAR] Program deriving (Show, Eq, Ord)
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder-- maybe CASL ops can be associated to programs as well
120efeede54a5f7650cda8e91363bd6832eac9a9Christian Maeder-- | the sentences for the logic
ce3928e71520030ad0275b72050a8f4377f9313cChristian Maederdata Sentence =
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder FormulaSen Dlformula
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder | DefprocSen [Defproc]
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder deriving (Show, Eq, Ord)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder{- formula kinds should be covered by Named Sentence -}
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder-- * Pretty instances
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederppWithSemis :: Pretty a => [a] -> Doc
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian MaederppWithSemis = fsep . punctuate semi . map pretty
d92635f998347112e5d5803301c2abfe7832ab65Christian Maederproc = text "PROCEDURE"
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maederparams :: Doc -> Doc
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederparams = (text "PARAMS" <+>)
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maederinstance Pretty Sigentry where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pretty (Procedure p ps _) = fsep
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder [ proc <+> idDoc p
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , if null ps then empty else params $ fsep $ punctuate semi
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder $ map prettyParam ps ]
04a1ed0b360858b85de6f449b84df4eab81b3fc9Christian MaederprettyParam :: Procparam a -> Doc
932f71e6f6f404ac139399c3d6a2b906ba055cbdChristian MaederprettyParam (Procparam _ m s) = text (map toUpper $ show m) <+> idDoc s
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maederinstance Pretty a => Pretty (Procparam a) where
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder pretty p@(Procparam v _ _) =
d48085f765fca838c1d972d2123601997174583dChristian Maeder pretty v <+> colon <+> prettyParam p
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maederblock :: Doc -> Doc
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maederblock d = vcat [text "BEGIN", d, text "END"]
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maederinstance Pretty Defproc where
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder pretty (Defproc p ps pr) = vcat
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder [ proc <+> idDoc p
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder , if null ps then empty else
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder params $ ppWithSemis ps
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder , text "BODY" <+> pretty pr
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder , text "PROCEDUREEND"]
df33a9af92444f63ad545da6bb326aac9284318eChristian Maederinstance Pretty a => Pretty (Ranged a) where
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder pretty (Ranged a _) = pretty a
df33a9af92444f63ad545da6bb326aac9284318eChristian Maederinstance Pretty PlainProgram where
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder pretty prg = case prg of
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder Abort -> text "ABORT"
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder Skip -> text "SKIP"
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder Assign v t -> pretty v <+> text ":=" <+> pretty t
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder Call p ts -> idDoc p <>
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder if null ts then empty else parens $ ppWithCommas ts
04a1ed0b360858b85de6f449b84df4eab81b3fc9Christian Maeder Return t -> text "RETURN" <+> pretty t
04a1ed0b360858b85de6f449b84df4eab81b3fc9Christian Maeder Block vs p -> block $ fsep [ppWithSemis vs, pretty p]
04a1ed0b360858b85de6f449b84df4eab81b3fc9Christian Maeder Seq p1 p2 -> vcat [pretty p1 <> semi, pretty p2]
932f71e6f6f404ac139399c3d6a2b906ba055cbdChristian Maeder If f t e -> vcat
ae8052003e1ec7247597f034069db0939a7387e1Christian Maeder [ text "IF" <+> pretty f
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder , text "THEN" <+> pretty t
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder , text "ELSE" <+> pretty e
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder , text "FI" ]
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder While f p -> vcat
e997f1724fcc2c5bb49f44e9f45e8354e0f3a2d6Christian Maeder [ text "WHILE" <+> pretty f
e997f1724fcc2c5bb49f44e9f45e8354e0f3a2d6Christian Maeder , text "DO" <+> pretty p
e997f1724fcc2c5bb49f44e9f45e8354e0f3a2d6Christian Maeder , text "OD" ]
932f71e6f6f404ac139399c3d6a2b906ba055cbdChristian Maederinstance Pretty Dlformula where
932f71e6f6f404ac139399c3d6a2b906ba055cbdChristian Maeder pretty (Dlformula b p f _) = let d = pretty p in
932f71e6f6f404ac139399c3d6a2b906ba055cbdChristian Maeder Box -> brackets d
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder Diamond -> less <> d <> greater)
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder <+> parens (pretty f)
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maederinstance Pretty Sentence where
932f71e6f6f404ac139399c3d6a2b906ba055cbdChristian Maeder pretty sen = case sen of
04a1ed0b360858b85de6f449b84df4eab81b3fc9Christian Maeder FormulaSen f -> pretty f
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder DefprocSen ps -> ppWithSemis ps