446N/A{- |

4744N/A Module : $Header$

446N/A Copyright : (c) Maciek Makowski, Warsaw University 2003-2004, C. Maeder

446N/A License : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt

446N/A

446N/A Maintainer : maeder@tzi.de

446N/A Stability : provisional

446N/A Portability : non-portable (via imports)

446N/A

446N/A Parsing the architectural part of heterogenous specifications.

446N/A Follows Sect. II:3.1.4 of the CASL Reference Manual plus refinement

446N/A extensions

446N/A

446N/A TODO:

446N/A check UNIT-BINDING

446N/A-}

446N/A

446N/Amodule Syntax.Parse_AS_Architecture where

446N/A

446N/Aimport Logic.Grothendieck

873N/Aimport Logic.Logic

446N/Aimport Syntax.AS_Structured

446N/Aimport Syntax.AS_Architecture

446N/Aimport Syntax.Parse_AS_Structured

446N/Aimport Common.AS_Annotation

5073N/Aimport Common.AnnoState

5508N/Aimport Common.Keywords

446N/Aimport Common.Lexer

446N/Aimport Common.Token

446N/Aimport Text.ParserCombinators.Parsec

4744N/Aimport Common.Id

4744N/A

4744N/A------------------------------------------------------------------------

4744N/A-- * Parsing functions

4744N/A

4744N/A

4744N/A-- | Parse annotated architectural specification

4744N/AannotedArchSpec :: LogicGraph -> AParser AnyLogic (Annoted ARCH_SPEC)

4744N/AannotedArchSpec l = annoParser2 (archSpec l)

4744N/A

4744N/A

4744N/A-- | Parse architectural specification

4744N/A-- @

4744N/A-- ARCH-SPEC ::= BASIC-ARCH-SPEC | GROUP-ARCH-SPEC

4744N/A-- @

4744N/AarchSpec :: LogicGraph -> AParser AnyLogic (Annoted ARCH_SPEC)

4744N/AarchSpec l =

4744N/A do asp <- basicArchSpec l

4744N/A return asp

4744N/A <|>

4744N/A do asp <- groupArchSpec l

4744N/A return asp

5073N/A

4744N/A

5073N/A-- | Parse group architectural specification

4744N/A-- @

4744N/A-- GROUP-ARCH-SPEC ::= { ARCH-SPEC } | ARCH-SPEC-NAME

4744N/A-- @

4744N/AgroupArchSpec :: LogicGraph -> AParser AnyLogic (Annoted ARCH_SPEC)

4744N/AgroupArchSpec l =

957N/A do kOpBr <- oBraceT

4744N/A asp <- annoParser $ archSpec l

4744N/A kClBr <- cBraceT

4744N/A return (replaceAnnoted

4744N/A (Group_arch_spec (item asp) $ toPos kOpBr [] kClBr) asp)

4744N/A <|>

4744N/A do name <- simpleId

4744N/A return (emptyAnno $ Arch_spec_name name)

4744N/A

4744N/A

4744N/A-- | Parse basic architectural specification

4744N/A-- @

4744N/A-- BASIC-ARCH-SPEC ::= unit/units UNIT-DECL-DEFNS

4744N/A-- result UNIT-EXPRESSION ;/

4744N/A-- @

4744N/AbasicArchSpec :: LogicGraph -> AParser AnyLogic (Annoted ARCH_SPEC)

4744N/AbasicArchSpec l =

4744N/A do kUnit <- pluralKeyword unitS

4744N/A (declDefn, ps) <- auxItemList [resultS] [] (unitDeclDefn l) (,)

4744N/A kResult <- asKey resultS

4744N/A expr <- annoParser2 $ unitExpr l

4744N/A (m, an) <- optSemi

4744N/A return (emptyAnno $ Basic_arch_spec declDefn (appendAnno expr an)

4744N/A (tokPos kUnit ++ ps ++ catPos (kResult:m)))

4744N/A

4744N/A-- | Parse unit declaration or definition

4744N/A-- @

4744N/A-- UNIT-DECL-DEFN ::= UNIT-DECL | UNIT-DEFN

4744N/A-- @

4744N/AunitDeclDefn :: LogicGraph -> AParser AnyLogic UNIT_DECL_DEFN

4744N/AunitDeclDefn l = do

4744N/A name <- simpleId

4744N/A do c <- colonT -- unit declaration

4744N/A decl <- refSpec l

4744N/A (gs, ps) <- option ([], []) $

4744N/A do kGiven <- asKey givenS

4744N/A (guts, qs) <- groupUnitTerm l `separatedBy` anComma

4744N/A return (guts, kGiven:qs)

4744N/A return (Unit_decl name decl gs $ catPos (c:ps))

4744N/A <|> -- unit definition

4744N/A unitDefn' l name

4744N/A

4744N/A-- | Parse unit declaration

4618N/A-- @

4744N/A-- UNIT-REF ::= UNIT-NAME : REF-SPEC

4744N/A-- @

4744N/AunitRef :: LogicGraph -> AParser AnyLogic UNIT_REF

4744N/AunitRef l =

4744N/A do name <- simpleId

4744N/A sep1 <- asKey toS

4744N/A usp <- refSpec l

4744N/A return $ Unit_ref name usp $ tokPos sep1

4744N/A

4744N/A

4744N/A-- | Parse unit specification

4744N/A-- @

4744N/A-- UNIT-SPEC ::= GROUP-SPEC

4744N/A-- | GROUP-SPEC * .. * GROUP-SPEC -> GROUP-SPEC

4744N/A-- | closed UNIT-SPEC

4744N/A-- @

4744N/AunitSpec :: LogicGraph -> AParser AnyLogic UNIT_SPEC

4744N/AunitSpec l =

4744N/A -- closed unit spec

4744N/A do kClosed <- asKey closedS

5073N/A uSpec <- unitSpec l

4744N/A return (Closed_unit_spec uSpec $ tokPos kClosed)

5073N/A <|> -- unit type

4744N/A{- NOTE: this can also be a spec name. If this is the case, this unit spec

4744N/A will be converted on the static analysis stage.

4744N/A See Static.AnalysisArchitecture.ana_UNIT_SPEC. -}

4744N/A do gps@(gs:gss, _) <- annoParser (groupSpec l) `separatedBy` crossT

4744N/A let rest = unitRestType l gps

4744N/A if null gss then do

4744N/A option ( {- case item gs of

4744N/A Spec_inst sn [] _ -> Spec_name sn -- annotations are lost

4744N/A _ -> -} Unit_type [] gs []) rest

4744N/A else rest

4744N/A

4744N/AunitRestType :: LogicGraph -> ([Annoted SPEC], [Token])

4744N/A -> AParser AnyLogic UNIT_SPEC

4744N/AunitRestType l (gs, ps) = do

4744N/A a <- asKey funS

4744N/A g <- annoParser $ groupSpec l

4744N/A return (Unit_type gs g $ catPos (ps ++ [a]))

4744N/A

4744N/ArefSpec :: LogicGraph -> AParser AnyLogic REF_SPEC

4744N/ArefSpec l = do

4744N/A (rs, ps) <- basicRefSpec l `separatedBy` (asKey thenS)

4744N/A return $ if isSingle rs then head rs

4744N/A else Compose_ref rs $ catPos ps

4744N/A

4744N/A-- | Parse refinement specification

4744N/A-- @

4744N/A-- REF-SPEC ::= UNIT_SPEC

4744N/A-- | UNIT_SPEC [bahav..] refined [via SYMB-MAP-ITEMS*] to REF-SPEC

4744N/A-- | arch spec GROUP-ARCH-SPEC

4744N/A-- | { UNIT-DECL, ..., UNIT-DECL }

4744N/A-- @

4744N/AbasicRefSpec :: LogicGraph -> AParser AnyLogic REF_SPEC

4744N/AbasicRefSpec l = -- component spec

4744N/A do o <- oBraceT `followedWith` (simpleId >> asKey toS)

4744N/A (us, ps) <- unitRef l `separatedBy` anComma

4744N/A c <- cBraceT

4744N/A return (Component_ref us $ toPos c ps o)

4744N/A <|> -- unit spec

4744N/A do uSpec <- unitSpec l

4744N/A refinedRestSpec l uSpec <|> return (Unit_spec uSpec)

4744N/A <|> -- architectural spec

4744N/A do kArch <- asKey archS

4744N/A kSpec <- asKey specS

4744N/A asp <- groupArchSpec l

4744N/A return (Arch_unit_spec asp (toPos kArch [] kSpec))

4744N/A

4744N/A

4744N/ArefinedRestSpec :: LogicGraph -> UNIT_SPEC -> AParser AnyLogic REF_SPEC

4744N/ArefinedRestSpec l u = do

4744N/A b <- asKey behaviourallyS

4744N/A onlyRefinedRestSpec l (tokPos b) u

4744N/A <|> onlyRefinedRestSpec l [] u

4744N/A

4744N/AonlyRefinedRestSpec :: LogicGraph -> [Pos] -> UNIT_SPEC ->

5073N/A AParser AnyLogic REF_SPEC

4744N/AonlyRefinedRestSpec l b u = do

5073N/A r <- asKey refinedS

4744N/A (ms, ps) <- option ([], []) $ do

4744N/A v <- asKey viaS -- not a keyword

4744N/A (m, ts) <- parseMapping l

4744N/A return (m, v : ts)

4744N/A t <- asKey toS

4744N/A rsp <- refSpec l

4744N/A return $ Refinement (null b) u ms rsp (b ++ toPos r ps t)

4744N/A

4744N/A-- | Parse group unit term

4744N/A-- @

4744N/A-- GROUP-UNIT-TERM ::= UNIT-NAME

4744N/A-- | UNIT-NAME FIT-ARG-UNITS

4744N/A-- | { UNIT-TERM }

4744N/A-- @

4744N/AgroupUnitTerm :: LogicGraph -> AParser AnyLogic (Annoted UNIT_TERM)

4744N/AgroupUnitTerm l = annoParser $

4744N/A -- unit name/application

4744N/A do name <- simpleId

4744N/A args <- many (fitArgUnit l)

4744N/A return (Unit_appl name args [])

4744N/A <|> -- unit term in brackets

4744N/A do lbr <- oBraceT

4744N/A ut <- unitTerm l

4744N/A rbr <- cBraceT

4744N/A return (Group_unit_term ut (catPos [lbr, rbr]))

4744N/A

4744N/A-- | Parse an argument for unit application.

4744N/A-- @

4744N/A-- FIT-ARG-UNIT ::= [ UNIT-TERM ]

4744N/A-- | [ UNIT-TERM fit SYMB-MAP-ITEMS-LIST ]

4744N/A-- @

4744N/A-- The SYMB-MAP-ITEMS-LIST is parsed using parseItemsMap.

4618N/AfitArgUnit :: LogicGraph -> AParser AnyLogic FIT_ARG_UNIT

4744N/AfitArgUnit l =

4744N/A do o <- oBracketT

4744N/A ut <- unitTerm l

4744N/A (fargs, qs) <- option ([], [])

4744N/A (do kFit <- asKey fitS

4744N/A (smis, ps) <- parseMapping l

4744N/A return (smis, kFit:ps))

4744N/A c <- cBracketT

4744N/A return $ Fit_arg_unit ut fargs $ toPos o qs c

4744N/A

4744N/A

4744N/A-- | Parse unit term.

4744N/A-- @

4744N/A-- UNIT-TERM ::= UNIT-TERM RENAMING

4744N/A-- | UNIT-TERM RESTRICTION

4744N/A-- | UNIT-TERM and ... and UNIT-TERM

4744N/A-- | local UNIT-DEFNS within UNIT-TERM

4744N/A-- | GROUP-UNIT-TERM

4744N/A-- @

4744N/A-- This will be done by subsequent functions in order to preserve

4744N/A-- the operator precedence; see other 'unitTerm*' functions.

5073N/AunitTerm :: LogicGraph -> AParser AnyLogic (Annoted UNIT_TERM)

4744N/AunitTerm l = unitTermAmalgamation l

5073N/A

4744N/A

4744N/A-- | Parse unit amalgamation.

4744N/A-- @

4744N/A-- UNIT-TERM-AMALGAMATION ::= UNIT-TERM-LOCAL and ... and UNIT-TERM-LOCAL

4744N/A-- @

4744N/AunitTermAmalgamation :: LogicGraph -> AParser AnyLogic (Annoted UNIT_TERM)

4744N/AunitTermAmalgamation l =

4744N/A do (uts, toks) <- annoParser2 (unitTermLocal l) `separatedBy` (asKey andS)

4744N/A return (case uts of

4744N/A [ut] -> ut

4744N/A _ -> emptyAnno (Amalgamation uts (catPos toks)))

4744N/A

4744N/A

4744N/A-- | Parse local unit term

4744N/A-- @

4744N/A-- UNIT-TERM-LOCAL ::= local UNIT-DEFNS within UNIT-TERM-LOCAL

4744N/A-- | UNIT-TERM-TRANS-RED

4744N/A-- @

4744N/AunitTermLocal :: LogicGraph -> AParser AnyLogic (Annoted UNIT_TERM)

4744N/AunitTermLocal l =

4744N/A -- local unit

4744N/A do kLocal <- asKey localS

4744N/A (uDefns, ps) <- auxItemList [withinS] [] (unitDefn l) (,)

4744N/A kWithin <- asKey withinS

4744N/A uTerm <- unitTermLocal l

4744N/A return (emptyAnno $ Local_unit uDefns uTerm

4744N/A (tokPos kLocal ++ ps ++ tokPos kWithin))

4744N/A <|> -- translation/reduction

4744N/A do ut <- unitTermTransRed l

4744N/A return ut

4744N/A

4744N/A

4618N/A-- | Parse translation or reduction unit term

4744N/A-- The original grammar

4744N/A-- @

4744N/A-- UNIT-TERM-TRANS-RED ::= UNIT-TERM-TRANS-RED RENAMING

4744N/A-- | UNIT-TERM-TRANS-RED RESTRICTION

4744N/A-- | GROUP-UNIT-TERM

4744N/A-- @

4744N/A

4744N/AunitTermTransRed :: LogicGraph -> AParser AnyLogic (Annoted UNIT_TERM)

4744N/AunitTermTransRed l = groupUnitTerm l >>=

4744N/A translation_list l Unit_translation Unit_reduction

4744N/A

4744N/A-- | Parse unit expression

4744N/A-- @

4744N/A-- UNIT-EXPRESSION ::= lambda UNIT-BINDINGS "." UNIT-TERM

4744N/A-- | UNIT-TERM

4744N/A-- @

4744N/AunitExpr :: LogicGraph -> AParser AnyLogic (Annoted UNIT_EXPRESSION)

4744N/AunitExpr l =

4744N/A do (bindings, poss) <- option ([], [])

4744N/A (do kLambda <- asKey lambdaS

4744N/A (bindings, poss) <- unitBinding l `separatedBy` anSemi

5073N/A kDot <- asKey dotS

4744N/A return (bindings, toPos kLambda poss kDot))

5073N/A ut <- unitTerm l

4744N/A return (emptyAnno $ Unit_expression bindings ut poss)

4744N/A

4744N/A-- | Parse unit binding

4744N/A-- @

4744N/A-- UNIT-BINDING ::= UNIT-NAME : UNIT-SPEC

4744N/A-- @

4744N/AunitBinding :: LogicGraph -> AParser AnyLogic UNIT_BINDING

4744N/AunitBinding l =

4744N/A do name <- simpleId

4744N/A kCol <- colonT

4744N/A usp <- unitSpec l

4744N/A return (Unit_binding name usp $ tokPos kCol)

4744N/A

4744N/A-- | Parse an unit definition

4744N/A-- @

4744N/A-- UNIT-DEFN ::= UNIT-NAME = UNIT-EXPRESSION

4744N/A-- @

4744N/AunitDefn :: LogicGraph -> AParser AnyLogic UNIT_DECL_DEFN

4744N/AunitDefn l = simpleId >>= unitDefn' l

4744N/A

4744N/AunitDefn' :: LogicGraph -> SIMPLE_ID -> AParser AnyLogic UNIT_DECL_DEFN

4744N/AunitDefn' l name = do

4744N/A kEqu <- asKey equalS

4744N/A expr <- annoParser2 $ unitExpr l

4744N/A return (Unit_defn name (item expr) $ tokPos kEqu)

4744N/A