module PMonad( Parser, parse, many, alternating, failure, empty, test, reportValue, reportCoords, lit, litValue, fatal, recover, mustBeLit, shouldBeLit, mustBeLitValue, SuccFailError(..) ) where ---------------------------------------------------------------------- -- Parsing monad module. -- Theo Norvell '92 Oct 24 -- Revised '95 Oct -- - Now defines an instance of the MonadPlus constructor class defined in -- Mark Jones's cc.prelude. -- - A few more exports defined. -- Revised '99 Feb -- - Converted to Haskell! -- -- This module imports a lexical analyzer and exports an abstract data type -- representing parsers that use that lexical analyzer. It is intended for -- import by modules that create and use such parsers. -- -- The point of this module is to provide a generic set of types and -- functions for hand-building industrial strength almost deterministic -- top down parsers. -- -- By almost determistic I mean the parser will succeed at most once. -- -- By industrial strength I mean that there is support for error reporting -- (both fatal and warning errors), and encapsulation of the lexical -- analysis. No other module need import the lexical analyzer. In particular -- not the parser module that uses this module. -- -- The principle exports are -- Parser alpha -- an ADT of parsers -- empty a -- a parser of empty strings (the monad unit) -- litValue terminal -- a parser of unit length strings -- p `bind` (\r -> q) -- catenation of parsers p and q (the Kleisly star) -- p ++ q -- alternation of parsers p and q -- parse p string -- For applying a parser p to a string. -- -- Copyright Theo Norvell. All rights to copy, use and modify this -- code are granted provided it is not used (in original or modified -- form) for any military use or by any military organization, and provided -- this notice is not removed. -- -- Note this is Gofer Code. It hasn't been tried with Haskell ---------------------------------------------------------------------- -- OPERATORS -- -- IMPORTS -- -- A lexer -- import Lexer(LexState, -- a private type Terminal, -- a type of class Eq public to the parser LexValue, -- a type public to the parser LexCoords, -- a type public to the parser lexNext, -- a function of type LexState -> Terminal lexValue, -- a function of type LexState -> LexValue lexAdvance, -- a function of type LexState -> LexState showTerminal,-- a function of type Terminal -> String lexCoords, -- a function of type LexState -> LexCoords showCoords, -- a function of type LexCoord -> String showNext, -- a function of type LexState -> String lexInit) -- a function of type string -> LexState -- Exports -- i :: alpha -> beta -- g :: alpha -> beta -> beta -- p :: Parser alpha -- q :: Parser beta -- r :: Parser () -- f :: alpha -> Parser beta -- x :: Terminal -- s :: String ) -- Terminal : The alphabet -- LexValue : A type representing information about tokens -- SuccFailError alpha : A generic type indicating the outcome of a parse -- : An `outcome' maybe success with a `result', failure, -- : of a fatal error. -- Parser alpha : A type representing parsers with results from alpha . -- parse p s : The outcome of parsing s with p . -- : which parses a the string using the Parser argument -- p `bind` f : A parser that matches strings that begin with a segment -- : p can parse and continue with a segment that f a can -- : parse where a is the result of parsing with p . -- : The outcome is the outcome of f a. -- p0 ++ p1 : The sequential alternation of p0 and p1 . -- : Failure in p0 lets p1 have a chance, but a fatal -- : error in p0 does not. -- many (a,g) p : matches 0 or more p's. Larger numbers are prefered. -- : If p ever produces a fatal error, so does many p . -- alternating (i,g) p r: matches 1 or more p's separated by r's. -- : Larger numbers are prefered. -- : If p or r ever produces a fatal error, so does -- : alternating p q . -- failure : A generic parser that always fails. -- empty a : A parser of the empty string with result a . -- test b : equivalent to if b then empty () else failure -- reportValue : A parser of the empty string that returns the ``text'' of -- : the next token in the input. -- reportCoords : A parser of the empty string that returns the coordinates -- : of the next token in the input. -- lit x : A parser of strings consisting of one x . Result is (). -- litValue x : A mixture of reportValue and lit. -- fatal s p : A parser that parses the same strings as p , but where -- : p would fail, this parser produces error message s . -- recover s a p: A parser that parses the same strings as p , but where -- : p would fail, this parser matches the empty string and -- : succeeds with result a , but also with warning message s. -- mustBeLit x : Like lit x but instead of failing produces a fatal error. -- shouldBeLit x: Like lit x but instead of failing matches the empty -- : string and gives a warning message (useful for noise tokens) -- mustBeLitValue x: A combination of mustBeLit and reportValue . ------------------------------------------------------------------------------- -- Types used in Parsing data ParserState = PState LexState getLexState :: ParserState -> LexState getLexState (PState l) = l advanceLexer :: ParserState -> ParserState advanceLexer (PState l) = PState (lexAdvance l) data SuccFailError alpha = Succ alpha ParserState String | Fail | Error String data Parser alpha = PR (ParserState -> SuccFailError alpha) parse :: Parser alpha -> String -> SuccFailError alpha parse (PR p) str = p (PState (lexInit str)) -- The Kliesly star operator for parsers -- Used for catenation pBind :: (Parser alpha) -> (alpha -> Parser beta) -> Parser beta (PR p) `pBind` k = PR (strict(\s -> case p s of Succ a t x -> let (PR q) = (k a) in case q t of Succ b u y -> Succ b u (x ++ y) Fail -> Fail Error y -> Error (x++y) Fail -> Fail Error x -> Error x)) -- The monad unit for parsers empty :: alpha -> Parser alpha empty a = PR (strict (\s -> Succ a s "")) ------------------------------------------------------------------ ------------------------------------------------------------------ -- Parsing combinators failure :: Parser alpha failure = PR (strict (\s -> Fail)) reportValue :: Parser LexValue reportValue = PR (strict (\s -> Succ (lexValue (getLexState s)) s "")) reportCoords :: Parser LexCoords reportCoords = PR (strict (\s -> Succ (lexCoords (getLexState s)) s "")) lit :: Terminal -> Parser () lit term = PR (strict (\s -> if term == lexNext (getLexState s) then Succ () (advanceLexer s) "" else Fail )) litValue :: Terminal -> Parser LexValue litValue term = PR(strict(\s -> if term == lexNext (getLexState s) then Succ (lexValue (getLexState s)) (advanceLexer s) "" else Fail )) fatal :: String -> Parser alpha -> Parser alpha fatal str (PR p) = PR(strict (\s -> case p s of i @ (Succ _ _ _) -> i Fail -> Error (makeMess "Fatal " s str) i @ (Error _) -> i )) recover :: String -> alpha -> Parser alpha -> Parser alpha recover str a (PR p) = PR(strict (\s -> case p s of i @ (Succ _ _ _) -> i Fail -> Succ a s (makeMess "Recovering from a " s str) i @ (Error _) -> i )) makeMess pream s str = pream ++ "syntax error at " ++ (showTerminal.lexNext.getLexState) s ++ " `" ++ (showNext.getLexState) s ++ "' " ++ (showCoords.lexCoords.getLexState) s ++ " :\n" ++ str ++ ".\n" mustBeLit :: Terminal -> Parser () mustBeLit term = fatal ("Expected " ++ showTerminal term) (lit term) mustBeLitValue :: Terminal -> Parser LexValue mustBeLitValue term = fatal ("Expected " ++ showTerminal term) (litValue term) shouldBeLit :: Terminal -> Parser () shouldBeLit term = recover ("Expected " ++ showTerminal term) () (lit term) pAlt :: Parser alpha -> Parser alpha -> Parser alpha (PR p) `pAlt` (PR q) = PR(strict(\s -> case p s of i @ (Succ _ _ _) -> i Fail -> q s i @ (Error _) -> i )) many :: (beta, alpha -> beta -> beta) -> Parser alpha -> Parser beta -- Example: many [] (:) stmt -- parses many statements and forms their parse results into a list. many (u,f) p = (p `pBind` (\a-> many (u,f) p `pBind` (\b -> empty (f a b)))) `pAlt` empty u alternating :: (alpha -> beta, alpha -> beta -> beta) -> Parser alpha -> Parser () -> Parser beta -- Example: alternating (tau, (:)) parameter (lit comma) -- where tau x = [x] -- Parses a list of comma separated parameters, forming a list -- or parse results. alternating (i,f) p q = (p `pBind` (\a-> q `pBind` (\()-> alternating (i,f) p q `pBind` (\b -> empty (f a b))))) `pAlt` (p `pBind` (\a-> empty (i a))) test :: Bool -> Parser () test b = if b then empty () else failure ----------------------------------------------------------- -- Instance declarations -- The rest of this file assumes constructor classes and the cc.prolog instance Functor Parser where map f p = [f a | a <- p] instance Monad Parser where return = empty (>>=) = pBind instance MonadZero Parser where zero = failure instance MonadPlus Parser where (++) = pAlt