Parse_AS_Structured.hs revision cc0298f887b0416641a8b87acfae2c2983caa062
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian Maeder Author: Till Mossakowski, Christian Maeder
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder Year: 2002/2003
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder Parsing the Structured part of hetrogenous specifications.
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder http://www.cofi.info/Documents/CASL/Summary/
f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maeder from 25 March 2001
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder C.2.2 Structured Specifications
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder fixing of details concerning annos
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maeder logic translations and implicit coercions
d48085f765fca838c1d972d2123601997174583dChristian Maeder "and" should do union of involved logics
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder therefore, logic should be explicit argument instead of kept in the state
47d6bc7bc9a708427f96be8d805f712697ad3d9eChristian Maedermodule Parse_AS_Structured where
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederimport Grothendieck
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian Maederimport Logic_CASL -- we need the default logic
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian Maederimport AS_Structured
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian Maederimport AS_Library
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maederimport AS_Annotation
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maederimport Anno_Parser
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maederimport Id(tokPos)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederimport Keywords
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maederimport ParsecChar (digit)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederimport Maybe(maybeToList)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederimport Print_AS_Structured -- for test purposes
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederimport Print_HetCASL
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder------------------------------------------------------------------------
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maeder-- annotation adapter
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder------------------------------------------------------------------------
eab576044505ba1fbc64610323053490fbd9e82cChristian MaederasKey = pToken . toKey
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder-- skip to leading annotation and read many
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederannos :: GenParser Char st [Annotation]
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederannos = skip >> many (annotationL << skip)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederannoParser parser = bind (\x y -> Annoted y [] x []) annos parser
ce3928e71520030ad0275b72050a8f4377f9313cChristian MaederannoParser2 parser = bind (\x (Annoted y pos l r) -> Annoted y pos (x++l) r) annos parser
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian MaederemptyAnno :: a -> Annoted a
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederemptyAnno x = Annoted x [] [] []
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder------------------------------------------------------------------------
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder-- simpleIds for spec- and view-name
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder------------------------------------------------------------------------
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederlogicS = "logic" -- new keyword
92aa1b88f02d2a413da60dba78acd34312e6f29aChristian MaedersimpleId = pToken (reserved (logicS:casl_reserved_words) scanAnyWords)
d92635f998347112e5d5803301c2abfe7832ab65Christian Maeder------------------------------------------------------------------------
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder-- logic and encoding names
81946e2b3f6dde6167f48769bd02c7a634736856Christian Maeder------------------------------------------------------------------------
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder-- exclude colon (because encoding must be recognized)
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder-- ecclude dot to recognize optional sublogic name
413db961f13e112716509b6d61d7a7bbf50c98b2Christian MaederotherChars = "_`"
36c6cc568751e4235502cfee00ba7b597dae78dcChristian Maeder-- better list what is allowed rather than exclude what is forbidden
024621f43239cfe9629e35d35a8669fad7acbba2Christian Maeder-- white spaces und non-printables should be not allowed!
d48085f765fca838c1d972d2123601997174583dChristian MaederencodingName = pToken(reserved (funS:casl_reserved_words) (many1
d48085f765fca838c1d972d2123601997174583dChristian Maeder (oneOf (otherChars ++ (signChars \\ ":."))
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder <|> scanLPD)))
d48085f765fca838c1d972d2123601997174583dChristian Maeder-- keep these identical in order to
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder-- decide after seeing ".", ":" or "->" what was meant
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian MaederlogicName = do e <- encodingName
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder do string dotS
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder s <- encodingName
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder return (Logic_name e (Just s))
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder <|> return (Logic_name e Nothing)
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder------------------------------------------------------------------------
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder-- parse Logic_code
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder------------------------------------------------------------------------
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian MaederparseLogic :: GenParser Char AnyLogic Logic_code
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder do l <- asKey logicS
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder do e <- logicName -- try to parse encoding or logic source after "logic"
2986838ec286d67e7c199e7ea81e7364ca36ad25Christian Maeder Logic_name _ (Just _) -> parseOptLogTarget Nothing (Just e) [l]
ae8052003e1ec7247597f034069db0939a7387e1Christian Maeder Logic_name f Nothing ->
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder do c <- asKey colonS
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder parseLogAfterColon (Just f) [l,c]
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder <|> parseOptLogTarget Nothing (Just e) [l]
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder <|> do f <- asKey funS -- parse at least a logic target after "logic"
d48085f765fca838c1d972d2123601997174583dChristian Maeder t <- logicName
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder return (Logic_code Nothing Nothing (Just t) (map tokPos [l,f]))
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder-- parse optional logic source and target after a colon (given an encoding e)
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian MaederparseLogAfterColon e l =
d48085f765fca838c1d972d2123601997174583dChristian Maeder do s <- logicName
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder parseOptLogTarget e (Just s) l
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder <|> return (Logic_code e (Just s) Nothing (map tokPos l))
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder <|> parseOptLogTarget e Nothing l
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder <|> return (Logic_code e Nothing Nothing (map tokPos l))
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder-- parse an optional logic target (given encoding e or source s)
d48085f765fca838c1d972d2123601997174583dChristian MaederparseOptLogTarget e s l =
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder do f <- asKey funS
d48085f765fca838c1d972d2123601997174583dChristian Maeder do t <- logicName
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder return (Logic_code e s (Just t) (map tokPos (l++[f])))
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder <|> return (Logic_code e s Nothing (map tokPos (l++[f])))
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder------------------------------------------------------------------------
d48085f765fca838c1d972d2123601997174583dChristian Maeder-- for parsing "," not followed by "logic" within G_mapping
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder------------------------------------------------------------------------
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder-- ParsecCombinator.notFollowedBy only allows to check for a single "tok"
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder-- thus a single Char.
d48085f765fca838c1d972d2123601997174583dChristian MaedernotFollowedWith :: GenParser tok st a -> GenParser tok st b
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder -> GenParser tok st a
d48085f765fca838c1d972d2123601997174583dChristian Maederp1 `notFollowedWith` p2 = try ((p1 >> p2 >> pzero) <|> p1)
d48085f765fca838c1d972d2123601997174583dChristian MaederplainComma = commaT `notFollowedWith` asKey logicS
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder-- rearrange list to keep current logic as first element
d48085f765fca838c1d972d2123601997174583dChristian Maeder-- does not consume anything! (may only fail)
d48085f765fca838c1d972d2123601997174583dChristian Maeder{-switchLogic :: Logic_code -> LogicGraph -> GenParser Char st LogicGraph
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederswitchLogic n l@(Logic i : _) =
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder let s = case n of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Logic_code _ _ (Just (Logic_name t _)) _ -> tokStr t
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder _ -> language_name i
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder (f, r) = partition (\ (Logic x) -> language_name x == s) l
eab576044505ba1fbc64610323053490fbd9e82cChristian Maeder in if null f then fail ("unknown language " ++ s)
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder else return (f++r)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder------------------------------------------------------------------------
d48085f765fca838c1d972d2123601997174583dChristian Maeder-- parse G_mapping (if you modify this, do so for G_hiding, too!)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder------------------------------------------------------------------------
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian MaederparseItemsMap :: GenParser Char AnyLogic (G_symb_map_items_list, [Token])
413db961f13e112716509b6d61d7a7bbf50c98b2Christian MaederparseItemsMap =
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder do Logic lid <- getState
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (cs, ps) <- callParser (parse_symb_map_items lid) (language_name lid) "symbol maps"
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder `separatedBy` commaT
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder -- ??? should be plainComma, but does not work for reveal s,t!
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder return (G_symb_map_items_list lid cs, ps)
37354e3ed68875fb527338105a610df481f98cb0Christian MaederparseMapping :: LogicGraph -> GenParser Char AnyLogic ([G_mapping], [Token])
413db961f13e112716509b6d61d7a7bbf50c98b2Christian MaederparseMapping l =
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder do n <- parseLogic
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder do c <- commaT
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (gs, ps) <- parseMapping l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (G_logic_translation n : gs, c:ps)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> return ([G_logic_translation n], [])
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> do (m, ps) <- parseItemsMap
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder do c <- commaT
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (gs, qs) <- parseMapping l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (G_symb_map m : gs, ps ++ c : qs)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> return ([G_symb_map m], ps)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder------------------------------------------------------------------------
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder-- parse G_hiding (copied from above, but code sharing would be better!)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder------------------------------------------------------------------------
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian MaederparseItemsList :: LogicGraph -> GenParser Char AnyLogic (G_symb_items_list, [Token])
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederparseItemsList l =
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder do Logic lid <- getState
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (cs, ps) <- callParser (parse_symb_items lid) (language_name lid) "symbols"
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder `separatedBy` plainComma
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (G_symb_items_list lid cs, [])
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederparseHiding :: LogicGraph -> GenParser Char AnyLogic ([G_hiding], [Token])
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederparseHiding l =
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder do n <- parseLogic
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder do c <- commaT
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (gs, ps) <- parseHiding l
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder return (G_logic_projection n : gs, c:ps)
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder <|> return ([G_logic_projection n], [])
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder <|> do (m, ps) <- parseItemsList l
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder do c <- commaT
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder (gs, qs) <- parseHiding l
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder return (G_symb_list m : gs, ps ++ c : qs)
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder <|> return ([G_symb_list m], ps)
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian MaederparseRevealing :: LogicGraph -> GenParser Char AnyLogic (G_symb_map_items_list, [Token])
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian MaederparseRevealing l = undefined
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder------------------------------------------------------------------------
f8a1ab8012a1f36060d6ce9b63399fa4a8a2981cChristian Maeder------------------------------------------------------------------------
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederspec :: LogicGraph -> GenParser Char AnyLogic (Annoted SPEC)
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maederspec l = do (sps,ps) <- annoParser2 (specA l) `separatedBy` (asKey thenS)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (case sps of
ce3928e71520030ad0275b72050a8f4377f9313cChristian Maeder otherwise -> emptyAnno (Extension sps (map tokPos ps)))
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian MaederspecA :: LogicGraph -> GenParser Char AnyLogic (Annoted SPEC)
f8a1ab8012a1f36060d6ce9b63399fa4a8a2981cChristian MaederspecA l = do (sps,ps) <- annoParser (specB l) `separatedBy` (asKey andS)
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder return (case sps of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder otherwise -> emptyAnno (Union sps (map tokPos ps)))
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian MaederspecB :: LogicGraph -> GenParser Char AnyLogic SPEC
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederspecB l = do p1 <- asKey localS
ce3928e71520030ad0275b72050a8f4377f9313cChristian Maeder sp1 <- aSpec l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder p2 <- asKey withinS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder sp2 <- annoParser (specB l)
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder return (Local_spec sp1 sp2 (map tokPos [p1,p2]))
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder <|> do sp <- specC l
68485f7bfab1b4c6f963ce6837cba5fb148ed625Christian Maeder return (item sp) -- ??? what to do with anno?
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederspecC :: LogicGraph -> GenParser Char AnyLogic (Annoted SPEC)
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian MaederspecC l = do sp <- annoParser (specD l)
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder translation_list l sp
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maedertranslation_list l sp =
5581c4644d91dcb9b7e2e7f6052f7cbf5f97b6deChristian Maeder do sp' <- translation l sp
5581c4644d91dcb9b7e2e7f6052f7cbf5f97b6deChristian Maeder translation_list l sp'
5581c4644d91dcb9b7e2e7f6052f7cbf5f97b6deChristian Maeder <|> return sp
5581c4644d91dcb9b7e2e7f6052f7cbf5f97b6deChristian Maedertranslation l sp =
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder do p <- asKey withS
8a6b503b50c0be589f12eb0d4ebeb4b4312fd491Christian Maeder (m, ps) <- parseMapping l
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder return (emptyAnno (Translation sp (Renaming m (map tokPos (p:ps)))))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> do p <- asKey hideS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (m, ps) <- parseHiding l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (emptyAnno (Reduction sp (Hidden m (map tokPos (p:ps)))))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> do p <- asKey revealS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (m, ps) <- parseItemsMap
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (emptyAnno (Reduction sp (Revealed m (map tokPos (p:ps)))))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederspecD :: LogicGraph -> GenParser Char AnyLogic SPEC
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder -- do some lookahead for free spec, to avoid clash with free type
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederspecD l = do (p,sp) <- try (do p <- asKey freeS
5581c4644d91dcb9b7e2e7f6052f7cbf5f97b6deChristian Maeder sp <- groupSpec l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (p,sp))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (Free_spec (emptyAnno sp) [tokPos p])
5581c4644d91dcb9b7e2e7f6052f7cbf5f97b6deChristian Maeder <|> do (p,sp) <- try (do p <- asKey cofreeS
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder sp <- groupSpec l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (p,sp))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (Cofree_spec (emptyAnno sp) [tokPos p])
966e627a1c06b302a06d59d08b8ab45905f3509cChristian Maeder <|> do p <- asKey closedS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder sp <- groupSpec l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (Closed_spec (emptyAnno sp) [tokPos p])
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian MaederspecE :: LogicGraph -> GenParser Char AnyLogic SPEC
eab576044505ba1fbc64610323053490fbd9e82cChristian MaederspecE l = do lookAhead (try (oBraceT >> cBraceT)) -- avoid overlap with group spec
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder <|> do lookAhead (oBraceT <|> ((simpleId << annos)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder `followedWith`
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (asKey withS <|> asKey hideS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> asKey revealS <|> asKey andS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> asKey thenS <|> cBraceT
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> asKey withinS <|> asKey endS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> oBracketT <|> cBracketT
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder <|> (eof >> return (Token "" nullPos)))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> logicSpec l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> basicSpec l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaedercallParser p name itemType = do
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder s <- getInput
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder pos <- getPosition
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (x,rest,line,col) <- case p of
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Nothing -> fail ("no "++itemType++" parser for language "
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder Just p -> return (p (sourceName pos)
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder (sourceLine pos)
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder (sourceColumn pos) s)
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder setInput rest
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder let pos' = setSourceColumn (setSourceLine pos line) col
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder setPosition pos'
028f19cdb09d52bb2fd207399b6fa874540d1670Christian MaederbasicSpec :: LogicGraph -> GenParser Char AnyLogic SPEC
028f19cdb09d52bb2fd207399b6fa874540d1670Christian MaederbasicSpec l = do Logic lid <- getState
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder bspec <- callParser (parse_basic_spec lid) (language_name lid)
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder "basic specification"
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder return (Basic_spec (G_basic_spec lid bspec))
028f19cdb09d52bb2fd207399b6fa874540d1670Christian MaederlogicSpec :: LogicGraph -> GenParser Char AnyLogic SPEC
028f19cdb09d52bb2fd207399b6fa874540d1670Christian MaederlogicSpec l = do
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder s1 <- asKey logicS
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder log <- logicName
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder let Logic_name t _ = log
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder s2 <- asKey ":"
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder oldlog <- getState
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder let newlog = lookupLogic log l
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder logtrans = coercelog newlog oldlog
028f19cdb09d52bb2fd207399b6fa874540d1670Christian Maeder setState newlog
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder sp <- annoParser (specE l)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder setState oldlog
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder let sp1 = Qualified_spec log sp (map tokPos [s1,t,s2])
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder return (logtrans sp1)
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian MaederlookupLogic (Logic_name log sublog) (logics,_) =
8a6b503b50c0be589f12eb0d4ebeb4b4312fd491Christian Maeder case find (\(Logic lid) -> language_name lid == tokStr log) logics of
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder Nothing -> error ("logic "++tokStr log++" unknown")
8a6b503b50c0be589f12eb0d4ebeb4b4312fd491Christian Maeder Just (Logic lid) ->
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder case sublog of
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder Nothing -> Logic lid
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder case find (\sub -> tokStr s `elem` sublogic_names lid sub)
8a6b503b50c0be589f12eb0d4ebeb4b4312fd491Christian Maeder (all_sublogics lid) of
8a6b503b50c0be589f12eb0d4ebeb4b4312fd491Christian Maeder Nothing -> error ("sublogic "++tokStr s++
8a6b503b50c0be589f12eb0d4ebeb4b4312fd491Christian Maeder " in logic "++tokStr log++" unknown")
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder Just sub -> Logic lid -- ??? can we throw away sublogic?
8a6b503b50c0be589f12eb0d4ebeb4b4312fd491Christian Maedercoercelog (Logic newlid) (Logic oldlid) =
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder if newlang == oldlang then id
8a6b503b50c0be589f12eb0d4ebeb4b4312fd491Christian Maeder else error ("Cannot coerce from "++newlang++" to "++oldlang)
8a6b503b50c0be589f12eb0d4ebeb4b4312fd491Christian Maeder where newlang = language_name newlid
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder oldlang = language_name oldlid
8a6b503b50c0be589f12eb0d4ebeb4b4312fd491Christian Maeder -- \sp -> Translation (emptyAnno sp) (Renaming [G_logic_translation (Logic_code...)] [])
413db961f13e112716509b6d61d7a7bbf50c98b2Christian MaederaSpec l = annoParser2 (spec l)
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian MaedergroupSpec l = do b <- oBraceT
8a6b503b50c0be589f12eb0d4ebeb4b4312fd491Christian Maeder return (Group a (map tokPos [b, c]))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder do n <- simpleId
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (f,ps) <- fitArgs l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (Spec_inst n f)
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder -- ??? What to do with ps? Spec_inst is not consistent here!
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederfitArgs :: LogicGraph -> GenParser Char AnyLogic ([Annoted FIT_ARG],[Pos])
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederfitArgs l = do fas <- many (fitArg l)
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder let (fas1,ps) = unzip fas
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder return (fas1,concat ps)
d92635f998347112e5d5803301c2abfe7832ab65Christian MaederfitArg :: LogicGraph -> GenParser Char AnyLogic (Annoted FIT_ARG,[Pos])
9c5b1136299d9052e4e995614a3a36a051a2682fChristian MaederfitArg l = do b <- oBracketT
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder fa <- annoParser (fittingArg l)
ce3928e71520030ad0275b72050a8f4377f9313cChristian Maeder c <- cBracketT
da245da15da78363c896e44ea97a14ab1f83eb50Christian Maeder return (fa,[tokPos b,tokPos c])
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederfittingArg :: LogicGraph -> GenParser Char AnyLogic FIT_ARG
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederfittingArg l = do (an,s) <- try (do an <- annos
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder s <- asKey viewS
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder return (an,s))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder vn <- simpleId
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (fa,ps) <- fitArgs l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (Fit_view vn fa (tokPos s:ps) an)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder do sp <- aSpec l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Logic lid <- getState
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (symbit,ps) <- option (G_symb_map_items_list lid [],[])
17388303189780ad2e579c56547bf1a849d3666bChristian Maeder (do s <- asKey fitS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (m, ps) <- parseItemsMap
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (m,[tokPos s]))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (Fit_spec sp symbit ps)
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederoptEnd = option Nothing (fmap Just (asKey endS))
f8a1ab8012a1f36060d6ce9b63399fa4a8a2981cChristian Maedergenerics l = do
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder (pa,ps1) <- params l
eab576044505ba1fbc64610323053490fbd9e82cChristian Maeder (imp,ps2) <- option ([],[]) (imports l)
eab576044505ba1fbc64610323053490fbd9e82cChristian Maeder return (Genericity (Params pa) (Imported imp) (ps1++ps2))
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maederparams :: LogicGraph -> GenParser Char AnyLogic ([Annoted SPEC],[Pos])
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maederparams l = do pas <- many (param l)
f8a1ab8012a1f36060d6ce9b63399fa4a8a2981cChristian Maeder let (pas1,ps) = unzip pas
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder return (pas1,concat ps)
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maederparam :: LogicGraph -> GenParser Char AnyLogic (Annoted SPEC,[Pos])
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederparam l = do b <- oBracketT
359e79584976afb25d37502669a67093a75f3c5bChristian Maeder pa <- aSpec l
359e79584976afb25d37502669a67093a75f3c5bChristian Maeder c <- cBracketT
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder return (pa,[tokPos b,tokPos c])
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maederimports l = do s <- asKey givenS
359e79584976afb25d37502669a67093a75f3c5bChristian Maeder (sps,ps) <- annoParser (groupSpec l) `separatedBy` commaT
359e79584976afb25d37502669a67093a75f3c5bChristian Maeder return (sps,map tokPos (s:ps))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederlibItem l = -- spec defn
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder do s <- asKey specS
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder n <- simpleId
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder g <- generics l
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder e <- asKey equalS
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder return (AS_Library.Spec_defn n g a (map tokPos ([s, e] ++ Maybe.maybeToList q)))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder <|> -- view defn
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder do s1 <- asKey viewS
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder vn <- simpleId
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder g <- generics l
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder s2 <- asKey ":"
f8a1ab8012a1f36060d6ce9b63399fa4a8a2981cChristian Maeder vt <- viewType l
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder (symbMap,ps) <- option ([],[])
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder (do s <- asKey equalS
eab576044505ba1fbc64610323053490fbd9e82cChristian Maeder (m, ps) <- parseMapping l
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder return (m,[s]))
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder return (AS_Library.View_defn vn g vt symbMap
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder (map tokPos ([s1,s2] ++ ps ++ Maybe.maybeToList q)))
f8a1ab8012a1f36060d6ce9b63399fa4a8a2981cChristian Maeder <|> -- download
f8a1ab8012a1f36060d6ce9b63399fa4a8a2981cChristian Maeder do s1 <- asKey fromS
f8a1ab8012a1f36060d6ce9b63399fa4a8a2981cChristian Maeder ln <- libName
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder s2 <- asKey getS
f8a1ab8012a1f36060d6ce9b63399fa4a8a2981cChristian Maeder (il,ps) <- itemNameOrMap `separatedBy` commaT
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder return (Download_items ln il
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder (map tokPos ([s1,s2]++ps++ Maybe.maybeToList q)))
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder do s1 <- asKey logicS
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder log <- logicName
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder let Logic_name t _ = log
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder setState (lookupLogic log l)
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder return (Logic_decl log (map tokPos [s1,t]))
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian MaederviewType l = do sp1 <- annoParser (groupSpec l)
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder s <- asKey toS
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder sp2 <- annoParser (groupSpec l)
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder return (View_type sp1 sp2 [tokPos s])
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian MaederlibName = do libid <- libId
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder v <- option Nothing (fmap Just version)
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder return (case v of
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder Nothing -> Lib_id libid
24f79601ad5e42ce74f4152a36aad257d7c4d7b5Christian Maeder Just v1 -> Lib_version libid v1)
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian MaederlibId = do pos <- getPosition
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder path <- scanAnyWords `sepBy1` (string "/")
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder return (Indirect_link (concat (intersperse "/" path)) [pos])
d92635f998347112e5d5803301c2abfe7832ab65Christian Maeder -- ??? URL need to be added
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maederversion = do s <- asKey versionS
ce3928e71520030ad0275b72050a8f4377f9313cChristian Maeder pos <- getPosition
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder n <- many1 digit `sepBy1` (string ".")
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (Version_number n ([tokPos s, pos]))
ce3928e71520030ad0275b72050a8f4377f9313cChristian MaederitemNameOrMap = do i1 <- simpleId
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder i' <- option Nothing (do
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder s <- asKey "|->"
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder i <- simpleId
f8a1ab8012a1f36060d6ce9b63399fa4a8a2981cChristian Maeder return (Just (i,s)))
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder return (case i' of
f8a1ab8012a1f36060d6ce9b63399fa4a8a2981cChristian Maeder Nothing -> Item_name i1
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Just (i2,s) -> Item_name_map i1 i2 [tokPos s])
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maederlibrary l = do skip
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder s1 <- asKey libraryS
f875f7eebac7f69bf9da98c93479a542d0a8056fChristian Maeder ln <- libName
54b698a84a1686b828c99d839fc671942b817534Christian Maeder ls <- many (annoParser (libItem l))
54b698a84a1686b828c99d839fc671942b817534Christian Maeder return (Lib_defn ln ls [tokPos s1] an)
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder-------------------------------------------------------------
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder-------------------------------------------------------------
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian MaedermylogicGraph = ([Logic CASL],[])
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian MaederparseSPEC fname =
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder do input <- readFile fname
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder case runParser (do x <- spec mylogicGraph
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder return (x,s1))
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder (Logic CASL) fname input of
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian Maeder Left err -> error (show err)
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder Right x -> return x
a59f2017dfc311ece7afcea3e8a3ceceac77ba5aChristian MaederparseLib fname =
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder do input <- readFile fname
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder case runParser (do x <- library mylogicGraph
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder return (x,s1))
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder (Logic CASL) fname input of
48c4688439e0aade4faeebf25ca8b16d661e47afChristian Maeder Left err -> error (show err)
aae7a026a323021c5364aef85a0e03d586e5a5c3Christian Maeder Right x -> return x
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maedertest fname = do
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder (x,errs) <- parseLib fname
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder putStrLn (show (printText0_eGA x))
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder if errs == "" then return ()
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder else putStrLn ("\nUnread input:\n"++take 20 errs++" ...")