Commit 7c7455a8 authored by Pietro Abate's avatar Pietro Abate

Add Type check for parametric types arguments

parent 08a5a432
......@@ -287,29 +287,30 @@ let deferr s = raise (Patterns.Error s)
(* From the intermediate representation to the internal one *)
let rec typ n =
let n = repr n in
match n.t with
| Some t -> t
| None -> let t = compute_typ n.desc in n.t <- Some t; t
and compute_typ = function
| IType (t,_) -> t
| IOr (s1,s2,_) -> Types.cup (typ s1) (typ s2)
| IAnd (s1,s2,_) -> Types.cap (typ s1) (typ s2)
| IDiff (s1,s2,_) -> Types.diff (typ s1) (typ s2)
| ITimes (s1,s2) -> Types.times (typ_node s1) (typ_node s2)
| IXml (s1,s2) -> Types.xml (typ_node s1) (typ_node s2)
| IArrow (s1,s2) -> Types.arrow (typ_node s1) (typ_node s2)
| IOptional (s,_) -> Types.Record.or_absent (typ s)
| IRecord (o,r,err) ->
Types.record_fields (o, LabelMap.map (compute_typ_field err) r)
| ILink _ -> assert false
| ICapture _ | IConstant (_,_) -> assert false
| IConcat _ | IMerge _ -> assert false
and compute_typ_field err = function
| (s, None) -> typ_node s
| (s, Some _) ->
raise (err "Or-else clauses are not allowed in types")
let rec typ ?(err=deferr) n =
let n = repr n in
match n.t with
| Some t -> t
| None -> let t = compute_typ err n.desc in n.t <- Some t; t
and compute_typ err = function
| IType (t,_) -> t
| IOr (s1,s2,_) -> Types.cup (typ s1) (typ s2)
| IAnd (s1,s2,_) -> Types.cap (typ s1) (typ s2)
| IDiff (s1,s2,_) -> Types.diff (typ s1) (typ s2)
| ITimes (s1,s2) -> Types.times (typ_node s1) (typ_node s2)
| IXml (s1,s2) -> Types.xml (typ_node s1) (typ_node s2)
| IArrow (s1,s2) -> Types.arrow (typ_node s1) (typ_node s2)
| IOptional (s,_) -> Types.Record.or_absent (typ s)
| IRecord (o,r,err) ->
Types.record_fields (o, LabelMap.map (compute_typ_field err) r)
| ILink _ -> assert false
| ICapture x | IConstant (x,_) ->
raise (err ("Identifier "^(to_string x)^" is not a valid type"))
| IConcat _ | IMerge _ -> assert false
and compute_typ_field err = function
| (s, None) -> typ_node s
| (s, Some _) ->
raise (err "Or-else clauses are not allowed in types")
and typ_node n =
let n = repr n in
......
......@@ -26,7 +26,7 @@ val internalize: node -> unit
val peek_fv: node -> id option
val typ : node -> Types.descr
val typ : ?err:err -> node -> Types.descr
val typ_node : node -> Types.Node.t
val pat_node : node -> Patterns.node
......
......@@ -394,10 +394,20 @@ module IType = struct
let a = Array.of_list a in
let l = ref [] in
for i=0 to (Array.length pargs) - 1 do
l := (pargs.(i), typ(derecurs env a.(i)))::!l
try
let err s = Error s in
l := (pargs.(i), typ ~err (derecurs env a.(i)))::!l
with
|Error s -> raise_loc_generic loc s
|_ -> assert false
done;
mk_type (Types.Positive.substitute_list t !l)
with Not_found -> mk_capture v
with Not_found ->
if List.length a >= 1 then
raise_loc_generic loc
(Printf.sprintf "Parametric type %s does not exists" (Ident.to_string v))
else
mk_capture v
end
| (ids,_) ->
mk_type (fst(find_global_type env.penv_tenv loc ids))
......@@ -533,7 +543,6 @@ let pat_false =
Patterns.define n (Patterns.constr Builtin_defs.false_type);
n
let ops = Hashtbl.create 13
let register_op op arity f = Hashtbl.add ops op (arity,f)
let typ_op op = snd (Hashtbl.find ops op)
......
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