{-# LANGUAGE DeriveDataTypeable #-}

{- |

Module : ./CspCASL/SymbItems.hs

Description : syntactic csp-casl symbols

Copyright : (c) Christian Maeder, DFKI GmbH 2011

License : GPLv2 or higher, see LICENSE.txt

Maintainer : Christian.Maeder@dfki.de

Stability : provisional

Portability : portable

-}

module CspCASL.SymbItems where

import CspCASL.AS_CspCASL_Process

import CspCASL.CspCASL_Keywords

import CspCASL.Print_CspCASL

import CspCASL.Parse_CspCASL_Process

import CASL.AS_Basic_CASL

import CASL.SymbolParser

import CASL.ToDoc

import Common.AnnoState

import Common.Doc hiding (braces)

import Common.DocUtils

import Common.Id

import Common.Keywords

import Common.Lexer

import Common.Parsec

import Common.Token

import Text.ParserCombinators.Parsec

import Control.Monad

import Data.Data

import qualified Data.Set as Set

data CspSymbItems = CspSymbItems CspSymbKind [CspSymb]

deriving (Show, Eq, Ord, Typeable, Data)

data CspSymbMapItems = CspSymbMapItems CspSymbKind [CspSymbMap]

deriving (Show, Eq, Ord, Typeable, Data)

data CspSymbKind = CaslKind SYMB_KIND | ProcessKind | ChannelKind

deriving (Show, Eq, Ord, Typeable, Data)

data CspSymb = CspSymb Id (Maybe CspType)

deriving (Show, Eq, Ord, Typeable, Data)

-- for channels with sorts we may re-use A_type that is ambiguous

data CspType = CaslType TYPE | ProcType ProcProfile

deriving (Show, Eq, Ord, Typeable, Data)

data CspSymbMap = CspSymbMap CspSymb (Maybe CspSymb)

deriving (Show, Eq, Ord, Typeable, Data)

pluralCspSympKind :: CspSymbKind -> [a] -> Doc

pluralCspSympKind k l = case k of

CaslKind c -> case c of

Implicit -> empty

_ -> keyword $ pluralS_symb_list c l

ProcessKind -> keyword processS

ChannelKind -> keyword $ channelS ++ appendS l

instance Pretty CspSymbKind where

pretty k = pluralCspSympKind k [()]

instance Pretty CspType where

pretty t = case t of

CaslType c -> colon <> pretty c

ProcType p -> printProcProfile p

instance Pretty CspSymb where

pretty (CspSymb i ms) = pretty i <+> pretty ms

instance Pretty CspSymbMap where

pretty (CspSymbMap s ms) = pretty s <+> case ms of

Nothing -> empty

Just t -> mapsto <+> pretty t

instance Pretty CspSymbItems where

pretty (CspSymbItems k l) = pluralCspSympKind k l <+> ppWithCommas l

instance Pretty CspSymbMapItems where

pretty (CspSymbMapItems k l) = pluralCspSympKind k l <+> ppWithCommas l

commAlpha :: AParser st CommAlpha

commAlpha = fmap Set.fromList $ single commType <|> bracedList

-- | parsing a possibly qualified identifier

cspSymb :: AParser st CspSymb

cspSymb =

do i <- parseCspId

do

_ <- colonST

t <- fmap CaslType (opOrPredType cspKeywords) <|>

fmap (ProcType . ProcProfile []) commAlpha

return $ CspSymb i $ Just t

<|> do

ts <- parenList cspSortId

colonT

cs <- commAlpha

return $ CspSymb i $ Just $ ProcType $ ProcProfile ts cs

<|> return (CspSymb i Nothing)

-- | parsing one symbol or a mapping of one to second symbol

cspSymbMap :: AParser st CspSymbMap

cspSymbMap = liftM2 CspSymbMap cspSymb $ optionMaybe

$ asKey mapsTo >> optional cspSymbKind >> cspSymb

-- | parse a kind keyword

cspSymbKind :: AParser st CspSymbKind

cspSymbKind =

fmap (const ChannelKind) (pluralKeyword channelS)

<|> fmap (const ProcessKind) (asKey processS)

<|> fmap (CaslKind . fst) symbKind

-- | parse a comma separated list of symbols

cspSymbs :: AParser st [CspSymb]

cspSymbs =

do s <- cspSymb

do

_ <- commaT `followedWith` parseCspId

is <- cspSymbs

return $ s : is

<|> return [s]

{- | Parse a possible kinded list of comma separated CspCASL symbols.

The argument is a list of keywords to avoid as identifiers. -}

cspSymbItems :: AParser st CspSymbItems

cspSymbItems = fmap (CspSymbItems $ CaslKind Implicit) cspSymbs <|> do

k <- cspSymbKind

fmap (CspSymbItems k) cspSymbs

-- | parse a comma separated list of symbols

cspSymbMaps :: AParser st [CspSymbMap]

cspSymbMaps =

do s <- cspSymbMap

do

_ <- commaT `followedWith` parseCspId

is <- cspSymbMaps

return $ s : is

<|> return [s]

-- | parse a possible kinded list of CspCASL symbol mappings

cspSymbMapItems :: AParser st CspSymbMapItems

cspSymbMapItems = fmap (CspSymbMapItems $ CaslKind Implicit) cspSymbMaps

<|> do

k <- cspSymbKind

fmap (CspSymbMapItems k) cspSymbMaps