SHARE
TWEET

Untitled

a guest Jan 11th, 2017 62 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. -- | Module containing code that is shared by Interpreter and
  2. -- TypeChecker
  3.  
  4. module Common where
  5.  
  6. import Control.Monad
  7. import Data.Map (Map)
  8. import Data.Monoid ((<>))
  9. import qualified Data.Map as M
  10. import CPP.Abs
  11. import CPP.ErrM
  12.  
  13. type Env s a = (Sig s, [Context a])
  14. type Sig s     = Map Id s
  15. type Context a = Map Id a
  16.  
  17. -- | Looks up `Type` of `Id` in the environment
  18. lookupVar :: Monad m => Env s a -> Id -> m a
  19. lookupVar (_, (c:cs)) id' =
  20.   case M.lookup id' c of
  21.     Nothing -> lookupVar (M.empty, cs) id'
  22.     Just v  -> return v
  23.  
  24. lookupVar (_,[]) id' = fail $ "use of undeclared variable " <> show id'
  25.  
  26. lookupFun :: Monad m => Env s a -> Id -> m s
  27. lookupFun (sig,_) id' =
  28.   case M.lookup id' sig of
  29.     Nothing -> fail $ "use of undeclared function " <> show id'
  30.     Just f  -> return f
  31.  
  32. containsVar :: Env s a -> Id -> Bool
  33. containsVar (sig, cs) id' = foldr (\c b -> M.member id' c || b) False cs
  34.  
  35. -- | Extends the variable context with a variable and a value
  36. extendVar :: Monad m => Env sig val -> Id -> val -> m (Env sig val)
  37. extendVar (_, []) _ _       = fail $ "cannot extend a non-existing context"
  38. extendVar (sig, c:cs) id' a =
  39.   case M.lookup id' c of
  40.     Just _  -> fail $ "declaration of already declared variable " <> show id'
  41.     Nothing -> return (sig, M.insert id' a c : cs)
  42.  
  43. -- | Extends the function context with a variable and a function signature
  44. extendFun :: Monad m => Env sig val -> Id -> sig -> m (Env sig val)
  45. extendFun (sigs, cs) id' def =
  46.   case M.lookup id' sigs of
  47.     Just f  -> fail $ "redeclaration of function " <> show id'
  48.     Nothing -> return (M.insert id' def sigs, cs)
  49.  
  50. -- | Updates a variable context with a new value
  51. updateVar :: Monad m => Env sig val -> Id -> val -> m (Env sig val)
  52. updateVar (sigs, cs) id' a = let
  53.   -- Does the traversing stuff
  54.   update :: Monad m => [Context val] -> Id -> val -> m ([Context val])
  55.   update [] _ _ = fail $ "assignment of undeclared variable " <> show id'
  56.   update (c:cs) id' a = case M.lookup id' c of
  57.     Nothing -> return ((:) c =<< update cs id' a)
  58.     Just _  -> return $ (M.insert id' a c) : cs
  59.   in do
  60.     cs' <- update cs id' a
  61.     return (sigs, cs')
  62.  
  63. -- | newBlock inserts a fresh variable context
  64. newBlock :: Env s a -> Env s a
  65. newBlock (s, cs) = (s, M.empty:cs)
  66.  
  67. -- | exitBlock pops the current context
  68. exitBlock :: Env s a -> Env s a
  69. exitBlock (s, cs) = (s, drop 1 cs)
  70.  
  71. -- | Applies function `f` on a temporary scope in the environment
  72. withBlock :: Env s a -> (Env s a -> Env s a) -> Env s a
  73. withBlock env f = exitBlock $ f $ newBlock env
  74.  
  75. -- | Applies function `f` on a temporary scope (inside a monad)
  76. withBlockM :: Monad m => Env s a -> (Env s a -> m (Env s a)) -> m (Env s a)
  77. withBlockM env f = f (newBlock env) >>= (return . exitBlock)
RAW Paste Data
Top