CASL/CompositionTable/ParseSparQ.hs

	ParseSparQ.hs revision b87efd3db0d2dc41615ea28669faf80fc1b48d56
446N/A{- |
4744N/AModule      :  $Header$
446N/ADescription :  parsing SparQ CompositionTables
446N/ACopyright   :  (c) Christian Maeder and Uni Bremen 2002-2005
446N/ALicense     :  GPLv2 or higher
446N/A
446N/AMaintainer  :  fmossa@informatik.uni-bremen.de
446N/AStability   :  provisional
446N/APortability :  portable
446N/A
446N/AParses CompositionTables in SparQ(Lisp)-Format using Parsec
446N/A <http://www.cs.uu.nl/~daan/parsec.html>
446N/A-}
446N/A
446N/Amodule CASL.CompositionTable.ParseSparQ (parseSparQTableFromFile) where
446N/A
446N/Aimport Text.ParserCombinators.Parsec
446N/Aimport CASL.CompositionTable.CompositionTable
446N/Aimport Common.Lexer
446N/Aimport Common.Parsec
873N/A
446N/AparseSparQTableFromFile :: String -> IO (Either ParseError Table)
446N/AparseSparQTableFromFile = parseFromFile parseSparQTable
446N/A
446N/AparseSparQTable :: Parser Table
5073N/AparseSparQTable = do
446N/A  skipMany skippable
446N/A  calculusName <- parseCalculusName
446N/A  skipMany skippable
4744N/A  identityRelation <- parseCalculusProperties
4744N/A  skipMany skippable
4744N/A  ct <- parseConversetable
4744N/A  try (do
4744N/A      skipMany skippable
4744N/A      parseReflectionOperations
4744N/A      skipMany skippable)
4744N/A    <|> skipMany skippable
4744N/A  br <- parseBaseRelations
4744N/A  skipMany skippable
4744N/A  compt <- parseCompTable
4744N/A  return $ Table
4744N/A    (Table_Attrs calculusName (Baserel identityRelation) br)
4744N/A    compt ct (Reflectiontable []) (Models [])
4744N/A
4744N/AparseArBaPa :: Parser String
4744N/AparseArBaPa = try parseArity <|> try parseBasisEntity <|> try parseQualifier
4744N/A
4744N/AparseCalculusProperties :: Parser String
4744N/AparseCalculusProperties = do
4744N/A  many (parseArBaPa <|> try parseParametric)
4744N/A  ide <- parseIdentityRelation
5073N/A  many parseArBaPa
4744N/A  many skippable
5073N/A  return ide
4744N/A
4744N/AparseParametric :: Parser String
4744N/AparseParametric = do
4744N/A  many skippable
4744N/A  string ":parametric?"
957N/A  many space
4744N/A  word
4744N/A
4744N/AparseArity :: Parser String
4744N/AparseArity = do
4744N/A  many skippable
4744N/A  string ":arity"
4744N/A  many space
4744N/A  string ":"
4744N/A  word
4744N/A
4744N/AparseBasisEntity :: Parser String
4744N/AparseBasisEntity = do
4744N/A  many skippable
4744N/A  string ":basis-entity"
4744N/A  many space
4744N/A  string ":"
4744N/A  word
4744N/A
4744N/AparseIdentityRelation :: Parser String
4744N/AparseIdentityRelation = do
4744N/A  many skippable
4744N/A  string ":identity-relation"
4744N/A  many space
4744N/A  ide <- parseRelationId
4744N/A  return (baserelBaserel ide)
4744N/A
4744N/AparseQualifier :: Parser String
4744N/AparseQualifier = do
4744N/A  many skippable
4744N/A  string ":qualifier"
4744N/A  many space
4744N/A  parseQualifierBrace
4744N/A
4744N/AparseQualifierBrace :: Parser String
4744N/AparseQualifierBrace = do
4744N/A  string "(" <|> string "#'("
4744N/A  many (many1 (noneOf "()") <|> try parseQualifierBrace)
4744N/A  string ")"
4744N/A  return ""
4744N/A
4744N/Askippable :: Parser String
4744N/Askippable = many1 space <|> parseAnnotation
4618N/A
4744N/AparseAnnotation :: Parser String
4744N/AparseAnnotation = try (do
4744N/A     string ";;#|"
4744N/A     many (many1 (noneOf ";") <|>
4744N/A           try (string ";" << notFollowedBy (char ';')))
4744N/A     string ";;|#")
4744N/A   <|> do
4744N/A     many space
4744N/A     string ";"
4744N/A     many (string ";")
4744N/A     many (noneOf "\n")
4744N/A     string "\n"
4744N/A
4744N/AparseCalculusName :: Parser String
4744N/AparseCalculusName = do
4744N/A  many skippable
4744N/A  string "(def-calculus"
4744N/A  many space
4744N/A  s <- parseQuotedStrings
4744N/A  space
5073N/A  return s
4744N/A
5073N/AparseQuotedStrings :: Parser String
4744N/AparseQuotedStrings = do
4744N/A  char '"'
4744N/A  cs <- many1 (noneOf "\"")
4744N/A  char '"'
4744N/A  return cs
4744N/A
4744N/Aword :: Parser String
4744N/Aword = many1 (letter <|> char '_' <|> char '.' <|> char '-' <|> digit)
4744N/A
4744N/AparseBaseRelations :: Parser [Baserel]
4744N/AparseBaseRelations = do
4744N/A  many skippable
4744N/A  string ":base-relations"
4744N/A  many skippable
4744N/A  oParenT
4744N/A  baserels <- many1 parseRelationId
4744N/A  cParenT
4744N/A  return baserels
4744N/A
4744N/AparseCompTable :: Parser Compositiontable
4744N/AparseCompTable = do
4744N/A  many skippable
4744N/A  string ":composition-operation"
4744N/A  many skippable
4744N/A  oParenT
4744N/A  cmptabentries <- parseComptabentryList
4744N/A  cParenT
4744N/A  return (Compositiontable cmptabentries)
4744N/A
4744N/AparseComptabentryList :: Parser [Cmptabentry]
4744N/AparseComptabentryList = many1 parseComptabentry
4744N/A
4744N/AparseComptabentry :: Parser Cmptabentry
4744N/AparseComptabentry = do
4744N/A  many skippable
4744N/A  oParenT
4744N/A  rel1 <- parseRelationId
4744N/A  rel2 <- parseRelationId
4744N/A  results <- parseComptabentryResults
4744N/A  cParenT
4744N/A  return (Cmptabentry (Cmptabentry_Attrs rel1 rel2) results)
4744N/A
4744N/AparseComptabentryResults :: Parser [Baserel]
4744N/AparseComptabentryResults = try (do
4744N/A    oParenT
4744N/A    results <- many1 parseRelationId
4744N/A    cParenT
4744N/A    return results)
4744N/A  <|> (tryString "NIL" >> return [])
4744N/A  <|> do
4744N/A    result <- parseRelationId
4744N/A    return [result]
4744N/A  <|> do
4744N/A    oParenT
5073N/A    many space
4744N/A    cParenT
5073N/A    return []
4744N/A
4744N/AparseConversetable :: Parser Conversetable
4744N/AparseConversetable = try (do
4744N/A    entry1 <- parseInverse
4744N/A    entry3 <- parseShortcut
4744N/A    entry2 <- parseHoming
4744N/A    return (Conversetable_Ternary entry1 entry3 entry2))
4744N/A  <|> do
4744N/A    entry <- parseConverse
4744N/A    return (Conversetable entry)
4744N/A
4744N/AparseConverse :: Parser [Contabentry]
4744N/AparseConverse = do
4744N/A  many skippable
4744N/A  string ":converse-operation"
4744N/A  many skippable
4744N/A  oParenT
4744N/A  invrels <- many1 parseContabentry
4744N/A  cParenT
4744N/A  return invrels
4744N/A
4744N/AparseContabentry:: Parser Contabentry
4744N/AparseContabentry = do
4744N/A  many skippable
4744N/A  oParenT
4744N/A  id1 <- parseRelationId
4744N/A  id2 <- parseRelationId
4744N/A  cParenT
4744N/A  return (Contabentry id1 id2)
4744N/A
4744N/AparseContabentryList :: String -> Parser [Contabentry_Ternary]
4744N/AparseContabentryList s = do
4618N/A  many skippable
4744N/A  string s
4744N/A  many skippable
4744N/A  oParenT
4744N/A  invrels <- many1 parseContabentryTernary
4744N/A  cParenT
4744N/A  return invrels
4744N/A
4744N/AparseContabentryTernary :: Parser Contabentry_Ternary
4744N/AparseContabentryTernary = do
4744N/A  many skippable
4744N/A  oParenT
4744N/A  id1 <- parseRelationId
4744N/A  ids <- many1 parseRelationId <|> parseBracedRelationIds
4744N/A  cParenT
4744N/A  return (Contabentry_Ternary id1 ids)
4744N/A
4744N/AparseBracedRelationIds :: Parser [Baserel]
4744N/AparseBracedRelationIds = do
4744N/A  many skippable
4744N/A  oParenT
4744N/A  ids <- many1 parseRelationId
5073N/A  cParenT
4744N/A  return ids
5073N/A
4744N/AparseReflectionOperations :: Parser String
4744N/AparseReflectionOperations =  do
4744N/A  many skippable
4744N/A  string ":reflection-operation"
4744N/A  many skippable
4744N/A  oParenT
4744N/A  many1 parseContabentry
4744N/A  cParenT
4744N/A  return ""
4744N/A
4744N/AparseInverse :: Parser [Contabentry_Ternary]
4744N/AparseInverse = parseContabentryList ":inverse-operation"
4744N/A
4744N/AparseHoming :: Parser [Contabentry_Ternary]
4744N/AparseHoming = parseContabentryList ":homing-operation"
4744N/A
4744N/AparseShortcut :: Parser [Contabentry_Ternary]
4744N/AparseShortcut = parseContabentryList ":shortcut-operation"
4744N/A
4744N/AparseRelationId :: Parser Baserel
4744N/AparseRelationId = do
4744N/A  chars <- many1 (noneOf "() \r\v\f\t\160\n")
4744N/A  skip
4744N/A  return (Baserel chars)
4744N/A