summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/simplCore/prog002/Simpl009Help.hs
blob: ac759430165945200c5c4d0b6e28dd1ad1ac6b27 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
{-# LANGUAGE ScopedTypeVariables, RankNTypes #-}

-- Helper for simpl009.hs (see comments there)

module Simpl009Help where
  
import Control.Monad

newtype Parser s a
  = Parser (forall res . (a -> [String] -> P s res) -> [String] -> P s res)

data P s res
  = Symbol (s -> P s res)
  | Fail [String] [String]
  | Result res (P s res)

instance Monad (Parser s) where
  return a = Parser (\fut -> fut a)
  
  Parser f >>= k =
    Parser (\fut -> f (\a -> let Parser g = k a in g fut))

  fail s =
    Parser (\fut exp -> Fail exp [s])

instance MonadPlus (Parser s) where
  mplus = error "urk"
  mzero = Parser (\fut exp -> Fail exp [])

lookAhead :: forall s. Parser s s
lookAhead =
  Parser (\fut exp -> Symbol (\c ->
    feed c (fut c [])
  ))
 where
  feed :: forall res. s -> P s res -> P s res
  feed c (Symbol sym)     = sym c
  feed c (Result res fut) = Result res (feed c fut)
  feed c p@(Fail _ _)     = p