1 --
    2 -- General parsing library, based on Richard Bird's parselib.orw for Orwell
    3 -- (with a number of extensions)
    4 -- Mark P. Jones November 1990
    5 --
    6 -- uses Haskell B. version 0.99.3
    7 --
    8 module Parse(Parser, faiL, okay, tok, sat, orelse, seQ, doo,
    9              sptok, just, listOf, many, sp, many1) where
   10 
   11 infixr 6 `seQ`
   12 infixl 5 `doo`
   13 infixr 4 `orelse`
   14 
   15 --- Type definition:
   16 
   17 type Parser a = [Char] -> [(a,[Char])]
   18 
   19 -- A parser is a function which maps an input stream of characters into
   20 -- a list of pairs each containing a parsed value and the remainder of the
   21 -- unused input stream.  This approach allows us to use the list of
   22 -- successes technique to detect errors (i.e. empty list ==> syntax error).
   23 -- it also permits the use of ambiguous grammars in which there may be more
   24 -- than one valid parse of an input string.
   25 
   26 --- Primitive parsers:
   27 
   28 -- faiL     is a parser which always fails.
   29 -- okay v   is a parser which always succeeds without consuming any characters
   30 --          from the input string, with parsed value v.
   31 -- tok w    is a parser which succeeds if the input stream begins with the
   32 --          string (token) w, returning the matching string and the following
   33 --          input.  If the input does not begin with w then the parser fails.
   34 -- sat p    is a parser which succeeds with value c if c is the first input
   35 --          character and c satisfies the predicate p.
   36 
   37 faiL        :: Parser a 
   38 faiL inn      = []
   39 
   40 okay        :: a -> Parser a  
   41 okay v inn    = [(v,inn)]
   42 
   43 tok         :: [Char] -> Parser [Char]
   44 tok w inn     = [(w, drop n inn) | w == take n inn]
   45                where n = length w
   46 
   47 sat         :: (Char -> Bool) -> Parser Char 
   48 sat p []     = []
   49 sat p (c:inn) = [ (c,inn) | p c ]
   50 
   51 --- Parser combinators:
   52 
   53 -- p1 `orelse` p2 is a parser which returns all possible parses of the input
   54 --                string, first using the parser p1, then using parser p2.
   55 -- p1 `seQ` p2    is a parser which returns pairs of values (v1,v2) where
   56 --                v1 is the result of parsing the input string using p1 and
   57 --                v2 is the result of parsing the remaining input using p2.
   58 -- p `doo` f       is a parser which behaves like the parser p, but returns
   59 --                the value f v wherever p would have returned the value v.
   60 --
   61 -- just p         is a parser which behaves like the parser p, but rejects any
   62 --                parses in which the remaining input string is not blank.
   63 -- sp p           behaves like the parser p, but ignores leading spaces.
   64 -- sptok w        behaves like the parser tok w, but ignores leading spaces.
   65 --
   66 -- many p         returns a list of values, each parsed using the parser p.
   67 -- many1 p        parses a non-empty list of values, each parsed using p.
   68 -- listOf p s     parses a list of input values using the parser p, with
   69 --                separators parsed using the parser s.
   70 
   71 orelse             :: Parser a -> Parser a -> Parser a 
   72 orelse p1 p2 inn = p1 inn ++ p2 inn
   73  
   74 seQ                :: Parser a -> Parser b -> Parser (a,b)
   75 seQ p1 p2 inn    = [((v1,v2),inn2) | (v1,inn1) <- p1 inn, (v2,inn2) <- p2 inn1]
   76 
   77 doo                 :: Parser a -> (a -> b) -> Parser b 
   78 doo p f inn       = [(f v, inn1) | (v,inn1) <- p inn]
   79 
   80 just               :: Parser a -> Parser a
   81 just p inn           = [ (v,"") | (v,inn')<- p inn, dropWhile (' '==) inn' == "" ]
   82 
   83 sp                 :: Parser a -> Parser a
   84 sp p                = p . dropWhile (' '==)
   85 
   86 sptok              :: [Char] -> Parser [Char]
   87 sptok               =  sp . tok
   88 
   89 many               :: Parser a  -> Parser [a]
   90 many p              = q
   91                       where q = ((p `seQ` q) `doo` makeList) `orelse` (okay [])
   92 
   93 many1              :: Parser a -> Parser [a]
   94 many1 p             = p `seQ` many p `doo` makeList
   95 
   96 listOf             :: Parser a -> Parser b -> Parser [a]
   97 listOf p s          = p `seQ` many (s `seQ` p) `doo` nonempty
   98                       `orelse` okay []
   99                       where nonempty (x,xs) = x:(map snd xs)
  100 
  101 --- Internals:
  102 
  103 makeList       :: (a,[a]) -> [a]
  104 makeList (x,xs) = x:xs
  105 
  106 {-
  107 -- an attempt to optimise the performance of the standard prelude function
  108 -- `take' in Haskell B 0.99.3 gives the wrong semantics.  The original
  109 -- definition, given below works correctly and is used in the above.
  110 
  111 safetake              :: (Integral a) => a -> [b] -> [b]
  112 safetake  _     []     =  []
  113 safetake  0     _      =  []
  114 safetake (n+1) (x:xs)  =  x : safetake n xs
  115 -}
  116 --- End of Parse.hs