Anno_Parser.hs revision 42c01284bba8d7c8d995c8dfb96ace57d28ed1bc
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederModule : $Header$
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiCopyright : (c) Klaus L�ttich, Christian Maeder and Uni Bremen 2002-2005
1549f3abf73c1122acff724f718b615c82fa3648Till MossakowskiLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederMaintainer : maeder@tzi.de
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederStability : provisional
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederPortability : portable
f3a94a197960e548ecd6520bb768cb0d547457bbChristian MaederThis file implements parsers for annotations and annoted items.
e6d40133bc9f858308654afb1262b8b483ec5922Till Mossakowski Follows Chap. II:5 of the CASL Reference Manual.
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder uses Lexer, Keywords and Token rather than CaslLanguage
f8b715ab2993083761c0aedb78f1819bcf67b6ccChristian Maedermodule Common.Anno_Parser (annotationL, annotations,
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder parse_anno, some_id) where
5e46b572ed576c0494768998b043d9d340594122Till Mossakowskiimport Text.ParserCombinators.Parsec.Pos as Pos
8c63cd89ef840cd7a3d3b75f0207dc800388c800Christian Maedercomment :: GenParser Char st Annotation
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maedercomment = commentLine <|> commentGroup
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maedersome_id :: GenParser Char st Id
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskisome_id = mixId keys keys where keys = ([], [])
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian MaedercharOrEof :: Char -> GenParser Char st ()
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaedercharOrEof c = (char c >> return ()) <|> eof
90c174bac60a72ffd81bc3bf5ae2dd9a61943b8bChristian MaedernewlineOrEof :: GenParser Char st ()
2561b4bfc45d280ee2be8a7870314670e4e682e4Christian MaedernewlineOrEof = charOrEof '\n'
aea143fff7a50aceb809845fbc42698b0b3f545aChristian MaedercommentLine :: GenParser Char st Annotation
ca020e82eb3567e7bdbb1cf70729efbd07e9caa4Klaus LuettichcommentLine = do
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder try $ string "%%"
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski line <- manyTill anyChar newlineOrEof
c7e03d0708369f944b6f235057b39142a21599f2Mihai Codescu return $ Unparsed_anno Comment_start (Line_anno line) (Range [p, q])
986d3f255182539098a97ac86da9eeee5b7a72e3Christian Maederdec :: Pos -> Pos
03136b84a0c70d877e227444f0875e209506b9e4Christian MaedercommentGroup :: GenParser Char st Annotation
03136b84a0c70d877e227444f0875e209506b9e4Christian MaedercommentGroup = do
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder try $ string "%{"
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder text_lines <- manyTill anyChar $ try $ string "}%"
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder return $ Unparsed_anno Comment_start
4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian Maeder (Group_anno $ lines text_lines) (Range [p, dec q])
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maederannote :: GenParser Char st Annotation
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maederannote = anno_label <|> do
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder i <- try anno_ident
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder anno <- annote_group p i <|> annote_line p i
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder case parse_anno anno p of
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder Left err -> do
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder setPosition (errorPos err)
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder fail (tail (showErrorMessages "or" "unknown parse error"
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder "expecting" "unexpected" "end of input"
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder (errorMessages err)))
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder Right pa -> return pa
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maederanno_label :: GenParser Char st Annotation
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maederanno_label = do
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder try $ string "%("
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder label_lines <- manyTill anyChar $ try $ string ")%"
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder return (Label (lines label_lines) (Range [p, dec q]))
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maederanno_ident :: GenParser Char st Annote_word
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maederanno_ident = fmap Annote_word $ string "%" >> casl_words
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maederannote_group :: Pos -> Annote_word -> GenParser Char st Annotation
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maederannote_group p s = do
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder char '(' -- )
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder annote_lines <- manyTill anyChar $ try $ string ")%"
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder return $ Unparsed_anno s (Group_anno $ lines annote_lines) (Range [p, dec q])
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maederannote_line :: Pos -> Annote_word -> GenParser Char st Annotation
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maederannote_line p s = do
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder line <- manyTill anyChar newlineOrEof
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder return $ Unparsed_anno s (Line_anno line) (Range [p, q])
03136b84a0c70d877e227444f0875e209506b9e4Christian MaederannotationL :: GenParser Char st Annotation
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian MaederannotationL = comment <|> annote <?> "\"%\""
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maederannotations :: GenParser Char st [Annotation]
5e46b572ed576c0494768998b043d9d340594122Till Mossakowskiannotations = many (annotationL << skip)
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder-----------------------------------------
fa167e362877db231378e17ba49c66fbb84862fcChristian Maeder-- parser for the contents of annotations
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder-----------------------------------------
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian MaedercommaIds :: GenParser Char st [Id]
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian MaedercommaIds = commaSep1 some_id
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maederparse_anno :: Annotation -> Pos -> Either ParseError Annotation
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maederparse_anno anno sp =
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder Unparsed_anno (Annote_word kw) txt qs ->
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski case lookup kw $ swapTable semantic_anno_table of
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski Just sa -> semantic_anno sa txt sp
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski _ -> let nsp = Id.incSourceColumn sp (length kw + 1)
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder inp = case txt of
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder Line_anno str -> str
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder Group_anno ls -> unlines ls
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder mkAssoc dir p = do
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder return (Assoc_anno dir res qs) in
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder "left_assoc" -> parse_internal (mkAssoc ALeft commaIds) nsp inp
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder "right_assoc" -> parse_internal (mkAssoc ARight commaIds) nsp inp
26d11a256b1433604a3dbc69913b520fff7586acChristian Maeder "prec" -> parse_internal (prec_anno qs) nsp inp
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder "display" -> parse_internal (display_anno qs) nsp inp
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder "number" -> parse_internal (number_anno qs) nsp inp
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder "string" -> parse_internal (string_anno qs) nsp inp
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder "list" -> parse_internal (list_anno qs) nsp inp
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder "floating" -> parse_internal (floating_anno qs) nsp inp
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder _ -> Right anno
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder _ -> Right anno
03136b84a0c70d877e227444f0875e209506b9e4Christian MaederfromPos :: Pos -> SourcePos
aea143fff7a50aceb809845fbc42698b0b3f545aChristian MaederfromPos p = Pos.newPos (Id.sourceName p) (Id.sourceLine p) (Id.sourceColumn p)
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maederparse_internal :: GenParser Char () a -> Pos -> [Char]
6a22b2854c3bc9cb4877cb7d29049d6559238639Christian Maeder -> Either ParseError a
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maederparse_internal p sp inp = parse (do setPosition $ fromPos sp
03136b84a0c70d877e227444f0875e209506b9e4Christian MaedercheckForPlaces :: [Token] -> GenParser Char st [Token]
aea143fff7a50aceb809845fbc42698b0b3f545aChristian MaedercheckForPlaces ts =
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski do let ps = filter isPlace ts
74d9a385499bf903b24848dff450a153f525bda7Christian Maeder if null ps then nextListToks $ topMix3 ([], [])
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder -- topMix3 starts with square brackets
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder else if isSingle ps then return []
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder else unexpected "multiple places"
03136b84a0c70d877e227444f0875e209506b9e4Christian MaedernextListToks :: GenParser Char st [Token] -> GenParser Char st [Token]
03136b84a0c70d877e227444f0875e209506b9e4Christian MaedernextListToks f =
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder cs <- checkForPlaces ts
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder return (ts ++ cs)
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian MaedercaslListBrackets :: GenParser Char st Id
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian MaedercaslListBrackets =
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder do l <- nextListToks $ afterPlace ([], [])
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder (c, p) <- option ([], nullRange) $ comps ([], [])
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder return $ Id l c p
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maederprec_anno, number_anno, string_anno, list_anno, floating_anno
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder :: Range -> GenParser Char st Annotation
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskiprec_anno ps = do
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski left_ids <- braces commaIds
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder sign <- (try (string "<>") <|> (string "<")) << skip
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder right_ids <- braces commaIds
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder return $ Prec_anno
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder (if sign == "<" then Lower else BothDirections)
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maedernumber_anno ps = do
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder return $ Number_anno n ps
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maederlist_anno ps = do
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder bs <- caslListBrackets
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder ni <- some_id
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder ci <- some_id
8c63cd89ef840cd7a3d3b75f0207dc800388c800Christian Maeder return $ List_anno bs ni ci ps
8c63cd89ef840cd7a3d3b75f0207dc800388c800Christian Maederstring_anno ps = literal_2ids_anno ps String_anno
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskifloating_anno ps = literal_2ids_anno ps Float_anno
ab642ff136ce716af9e609b667e3f06d766c4ad7Christian Maederliteral_2ids_anno :: Range -> (Id -> Id -> Range -> Annotation)
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder -> GenParser Char st Annotation
99476ac2689c74251219db4782e57fe713a24a52Christian Maederliteral_2ids_anno ps con = do
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder i1 <- some_id
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder i2 <- some_id
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder return $ con i1 i2 ps
99476ac2689c74251219db4782e57fe713a24a52Christian Maederdisplay_anno :: Range -> GenParser Char st Annotation
99476ac2689c74251219db4782e57fe713a24a52Christian Maederdisplay_anno ps = do
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder ident <- some_id
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder tls <- many $ foldl1 (<|>) $ map disp_symb display_format_table
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder return (Display_anno ident tls ps)
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder where disp_symb (df_symb, symb) =
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder do (try $ string $ "%"++symb) << skip
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder str <- manyTill anyChar $ lookAhead $ charOrEof '%'
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder return (df_symb, reverse $ dropWhile (`elem` whiteChars)
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder $ reverse str)
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maedersemantic_anno :: Semantic_anno -> Annote_text -> Pos
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder -> Either ParseError Annotation
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maedersemantic_anno sa text sp =
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder let err = Left $ newErrorMessage
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder (UnExpect ("garbage after %"
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder ++ lookupSemanticAnno sa))
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder in case text of
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder Line_anno str ->
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder if all (`elem` whiteChars) str then
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder Right $ Semantic_anno sa (Range [sp])