Commit a9f2b925 authored by Mário Pereira's avatar Mário Pereira

Extraction: treatment of masks in exceptions (wip)

parent 530bdf0b
......@@ -488,6 +488,18 @@ module Translate = struct
| Mltree.Tapp (_, tyl) | Mltree.Ttuple tyl ->
List.fold_left add_tvar acc tyl
let exp_of_mask e = function
| MaskGhost -> e_void
| MaskVisible -> e
(* | MaskTuple l -> match e with *)
(* | Capp (rs, pvl) -> assert (is_rs_tuple rs); *)
(* let rec add_exp acc pv = begin function *)
(* | MaskGhost -> acc *)
(* | MaskVisible -> pv *)
(* | MaskTuple l -> *)
(* end *)
| _ -> assert false
(* expressions *)
let rec expr info svar ({e_effect = eff; e_label = lbl} as e) =
assert (not (e_ghost e));
......@@ -616,16 +628,17 @@ module Translate = struct
List.map (fun (xs, (pvl, e)) -> xs, pvl, expr info svar e) bl_map in
ML.mk_expr (Mltree.Etry (etry, bl)) (Mltree.I e.e_ity) eff lbl
| Eraise (xs, ex) ->
let ex =
match expr info svar ex with
let ex = exp_of_mask ex xs.xs_mask in
let ex = match expr info svar ex with
| {Mltree.e_node = Mltree.Eblock []} -> None
| e -> Some e
in
| e -> Some e in
ML.mk_expr (Mltree.Eraise (xs, ex)) (Mltree.I e.e_ity) eff lbl
| Eexn (xs, e1) ->
let e1 = expr info svar e1 in
let ty = if ity_equal xs.xs_ity ity_unit
then None else Some (mlty_of_ity xs.xs_mask xs.xs_ity) in
if mask_ghost e1.e_mask then ML.mk_expr
(Mltree.Eexn (xs, None, ML.e_unit)) (Mltree.I e.e_ity) eff lbl
else let e1 = expr info svar e1 in
let ty = if ity_equal xs.xs_ity ity_unit then None else
Some (mlty_of_ity xs.xs_mask xs.xs_ity) in
ML.mk_expr (Mltree.Eexn (xs, ty, e1)) (Mltree.I e.e_ity) eff lbl
| Elet (LDsym (_, {c_node=(Cany|Cpur (_, _)); _ }), _)
| Eexec ({c_node=Cpur (_, _); _ }, _) -> ML.mk_hole
......@@ -761,7 +774,8 @@ module Translate = struct
let itsd = List.map tdef itl in
[Mltree.Dtype itsd]
| PDexn xs ->
if ity_equal xs.xs_ity ity_unit then [Mltree.Dexn (xs, None)]
if ity_equal xs.xs_ity ity_unit || xs.xs_mask = MaskGhost then
[Mltree.Dexn (xs, None)]
else [Mltree.Dexn (xs, Some (mlty_of_ity xs.xs_mask xs.xs_ity))]
let pdecl_m m pd =
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment