Fixed stupid bug #1
This commit is contained in:
parent
c0602c6df6
commit
03f0d5d89a
|
@ -101,12 +101,12 @@ let rec whenc context e c n =
|
||||||
type kind = ExtValue | Any
|
type kind = ExtValue | Any
|
||||||
|
|
||||||
(** Creates an equation and add it to the context if necessary. *)
|
(** Creates an equation and add it to the context if necessary. *)
|
||||||
let add context expected_kind ({ e_desc = de } as e) =
|
let add context expected_kind e =
|
||||||
let up = match de, expected_kind with
|
let up = match e.e_desc, expected_kind with
|
||||||
| (Evar _ | Eapp ({ a_op = Efield }, _, _) | Ewhen _
|
| (Evar _ | Eapp ({ a_op = Efield }, _, _) | Ewhen _
|
||||||
| Eapp ({ a_op = Etuple }, _, _) | Econst _) , ExtValue -> false
|
| Eapp ({ a_op = Etuple }, _, _) | Econst _) , ExtValue -> false
|
||||||
| _ , ExtValue -> true
|
| _ , ExtValue -> true
|
||||||
| _ -> false in
|
| _ -> Format.printf "Not normalizing \n"; false in
|
||||||
if up then
|
if up then
|
||||||
let context, n = equation context e in
|
let context, n = equation context e in
|
||||||
context, { e with e_desc = n }
|
context, { e with e_desc = n }
|
||||||
|
@ -114,7 +114,7 @@ let add context expected_kind ({ e_desc = de } as e) =
|
||||||
context, e
|
context, e
|
||||||
|
|
||||||
let rec translate kind context e =
|
let rec translate kind context e =
|
||||||
let context, e = match e.e_desc with
|
let context, e' = match e.e_desc with
|
||||||
| Econst _
|
| Econst _
|
||||||
| Evar _ -> context, e
|
| Evar _ -> context, e
|
||||||
| Epre(v, e1) -> fby kind context e v e1
|
| Epre(v, e1) -> fby kind context e v e1
|
||||||
|
@ -143,7 +143,7 @@ let rec translate kind context e =
|
||||||
flatten_e_list e_list, reset) }
|
flatten_e_list e_list, reset) }
|
||||||
| Elast _ | Efby _ ->
|
| Elast _ | Efby _ ->
|
||||||
Error.message e.e_loc Error.Eunsupported_language_construct
|
Error.message e.e_loc Error.Eunsupported_language_construct
|
||||||
in add context kind e
|
in add context kind e'
|
||||||
|
|
||||||
and translate_list kind context e_list =
|
and translate_list kind context e_list =
|
||||||
match e_list with
|
match e_list with
|
||||||
|
@ -196,7 +196,7 @@ and ifthenelse context e e1 e2 e3 =
|
||||||
{ e with e_desc = Eapp(mk_app Etuple, e_list, None) }
|
{ e with e_desc = Eapp(mk_app Etuple, e_list, None) }
|
||||||
in
|
in
|
||||||
if is_list e2 then (
|
if is_list e2 then (
|
||||||
context, mk_ite_list (e_to_e_list e2) (e_to_e_list e2)
|
context, mk_ite_list (e_to_e_list e2) (e_to_e_list e3)
|
||||||
) else
|
) else
|
||||||
context, { e with e_desc = Eapp (mk_app Eifthenelse, [e1; e2; e3], None) }
|
context, { e with e_desc = Eapp (mk_app Eifthenelse, [e1; e2; e3], None) }
|
||||||
|
|
||||||
|
@ -244,13 +244,19 @@ and distribute ((d_list, eq_list) as context) eq pat e =
|
||||||
dist_e_list pat_list e_list
|
dist_e_list pat_list e_list
|
||||||
| Etuplepat(pat_list), Econst { se_desc = Stuple se_list } ->
|
| Etuplepat(pat_list), Econst { se_desc = Stuple se_list } ->
|
||||||
dist_e_list pat_list (exp_list_of_static_exp_list se_list)
|
dist_e_list pat_list (exp_list_of_static_exp_list se_list)
|
||||||
| _ -> d_list, eq :: eq_list
|
| _ ->
|
||||||
|
let eq = { eq with eq_desc = Eeq(pat, e) } in
|
||||||
|
d_list, eq :: eq_list
|
||||||
|
|
||||||
and translate_eq context eq = match eq.eq_desc with
|
and translate_eq ((d_list, eq_list) as context) eq = match eq.eq_desc with
|
||||||
| Eeq (pat, e) ->
|
| Eeq (pat, e) ->
|
||||||
let context, e = translate Any context e in
|
let context, e = translate Any context e in
|
||||||
distribute context eq pat e
|
distribute context eq pat e
|
||||||
| _ -> raise Errors.Fallback
|
| Eblock b ->
|
||||||
|
let v, eqs = translate_eq_list [] b.b_equs in
|
||||||
|
let eq = { eq with eq_desc = Eblock { b with b_local = v @ b.b_local; b_equs = eqs} } in
|
||||||
|
d_list, eq :: eq_list
|
||||||
|
| _ -> Misc.internal_error "normalize" 0
|
||||||
|
|
||||||
and translate_eq_list d_list eq_list =
|
and translate_eq_list d_list eq_list =
|
||||||
List.fold_left
|
List.fold_left
|
||||||
|
|
Loading…
Reference in a new issue