diff options
| author | Kathy Gray | 2014-02-14 15:55:38 +0000 |
|---|---|---|
| committer | Kathy Gray | 2014-02-14 15:55:38 +0000 |
| commit | e63004599c19e8e741918c6e64ec0a5362abc8ed (patch) | |
| tree | febb92f46e3b83db9b4a96e36893d15660109de5 /src | |
| parent | 65c30622a25d10eebec650284949c6c3270df5ac (diff) | |
Fix infinite loop bug, and test1.sail type checking bug
Diffstat (limited to 'src')
| -rw-r--r-- | src/lem_interp/interp.lem | 9 | ||||
| -rw-r--r-- | src/test/test1.sail | 2 | ||||
| -rw-r--r-- | src/type_check.ml | 2 |
3 files changed, 10 insertions, 3 deletions
diff --git a/src/lem_interp/interp.lem b/src/lem_interp/interp.lem index 7aee25e3..f498295c 100644 --- a/src/lem_interp/interp.lem +++ b/src/lem_interp/interp.lem @@ -819,7 +819,14 @@ and interp_main t_level l_env l_mem exp = | (outcome,Just lexp_builder) -> resolve_outcome outcome (fun v lm le -> (Value v,lm,le)) - (fun a -> update_stack a (add_to_top_frame (fun e -> (E_assign (lexp_builder e) (to_exp v))))) end)) + (fun a -> + (match a with + | (Action (Write_reg regf range value) stack) -> + (Action (Write_reg regf range value) stack) + | (Action (Write_mem id a range value) stack) -> + (Action (Write_mem id a range value) stack) + | _ -> update_stack a (add_to_top_frame (fun e -> (E_assign (lexp_builder e) (to_exp v)))) end)) + end)) (fun a -> update_stack a (add_to_top_frame (fun v -> (E_assign lexp v)))) end diff --git a/src/test/test1.sail b/src/test/test1.sail index c27d1c77..34210f97 100644 --- a/src/test/test1.sail +++ b/src/test/test1.sail @@ -31,7 +31,7 @@ function clause f ( C (a) ) = C(a) end ast end f -(*function unit a (bit) b = if b then () else ()*) +function unit a (bit) b = if b then () else () function bit sw s = switch s { case 0 -> bitzero } diff --git a/src/type_check.ml b/src/type_check.ml index 9c1f4942..613a0a2c 100644 --- a/src/type_check.ml +++ b/src/type_check.ml @@ -1005,7 +1005,7 @@ let check_fundef envs (FD_aux(FD_function(recopt,tannotopt,effectopt,funcls),(l, (List.map (fun (FCL_aux((FCL_Funcl(id,pat,exp)),(l,annot))) -> let (pat',t_env',constraints',t') = check_pattern (Env(d_env,t_env)) pat in let u,cs = type_consistent l d_env t' param_t in - let exp',_,_,constraints,ef = check_exp (Env(d_env,Envmap.union t_env' t_env)) ret_t exp in + let exp',_,_,constraints,ef = check_exp (Env(d_env,Envmap.union t_env t_env')) ret_t exp in (*let _ = (Pretty_print.pp_exp Format.std_formatter) exp' in*) (FCL_aux((FCL_Funcl(id,pat',exp')),(l,tannot)),constraints'@cs@constraints)) funcls) in match (in_env,tannot) with |