utils/heap-view/Parse.lhs

   1 > module Parse where
   2
   3 The Parser monad in "Comprehending Monads"
   4
   5 > infixr 9 `thenP`
   6 > infixr 9 `thenP_`
   7 > infixr 9 `plusP`
   8
   9 > type P t a = [t] -> [(a,[t])]
  10
  11 > unitP :: a -> P t a
  12 > unitP a = \i -> [(a,i)]
  13
  14 > thenP :: P t a -> (a -> P t b) -> P t b
  15 > m `thenP` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k a i1]
  16
  17 > thenP_ :: P t a -> P t b -> P t b
  18 > m `thenP_` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k i1]
  19
  20 zeroP is the parser that always fails to parse its input
  21
  22 > zeroP :: P t a
  23 > zeroP = \i -> []
  24
  25 plusP combines two parsers in parallel
  26 (called "alt" in "Comprehending Monads")
  27
  28 > plusP :: P t a -> P t a -> P t a
  29 > a1 `plusP` a2 = \i -> (a1 i) ++ (a2 i)
  30
  31 itemP is the parser that parses a single token
  32 (called "next" in "Comprehending Monads")
  33
  34 > itemP :: P t t
  35 > itemP = \i -> [(head i, tail i) | not (null i)]
  36
  37 force successful parse
  38
  39 > cutP :: P t a -> P t a
  40 > cutP p = \u -> let l = p u in if null l then [] else [head l]
  41
  42 find all complete parses of a given string
  43
  44 > useP :: P t a -> [t] -> [a]
  45 > useP m =  \x -> [ a | (a,[]) <- m x ]
  46
  47 find first complete parse
  48
  49 > theP :: P t a -> [t] -> a
  50 > theP m = head . (useP m)
  51
  52
  53 Some standard parser definitions
  54
  55 mapP applies f to all current parse trees
  56
  57 > mapP :: (a -> b) -> P t a -> P t b
  58 > f `mapP` m =  m `thenP` (\a -> unitP (f a))
  59
  60 filter is the parser that parses a single token if it satisfies a
  61 predicate and fails otherwise.
  62
  63 > filterP :: (a -> Bool) -> P t a -> P t a
  64 > p `filterP` m = m `thenP` (\a -> (if p a then unitP a else zeroP))
  65
  66 lit recognises literals
  67
  68 > litP :: Eq t => t -> P t ()
  69 > litP t = ((==t) `filterP` itemP) `thenP` (\c -> unitP () )
  70
  71 > showP :: (Text a) => P t a -> [t] -> String
  72 > showP m xs = show (theP m xs)
  73
  74
  75 Simon Peyton Jones adds some useful operations:
  76
  77 > zeroOrMoreP :: P t a -> P t [a]
  78 > zeroOrMoreP p = oneOrMoreP p `plusP` unitP []
  79
  80 > oneOrMoreP :: P t a -> P t [a]
  81 > oneOrMoreP p = seq p
  82 >  where seq p = p              `thenP` (\a ->
  83 >               (seq p          `thenP` (\as -> unitP (a:as)))
  84 >               `plusP`
  85 >               unitP [a] )
  86
  87 > oneOrMoreWithSepP :: P t a -> P t b -> P t [a]
  88 > oneOrMoreWithSepP p1 p2 = seq1 p1 p2
  89 >   where seq1 p1 p2 =  p1 `thenP` (\a -> seq2 p1 p2 a `plusP`  unitP [a])
  90 >         seq2 p1 p2 a =        p2              `thenP` (\_ ->
  91 >                               seq1 p1 p2      `thenP` (\as -> unitP (a:as) ))
  92