Commit 17335b8d authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][LAMBDA] Fix accept type for branches in abstraction

parent cc0fe98c
......@@ -7,6 +7,8 @@ module Locals = Map.Make(String)
(* To throw in case of an unbound name *)
exception Error
let polyvar = Types.var (`Var (Var.make_id "A"))
let type_of_string s = match s with
| "Int" -> Builtin_defs.int
| "String" -> Builtin_defs.string
......@@ -107,17 +109,6 @@ and make_sigma s =
| [] -> acc in
aux [] s
and type_of_sigma x s =
let rec aux2 x acc = function
| [] -> acc
| (id, t2) :: rest when id = x ->
aux2 x (Types.cap acc (type_of_ptype t2)) rest
| _ :: rest -> aux2 x acc rest in
let rec aux x acc = function
| [] -> acc
| l :: rest -> aux x (Types.cup acc (aux2 x Types.any l)) rest in
aux x Types.empty s
and type_of_ptype =
let open Types in function
| Type(t) -> type_of_string t
......@@ -151,6 +142,9 @@ and first_param loc iface =
in
_first_param loc [] iface
and accept_type t =
if Types.equiv t polyvar then Builtin_defs.any else t
and parse_abstr env l loc fun_name iface fv body =
let fun_typ = type_of_ptype iface in
let ptype, iface = first_param loc iface in
......@@ -158,7 +152,7 @@ and parse_abstr env l loc fun_name iface fv body =
| None -> l
| Some (id, name) -> Locals.add name (id,fun_typ) l) in
let b, btype = parse_branches env l ptype [] Types.empty body in
let brs = { Typed.br_typ=type_of_ptype ptype; br_accept=Types.any;
let brs = { Typed.br_typ=btype; br_accept=accept_type btype;
br_branches=b } in
let abstr = { Typed.fun_name=fun_name; fun_iface=iface; fun_body=brs;
fun_typ=fun_typ; fun_fv=fv } in
......
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