summaryrefslogtreecommitdiff
path: root/src/Hint/Eval.hs
blob: 36628dc99edaea3d14023e9462d7ce9f686f5b45 (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
module Hint.Eval where

import           Control.Applicative ((<|>))
import qualified Data.Map            as M
import           Data.Maybe          (fromJust)
import           Hint.Data

type Env = M.Map Identifier Expr

data Scope = Scope
  { env   :: [Env] }
  deriving (Show, Eq)

basic :: Scope
basic = Scope mempty

enter :: Env -> Scope -> Scope
enter e (Scope es) = Scope (e : es)

leave :: Scope -> Scope
leave (Scope [] )      = error "bad"
leave (Scope (_ : es)) = Scope es

scopeLookup :: Identifier -> Scope -> Maybe Expr
scopeLookup _ (Scope [])       = Nothing
scopeLookup i (Scope (e : es)) = M.lookup i e <|> scopeLookup i (Scope es)

eval :: Scope -> Expr -> Maybe Expr
eval _ (Literal l) = Literal <$> pure l
eval s (Ident i) = scopeLookup i s
eval scope (Bind name val rest) =
  eval (enter (M.fromList [(name, fromJust $ eval scope val)]) scope) rest
eval s (If cond a b) = do
  Literal (Boolean c) <- eval s cond
  if c then eval s a else eval s b