blob: f0c4f1303f9acf08d5624a6d73231d5f17900338 (
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
57
|
module Eval where
import AbsSrc
import AbsTgt
import SMacros
import TMacros
import Match
import Env
import STM
eval :: Exp -> STM Env Val
eval e = case e of
EAbs x b -> do
addVar x ---- adds new VArg i
eval b
EApp _ _ -> do
let (f,xs) = apps e
xs' <- mapM eval xs
case f of
ECon c -> do
v <- lookEnv values c
return $ appVal v xs'
EOpr c -> do
e <- lookEnv opers c
v <- eval e ---- not possible in general
return $ appVal v xs'
ECon c -> lookEnv values c
EOpr c -> lookEnv opers c >>= eval ---- not possible in general
EVar x -> lookEnv vars x
ECst _ _ -> lookEnv parvals e
EStr s -> return $ VTok s
ECat x y -> do
x' <- eval x
y' <- eval y
return $ VCat x' y'
ERec fs -> do
vs <- mapM eval [e | FExp _ e <- fs]
return $ VRec vs
ETab ty cs -> do
-- sz <- lookEnv parsizes ty
-- let ps = map (VPar . toInteger) [0..sz-1]
ps <- lookEnv partypes ty
vs <- mapM (\p -> match cs p >>= eval) ps
return $ VRec vs
ESel t v -> do
t' <- eval t
v' <- eval v
---- pattern match first
return $ compVal [] $ VPro t' v' ---- []
EPro t v@(Lab _ i) -> do
t' <- eval t
return $ compVal [] $ VPro t' (VPar i)
|
