hets/CspCASL/SymbItems.hs

	SymbItems.hs revision e9458b1a7a19a63aa4c179f9ab20f4d50681c168


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
18861N/A{-# LANGUAGE DeriveDataTypeable #-}
18861N/A{- |
18861N/AModule      :  ./CspCASL/SymbItems.hs
18861N/ADescription :  syntactic csp-casl symbols
18861N/ACopyright   :  (c) Christian Maeder, DFKI GmbH 2011
18861N/ALicense     :  GPLv2 or higher, see LICENSE.txt
18861N/AMaintainer  :  Christian.Maeder@dfki.de
18861N/AStability   :  provisional
18861N/APortability :  portable
18861N/A
18861N/A-}
18861N/A
18861N/Amodule CspCASL.SymbItems where
18861N/A
18861N/Aimport CspCASL.AS_CspCASL_Process
18861N/Aimport CspCASL.CspCASL_Keywords
18861N/Aimport CspCASL.Print_CspCASL
18861N/Aimport CspCASL.Parse_CspCASL_Process
18861N/A
18861N/Aimport CASL.AS_Basic_CASL
18861N/Aimport CASL.SymbolParser
18861N/Aimport CASL.ToDoc
18861N/A
18861N/Aimport Common.AnnoState
18861N/Aimport Common.Doc hiding (braces)
18861N/Aimport Common.DocUtils
18861N/Aimport Common.Id
18861N/Aimport Common.Keywords
18861N/Aimport Common.Lexer
18861N/Aimport Common.Parsec
18861N/Aimport Common.Token
18861N/A
18861N/Aimport Text.ParserCombinators.Parsec
18861N/A
18861N/Aimport Control.Monad
18861N/Aimport Data.Data
18861N/A
18861N/Aimport qualified Data.Set as Set
18861N/A
18861N/Adata CspSymbItems = CspSymbItems CspSymbKind [CspSymb]
18861N/A  deriving (Show, Eq, Ord, Typeable, Data)
18861N/A
18861N/Adata CspSymbMapItems = CspSymbMapItems CspSymbKind [CspSymbMap]
18861N/A  deriving (Show, Eq, Ord, Typeable, Data)
18861N/A
18861N/Adata CspSymbKind = CaslKind SYMB_KIND | ProcessKind | ChannelKind
18861N/A  deriving (Show, Eq, Ord, Typeable, Data)
18861N/A
18861N/Adata CspSymb = CspSymb Id (Maybe CspType)
18861N/A  deriving (Show, Eq, Ord, Typeable, Data)
18861N/A
18861N/A-- for channels with sorts we may re-use A_type that is ambiguous
18861N/Adata CspType = CaslType TYPE | ProcType ProcProfile
18861N/A  deriving (Show, Eq, Ord, Typeable, Data)
18861N/A
18861N/Adata CspSymbMap = CspSymbMap CspSymb (Maybe CspSymb)
18861N/A  deriving (Show, Eq, Ord, Typeable, Data)
18861N/A
18861N/ApluralCspSympKind :: CspSymbKind -> [a] -> Doc
18861N/ApluralCspSympKind k l = case k of
18861N/A    CaslKind c -> case c of
18861N/A      Implicit -> empty
18861N/A      _ -> keyword $ pluralS_symb_list c l
18861N/A    ProcessKind -> keyword processS
18861N/A    ChannelKind -> keyword $ channelS ++ appendS l
18861N/A
18861N/Ainstance Pretty CspSymbKind where
18861N/A  pretty k = pluralCspSympKind k [()]
18861N/A
18861N/Ainstance Pretty CspType where
18861N/A  pretty t = case t of
18861N/A    CaslType c -> colon <> pretty c
18861N/A    ProcType p -> printProcProfile p
18861N/A
18861N/Ainstance Pretty CspSymb where
18861N/A  pretty (CspSymb i ms) = pretty i <+> pretty ms
18861N/A
18861N/Ainstance Pretty CspSymbMap where
18861N/A  pretty (CspSymbMap s ms) = pretty s <+> case ms of
18861N/A    Nothing -> empty
18861N/A    Just t -> mapsto <+> pretty t
18861N/A
18861N/Ainstance Pretty CspSymbItems where
18861N/A  pretty (CspSymbItems k l) = pluralCspSympKind k l <+> ppWithCommas l
18861N/A
18861N/Ainstance Pretty CspSymbMapItems where
18861N/A  pretty (CspSymbMapItems k l) = pluralCspSympKind k l <+> ppWithCommas l
18861N/A
18861N/AcommAlpha :: AParser st CommAlpha
18861N/AcommAlpha = fmap Set.fromList $ single commType <|> bracedList
18861N/A
18861N/A-- | parsing a possibly qualified identifier
18861N/AcspSymb :: AParser st CspSymb
18861N/AcspSymb =
18861N/A    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