--- Defines datatypes and corresponding --- constructor functions, combinators and --- selectors used by the SQLParser --- --- @author Julia Krone --- @version 0.1 -- ------------------------------------------ module SQLParserTypes where import ParseTypes import SQLToken infix 2 .~>. infix 2 .<~. --- Datatype for organization of the parsing process used in the monadic --- structure SPMParser (therefore its name). --- Note that the SPM itself is not used as a monad here although --- corresponding functions (satisfying monadic laws) could easily be defined. --- Consists of the position of integrated Code, a PM which contains --- the result/errors and warnings that were calculated before and --- the list of SQLToken which to parse. --- It is parameterized over a, which represents the result type. data SPM a = SPM Pos (PM a) [Token] --- Datatype for an Empty SQLParserMonad. --- Same as SPM but without a result. data EmptySPM = ESPM Pos [Token] --- Monadic structure which is the basic type for parsing process. --- Takes an EmptySPM and passes it down, parsing the Token --- and generating the result which is finally passed back. --- Returns the SPM with the result which is constructed --- bottom-up. type SPMParser a = EmptySPM -> SPM a --- constructor function for SPM --- @param pos - position of the integrated Code --- @param ele - a value of type a to initialize the PM --- @param tks - list of Token which to parse --- @return an initialized SQLParserMonad with initialized PM newSPM :: Pos -> a -> [Token] -> SPM a newSPM pos ele tks = SPM pos (cleanPM ele) tks --- constructor function for an EmptySPM --- @param pos - position of the integrated code --- @param tks - list of Token which to parse --- @return an EmptySPM newEmptySPM :: Pos -> [Token] -> EmptySPM newEmptySPM pos tks = ESPM pos tks --- initializes a SPM - return function of SPMParser ---@ param ele - a value of type a to initialize the PM ---@ param espm - the EmptySPM to insert the element ---@return the initialized SPM with initialized PM. Token and --- Symboltable are passed from the EmptySPM initializeSPM :: a -> EmptySPM -> SPM a initializeSPM ele (ESPM pos tks) = SPM pos (cleanPM ele) tks -- Concats two SQLParserMonads by given function. -- If at least one of the PMs contains an error it will be thrown. -- Otherwise the Warnings of the PMs will be concatenated and the results -- will be combined by f. -- The Token of the least given Monad are used to continue. concatSPMs :: (a -> b -> c) -> SPM a -> SPM b -> SPM c concatSPMs f (SPM pos pm1 _) (SPM _ pm2 tks2) = (SPM pos (combinePMs f pm1 pm2) tks2) --- Returns whether the List of Token contained by the given EmptySPM --- is not empty --- @param espm - the EmptySPM --- @return False if list is empty, true otherwise hasToken :: EmptySPM -> Bool hasToken (ESPM _ tk) | tk == [] = False | otherwise = True --- Sets the List of Token. --- @param tks - the list of Token --- @param espm - the EmptySPM --- @return the altered EmptySPM setToken :: [Token] -> EmptySPM -> EmptySPM setToken tks (ESPM pos _) = ESPM pos tks --- Returns the list of Token. --- @param espm - the EmptySPM token :: EmptySPM -> [Token] token (ESPM _ tk) = tk --- Partially defined! Returns first token of the non-empty List of Token. headToken :: EmptySPM -> Token headToken (ESPM _ (t:_)) = t --- Cuts the first Token of the List without doing anything else. --- Does Nothing if List of Token is empty. continue :: EmptySPM -> EmptySPM continue espm@(ESPM _ []) = espm continue (ESPM pos (_:tks)) = ESPM pos tks --- Lift: Applies a given function to the result of the --- given parser. ---@param f - function to apply ---@param parser - parser function generating SPM of type a ---@param espm - EmptySPM which parser function is applied to ---@return SPM genrated by parser function and altered by f liftSPM :: (a -> b) -> SPMParser a -> SPMParser b liftSPM f parser espm = let (SPM pos pm tks) = parser espm in (SPM pos (liftPM f pm) tks) --- Bind-function for SPMParser. --- The additional list of Token is for error recovery, normally the follow set --- of the piece of code that is parsed by the first parser. --- In case the first parser fails the second one is never invoked, the list of --- remaining tokes is cut until the first token that is member of the follow set. bindSPM :: SPMParser a -> (a -> SPMParser b) -> [Token] -> SPMParser b bindSPM parserA f toks espm = case parserA espm of SPM pos (WM (Errors err) ws) tks -> let rTks = (dropWhile (\t -> not (t `elem` toks || t== Semi)) tks) in SPM pos (returnWM (Errors err) ws) rTks SPM pos (WM (OK res) _) tks -> f res (ESPM pos tks) --- Bind-function for SPMParser with superior error menagement. --- In case the first parser fails, the --- second one is invoked with a default value and the tokens set to the --- next one that is element of the given list (typically the follow-set). --- @param parserA - first parser with result type a --- @param defEle - default value of type a that is used if first parser fails --- @param f - second parser binding the result of the first one --- @param toks - list of token to follow with if first parser fails --- @return SPM - result of second parser bindDefSPM :: SPMParser a -> a -> (a -> SPMParser b) -> [Token] -> SPMParser b bindDefSPM parserA defEle f toks espm = let resA = parserA espm in case resA of SPM pos (WM (Errors err) ws) tks -> let rTks = dropWhile (\t -> not (t `elem` toks || t== Semi)) tks (SPM _ pm tks2) = f defEle (ESPM pos rTks) in (SPM pos (combinePMs proj2 --(\ _ y -> y) (WM (Errors err) ws) pm) tks2) SPM pos (WM (OK res) _) tks -> f res (ESPM pos tks) where -- This explicitly typed auxiliary function is necesary to avoid -- a typing error in GHC/KiCS2: proj2 :: b -> b -> b proj2 _ y = y --- Concats a terminal-Parser to a SPMParser. --- Invokes the second one just if the first one did not fail. (.~>.) :: (EmptySPM -> Either EmptySPM (SPM a)) -> SPMParser a -> SPMParser a (.~>.) eparser parser espm = case (eparser espm) of Left espm1 -> parser espm1 Right spm -> spm --- Concats a SPMParser to a following terminal-Parser. --- If the terminal-Parser fails, the errors are concatenated to the former --- otherwise the result of the SPMParser is returned. (.<~.) :: SPMParser a -> (EmptySPM -> Either EmptySPM (SPM a)) -> SPMParser a (.<~.) parser eparser espm = let spm@(SPM pos pm tks) = parser espm res = eparser (ESPM pos tks) in case res of Left (ESPM _ rtks) -> (SPM pos pm rtks) Right spm1 -> case pm of (WM (Errors _) _) -> concatSPMs (\_ b -> b) spm spm1 (WM (OK _) _) -> spm1 --- Combines two SPMParsers in an alternate manner: --- Both parsers are applied independently , the second one taking the --- list of token altered by the first one. --- The resulting PMs are combined afterwards. --- @param f - function to combine results --- @return The resulting SPM combineSPMs :: (a -> b -> c) -> SPMParser a -> SPMParser b -> SPMParser c combineSPMs f spma spmb espm = let (SPM p pm1 tks1) = spma espm (SPM _ pm2 tks2) = spmb (ESPM p tks1) in (SPM p (combinePMs f pm1 pm2) tks2) --- Drop token until given token or Semi is reached. proceedWith :: Token -> EmptySPM -> EmptySPM proceedWith tok (ESPM p tks) = (ESPM p (dropWhile (\t -> t /= tok && t /= Semi) tks)) --- Drop Token until one of the token in the list or Semi is reached. --- Tokens are tried in given order. --- As soon as one token is found, the remaining ones are not tried anymore. proceedWithOneOf :: [Token] -> EmptySPM -> EmptySPM proceedWithOneOf toks (ESPM p tks) = ESPM p (dropWhile (\t -> not (t `elem` toks || t== Semi)) tks) --- Drop Token including the given one. proceedAfter :: Token -> EmptySPM -> EmptySPM proceedAfter tok (ESPM p tks) = (ESPM p (tail(dropWhile (\t -> t /= tok) tks))) --- Parses a terminal. --- @return EmptySPM with corresponding token consumed if there was no error. --- A SPM containing the error message otherwise. terminal :: Token -> EmptySPM -> Either EmptySPM (SPM _) terminal tk espm | hasToken espm = if tk == headToken espm then Left $ continue espm else Right $ parseError ("Expected " ++ tokentoString tk ++ " but got "++ tokentoString (headToken espm)) espm |otherwise = Right $ emptyTkErr espm --- Alternate terminal-parser: Additionally takes token with which to proceed --- in case of an error. terminalOrProc :: Token -> [Token] -> EmptySPM -> Either EmptySPM (SPM _) terminalOrProc tk rtoks espm | hasToken espm = if tk == headToken espm then Left $ continue espm else Right $ parseError ("Expected " ++ tokentoString tk ++ " but got "++ tokentoString (headToken espm)) (proceedWithOneOf rtoks espm) |otherwise = Right $ emptyTkErr espm --- alternative terminal parser which in case of error consumes all --- token including the given one terminalOrConsume :: Token -> EmptySPM -> Either EmptySPM (SPM _) terminalOrConsume tk espm | hasToken espm = if tk == headToken espm then Left $ continue espm else Right $ parseError ("Expected " ++ tokentoString tk ++ " but got "++ tokentoString (headToken espm)) (proceedAfter tk espm) --- Returns Error with given message. --- @param errMsg - the error message --- @param espm - the EmptySPM parseError :: String -> SPMParser _ parseError errMsg (ESPM pos tks) = SPM pos (throwPM pos errMsg) tks --- Returns Standarderror in case the TokenList is empty. --- Inserts a single semicolon as Tokenlist to avoid subsequent errors. emptyTkErr :: SPMParser _ emptyTkErr (ESPM pos _) = SPM pos (throwPM pos "Statement ended unexpectedly") [Semi]