| 148 |
match e.Typed.exp_descr with |
match e.Typed.exp_descr with |
| 149 |
| Typed.Var s -> Env.find s env |
| Typed.Var s -> Env.find s env |
| 150 |
| Typed.Apply (f,arg) -> |
| Typed.Apply (f,arg) -> |
| 151 |
let f = eval env f and arg = eval env arg in |
eval_apply (eval env f) (eval env arg) |
|
(match f with |
|
|
| Fun a -> eval_branches a.fun_env a.fun_body arg |
|
|
| _ -> failwith "application with a non-functional value !" |
|
|
) |
|
| 152 |
| Typed.Abstraction a -> |
| Typed.Abstraction a -> |
| 153 |
let a' = { |
let a' = { |
| 154 |
fun_env = env; |
fun_env = env; |
| 165 |
| Typed.Pair (e1,e2) -> Pair (eval env e1, eval env e2) |
| Typed.Pair (e1,e2) -> Pair (eval env e1, eval env e2) |
| 166 |
| Typed.Cst c -> const c |
| Typed.Cst c -> const c |
| 167 |
| Typed.Match (arg,brs) -> eval_branches env brs (eval env arg) |
| Typed.Match (arg,brs) -> eval_branches env brs (eval env arg) |
| 168 |
|
| Typed.Map (arg,brs) -> eval_map env brs (eval env arg) |
| 169 |
|
| Typed.Op ("flatten", [e]) -> eval_flatten (eval env e) |
| 170 |
|
| Typed.Op ("@", [e1; e2]) -> eval_concat (eval env e1) (eval env e2) |
| 171 |
|
| Typed.Op ("+", [e1; e2]) -> eval_add (eval env e1) (eval env e2) |
| 172 |
|
| Typed.Op ("*", [e1; e2]) -> eval_mul (eval env e1) (eval env e2) |
| 173 |
|
| Typed.Op ("-", [e1; e2]) -> eval_sub (eval env e1) (eval env e2) |
| 174 |
|
| Typed.Op ("/", [e1; e2]) -> eval_div (eval env e1) (eval env e2) |
| 175 |
|
| Typed.Dot (e, l) -> eval_dot l (eval env e) |
| 176 |
|
| Typed.DebugTyper t -> failwith "Evaluating a ! expression" |
| 177 |
|
| _ -> failwith "Unknown expression" |
| 178 |
|
|
| 179 |
|
|
| 180 |
|
and eval_apply f arg = match f with |
| 181 |
|
| Fun a -> eval_branches a.fun_env a.fun_body arg |
| 182 |
| _ -> assert false |
| _ -> assert false |
| 183 |
|
|
| 184 |
and eval_branches env brs arg = |
and eval_branches env brs arg = |
| 189 |
List.fold_left (fun env (x,i) -> Env.add x bindings.(i) env) env bind in |
List.fold_left (fun env (x,i) -> Env.add x bindings.(i) env) env bind in |
| 190 |
eval env e |
eval env e |
| 191 |
|
|
| 192 |
|
and eval_map env brs = function |
| 193 |
|
| Pair (x,y) -> Pair (eval_branches env brs x, eval_map env brs y) |
| 194 |
|
| q -> q |
| 195 |
|
|
| 196 |
|
and eval_flatten = function |
| 197 |
|
| Pair (x,y) -> eval_concat x (eval_flatten y) |
| 198 |
|
| q -> q |
| 199 |
|
|
| 200 |
|
and eval_concat l1 l2 = match l1 with |
| 201 |
|
| Pair (x,y) -> Pair (x, eval_concat y l2) |
| 202 |
|
| q -> l2 |
| 203 |
|
|
| 204 |
|
and eval_dot l = function |
| 205 |
|
| Record r -> List.assoc l r |
| 206 |
|
| _ -> assert false |
| 207 |
|
|
| 208 |
|
and eval_add x y = match (x,y) with |
| 209 |
|
| (Integer x, Integer y) -> Integer (Big_int.add_big_int x y) |
| 210 |
|
| _ -> assert false |
| 211 |
|
|
| 212 |
|
and eval_mul x y = match (x,y) with |
| 213 |
|
| (Integer x, Integer y) -> Integer (Big_int.mult_big_int x y) |
| 214 |
|
| _ -> assert false |
| 215 |
|
|
| 216 |
|
and eval_sub x y = match (x,y) with |
| 217 |
|
| (Integer x, Integer y) -> Integer (Big_int.sub_big_int x y) |
| 218 |
|
| _ -> assert false |
| 219 |
|
|
| 220 |
|
and eval_div x y = match (x,y) with |
| 221 |
|
| (Integer x, Integer y) -> Integer (Big_int.div_big_int x y) |
| 222 |
|
| _ -> assert false |
| 223 |
|
|
Parent Directory
| 
Revision Log
| 
Patch