summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGuillaume Seguin <guillaume@segu.in>2009-01-15 22:05:12 +0100
committerGuillaume Seguin <guillaume@segu.in>2009-01-15 22:05:12 +0100
commitee85f525da54e20afe0dc7dd5583c53545dcad81 (patch)
treee466b6d0be25bd3f314ce9771f87f4223c5740cc
parentd15a8216ab6564a9f07d1ac8fb3a4d39cb96989d (diff)
downloadpetitcaml-ee85f525da54e20afe0dc7dd5583c53545dcad81.tar.gz
petitcaml-ee85f525da54e20afe0dc7dd5583c53545dcad81.tar.bz2
[petitcaml] Fix localisation of errors inside calls
-rw-r--r--parser.mly7
-rw-r--r--tests/typing/call-loc.ml8
-rw-r--r--typing.ml6
3 files changed, 17 insertions, 4 deletions
diff --git a/parser.mly b/parser.mly
index 583c381..e6467ec 100644
--- a/parser.mly
+++ b/parser.mly
@@ -68,7 +68,7 @@ decl:
{ (name, e, make_loc $startpos $endpos) }
| LET recur = ioption(REC) id = IDENT args = nonempty_list(motif) EQ e = expr
{ (locd_motif (Mident id) (make_loc $startpos(id) $endpos(id)),
- raw_expr (make_func id recur e args),
+ { e = (make_func id recur e args) ; t = None ; loc = e.loc },
make_loc $startpos $endpos) }
;
@@ -91,7 +91,10 @@ expr:
{ match args with
| [] -> failwith "parser.mly / expr : Unreachable matching"
| arg::args ->
- List.fold_left (fun base arg -> raw_expr (Ecall (base, arg)))
+ List.fold_left (fun base arg ->
+ { e = (Ecall (base, arg)) ;
+ t = None ;
+ loc = arg.loc })
(locd_expr (Ecall (func, arg))
(make_loc $startpos $endpos))
args }
diff --git a/tests/typing/call-loc.ml b/tests/typing/call-loc.ml
new file mode 100644
index 0000000..a865803
--- /dev/null
+++ b/tests/typing/call-loc.ml
@@ -0,0 +1,8 @@
+(*
+ return : 1
+ output :
+File "tests/typing/call-loc.ml", line 8, characters 12-18:
+Erreur dans l'analyse sémantique : Cette expression a le type string mais est ici utilisée avec le type int
+*)
+let f a b = a + b
+let _ = f 2 "toto"
diff --git a/typing.ml b/typing.ml
index 40c8153..5ce6b91 100644
--- a/typing.ml
+++ b/typing.ml
@@ -415,9 +415,11 @@ let rec w env e =
let func_t = w env func_expr
and arg_t = w env arg
and alpha_t = Tvar (V.create ())
+ and beta_t = Tvar (V.create ())
in
- unify func_expr.loc func_t (Tarrow (arg_t, alpha_t));
- alpha_t
+ unify func_expr.loc func_t (Tarrow (alpha_t, beta_t));
+ unify arg.loc arg_t alpha_t;
+ beta_t
| Ematch (match_expr, empty_expr, head_m, tail_m, expr) ->
(* Typage du match :
* On type l'expression matchée, l'expression retournée