diff options
| author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2000-03-16 03:30:59 +0000 |
|---|---|---|
| committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2000-03-16 03:30:59 +0000 |
| commit | 3375e52091a4274b9503be74351a4aada59a94db (patch) | |
| tree | 6efe7119ffe195b7504e09a23875c2fe74aef095 | |
| parent | 68366b25009f92c180dc690d9fc80f255add2494 (diff) | |
check labels first in type_application
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2961 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | typing/typecore.ml | 21 |
1 files changed, 13 insertions, 8 deletions
diff --git a/typing/typecore.ml b/typing/typecore.ml index ebdb56dd1..cb17bdd27 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -942,7 +942,8 @@ and type_application env funct sargs = let ignored = ref [] in let rec type_unknown_args args omitted ty_fun = function [] -> - (List.rev args, result_type omitted ty_fun) + (List.rev_map (function None -> None | Some f -> Some (f ())) args, + result_type omitted ty_fun) | (l1, sarg1) :: sargl -> let (ty1, ty2) = try @@ -960,8 +961,11 @@ and type_application env funct sargs = | _ -> raise(Error(funct.exp_loc, Apply_non_function funct.exp_type)) in - let arg1 = type_expect env sarg1 ty1 in - if is_optional l1 then unify_exp env arg1 (type_option(newvar())); + let arg1 () = + let arg1 = type_expect env sarg1 ty1 in + if is_optional l1 then unify_exp env arg1 (type_option(newvar())); + arg1 + in type_unknown_args (Some arg1 :: args) omitted ty2 sargl in let rec type_args args omitted ty_fun ty_old sargs more_sargs = @@ -978,7 +982,8 @@ and type_application env funct sargs = | _, (l', sarg0) :: more_sargs -> if l <> l' && l' <> "" then raise(Error(sarg0.pexp_loc, Apply_wrong_label(l', ty_fun'))) - else ([], more_sargs, Some (type_argument env sarg0 ty)) + else + ([], more_sargs, Some (fun () -> type_argument env sarg0 ty)) | _ -> assert false end else try @@ -992,17 +997,17 @@ and type_application env funct sargs = in sargs, more_sargs, if is_optional l' || not (is_optional l) then - Some (type_argument env sarg0 ty) + Some (fun () -> type_argument env sarg0 ty) else - let arg = type_argument env sarg0 (extract_option_type env ty) in - Some (option_some arg) + Some (fun () -> option_some (type_argument env sarg0 + (extract_option_type env ty))) with Not_found -> sargs, more_sargs, if is_optional l && (List.mem_assoc "" sargs || List.mem_assoc "" more_sargs) then begin ignored := (l,ty,lv) :: !ignored; - Some (option_none ty Location.none) + Some (fun () -> option_none ty Location.none) end else None in let omitted = if arg = None then (l,ty,lv) :: omitted else omitted in |