summaryrefslogtreecommitdiff
path: root/devel/compiler/Env.hs
blob: 7e1d23983835f1646cb96311d773c37e0f75726f (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
49
50
51
52
53
54
55
56
module Env where

import AbsSrc
import AbsTgt

import STM
import qualified Data.Map as M

data Env = Env {
  values   :: M.Map Ident Val,
  types    :: M.Map Ident Type,
  opers    :: M.Map Ident Exp,
  typedefs :: M.Map Ident Type,
  parsizes :: M.Map Type  Int,
  partypes :: M.Map Type  [Exp],
  parvals  :: M.Map Exp   Val,
  vars     :: M.Map Ident Val
---  constrs  :: M.Map Ident ([Int] -> Int)
  }

emptyEnv = Env M.empty M.empty M.empty M.empty M.empty M.empty M.empty M.empty

lookEnv :: (Show i, Ord i) => (Env -> M.Map i a) -> i -> STM Env a
lookEnv field c = do
  s <- readSTM 
  maybe (raise $ "unknown " ++ show c) return $ M.lookup c $ field s

addVal :: Ident -> Val -> STM Env ()
addVal c v = updateSTM (\env -> (env{values = M.insert c v (values env)}))

addType :: Ident -> Type -> STM Env ()
addType c v = updateSTM (\env -> (env{types = M.insert c v (types env)}))

addOper :: Ident -> Exp -> STM Env ()
addOper c v = updateSTM (\env -> (env{opers = M.insert c v (opers env)}))

addTypedef :: Ident -> Type -> STM Env ()
addTypedef c v = updateSTM (\env -> (env{typedefs = M.insert c v (typedefs env)}))

addParsize :: Type -> Int -> STM Env ()
addParsize c v = updateSTM (\env -> (env{parsizes = M.insert c v (parsizes env)}))

addPartype :: Type -> [Exp] -> STM Env ()
addPartype c v = updateSTM (\env -> (env{partypes = M.insert c v (partypes env)}))

addParVal :: Exp -> Val -> STM Env ()
addParVal c v = updateSTM (\env -> (env{parvals = M.insert c v (parvals env)}))

---addEnv :: (Env -> M.Map Ident a) -> Ident -> a -> STM Env ()
---addEnv field c v = updateSTM (\env -> (env{field = M.insert c v (field env)},()))

addVar :: Ident -> STM Env ()
addVar x = do
  s <- readSTM
  let i = M.size $ vars s
  updateSTM (\env -> (env{vars = M.insert x (VArg $ toInteger i) (vars env)}))