daily pastebin goal
15%
SHARE
TWEET

Untitled

a guest Feb 16th, 2019 69 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. diff --git a/typing/typecore.ml b/typing/typecore.ml
  2. index 848c8e6..0561de4 100644
  3. --- a/typing/typecore.ml
  4. +++ b/typing/typecore.ml
  5. @@ -1476,14 +1476,43 @@ and type_argument env sarg ty_expected' =
  6.    | _, {pexp_desc = Pexp_function(l,_,_)} when not (is_optional l) ->
  7.        type_expect env sarg ty_expected
  8.    | {desc = Tarrow("",ty_arg,ty_res,_); level = lv}, _ ->
  9. -      (* apply optional arguments when expected type is "" *)
  10. -      (* we must be very careful about not breaking the semantics *)
  11. +      (* We are in the situation of typing the argument
  12. +         of an application`f a`, with
  13. +           f : (t -> u) -> v
  14. +           a : ?l1:t1 -> ?l2:t2 -> ... -> ?ln:tn -> t -> u
  15. +
  16. +         In this situation, we will implicitly coerce the argument `a`
  17. +         into the desired type `t -> u` by feeding the default 'None'
  18. +         argument to its optional parameters.
  19. +        
  20. +         Note that functions with optional arguments must always have
  21. +         a non-optinal argument after their optional argument, that's
  22. +         how we now that, after ?l1..?ln, the type of a is still an
  23. +         function type `t -> u`. (We allow to coerce only if f's
  24. +         function argument expects no optional parameter at all, not
  25. +         only less than `a` requests.)
  26. +
  27. +         `f (a ~l1:None ~l2:None ... ~ln:None)` would be type-correct,
  28. +         but would not respect the semantics we expect: we want the
  29. +         application of the default arguments to happen when `a` is
  30. +         used as a function (passed an argument of type `t`). To
  31. +         respect that semantics, we delay the application of the
  32. +         default argument to whenever `a` is used as a function inside
  33. +         `f`, by eta-expansion
  34. +
  35. +         f (let x = a in fun (y:t) -> x ~l1:None ... ~ln:None y)
  36. +
  37. +         (Note that the use of `let x = a in` preserves the evaluation
  38. +         of `a` at the application site `f a`, instead of being delayed
  39. +         and repeated by the eta-expansion closure.)
  40. +      *)
  41.        if !Clflags.principal then begin_def ();
  42.        let texp = type_exp env sarg in
  43.        if !Clflags.principal then begin
  44.          end_def ();
  45.          generalize_structure texp.exp_type
  46.        end;
  47. +      (* collect the optional labels ~l1 .. ~ln for application of None *)
  48.        let rec make_args args ty_fun =
  49.          match (expand_head env ty_fun).desc with
  50.          | Tarrow (l,ty_arg,ty_fun,_) when is_optional l ->
  51. @@ -1507,7 +1536,7 @@ and type_argument env sarg ty_expected' =
  52.        end else begin
  53.        unify_exp env {texp with exp_type = ty_fun} ty_expected;
  54.        if args = [] then texp else
  55. -      (* eta-expand to avoid side effects *)
  56. +      (* eta-expand (delay application-time side effects) *)
  57.        let var_pair name ty =
  58.          let id = Ident.create name in
  59.          {pat_desc = Tpat_var id; pat_type = ty;
  60. @@ -1525,7 +1554,8 @@ and type_argument env sarg ty_expected' =
  61.        if warn then Location.prerr_warning texp.exp_loc
  62.            (Warnings.Without_principality "eliminated optional argument");
  63.        if is_nonexpansive texp then func texp else
  64. -      (* let-expand to have side effects *)
  65. +      (* let-expand (avoid having side-effects of [texp] delayed by
  66. +         eta-expanding) *)
  67.        let let_pat, let_var = var_pair "let" texp.exp_type in
  68.        re { texp with exp_type = ty_fun; exp_desc =
  69.             Texp_let (Nonrecursive, [let_pat, texp], func let_var) }
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top