d29201dd5328b88140ce050100693c501852657dChristian Maeder{- |

211c5fb252e0a776baad9a4857ab198659289a4aKristina SojakovaModule : ./CASL/CompositionTable/ParseSparQ.hs

e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerDescription : parsing SparQ CompositionTables

211c5fb252e0a776baad9a4857ab198659289a4aKristina SojakovaCopyright : (c) Christian Maeder and Uni Bremen 2002-2005

211c5fb252e0a776baad9a4857ab198659289a4aKristina SojakovaLicense : GPLv2 or higher, see LICENSE.txt

94e2e03f6efde106de095ef4ea0ec87f74955a31Kristina Sojakova

98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuMaintainer : fmossa@informatik.uni-bremen.de

211c5fb252e0a776baad9a4857ab198659289a4aKristina SojakovaStability : provisional

94e2e03f6efde106de095ef4ea0ec87f74955a31Kristina SojakovaPortability : portable

211c5fb252e0a776baad9a4857ab198659289a4aKristina Sojakova

211c5fb252e0a776baad9a4857ab198659289a4aKristina SojakovaParses CompositionTables in SparQ(Lisp)-Format using Parsec

211c5fb252e0a776baad9a4857ab198659289a4aKristina Sojakova <http://www.cs.uu.nl/~daan/parsec.html>

a3a6b6ebe9c2d1dc3554e44779dc7361a90e7617Kristina Sojakova-}

211c5fb252e0a776baad9a4857ab198659289a4aKristina Sojakova

211c5fb252e0a776baad9a4857ab198659289a4aKristina Sojakovamodule CASL.CompositionTable.ParseSparQ where

211c5fb252e0a776baad9a4857ab198659289a4aKristina Sojakova

7bb21262b4e6ea26f20869f13d2163583c120156Kristina Sojakovaimport Text.ParserCombinators.Parsec

7bb21262b4e6ea26f20869f13d2163583c120156Kristina Sojakovaimport CASL.CompositionTable.CompositionTable

e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maederimport CASL.CompositionTable.Keywords

e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maederimport Common.Parsec

e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maeder

e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maederimport Data.Char

e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederparseSparQTableOld :: Parser Table

e16b3696b2c173aac14200321868ed81b8f7dc69Christian MaederparseSparQTableOld = inParens $ do

65e11df7259566aa1d95e5977c7ebf1c332a9461Kristina Sojakova calculusName <- parseCalculusName

8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova (i1, rs1) <- parseIdBaOths

8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova ct <- parseConversetable

9f8b6c20948cc102562f8ad0c39a4b5e3855b02fKristina Sojakova (i2, rs2) <- parseIdBaOths

8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova compt <- parseCompTable

2ddc9d39235393dca2e40203dde20284db4c3deeKristina Sojakova (i3, rs3) <- parseIdBaOths

2ddc9d39235393dca2e40203dde20284db4c3deeKristina Sojakova case i1 ++ i2 ++ i3 of

45caf47cd6ed07be0637f6c51e4735512ce9d83aKristina Sojakova [i] -> return $ Table

e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maeder (Table_Attrs calculusName i $ rs1 ++ rs2 ++ rs3)

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova compt ct (Reflectiontable []) $ Models []

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova [] -> fail "missing identity relation"

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova is -> fail $ "non-unique identity relation " ++ show is

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina SojakovaparseIdBaOths :: Parser ([Baserel], [Baserel])

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina SojakovaparseIdBaOths = fmap (\ l ->

dd6f22b9dcff2695181b86372e4df03d5b96e92dKristina Sojakova (concatMap fst l, concatMap snd l))

dd6f22b9dcff2695181b86372e4df03d5b96e92dKristina Sojakova $ many parseIdBaOth

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina SojakovaparseIdBaOth :: Parser ([Baserel], [Baserel])

8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina SojakovaparseIdBaOth = try $ do

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian Maeder s <- cWord

51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova case () of

51bbd37b3957f301b2628422e161aac2cbd46f1cKristina Sojakova _ | s == identityRelationS

14650c9e129d8dc51ed55b2edc6ec27d9f0f6d00Kristina Sojakova -> do

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian Maeder i <- parseRelationId

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder return ([i], [])

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova _ | s == baseRelationsS

e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maeder -> do

e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maeder rs <- inParens (many1 parseRelationId)

e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maeder return ([], rs)

e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maeder _ | elem s [converseOperationS

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova , compositionOperationS, homingOperationS, inverseOperationS

a65c6747c9acbbebc93baba7bae94d2e3d8cdafbTill Mossakowski , shortcutOperationS]

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova -> pzero

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian Maeder _ | s == parametricS

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian Maeder -> forget word >> return ([], [])

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova _ -> (skipMany parseQualifierBrace <|> forget cWord)

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova >> return ([], [])

345d3dcc9f809776009851c446916fc770aa428dKristina Sojakova

a669e4685b32ff5ca1bca785eacc5e30a545b010Christian MaederparseQualifierBrace :: Parser ()

a669e4685b32ff5ca1bca785eacc5e30a545b010Christian MaederparseQualifierBrace = do

63dbf3642c023a8bebbc8ca0d56f698114551c8cKristina Sojakova string "(" <|> tryString "#'("

cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina Sojakova skip

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova many $ parseQualifierBrace <|> ((stringLit <|> many1 (noneOf ";()")) >> skip)

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova cParenT

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian Maeder

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian MaedercKey :: String -> Parser ()

2fa2a7c86b9416f0e1607787e9416e274feb1143Christian MaedercKey s = tryString (':' : s) >> skip

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian Maeder

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian MaedercWord :: Parser String

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian MaedercWord = char ':' >> word

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian Maeder

2fa2a7c86b9416f0e1607787e9416e274feb1143Christian Maederskip :: Parser ()

2ddc9d39235393dca2e40203dde20284db4c3deeKristina Sojakovaskip = skipMany $ single space <|> nestedComment ";;#|" ";;|#"

8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakova <|> char ';' <:> many (noneOf "\n")

2ddc9d39235393dca2e40203dde20284db4c3deeKristina Sojakova

a669e4685b32ff5ca1bca785eacc5e30a545b010Christian MaederparseCalculusName :: Parser String

80d2ec8f37d5ddec13c14b17b1bab01e9c94630aChristian MaederparseCalculusName =

c82e21a85ef57135a0c582ca0f418b1541151645Kristina Sojakova string "def-calculus" >> skip >> fmap (init . tail) stringLit << skip

63dbf3642c023a8bebbc8ca0d56f698114551c8cKristina Sojakova

c82e21a85ef57135a0c582ca0f418b1541151645Kristina Sojakovaword :: Parser String

8b054cade993ef373d564b2d74c9c5a2da48f8b7Kristina Sojakovaword = many1 (letter <|> oneOf "_.-?" <|> digit) << skip

a669e4685b32ff5ca1bca785eacc5e30a545b010Christian Maeder

9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina SojakovaoParenT :: Parser ()

9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina SojakovaoParenT = char '(' >> skip

a669e4685b32ff5ca1bca785eacc5e30a545b010Christian Maeder

9d770d1ea15092156d65e2a89b081eeeb8c6b153Kristina SojakovacParenT :: Parser ()

63dbf3642c023a8bebbc8ca0d56f698114551c8cKristina SojakovacParenT = char ')' >> skip

63dbf3642c023a8bebbc8ca0d56f698114551c8cKristina Sojakova

45caf47cd6ed07be0637f6c51e4735512ce9d83aKristina SojakovainParens :: Parser a -> Parser a

df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina SojakovainParens p = oParenT >> p << cParenT

df31d6f25f90e5112184f4eb60c8d3c7b116ca2dKristina Sojakova

345a7bff808e621f05d2ce86fdbab2a28c9e0d3dKristina SojakovaparseCompTable :: Parser Compositiontable

cb5d588c4c3b286cc1e7210335d6ef7f584d79bcKristina SojakovaparseCompTable = cKey compositionOperationS

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova >> inParens (fmap Compositiontable parseComptabentryList)

150dbefbeef7403ab31ecbf9c3bb56515be67cdfKristina Sojakova

4b61e23f57d9d13d036aedb1b10178d3e013ab38Kristina SojakovaparseComptabentryList :: Parser [Cmptabentry]

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian MaederparseComptabentryList = many1 parseComptabentry

2fa2a7c86b9416f0e1607787e9416e274feb1143Christian Maeder

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian MaederparseComptabentry :: Parser Cmptabentry

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian MaederparseComptabentry = inParens $ do

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian Maeder rel1 <- parseRelationId

9be5b6267dea82f0eb283bd4ae9d4f83e05a6944Christian Maeder rel2 <- parseRelationId

2fa2a7c86b9416f0e1607787e9416e274feb1143Christian Maeder results <- parseComptabentryResults

2ddc9d39235393dca2e40203dde20284db4c3deeKristina Sojakova return (Cmptabentry (Cmptabentry_Attrs rel1 rel2) results)

4b61e23f57d9d13d036aedb1b10178d3e013ab38Kristina Sojakova

345d3dcc9f809776009851c446916fc770aa428dKristina SojakovaparseComptabentryResults :: Parser [Baserel]

345d3dcc9f809776009851c446916fc770aa428dKristina SojakovaparseComptabentryResults = inParens (many parseRelationId)

345d3dcc9f809776009851c446916fc770aa428dKristina Sojakova <|> do

345d3dcc9f809776009851c446916fc770aa428dKristina Sojakova result@(Baserel str) <- parseRelationId

return $ if map toUpper str == "NIL" then [] else [result]

parseConversetable :: Parser Conversetable

parseConversetable = do

entry1 <- parseInverse

entry3 <- parseShortcut

entry2 <- parseHoming

return $ Conversetable_Ternary entry1 entry3 entry2

<|> fmap Conversetable parseConverse

parseConverse :: Parser [Contabentry]

parseConverse = cKey converseOperationS

>> inParens (many1 parseContabentry)

parseContabentry :: Parser Contabentry

parseContabentry = inParens $ do

id1 <- parseRelationId

fmap (Contabentry id1) $

single parseRelationId <|> parseBracedRelationIds

parseContabentryList :: String -> Parser [Contabentry_Ternary]

parseContabentryList s = cKey s

>> inParens (many1 parseContabentryTernary)

parseContabentryTernary :: Parser Contabentry_Ternary

parseContabentryTernary = inParens $ do

id1 <- parseRelationId

ids <- many1 parseRelationId <|> parseBracedRelationIds

return (Contabentry_Ternary id1 ids)

parseBracedRelationIds :: Parser [Baserel]

parseBracedRelationIds = inParens $ many1 parseRelationId

parseInverse :: Parser [Contabentry_Ternary]

parseInverse = parseContabentryList inverseOperationS

parseHoming :: Parser [Contabentry_Ternary]

parseHoming = parseContabentryList homingOperationS

parseShortcut :: Parser [Contabentry_Ternary]

parseShortcut = parseContabentryList shortcutOperationS

parseRelationId :: Parser Baserel

parseRelationId =

fmap Baserel (many1 $ satisfy $ \ c ->

not (isSpace c) && notElem c "():;#'\"") << skip