~ubuntu-branches/ubuntu/raring/agda/raring-proposed

« back to all changes in this revision

Viewing changes to src/full/Agda/Compiler/Alonzo/PatternMonad.hs

  • Committer: Bazaar Package Importer
  • Author(s): Iain Lane
  • Date: 2009-07-20 19:49:41 UTC
  • Revision ID: james.westby@ubuntu.com-20090720194941-hcjy91vrn16csh7d
Tags: upstream-2.2.4+dfsg
ImportĀ upstreamĀ versionĀ 2.2.4+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
module Agda.Compiler.Alonzo.PatternMonad where
 
2
import Agda.Syntax.Internal
 
3
import Agda.TypeChecking.Monad.Base
 
4
 
 
5
import Control.Monad.State
 
6
import Control.Monad.Error
 
7
 
 
8
import qualified Data.Map
 
9
import Data.Map (Map)
 
10
 
 
11
import Language.Haskell.Syntax
 
12
import Agda.TypeChecking.Monad
 
13
import Agda.Utils.Permutation
 
14
import Agda.Utils.Size
 
15
 
 
16
type Defs =  Map QName Definition
 
17
data PState = PSt
 
18
  { cnt :: Int
 
19
  , vars :: [Int]
 
20
  , lst :: [HsPat]
 
21
  , clause :: Clause
 
22
  , defs :: Defs
 
23
  }
 
24
 
 
25
initPState :: Clause -> Defs -> PState
 
26
initPState c@(Clause{ clausePerm = perm }) d = PSt
 
27
  { cnt = 0
 
28
  , vars = permute perm [0..]
 
29
  , lst = []
 
30
  , clause = c
 
31
  , defs = d
 
32
  }
 
33
 
 
34
type PM a = StateT PState TCM a
 
35
 
 
36
getPDefs :: PM Defs
 
37
getPDefs = gets defs
 
38
 
 
39
getPcnt :: PM Int
 
40
getPcnt = gets cnt
 
41
 
 
42
getPlst :: PM [HsPat]
 
43
getPlst = gets lst
 
44
 
 
45
getPclause :: PM Clause
 
46
getPclause = gets clause
 
47
 
 
48
putPlst :: [HsPat] -> PM()
 
49
putPlst newlst = modify $ \s -> s { lst = newlst }
 
50
 
 
51
putPcnt :: Int -> PM()
 
52
putPcnt newcnt = modify $ \s -> s { cnt = newcnt }
 
53
 
 
54
incPcnt :: PM()
 
55
incPcnt = modify $ \s -> s { cnt = 1 + cnt s }
 
56
 
 
57
addWildcard :: PM()
 
58
addWildcard = do
 
59
        lst <- getPlst
 
60
        putPlst $ lst++[HsPWildCard]
 
61
 
 
62
addVar :: PM()
 
63
addVar = do
 
64
        lst <- getPlst
 
65
        s <- get
 
66
        let v : vs = vars s
 
67
        put $ s { vars = vs }
 
68
        putPlst $ lst++[HsPVar(HsIdent ("v" ++ show v))]