Commit 5bc6df74 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2002-10-21 18:07:22 by cvscast] Empty log message

Original author: cvscast
Date: 2002-10-21 18:07:23+00:00
parent 258ce52d
......@@ -41,10 +41,13 @@ let rec print_exn ppf = function
(Types.label_name l);
Format.fprintf ppf "applied to an expression of type %a@\n"
Types.Print.print_descr t
| Typer.MultipleLabel l ->
Format.fprintf ppf "Multiple occurences for the record label %s@\n"
(Types.label_name l);
| Typer.ShouldHave (t,msg) ->
Format.fprintf ppf "This expression should have type %a@\n%s@\n"
Types.Print.print_descr t
msg
msg
| Typer.Constraint (s,t,msg) ->
Format.fprintf ppf "This expression should have type %a@\n"
Types.Print.print_descr t;
......@@ -82,8 +85,9 @@ let () =
) [] p in
Typer.register_global_types type_decls;
List.iter phrase p
with (Failure _) as e -> raise e
| exn -> print_exn ppf exn
with
| (Failure _) as e -> raise e (* To get the ocamlrun stack trace *)
| exn -> print_exn ppf exn
......
......@@ -6,6 +6,7 @@ open Ast
exception Pattern of string
exception NonExhaustive of Types.descr
exception MultipleLabel of Types.label
exception Constraint of Types.descr * Types.descr * string
exception ShouldHave of Types.descr * string
exception WrongLabel of Types.descr * Types.label
......@@ -334,9 +335,13 @@ let rec expr { loc = loc; descr = d } =
| RecordLitt r ->
(* XXX TODO: check that no label appears twice *)
let fv = ref Fv.empty in
let labs = ref [] in
let r = List.map
(fun (l,e) ->
let (fv2,e) = expr e in
if (List.mem l !labs) then
raise_loc loc (MultipleLabel l);
labs := l :: !labs;
fv := Fv.union !fv fv2;
(l,e)
) r in
......
exception Pattern of string
exception NonExhaustive of Types.descr
exception MultipleLabel of Types.label
exception Constraint of Types.descr * Types.descr * string
exception ShouldHave of Types.descr * string
exception WrongLabel of Types.descr * Types.label
......
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