summaryrefslogtreecommitdiff
path: root/testsuite/tests/simplCore/prog002/Simpl009Help.hs
blob: b1e2a080e22b09da194f8bcf1124b7fc4a3380e1 (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
40
41
42
43
44
45
46
47
48
{-# LANGUAGE ScopedTypeVariables, RankNTypes #-}

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

module Simpl009Help where

import Control.Applicative (Applicative(..), Alternative(empty, (<|>)))
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 Functor (Parser s) where
    fmap = liftM

instance Applicative (Parser s) where
    pure a = Parser (\fut -> fut a)
    (<*>) = ap

instance Monad (Parser s) where


  Parser f >>= k =
    Parser (\fut -> f (\a -> let Parser g = k a in g fut))

instance Alternative (Parser s) where
    empty = mzero
    (<|>) = mplus

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