?prevdifflink? - Blame
|
{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -Wall #-} ------------------------------------------------------------------------------- {- | Module : Language.Derivation.Parser Description : Copyright : (c) Paulo Silva License : LGPL Maintainer : paufil@di.uminho.pt Stability : experimental Portability : portable -} ------------------------------------------------------------------------------- module Language.Derivation.Parser ( parser, parseDeriv ) where import Control.GalcError import Control.Monad.Error import Language.Derivation.Syntax import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Language import qualified Text.ParserCombinators.Parsec.Token as P ------------------------------------------------------------------------------- type DerivParser = Parser Derivation ------------------------------------------------------------------------------- reservNames :: [String] reservNames = derivations ------------------------------------------------------------------------------- lexer :: P.TokenParser st lexer = P.makeTokenParser $ emptyDef { P.reservedNames = reservNames } ------------------------------------------------------------------------------- reserved :: String -> CharParser st () reserved = P.reserved lexer whiteSpace :: CharParser st () whiteSpace = P.whiteSpace lexer identifier :: CharParser st String identifier = P.identifier lexer ------------------------------------------------------------------------------- parser :: MonadError GalcError m => String -> m Derivation parser = either2error (ParsingError . show) . parse mainDerivParser "" ------------------------------------------------------------------------------- mainDerivParser :: DerivParser mainDerivParser = do whiteSpace t <- parseDeriv eof return t ------------------------------------------------------------------------------- parseDeriv :: DerivParser parseDeriv = parseInv <|> parseShunt <|> parseDistrLow <|> parseDistrUp <|> parseMonotUp <|> parseMonotLow <|> parseTopPreserv <|> parseBotPreserv <|> parseCancUp <|> parseCancLow <|> parseFree <|> parseApply ------------------------------------------------------------------------------- parseInv :: DerivParser parseInv = do reserved "inv" drv <- parseDeriv return $ Inv drv ------------------------------------------------------------------------------- parseShunt :: DerivParser parseShunt = do reserved "shunt" ident <- identifier return $ Shunt ident ------------------------------------------------------------------------------- parseDistrLow :: DerivParser parseDistrLow = do reserved "distr_low" ident <- identifier return $ DistrLow ident ------------------------------------------------------------------------------- parseDistrUp :: DerivParser parseDistrUp = do reserved "distr_up" ident <- identifier return $ DistrUp ident ------------------------------------------------------------------------------- parseMonotUp :: DerivParser parseMonotUp = do reserved "monot_up" ident <- identifier return $ MonotUp ident ------------------------------------------------------------------------------- parseMonotLow :: DerivParser parseMonotLow = do reserved "monot_low" ident <- identifier return $ MonotLow ident ------------------------------------------------------------------------------- parseTopPreserv :: DerivParser parseTopPreserv = do reserved "top_preserving" ident <- identifier return $ TopPreserv ident ------------------------------------------------------------------------------- parseBotPreserv :: DerivParser parseBotPreserv = do reserved "bot_preserving" ident <- identifier return $ BotPreserv ident ------------------------------------------------------------------------------- parseCancUp :: DerivParser parseCancUp = do reserved "canc_up" ident <- identifier return $ CancUp ident ------------------------------------------------------------------------------- parseCancLow :: DerivParser parseCancLow = do reserved "canc_low" ident <- identifier return $ CancLow ident ------------------------------------------------------------------------------- parseFree :: DerivParser parseFree = do reserved "free" ident <- identifier return $ Free ident ------------------------------------------------------------------------------- parseApply :: DerivParser parseApply = do reserved "apply" ident <- identifier return $ Apply ident ------------------------------------------------------------------------------- |