2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovmodule LF.MorphParser where

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovimport LF.Sign

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovimport LF.Morphism

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovimport Common.Lexer

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovimport Common.Parsec

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovimport Common.AnnoParser (commentLine)

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovimport Text.ParserCombinators.Parsec

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovimport qualified Data.Map as Map

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov-- | plain string parser with skip

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovpkeyword :: String -> CharParser st ()

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovpkeyword s = keywordNotFollowedBy s (alphaNum <|> char '/') >> return ()

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovkeywordNotFollowedBy :: String -> CharParser st Char -> CharParser st String

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovkeywordNotFollowedBy s c = skips $ try $ string s << notFollowedBy c

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovskips :: CharParser st a -> CharParser st a

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovskips = (<< skipMany

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov (forget space <|> forget commentLine <|> nestCommentOut <?> ""))

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovqString :: CharParser st String

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovqString = skips stringLit

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparensP :: CharParser st a -> CharParser st a

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparensP = between (skipChar '(') (skipChar ')')

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovbracesP :: CharParser st a -> CharParser st a

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovbracesP = between (skipChar '{') (skipChar '}')

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovbracketsP :: CharParser st a -> CharParser st a

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovbracketsP = between (skipChar '[') (skipChar ']')

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovcommaP :: CharParser st ()

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovcommaP = skipChar ',' >> return ()

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovsepByComma :: CharParser st a -> CharParser st [a]

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovsepByComma p = sepBy1 p commaP

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovskipChar :: Char -> CharParser st ()

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovskipChar = forget . skips . char

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseWithEq :: String -> CharParser st String

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseWithEq s = do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword s

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "="

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov qString >>= return

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseSym :: CharParser st Symbol

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseSym = do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "Symbol"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '{'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov sb <- parseWithEq "symBase"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov sm <- parseWithEq "symModule"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov sn <- parseWithEq "symName"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '}'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov return $ Symbol sb sm sn

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovparse1Context :: CharParser st CONTEXT

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovparse1Context = do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '('

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov v <- qString

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov e <- parseExp

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov option () $ skipChar ')'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov return [(v, e)]

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseExp :: CharParser st EXP

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseExp = do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "Type" >> return Type

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov <|> do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "Var"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov fmap Var qString

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov <|> do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "Const"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov fmap Const parseSym

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov <|> do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "Appl"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov option () $ skipChar '('

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov ex <- parseExp

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov option () $ skipChar ')'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov exl <- bracketsP $ option [] $ sepByComma parseExp

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov return $ Appl ex exl

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov <|> do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "Func"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov exl <- bracketsP $ option [] $ sepByComma parseExp

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov option () $ skipChar '('

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov ex <- parseExp

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov option () $ skipChar ')'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov return $ Func exl ex

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov <|> do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov ty <- choice $ map (\ ty -> pkeyword ty >> return ty)

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov ["Pi", "Lamb"]

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov c <- bracketsP $ option [] $ sepByComma parse1Context

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov option () $ skipChar '('

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov e <- parseExp

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov option () $ skipChar ')'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov return $ (case ty of

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov "Pi" -> Pi

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov "Lamb" -> Lamb

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov _ -> error $ "Pi or Lamb expected.\n") (concat c) e

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseDef :: CharParser st DEF

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseDef = do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "Def"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '{'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "getSym"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '='

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov sym <- parseSym

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "getType"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '='

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov tp <- parseExp

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "getValue"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '='

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov val <- do pkeyword "Nothing" >> return Nothing

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov <|> do pkeyword "Just"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov option () $ skipChar '('

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov e <- parseExp

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov option () $ skipChar ')'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov return $ Just e

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '}'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov return $ Def sym tp val

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseSignature :: CharParser st Sign

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseSignature = do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "Sign"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '{'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov sb <- parseWithEq "sigBase"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov sm <- parseWithEq "sigModule"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "getDefs"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '='

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov sd <- bracketsP $ option [] $ sepByComma parseDef

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '}'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov return $ Sign sb sm sd

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseMorphType :: CharParser st MorphType

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseMorphType = do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov choice $ map (\ t -> pkeyword (show t) >> return t)

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov [Definitional, Postulated, Unknown ]

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovparse1Map :: CharParser st (Symbol, EXP)

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatovparse1Map = do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '('

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov s <- parseSym

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov e <- parseExp

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ')'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov return (s, e)

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseMap :: CharParser st (Map.Map Symbol EXP)

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseMap = do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "fromList"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov fmap Map.fromList $ bracketsP $ option [] $ sepByComma parse1Map

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseMorphism :: CharParser st Morphism

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia IgnatovparseMorphism = do

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skips $ manyTill anyChar (string "=")

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "Morphism"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '{'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov mb <- parseWithEq "morphBase"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov mm <- parseWithEq "morphModule"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov mn <- parseWithEq "morphName"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "source"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '='

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov s <- parseSignature

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "target"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '='

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov t <- parseSignature

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "morphType"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '='

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov mt <- parseMorphType

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar ','

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov pkeyword "symMap"

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '='

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov sm <- parseMap

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov skipChar '}'

2cb6df4f21c52732336579a79f7e5d28299b3500Iulia Ignatov return $ Morphism mb mm mn s t mt sm