Commit 1ce9a979 authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

- Saner version of string comparisons.

 - Properly check for unbound type variables in type definitions.
parent 9f2d1e7f
......@@ -37,6 +37,7 @@ module String : T with type t = string = struct
let dump = Format.pp_print_string
let check s = ()
(*
let rec compare_string_aux s1 s2 l =
if (l == 0) then 0
else
......@@ -48,7 +49,8 @@ module String : T with type t = string = struct
let compare s1 s2 =
let l1 = String.length s1 and l2 = String.length s2 in
if l1 != l2 then l2 - l1 else compare_string_aux s1 s2 l1
*)
let compare = String.compare
let equal x y = compare x y = 0
......
......@@ -16,11 +16,16 @@ module V = struct
Format.fprintf ppf "%a(%d_%a)" Ident.U.print t.name t.id print_kind t.kind
let compare x y =
let c = compare_kind x.kind y.kind in
if c == 0 then
let c = Ident.U.compare x.name y.name in
if c == 0 then Pervasives.compare x.id y.id else
c
(*
let c = Pervasives.compare x.id y.id in
if c == 0 then Ident.U.compare x.name y.name
else c
else c *)
else c
let equal x y =
......
......@@ -157,7 +157,7 @@ let find_id env0 env loc head x =
raise_loc loc (UnboundCompUnit x)
let find_id_comp env0 env loc head x =
let l2 =
let l2 =
if ((match (U.get_str x).[0] with 'A'..'Z' -> true | _ -> false)
&& !has_ocaml_unit x)
then [ EOCaml (U.get_str x) ]
......@@ -680,11 +680,20 @@ let invalid_instance_error loc s =
("This definition yields an empty type for " ^ (Ident.to_string v));
let vars_rhs = Types.all_vars t_rhs in
if List.exists (fun x -> not (Var.Set.mem vars_rhs (Var.mk (U.to_string x)) )) args then
raise_loc_generic loc
(Printf.sprintf "Definition of type %s contains unbound type variables"
(Ident.to_string v));
let vars_mapping = (* create a sequence 'a -> 'a_0 for all variables *)
let vars_lhs =
List.fold_left
(fun acc x -> Var.Set.add (Var.mk (U.to_string x)) acc)
Var.Set.empty
args
in
let undecl = Var.Set.diff vars_rhs vars_lhs in
if not (Var.Set.is_empty undecl) then
raise_loc_generic
loc
(Printf.sprintf "The definition of type %s contains an unbound type variable '%s"
(Ident.to_string v) (Var.ident (Var.Set.choose undecl)));
let vars_mapping = (* create a sequence 'a -> 'a_0 for all variables *)
List.map (fun v -> let vv = Var.mk (U.to_string v) in vv, Var.refresh vv) args
in
let sub_list = List.map (fun (v,vt) -> v, Types.var vt) vars_mapping 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