diff options
| author | Jérôme Vouillon <Jerome.Vouillon@pps.jussieu.fr> | 1997-03-07 22:00:19 +0000 |
|---|---|---|
| committer | Jérôme Vouillon <Jerome.Vouillon@pps.jussieu.fr> | 1997-03-07 22:00:19 +0000 |
| commit | 48991be706d6328c35d0d36caf8c57f5cc0efd3f (patch) | |
| tree | 712eeba45b90df56d65214b117265eb3176d9ccf | |
| parent | c8f445d899b9110f474436e84b2461efba0b2c87 (diff) | |
Bug de generalisation.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1329 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | typing/typecore.ml | 29 |
1 files changed, 24 insertions, 5 deletions
diff --git a/typing/typecore.ml b/typing/typecore.ml index 160e7aa78..416642b49 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -180,6 +180,23 @@ let type_pattern_list env spatl = let new_env = add_pattern_variables env in (patl, new_env) +let rec iter_pattern f p = + f p; + match p.pat_desc with + Tpat_any | Tpat_var _ | Tpat_constant _ -> + () + | Tpat_alias (p, _) -> + iter_pattern f p + | Tpat_tuple pl -> + List.iter (iter_pattern f) pl + | Tpat_construct (_, pl) -> + List.iter (iter_pattern f) pl + | Tpat_record fl -> + List.iter (fun (_, p) -> iter_pattern f p) fl + | Tpat_or (p, p') -> + iter_pattern f p; + iter_pattern f p' + (* Generalization criterion for expressions *) let rec is_nonexpansive exp = @@ -704,12 +721,14 @@ and type_let env rec_flag spat_sexp_list = (fun pat exp -> Parmatch.check_partial pat.pat_loc [pat, exp]) pat_list exp_list; end_def(); + List.iter2 + (fun pat exp -> + if not (is_nonexpansive exp) then + iter_pattern (fun pat ->make_nongen pat.pat_type) pat) + pat_list exp_list; List.iter - (fun exp -> if not (is_nonexpansive exp) then make_nongen exp.exp_type) - exp_list; - List.iter - (fun exp -> generalize exp.exp_type) - exp_list; + (fun pat -> iter_pattern (fun pat -> generalize pat.pat_type) pat) + pat_list; (List.combine pat_list exp_list, new_env) (* Typing of toplevel bindings *) |