SymbolParser.hs revision 8c63cd89ef840cd7a3d3b75f0207dc800388c800
fa9e4066f08beec538e775443c5be79dd423fcabahrens{- |
fa9e4066f08beec538e775443c5be79dd423fcabahrensModule : $Header$
fa9e4066f08beec538e775443c5be79dd423fcabahrensDescription : Parser for symbols in translations and reductions
fa9e4066f08beec538e775443c5be79dd423fcabahrensCopyright : (c) Christian Maeder, Uni Bremen 2002-2006
906d120cc2c2b1f1a14621790e25a6a33de50ce8llingLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
906d120cc2c2b1f1a14621790e25a6a33de50ce8lling
fa9e4066f08beec538e775443c5be79dd423fcabahrensMaintainer : Christian.Maeder@dfki.de
fa9e4066f08beec538e775443c5be79dd423fcabahrensStability : provisional
fa9e4066f08beec538e775443c5be79dd423fcabahrensPortability : portable
fa9e4066f08beec538e775443c5be79dd423fcabahrens
fa9e4066f08beec538e775443c5be79dd423fcabahrensParsing symbols for translations and reductions
fa9e4066f08beec538e775443c5be79dd423fcabahrens-}
fa9e4066f08beec538e775443c5be79dd423fcabahrens
fa9e4066f08beec538e775443c5be79dd423fcabahrensmodule CASL.SymbolParser where
fa9e4066f08beec538e775443c5be79dd423fcabahrens
fa9e4066f08beec538e775443c5be79dd423fcabahrensimport Common.Id
fa9e4066f08beec538e775443c5be79dd423fcabahrensimport Common.Keywords
fa9e4066f08beec538e775443c5be79dd423fcabahrensimport Common.Lexer
fa9e4066f08beec538e775443c5be79dd423fcabahrensimport CASL.AS_Basic_CASL
fa9e4066f08beec538e775443c5be79dd423fcabahrensimport Text.ParserCombinators.Parsec
fa9e4066f08beec538e775443c5be79dd423fcabahrensimport Common.Token
27dd1e87cd3d939264769dd4af7e6a529cde001fMark Shellenbaumimport CASL.Formula
edf345e6b8342e8627ec20ce821a977a62cee19dMatthew Ahrens
a6f561b4aee75d0d028e7b36b151c8ed8a86bc76Sašo Kiselkov-- | parsing a possibly qualified identifier
c3d26abc9ee97b4f60233556aadeb57e0bd30bb9Matthew Ahrenssymb :: [String] -> GenParser Char st SYMB
007a6c1f69652d7e3f2d2012a9332221d430491bJerry Jelineksymb ks =
fa9e4066f08beec538e775443c5be79dd423fcabahrens do i <- parseId ks
fa9e4066f08beec538e775443c5be79dd423fcabahrens do c <- colonST
55da60b91d96984f12de050ce428373ea25c7f35Mark J Musante t <- opOrPredType ks
55da60b91d96984f12de050ce428373ea25c7f35Mark J Musante return (Qual_id i t $ tokPos c)
fa9e4066f08beec538e775443c5be79dd423fcabahrens <|> return (Symb_id i)
fa9e4066f08beec538e775443c5be79dd423fcabahrens
de8267e0f723ed2c38ea9def92d465f69a300f56timh-- | parsing a type for an operation or a predicate
fa9e4066f08beec538e775443c5be79dd423fcabahrensopOrPredType :: [String] -> GenParser Char st TYPE
fa9e4066f08beec538e775443c5be79dd423fcabahrensopOrPredType ks =
e7437265dc2a4920c197ed4337665539d358b22cahrens do (b, s, p) <- opSort ks
fa9e4066f08beec538e775443c5be79dd423fcabahrens if b then return (O_type (Op_type Partial [] s p))
fa9e4066f08beec538e775443c5be79dd423fcabahrens else do c <- crossT
ecd6cf800b63704be73fb264c3f5b6e0dafc068dmarks (ts, ps) <- sortId ks `separatedBy` crossT
fa9e4066f08beec538e775443c5be79dd423fcabahrens fmap O_type (opFunSort ks (s:ts) (c:ps))
fa9e4066f08beec538e775443c5be79dd423fcabahrens <|> return (P_type $ Pred_type (s:ts)
fa9e4066f08beec538e775443c5be79dd423fcabahrens $ catRange $ c:ps)
fa9e4066f08beec538e775443c5be79dd423fcabahrens <|> fmap O_type (opFunSort ks [s] [])
fa9e4066f08beec538e775443c5be79dd423fcabahrens <|> return (A_type s)
fa9e4066f08beec538e775443c5be79dd423fcabahrens <|> fmap P_type predUnitType
fa9e4066f08beec538e775443c5be79dd423fcabahrens
fa9e4066f08beec538e775443c5be79dd423fcabahrens-- | parsing one symbol or a mapping of one to second symbol
fa9e4066f08beec538e775443c5be79dd423fcabahrenssymbMap :: [String] -> GenParser Char st SYMB_OR_MAP
990b4856d0eaada6f8140335733a1b1771ed2746llingsymbMap ks =
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens do s <- symb ks
148434217c040ea38dc844384f6ba68d9b325906Matthew Ahrens do f <- pToken $ toKey mapsTo
148434217c040ea38dc844384f6ba68d9b325906Matthew Ahrens t <- symb ks
148434217c040ea38dc844384f6ba68d9b325906Matthew Ahrens return (Symb_map s t $ tokPos f)
148434217c040ea38dc844384f6ba68d9b325906Matthew Ahrens <|> return (Symb s)
148434217c040ea38dc844384f6ba68d9b325906Matthew Ahrens
148434217c040ea38dc844384f6ba68d9b325906Matthew Ahrens-- | parse a kind keyword
148434217c040ea38dc844384f6ba68d9b325906Matthew AhrenssymbKind :: GenParser Char st (SYMB_KIND, Token)
148434217c040ea38dc844384f6ba68d9b325906Matthew AhrenssymbKind = try(
990b4856d0eaada6f8140335733a1b1771ed2746lling do q <- pluralKeyword opS
990b4856d0eaada6f8140335733a1b1771ed2746lling return (Ops_kind, q)
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens <|>
990b4856d0eaada6f8140335733a1b1771ed2746lling do q <- pluralKeyword predS
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens return (Preds_kind, q)
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens <|>
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens do q <- pluralKeyword sortS
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens return (Sorts_kind, q)) <?> "kind"
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens
990b4856d0eaada6f8140335733a1b1771ed2746lling-- | parse a possible kinded list of comma separated symbols
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrenssymbItems :: [String] -> GenParser Char st SYMB_ITEMS
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrenssymbItems ks =
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens do (is, ps) <- symbs ks
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens return (Symb_items Implicit is $ catRange ps)
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens <|>
810e43b2eb0e320833671a403fdda51917e8b036Bill Pijewski do (k, p) <- symbKind
45818ee124adeaaf947698996b4f4c722afc6d1fMatthew Ahrens (is, ps) <- symbs ks
45818ee124adeaaf947698996b4f4c722afc6d1fMatthew Ahrens return (Symb_items k is $ catRange $ p:ps)
45818ee124adeaaf947698996b4f4c722afc6d1fMatthew Ahrens
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens-- | parse a comma separated list of symbols
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrenssymbs :: [String] -> GenParser Char st ([SYMB], [Token])
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrenssymbs ks =
b24ab6762772a3f6a89393947930c7fa61306783Jeff Bonwick do s <- symb ks
b24ab6762772a3f6a89393947930c7fa61306783Jeff Bonwick do c <- commaT `followedWith` symb ks
b24ab6762772a3f6a89393947930c7fa61306783Jeff Bonwick (is, ps) <- symbs ks
b24ab6762772a3f6a89393947930c7fa61306783Jeff Bonwick return (s:is, c:ps)
b24ab6762772a3f6a89393947930c7fa61306783Jeff Bonwick <|> return ([s], [])
b24ab6762772a3f6a89393947930c7fa61306783Jeff Bonwick
b24ab6762772a3f6a89393947930c7fa61306783Jeff Bonwick-- | parse a possible kinded list of symbol mappings
45818ee124adeaaf947698996b4f4c722afc6d1fMatthew AhrenssymbMapItems :: [String] -> GenParser Char st SYMB_MAP_ITEMS
45818ee124adeaaf947698996b4f4c722afc6d1fMatthew AhrenssymbMapItems ks =
45818ee124adeaaf947698996b4f4c722afc6d1fMatthew Ahrens do (is, ps) <- symbMaps ks
45818ee124adeaaf947698996b4f4c722afc6d1fMatthew Ahrens return (Symb_map_items Implicit is $ catRange $ ps)
45818ee124adeaaf947698996b4f4c722afc6d1fMatthew Ahrens <|>
45818ee124adeaaf947698996b4f4c722afc6d1fMatthew Ahrens do (k, p) <- symbKind
45818ee124adeaaf947698996b4f4c722afc6d1fMatthew Ahrens (is, ps) <- symbMaps ks
45818ee124adeaaf947698996b4f4c722afc6d1fMatthew Ahrens return (Symb_map_items k is $ catRange $ p : ps)
b24ab6762772a3f6a89393947930c7fa61306783Jeff Bonwick
b24ab6762772a3f6a89393947930c7fa61306783Jeff Bonwick-- | parse a comma separated list of symbol mappings
b24ab6762772a3f6a89393947930c7fa61306783Jeff BonwicksymbMaps :: [String] -> GenParser Char st ([SYMB_OR_MAP], [Token])
990b4856d0eaada6f8140335733a1b1771ed2746llingsymbMaps ks =
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens do s <- symbMap ks
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens do c <- commaT `followedWith` symb ks
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens (is, ps) <- symbMaps ks
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens return (s:is, c:ps)
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens <|> return ([s], [])
91ebeef555ce7f899b6270a3c2df47b51f7ad59aahrens