hphp/hack/src/hhbc/emit_type_hint.ml

   1 (*
   2  * Copyright (c) 2017, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 open Core_kernel
  11 open Hhbc_string_utils
  12 module A = Ast_defs
  13 module SN = Naming_special_names
  14 module TC = Hhas_type_constraint
  15
  16 type type_hint_kind =
  17   | Property
  18   | Return
  19   | Param
  20   | TypeDef
  21
  22 (* Produce the "userType" bit of the annotation *)
  23 let rec fmt_name_or_prim ~tparams ~namespace x =
  24   let name = snd x in
  25   if List.mem ~equal:( = ) tparams name || is_self name || is_parent name then
  26     name
  27   else
  28     let needs_unmangling = Xhp.is_xhp (strip_ns name) in
  29     let fq_id = Hhbc_id.Class.elaborate_id namespace x in
  30     if needs_unmangling then
  31       Hhbc_id.Class.to_unmangled_string fq_id
  32     else
  33       Hhbc_id.Class.to_raw_string fq_id
  34
  35 and prim_to_string prim =
  36   match prim with
  37   | Aast.Tnull -> SN.Typehints.null
  38   | Aast.Tvoid -> SN.Typehints.void
  39   | Aast.Tint -> SN.Typehints.int
  40   | Aast.Tbool -> SN.Typehints.bool
  41   | Aast.Tfloat -> SN.Typehints.float
  42   | Aast.Tstring -> SN.Typehints.string
  43   | Aast.Tresource -> SN.Typehints.resource
  44   | Aast.Tnum -> SN.Typehints.num
  45   | Aast.Tarraykey -> SN.Typehints.arraykey
  46   | Aast.Tnoreturn -> SN.Typehints.noreturn
  47   | Aast.Tatom s -> ":@" ^ s
  48
  49 and fmt_hint ~tparams ~namespace ?(strip_tparams = false) (pos, h) =
  50   let fmt_name_or_prim = fmt_name_or_prim ~tparams ~namespace in
  51   match h with
  52   | Aast.Happly (id, []) -> fmt_name_or_prim id
  53   | Aast.Happly (id, args) ->
  54     let name = fmt_name_or_prim id in
  55     if strip_tparams then
  56       name
  57     else
  58       name ^ "<" ^ fmt_hints ~tparams ~namespace args ^ ">"
  59   | Aast.Hfun { is_coroutine = true; _ } ->
  60     failwith "Codegen for coroutine functions is not supported"
  61   | Aast.Hfun
  62       {
  63         reactive_kind = _;
  64         is_coroutine = false;
  65         param_tys = args;
  66         param_kinds = _;
  67         param_mutability = _;
  68         variadic_ty = _;
  69         return_ty = ret;
  70         is_mutable_return = _;
  71       } ->
  72     (* TODO(mqian): Implement for inout parameters *)
  73     "(function ("
  74     ^ fmt_hints ~tparams ~namespace args
  75     ^ "): "
  76     ^ fmt_hint ~tparams ~namespace ret
  77     ^ ")"
  78   | Aast.Htuple hs -> "(" ^ fmt_hints ~tparams ~namespace hs ^ ")"
  79   | Aast.Haccess ((_, Aast.Happly (id, _)), accesses) ->
  80     fmt_name_or_prim id
  81     ^ "::"
  82     ^ String.concat ~sep:"::" (List.map accesses snd)
  83   | Aast.Haccess _ -> failwith "ast_to_nast error. Should be Haccess(Happly())"
  84   (* Follow HHVM order: soft -> option *)
  85   (* Can we fix this eventually? *)
  86   | Aast.Hoption (_, Aast.Hsoft t) -> "@?" ^ fmt_hint ~tparams ~namespace t
  87   | Aast.Hoption t -> "?" ^ fmt_hint ~tparams ~namespace t
  88   | Aast.Hlike t -> "~" ^ fmt_hint ~tparams ~namespace t
  89   | Aast.Hsoft h -> "@" ^ fmt_hint ~tparams ~namespace h
  90   (* No guarantee that this is in the correct order when using map instead of list
  91    * TODO: Check whether shape fields need to retain order *)
  92   | Aast.Hshape { Aast.nsi_field_map; _ } ->
  93     let fmt_field_name name =
  94       match name with
  95       | A.SFlit_int (_, s_i) -> s_i
  96       | A.SFlit_str (_, s) -> "'" ^ s ^ "'"
  97       | A.SFclass_const (cid, (_, s2)) -> fmt_name_or_prim cid ^ "::" ^ s2
  98     in
  99     let format { Aast.sfi_hint; Aast.sfi_optional; Aast.sfi_name } =
 100       let prefix =
 101         if sfi_optional then
 102           "?"
 103         else
 104           ""
 105       in
 106       prefix
 107       ^ fmt_field_name sfi_name
 108       ^ "=>"
 109       ^ fmt_hint ~tparams ~namespace sfi_hint
 110     in
 111     let shape_fields = List.map ~f:format nsi_field_map in
 112     prefix_namespace "HH" "shape(" ^ String.concat ~sep:", " shape_fields ^ ")"
 113   | Aast.Hprim p -> fmt_name_or_prim (pos, prim_to_string p)
 114   (* Didn't exist in the AST *)
 115   | Aast.Herr
 116   | Aast.Hany ->
 117     failwith "I'm convinced that this should be an error caught in naming"
 118   | Aast.Hmixed -> fmt_name_or_prim (pos, SN.Typehints.mixed)
 119   | Aast.Hnonnull -> fmt_name_or_prim (pos, SN.Typehints.nonnull)
 120   | Aast.Habstr s -> fmt_name_or_prim (pos, s)
 121   | Aast.Harray _ -> fmt_name_or_prim (pos, SN.Typehints.array)
 122   | Aast.Hdarray _ -> fmt_name_or_prim (pos, SN.Typehints.darray)
 123   | Aast.Hvarray _ -> fmt_name_or_prim (pos, SN.Typehints.varray)
 124   | Aast.Hvarray_or_darray _ ->
 125     fmt_name_or_prim (pos, SN.Typehints.varray_or_darray)
 126   | Aast.Hthis -> fmt_name_or_prim (pos, SN.Typehints.this)
 127   | Aast.Hdynamic -> fmt_name_or_prim (pos, SN.Typehints.dynamic)
 128   | Aast.Hnothing -> fmt_name_or_prim (pos, SN.Typehints.nothing)
 129   | Aast.Hpu_access (h, sid) ->
 130     "(" ^ fmt_hint ~tparams ~namespace h ^ ":@" ^ snd sid ^ ")"
 131
 132 and fmt_hints ~tparams ~namespace hints =
 133   String.concat ~sep:", " (List.map hints (fmt_hint ~tparams ~namespace))
 134
 135 (* Differs from above in that this assumes that naming has occurred *)
 136 let can_be_nullable (_, h) =
 137   match h with
 138   | Aast.Hfun _
 139   | Aast.Hoption (_, Aast.Hfun _)
 140   | Aast.Happly ((_, "dynamic"), _)
 141   | Aast.Hoption (_, Aast.Happly ((_, "dynamic"), _))
 142   | Aast.Happly ((_, "nonnull"), _)
 143   | Aast.Hoption (_, Aast.Happly ((_, "nonnull"), _))
 144   | Aast.Happly ((_, "mixed"), _)
 145   | Aast.Hoption (_, Aast.Happly ((_, "mixed"), _))
 146   | Aast.Hdynamic
 147   | Aast.Hnonnull
 148   | Aast.Hmixed
 149   | Aast.Hoption (_, Aast.Hdynamic)
 150   | Aast.Hoption (_, Aast.Hnonnull)
 151   | Aast.Hoption (_, Aast.Hmixed) ->
 152     false
 153   | Aast.Haccess _ -> false
 154   (* HHVM does not emit nullable for type consts that are set to null by default
 155    * function(Class::Type $a = null) unless it is explicitly marked as nullable
 156    *)
 157   | Aast.Herr
 158   | Aast.Hany ->
 159     failwith "I'm convinced that this should be an error caught in naming"
 160   (* Naming converted the following from Happly's so assuming it should be true *)
 161   | Aast.Habstr _
 162   | Aast.Harray _
 163   | Aast.Hdarray _
 164   | Aast.Hvarray _
 165   | Aast.Hvarray_or_darray _
 166   | Aast.Hthis ->
 167     true
 168   | _ -> true
 169
 170 let rec hint_to_type_constraint ~kind ~tparams ~skipawaitable ~namespace (p, h)
 171     =
 172   let happly_helper ((pos, name) as id) =
 173     if List.mem ~equal:( = ) tparams name then
 174       let tc_name = Some "" in
 175       let tc_flags = [TC.HHType; TC.ExtendedHint; TC.TypeVar] in
 176       TC.make tc_name tc_flags
 177     else if kind = TypeDef && (is_self name || is_parent name) then
 178       Emit_fatal.raise_fatal_runtime
 179         pos
 180         (Printf.sprintf "Cannot access %s when no class scope is active" name)
 181     else
 182       let tc_name =
 183         if is_self name || is_parent name then
 184           name
 185         else
 186           let fq_id = Hhbc_id.Class.elaborate_id namespace id in
 187           Hhbc_id.Class.to_raw_string fq_id
 188       in
 189       let tc_flags = [TC.HHType] in
 190       TC.make (Some tc_name) tc_flags
 191   in
 192   match h with
 193   (* The dynamic and nonnull types are treated by the runtime as mixed *)
 194   | Aast.Happly ((_, "dynamic"), [])
 195   | Aast.Happly ((_, "mixed"), [])
 196   | Aast.Hdynamic
 197   | Aast.Hlike _
 198   | Aast.Hfun _
 199   | Aast.Hmixed ->
 200     TC.make None []
 201   | Aast.Hprim Aast.Tvoid when kind <> TypeDef -> TC.make None []
 202   | Aast.Happly ((_, s), [])
 203     when String.lowercase s = "void" && kind <> TypeDef ->
 204     TC.make None []
 205   | Aast.Haccess _ ->
 206     let tc_name = Some "" in
 207     let tc_flags = [TC.HHType; TC.ExtendedHint; TC.TypeConstant] in
 208     TC.make tc_name tc_flags
 209   (* Elide the Awaitable class for async return types only *)
 210   | Aast.Happly ((_, "Awaitable"), [(_, Aast.Hprim Aast.Tvoid)])
 211   | Aast.Happly ((_, "Awaitable"), [(_, Aast.Happly ((_, "void"), []))])
 212     when skipawaitable ->
 213     TC.make None []
 214   | Aast.Happly ((_, "Awaitable"), [h])
 215   | Aast.Hoption (_, Aast.Happly ((_, "Awaitable"), [h]))
 216     when skipawaitable ->
 217     hint_to_type_constraint ~kind ~tparams ~skipawaitable:false ~namespace h
 218   | Aast.Hoption (_, Aast.Hsoft (_, Aast.Happly ((_, "Awaitable"), [h])))
 219     when skipawaitable ->
 220     make_tc_with_flags_if_non_empty_flags
 221       ~kind
 222       ~tparams
 223       ~skipawaitable
 224       ~namespace
 225       h
 226       [TC.Soft; TC.HHType; TC.ExtendedHint]
 227   | Aast.Happly ((_, "Awaitable"), [])
 228   | Aast.Hoption (_, Aast.Happly ((_, "Awaitable"), []))
 229     when skipawaitable ->
 230     TC.make None []
 231   (* Need to differentiate between type params and classes *)
 232   | Aast.Happly ((pos, name), _) -> happly_helper (pos, name)
 233   (* Shapes and tuples are just arrays *)
 234   | Aast.Hshape _ ->
 235     let tc_name = Some "HH\\darray" in
 236     let tc_flags = [TC.HHType; TC.ExtendedHint] in
 237     TC.make tc_name tc_flags
 238   | Aast.Htuple _ ->
 239     let tc_name = Some "HH\\varray" in
 240     let tc_flags = [TC.HHType; TC.ExtendedHint] in
 241     TC.make tc_name tc_flags
 242   | Aast.Hoption t ->
 243     make_tc_with_flags_if_non_empty_flags
 244       ~kind
 245       ~tparams
 246       ~skipawaitable
 247       ~namespace
 248       t
 249       [TC.Nullable; TC.DisplayNullable; TC.HHType; TC.ExtendedHint]
 250   | Aast.Hsoft t ->
 251     make_tc_with_flags_if_non_empty_flags
 252       ~kind
 253       ~tparams
 254       ~skipawaitable
 255       ~namespace
 256       t
 257       [TC.Soft; TC.HHType; TC.ExtendedHint]
 258   | Aast.Herr
 259   | Aast.Hany ->
 260     failwith "I'm convinced that this should be an error caught in naming"
 261   (* Naming converted the following from Happly's so use the Happly logic here*)
 262   | Aast.Hnonnull -> happly_helper (p, SN.Typehints.nonnull)
 263   | Aast.Harray _ -> happly_helper (p, SN.Typehints.array)
 264   | Aast.Hdarray _ -> happly_helper (p, SN.Typehints.darray)
 265   | Aast.Hvarray _ -> happly_helper (p, SN.Typehints.varray)
 266   | Aast.Hvarray_or_darray _ -> happly_helper (p, SN.Typehints.varray_or_darray)
 267   | Aast.Hprim prim -> happly_helper (p, prim_to_string prim)
 268   | Aast.Hthis -> happly_helper (p, SN.Typehints.this)
 269   | Aast.Hnothing -> happly_helper (p, SN.Typehints.nothing)
 270   | Aast.Habstr s -> happly_helper (p, s)
 271   | Aast.Hpu_access _ -> TC.make None []
 272
 273 and make_tc_with_flags_if_non_empty_flags
 274     ~kind ~tparams ~skipawaitable ~namespace t flags =
 275   let tc =
 276     hint_to_type_constraint ~kind ~tparams ~skipawaitable ~namespace t
 277   in
 278   let tc_name = TC.name tc in
 279   let tc_flags = TC.flags tc in
 280   match (tc_name, tc_flags) with
 281   | (None, []) -> tc
 282   | _ ->
 283     let tc_flags = List.stable_dedup (flags @ tc_flags) in
 284     TC.make tc_name tc_flags
 285
 286 let add_nullable ~nullable flags =
 287   if nullable then
 288     List.stable_dedup (TC.Nullable :: TC.DisplayNullable :: flags)
 289   else
 290     flags
 291
 292 let try_add_nullable ~nullable h flags =
 293   add_nullable ~nullable:(nullable && can_be_nullable h) flags
 294
 295 let make_type_info ~tparams ~namespace h tc_name tc_flags =
 296   let type_info_user_type = Some (fmt_hint ~tparams ~namespace h) in
 297   let type_info_type_constraint = TC.make tc_name tc_flags in
 298   Hhas_type_info.make type_info_user_type type_info_type_constraint
 299
 300 let param_hint_to_type_info
 301     ~kind ~skipawaitable ~nullable ~tparams ~namespace h =
 302   let is_simple_hint =
 303     match snd h with
 304     | Aast.Hsoft _
 305     | Aast.Hoption _
 306     | Aast.Haccess _
 307     | Aast.Hfun _
 308     | Aast.Happly (_, _ :: _)
 309     | Aast.Happly ((_, "dynamic"), [])
 310     | Aast.Happly ((_, "nonnull"), [])
 311     | Aast.Happly ((_, "mixed"), [])
 312     | Aast.Hdynamic
 313     | Aast.Hnonnull
 314     | Aast.Hmixed ->
 315       false
 316     (* I think Happly where id is in tparams is translated into Habstr *)
 317     | Aast.Habstr s when List.mem ~equal:( = ) tparams s -> false
 318     | Aast.Happly ((_, id), _) when List.mem ~equal:( = ) tparams id -> false
 319     | Aast.Herr
 320     | Aast.Hany ->
 321       failwith "Expected error on Tany in naming: param_hint_to_type_info"
 322     (* The following are based on Happly conversions in naming *)
 323     | Aast.Harray (Some _, Some _) -> false
 324     | Aast.Harray _ -> true
 325     | Aast.Hdarray _ -> false
 326     | Aast.Hvarray _ -> true
 327     | Aast.Hvarray_or_darray _ -> true
 328     | Aast.Hprim _ -> true
 329     | Aast.Hthis -> true
 330     | _ -> true
 331   in
 332   let tc =
 333     hint_to_type_constraint ~kind ~tparams ~skipawaitable ~namespace h
 334   in
 335   let tc_name = TC.name tc in
 336   if is_simple_hint then
 337     let tc_flags = try_add_nullable ~nullable h [TC.HHType] in
 338     make_type_info ~tparams ~namespace h tc_name tc_flags
 339   else
 340     let tc_flags = TC.flags tc in
 341     let tc_flags = try_add_nullable ~nullable h tc_flags in
 342     make_type_info ~tparams ~namespace h tc_name tc_flags
 343
 344 let hint_to_type_info ~kind ~skipawaitable ~nullable ~tparams ~namespace h =
 345   match kind with
 346   | Param ->
 347     param_hint_to_type_info
 348       ~kind
 349       ~skipawaitable
 350       ~nullable
 351       ~tparams
 352       ~namespace
 353       h
 354   | _ ->
 355     let tc =
 356       hint_to_type_constraint ~kind ~tparams ~skipawaitable ~namespace h
 357     in
 358     let tc_name = TC.name tc in
 359     let tc_flags = TC.flags tc in
 360     let tc_flags =
 361       if (kind = Return || kind = Property) && tc_name <> None then
 362         List.stable_dedup (TC.ExtendedHint :: tc_flags)
 363       else
 364         tc_flags
 365     in
 366     let tc_flags =
 367       if kind = TypeDef then
 368         add_nullable ~nullable tc_flags
 369       else
 370         try_add_nullable ~nullable h tc_flags
 371     in
 372     make_type_info ~tparams ~namespace h tc_name tc_flags
 373
 374 let hint_to_class ~namespace (h : Aast.hint) =
 375   match h with
 376   | (_, Aast.Happly (id, _)) ->
 377     let fq_id = Hhbc_id.Class.elaborate_id namespace id in
 378     fq_id
 379   | _ -> Hhbc_id.Class.from_raw_string "__type_is_not_class__"
 380
 381 let emit_type_constraint_for_native_function tparams ret ti =
 382   let user_type = Hhas_type_info.user_type ti in
 383   let (name, flags) =
 384     match (user_type, ret) with
 385     | (_, None)
 386     | (None, _) ->
 387       (Some "HH\\void", [TC.HHType; TC.ExtendedHint])
 388     | (Some t, _) when t = "HH\\mixed" || t = "callable" -> (None, [])
 389     | (Some t, Some ret) ->
 390       let strip_nullable n = String_utils.lstrip n "?" in
 391       let strip_soft n = String_utils.lstrip n "@" in
 392       let vanilla_name n = Hhbc_string_utils.strip_type_list n in
 393       let name =
 394         (* Strip twice since we don't know which one is coming first *)
 395         Some (vanilla_name @@ strip_nullable @@ strip_soft @@ strip_nullable t)
 396       in
 397       let flags = [TC.HHType; TC.ExtendedHint] in
 398       let rec get_flags (_, t) flags =
 399         match t with
 400         | Aast.Hoption x ->
 401           TC.Nullable :: TC.DisplayNullable :: get_flags x flags
 402         | Aast.Hsoft x -> TC.Soft :: get_flags x flags
 403         | Aast.Haccess _ -> TC.TypeConstant :: flags
 404         | Aast.Happly ((_, name), _) when List.mem ~equal:( = ) tparams name ->
 405           TC.TypeVar :: flags
 406         | _ -> flags
 407       in
 408       let flags = get_flags ret flags in
 409       (name, flags)
 410   in
 411   let tc = Hhas_type_constraint.make name flags in
 412   Hhas_type_info.make user_type tc