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

Compile: cosmetic

parent 45a76d04
...@@ -233,7 +233,7 @@ module Translate = struct ...@@ -233,7 +233,7 @@ module Translate = struct
(* remove ghost components from tuple, using mask *) (* remove ghost components from tuple, using mask *)
let visible_of_mask m sl = match m with let visible_of_mask m sl = match m with
| MaskGhost -> assert false (* FIXME *) | MaskGhost -> assert false (* FIXME ? *)
| MaskVisible -> sl | MaskVisible -> sl
| MaskTuple ml -> | MaskTuple ml ->
let add_ity acc m ity = if mask_ghost m then acc else ity :: acc in let add_ity acc m ity = if mask_ghost m then acc else ity :: acc in
...@@ -299,15 +299,13 @@ module Translate = struct ...@@ -299,15 +299,13 @@ module Translate = struct
(* individual types *) (* individual types *)
let mlty_of_ity mask t = let mlty_of_ity mask t =
let rec loop t = match t.ity_node with let rec loop t = match t.ity_node with
| _ when mask_ghost mask -> | _ when mask_ghost mask -> ML.tunit
ML.tunit
| Ityvar (tvs, _) -> | Ityvar (tvs, _) ->
Mltree.Tvar tvs Mltree.Tvar tvs
| Ityapp ({its_ts = ts}, itl, _) when is_ts_tuple ts -> | Ityapp ({its_ts = ts}, itl, _) when is_ts_tuple ts ->
let itl = List.rev (visible_of_mask mask itl) in let itl = List.rev (visible_of_mask mask itl) in
Mltree.Ttuple (List.map loop itl) Mltree.Ttuple (List.map loop itl)
| Ityapp ({its_ts = ts}, itl, _) -> | Ityapp ({its_ts = ts}, itl, _) ->
let itl = List.rev (visible_of_mask mask itl) in
Mltree.Tapp (ts.ts_name, List.map loop itl) Mltree.Tapp (ts.ts_name, List.map loop itl)
| Ityreg {reg_its = its; reg_args = args} -> | Ityreg {reg_its = its; reg_args = args} ->
let args = List.map loop args in let args = List.map loop args in
...@@ -625,12 +623,9 @@ module Translate = struct ...@@ -625,12 +623,9 @@ module Translate = struct
(* assert false (\*TODO*\) *) (* assert false (\*TODO*\) *)
and ebranch info ({pp_pat = p; pp_mask = m}, e) = and ebranch info ({pp_pat = p; pp_mask = m}, e) =
(* If the [case] expression is not ghost but there is (at least) one ghost (* if the [case] expression is not ghost but there is (at least) one ghost
branch, then it must be the case that this is an effectful [case], branch, then it must be the case that all the branches return [unit]
i.e., at least one of the non-ghost branches is effectful. In extract and at least one of the non-ghost branches is effectful *)
code, the onlye sound meaning for this [case] expression is to keep for
each branch the effectul sub-expression. This is similar to the case
of a [let x = e1 in e2] where [x] is a ghost [pvsymbol] *)
if e.e_effect.eff_ghost then (pat m p, ML.mk_unit) if e.e_effect.eff_ghost then (pat m p, ML.mk_unit)
else (pat m p, expr info e) else (pat m p, expr info e)
...@@ -683,7 +678,7 @@ module Translate = struct ...@@ -683,7 +678,7 @@ module Translate = struct
let rec fun_expr_of_mask mask e = let rec fun_expr_of_mask mask e =
let open Mltree in let open Mltree in
let mk_e e_node = { e with e_node = e_node } in let mk_e e_node = { e with e_node = e_node } in
(* assert (mask <> MaskGhost); *) assert (mask <> MaskGhost);
match e.e_node with match e.e_node with
| Econst _ | Evar _ | Efun _ | Eassign _ | Ewhile _ | Econst _ | Evar _ | Efun _ | Eassign _ | Ewhile _
| Efor _ | Eraise _ | Eexn _ | Eabsurd | Ehole -> e | Efor _ | Eraise _ | Eexn _ | Eabsurd | Ehole -> e
...@@ -725,15 +720,9 @@ module Translate = struct ...@@ -725,15 +720,9 @@ module Translate = struct
(* raise (ExtractionVal _rs) *) (* raise (ExtractionVal _rs) *)
| PDlet (LDsym (_, {c_node = Cfun e})) when is_val e.e_node -> | PDlet (LDsym (_, {c_node = Cfun e})) when is_val e.e_node ->
[] []
| PDlet (LDsym ({rs_cty = cty} as rs, {c_node = Cfun e; c_cty = _c_cty})) -> | PDlet (LDsym ({rs_cty = cty} as rs, {c_node = Cfun e})) ->
let args = params cty.cty_args in let args = params cty.cty_args in
(* let open Format in *)
(* let pr_mask fmt = function *)
(* | MaskVisible -> fprintf fmt "Visible@." *)
(* | MaskTuple _ -> fprintf fmt "Tuple@." *)
(* | MaskGhost -> fprintf fmt "Ghost@." in *)
let res = mlty_of_ity cty.cty_mask cty.cty_result in let res = mlty_of_ity cty.cty_mask cty.cty_result in
(* eprintf "Mask of %s:%a@." rs.rs_name.id_string pr_mask c_cty.cty_mask; *)
let e = expr info e in let e = expr info e in
let e = fun_expr_of_mask cty.cty_mask e in let e = fun_expr_of_mask cty.cty_mask e in
[Mltree.Dlet (Mltree.Lsym (rs, res, args, e))] [Mltree.Dlet (Mltree.Lsym (rs, res, args, e))]
......
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