← Back to branch summary

~ubuntu-branches/ubuntu/wily/agda/wily-proposed

« back to all changes in this revision

Viewing changes to src/prototyping/mixfix/benchmarks/AmbTrie.hs

  • Committer: Package Import Robot
  • Author(s): Iain Lane
  • Date: 2014-08-05 06:38:12 UTC
  • mfrom: (1.1.6)
  • Revision ID: package-import@ubuntu.com-20140805063812-io8e77niomivhd49
Tags: 2.4.0.2-1
* [6e140ac] Imported Upstream version 2.4.0.2
* [2049fc8] Update Build-Depends to match control
* [93dc4d4] Install the new primitives
* [e48f40f] Fix typo dev→doc

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/prototyping/mixfix/benchmarks/AmbTrie.hs
1
 
------------------------------------------------------------------------
2
 
------------------------------------------------------------------------
3
 
 
4
 
 
5
 
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
6
 
 
7
 
module AmbTrie where
8
 
 
9
 
import Control.Monad
10
 
import qualified Data.Map as Map
11
 
import Data.Map (Map)
12
 
import qualified Parser
13
 
import Control.Applicative
14
 
 
15
 
infix 4 :&:
16
 
 
17
 
data Parser k r' tok r = ![ r ] :&: !(Map tok (Parser k r' tok r))
18
 
 
19
 
instance Ord tok => Functor (Parser k r' tok) where
20
 
  fmap = liftM
21
 
 
22
 
 
23
 
instance Ord tok => Alternative (Parser k r' tok) where
24
 
  empty                     = [] :&: Map.empty
25
 
  xs1 :&: f1 <|> xs2 :&: f2 =
26
 
    xs1 ++ xs2 :&: Map.unionWith (<|>) f1 f2
27
 
 
28
 
 
29
 
instance Ord tok => Monad (Parser k r' tok) where
30
 
  return x       = [x] :&: Map.empty
31
 
  xs :&: f >>= g = foldr (<|>) ([] :&: Map.map (>>= g) f) (map g xs)
32
 
 
33
 
instance Ord tok => Applicative (Parser k r' tok) where
34
 
  pure      = return
35
 
  p1 <*> p2 = p1 >>= \f -> p2 >>= \x -> return (f x)
36
 
 
37
 
 
38
 
parse :: Ord tok => Parser k r' tok r -> [ tok ] -> [ r ]
39
 
parse (xs :&: f) []      = xs
40
 
parse (xs :&: f) (c : s) = case Map.lookup c f of
41
 
  Nothing -> []
42
 
  Just f' -> parse f' s
43
 
 
44
 
instance Ord tok => Parser.Parser (Parser k r' tok) k r' tok where
45
 
  sym c = [] :&: Map.singleton c (return c)