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