Commit 7dfce3f8 authored by Mário Pereira's avatar Mário Pereira

Extraction: recognize [val x: t] as a valid functor argument

parent b4380d74
......@@ -227,7 +227,8 @@ module Print = struct
| Lany (rs, _, _) ->
check_val_in_drv info rs
and print_expr ?(paren=false) info fmt e = match e.e_node with
and print_expr ?(paren=false) info fmt e =
match e.e_node with
| Econst c ->
let n = Number.compute_int_constant c in
let n = BigInt.to_string n in
......@@ -246,6 +247,7 @@ module Print = struct
| Eabsurd ->
fprintf fmt (protect_on paren "assert false (* absurd *)")
| Ehole -> ()
| Eany _ -> assert false
| Eapp (rs, []) when rs_equal rs rs_true ->
fprintf fmt "true"
| Eapp (rs, []) when rs_equal rs rs_false ->
......
......@@ -494,6 +494,11 @@ module Translate = struct
if eff_pure e.e_effect then []
else let unit_ = pv (* create_pvsymbol (id_fresh "_") ity_unit *) in
[ML.Dlet (ML.Lvar (unit_, expr info Stv.empty MaskGhost e))]
| PDlet (LDvar (pv, {e_node = Eexec ({c_node = Cany}, cty)})) ->
Debug.dprintf debug_compile "compiling undifined constant %a@"
print_pv pv;
let ty = mlty_of_ity cty.cty_mask cty.cty_result in
[ML.Dlet (ML.Lvar (pv, ML.e_any ty cty))]
| PDlet (LDvar (pv, e)) ->
Debug.dprintf debug_compile "compiling top-level symbol %a@."
print_pv pv;
......@@ -674,7 +679,7 @@ module Transform = struct
mk (Eraise (exn, Some e)), spv
| Eassign _al ->
e, Spv.empty
| Econst _ | Eabsurd | Ehole -> e, Spv.empty
| Econst _ | Eabsurd | Ehole | Eany _ -> e, Spv.empty
| Eignore e ->
let e, spv = expr info subst e in
mk (Eignore e), spv
......
......@@ -1011,7 +1011,7 @@ module MLToC = struct
| None, None -> raise (Unsupported ("assign not in driver")) in
[], C.(Sexpr(Ebinop(Bassign, t, C.Evar v.pv_vs.vs_name)))
| Eassign _ -> raise (Unsupported "assign")
| Ehole -> assert false
| Ehole | Eany _ -> assert false
| Eexn _ -> raise (Unsupported "exception")
| Eignore e ->
[], C.Sseq(C.Sblock(expr info {env with computes_return_value = false} e),
......
......@@ -769,6 +769,8 @@ let rec interp_expr info (e:Mltree.expr) : value =
raise CannotReduce
| Ehole -> Debug.dprintf debug_interp "Ehole@.";
raise CannotReduce
| Eany _ -> Debug.dprintf debug_interp "Eany@.";
raise CannotReduce
| Ematch (e, l, bl) ->
Debug.dprintf debug_interp "Ematch@.";
begin match interp_expr info e with
......
......@@ -63,6 +63,7 @@ and expr_node =
| Eraise of xsymbol * expr option
| Eexn of xsymbol * ty option * expr
| Eignore of expr
| Eany of ty
| Eabsurd
| Ehole
......@@ -183,7 +184,7 @@ and iter_deps_pat f = function
| Pas (p, _) -> iter_deps_pat f p
and iter_deps_expr f e = match e.e_node with
| Econst _ | Evar _ | Eabsurd | Ehole -> ()
| Econst _ | Evar _ | Eabsurd | Ehole | Eany _ -> ()
| Eapp (rs, exprl) ->
f rs.rs_name; List.iter (iter_deps_expr f) exprl
| Efun (args, e) ->
......@@ -280,6 +281,9 @@ let is_unit = function
let enope = Eblock []
let e_any ty c =
mk_expr (Eany ty) (C c) MaskVisible Ity.eff_empty Sattr.empty
let mk_hole =
mk_expr Ehole (I Ity.ity_unit) MaskVisible Ity.eff_empty Sattr.empty
......
......@@ -387,6 +387,10 @@ module Print = struct
(print_expr info) e
and print_let_def ?(functor_arg=false) info fmt = function
| Lvar (pv, {e_node = Eany ty}) when functor_arg ->
fprintf fmt "@[<hov 2>val %a : %a@]"
(print_lident info) (pv_name pv)
(print_ty info) ty;
| Lvar (pv, e) ->
fprintf fmt "@[<hov 2>let %a =@ %a@]"
(print_lident info) (pv_name pv)
......@@ -424,7 +428,8 @@ module Print = struct
forget_vars args
| Lany (rs, _, _) -> check_val_in_drv info rs
and print_expr ?(paren=false) info fmt e = match e.e_node with
and print_expr ?(paren=false) info fmt e =
match e.e_node with
| Econst c ->
let n = Number.compute_int_constant c in
let n = BigInt.to_string n in
......@@ -445,6 +450,7 @@ module Print = struct
| Eabsurd ->
fprintf fmt (protect_on paren "assert false (* absurd *)")
| Ehole -> ()
| Eany _ -> assert false
| Eapp (rs, []) when rs_equal rs rs_true ->
fprintf fmt "true"
| Eapp (rs, []) when rs_equal rs rs_false ->
......@@ -612,6 +618,7 @@ module Print = struct
let rec is_signature_decl info = function
| Dtype _ -> true
| Dlet (Lany _) -> true
| Dlet (Lvar (_, {e_node = Eany _})) -> true
| Dlet _ -> false
| Dexn _ -> true
| Dmodule (_, dl) -> is_signature info dl
......
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