Implement typing for optional shape fields

Summary:
This diff models typing for optional shape fields.

= Model

These fields are modeled as follows:

```name=typing_defs.ml,lang=ocaml
'phase shape_field_type = {
  sft_optional : bool;
  sft_ty : 'phase ty;
}
```

And integrated into the existing type structure as follows:

```name=typing_defs.ml,lang=diff
ty_ = (* ...existing types... *)
  | Tshape :
      shape_fields_known *
-     ('phase ty Nast.ShapeMap.t)
+     ('phase shape_field_type Nast.ShapeMap.t)
      -> 'phase ty_
```

= Justification

There were two reasonable ways of modeling optional shape fields:

  # `Tshape` remains unchanged, and a new toplevel type `Toptional_shape_field` is introduced.
  # `Tshape` is changed to hold `shape_field_type`s that explicitly denote whether they are optional or not.

I have opted for #2.

Choice #1 has these trade-offs:

  # (good) The shape handling code remains unchanged.
  # (ok/good) `Tshape` is symmetric in a sense, and does not need additional handling logic. Handling logic can be placed closer to where toplevel processing for `ty` appears.
  # (bad) **Everywhere** that a `ty` is processed, a new case has to be added to handle the optional shape field. In most of these cases, optional shape fields are not even logically possible!
  # (extremely bad) There is special casing logic that needs to be written for optional shape fields, and this logic must be done **in the context of a `Tshape`**. This design would break the abstraction, forcing us to push through `Tshape` information to the toplevel processing for `ty`.

Choice #2 has these trade-offs:

  # (good) An `shape_field_type` may //only// appear in the context of a `Tshape`. We will never process an `shape_field_type` in a place where it's not logically possible. Consequently, the processing always has visibility to the `Tshape` of which the `shape_field_type` is a part of.
  # (good) This design forces the developer to handle processing for `shape_field_type`s when processing a `Tshape`. It will be very hard to "forget" to handle this case, since it will be enforced by the type system.
  # (bad) It turns out there are lots of places that don't care about whether a type is optional or not. These points in the code now have to be filled with boilerplate to unwrap the `ty` from the `shape_field_type`.

= Conclusion

Whereas #1 has serious logic and maintainability concerns, #2 really just has concerns related to code cleanliness. Additionally, to handle those code cleanliness concerns, I created the `typing_helpers` library to handle patterns that occurred repeatedly in this diff.

= Other notes

There are lots of locations in this diff where I'm not completely sure what's going on. Please let me know if there are any areas that look suspect. If things do in fact look off, it might be useful for us to go through some parts of the diff in person. Since the existing typecheck tests and the new ones for the optional shape fields all pass, I'm reasonably confident that there's not a regression, but I can't be sure.

Reviewed By: dlreeves

Differential Revision: D4563246

fbshipit-source-id: da8d446429351bf804c0485335c29ab83fd049da

hphp/hack/src/decl/decl_hint.ml

@@ -21,9 +21,8 @@ let rec hint env (p, h) =
   let h = hint_ p env h in
   Typing_reason.Rhint p, h
 
-(* TODO(tingley): Record the optional status and use this to reconcile types. *)
-and shape_field_info_to_shape_field_type env { sfi_optional=_; sfi_hint } =
-  hint env sfi_hint
+and shape_field_info_to_shape_field_type env { sfi_optional; sfi_hint } =
+  { sft_optional = sfi_optional; sft_ty = hint env sfi_hint }
 
 and hint_ p env = function
   | Hany -> Tany

hphp/hack/src/decl/decl_instantiate.ml

@@ -100,7 +100,7 @@ and instantiate_ subst x =
       let tyl = List.map tyl (instantiate subst) in
       Tapply (x, tyl)
   | Tshape (fields_known, fdm) ->
-      let fdm = Nast.ShapeMap.map (instantiate subst) fdm in
+      let fdm = ShapeFieldMap.map (instantiate subst) fdm in
       Tshape (fields_known, fdm)
 
 let instantiate_ce subst ({ ce_type = x; _ } as ce) =

hphp/hack/src/decl/decl_pos_utils.ml

@@ -1,12 +1,12 @@
 (**
- * Copyright (c) 2015, Facebook, Inc.
- * All rights reserved.
- *
- * This source code is licensed under the BSD-style license found in the
- * LICENSE file in the "hack" directory of this source tree. An additional grant
- * of patent rights can be found in the PATENTS file in the same directory.
- *
- *)
+* Copyright (c) 2015, Facebook, Inc.
+* All rights reserved.
+*
+* This source code is licensed under the BSD-style license found in the
+* LICENSE file in the "hack" directory of this source tree. An additional grant
+* of patent rights can be found in the PATENTS file in the same directory.
+*
+*)
 
 open Core
 open Decl_defs
@@ -16,74 +16,74 @@ module ShapeMap = Nast.ShapeMap
 
 (*****************************************************************************)
 (* Functor traversing a type, but applies a user defined function for
- * positions.
- *)
+* positions.
+*)
 (*****************************************************************************)
 module TraversePos(ImplementPos: sig val pos: Pos.t -> Pos.t end) = struct
-  open Typing_reason
-
-  let pos = ImplementPos.pos
-
-  let rec reason = function
-    | Rnone                  -> Rnone
-    | Rwitness p             -> Rwitness (pos p)
-    | Ridx (p, r)            -> Ridx (pos p, reason r)
-    | Ridx_vector p          -> Ridx_vector (pos p)
-    | Rappend p              -> Rappend (pos p)
-    | Rfield p               -> Rfield (pos p)
-    | Rforeach p             -> Rforeach (pos p)
-    | Rasyncforeach p        -> Rasyncforeach (pos p)
-    | Raccess p              -> Raccess (pos p)
-    | Rarith p               -> Rarith (pos p)
-    | Rarith_ret p           -> Rarith_ret (pos p)
-    | Rarray_plus_ret p      -> Rarray_plus_ret (pos p)
-    | Rstring2 p             -> Rstring2 (pos p)
-    | Rcomp p                -> Rcomp (pos p)
-    | Rconcat p              -> Rconcat (pos p)
-    | Rconcat_ret p          -> Rconcat_ret (pos p)
-    | Rlogic p               -> Rlogic (pos p)
-    | Rlogic_ret p           -> Rlogic_ret (pos p)
-    | Rbitwise p             -> Rbitwise (pos p)
-    | Rbitwise_ret p         -> Rbitwise_ret (pos p)
-    | Rstmt p                -> Rstmt (pos p)
-    | Rno_return p           -> Rno_return (pos p)
-    | Rno_return_async p     -> Rno_return_async (pos p)
-    | Rret_fun_kind (p, k)   -> Rret_fun_kind (pos p, k)
-    | Rhint p                -> Rhint (pos p)
-    | Rnull_check p          -> Rnull_check (pos p)
-    | Rnot_in_cstr p         -> Rnot_in_cstr (pos p)
-    | Rthrow p               -> Rthrow (pos p)
-    | Rplaceholder p         -> Rplaceholder (pos p)
-    | Rattr p                -> Rattr (pos p)
-    | Rxhp p                 -> Rxhp (pos p)
-    | Rret_div p             -> Rret_div (pos p)
-    | Ryield_gen p           -> Ryield_gen (pos p)
-    | Ryield_asyncgen p      -> Ryield_asyncgen (pos p)
-    | Ryield_asyncnull p     -> Ryield_asyncnull (pos p)
-    | Ryield_send p          -> Ryield_send (pos p)
-    | Rlost_info (s, r1, p2) -> Rlost_info (s, reason r1, pos p2)
-    | Rcoerced (p1, p2, x)   -> Rcoerced (pos p1, pos p2, x)
-    | Rformat (p1, s, r)     -> Rformat (pos p1, s, reason r)
-    | Rclass_class (p, s)    -> Rclass_class (pos p, s)
-    | Runknown_class p       -> Runknown_class (pos p)
-    | Rdynamic_yield (p1, p2, s1, s2) -> Rdynamic_yield(pos p1, pos p2, s1, s2)
-    | Rmap_append p          -> Rmap_append (pos p)
-    | Rvar_param p           -> Rvar_param (pos p)
-    | Runpack_param p        -> Runpack_param (pos p)
-    | Rinstantiate (r1,x,r2) -> Rinstantiate (reason r1, x, reason r2)
-    | Rarray_filter (p, r)   -> Rarray_filter (pos p, reason r)
-    | Rtype_access (r1, x, r2) -> Rtype_access (reason r1, x, reason r2)
-    | Rexpr_dep_type (r, p, n) -> Rexpr_dep_type (reason r, pos p, n)
-    | Rnullsafe_op p           -> Rnullsafe_op (pos p)
-    | Rtconst_no_cstr (p, s)   -> Rtconst_no_cstr (pos p, s)
-    | Rused_as_map p           -> Rused_as_map (pos p)
-    | Rused_as_shape p         -> Rused_as_shape (pos p)
-    | Rpredicated (p, f)       -> Rpredicated (pos p, f)
-    | Rinstanceof (p, f)       -> Rinstanceof (pos p, f)
-  let string_id (p, x) = pos p, x
-
-  let rec ty (p, x) =
-    reason p, ty_ x
+open Typing_reason
+
+let pos = ImplementPos.pos
+
+let rec reason = function
+  | Rnone                  -> Rnone
+  | Rwitness p             -> Rwitness (pos p)
+  | Ridx (p, r)            -> Ridx (pos p, reason r)
+  | Ridx_vector p          -> Ridx_vector (pos p)
+  | Rappend p              -> Rappend (pos p)
+  | Rfield p               -> Rfield (pos p)
+  | Rforeach p             -> Rforeach (pos p)
+  | Rasyncforeach p        -> Rasyncforeach (pos p)
+  | Raccess p              -> Raccess (pos p)
+  | Rarith p               -> Rarith (pos p)
+  | Rarith_ret p           -> Rarith_ret (pos p)
+  | Rarray_plus_ret p      -> Rarray_plus_ret (pos p)
+  | Rstring2 p             -> Rstring2 (pos p)
+  | Rcomp p                -> Rcomp (pos p)
+  | Rconcat p              -> Rconcat (pos p)
+  | Rconcat_ret p          -> Rconcat_ret (pos p)
+  | Rlogic p               -> Rlogic (pos p)
+  | Rlogic_ret p           -> Rlogic_ret (pos p)
+  | Rbitwise p             -> Rbitwise (pos p)
+  | Rbitwise_ret p         -> Rbitwise_ret (pos p)
+  | Rstmt p                -> Rstmt (pos p)
+  | Rno_return p           -> Rno_return (pos p)
+  | Rno_return_async p     -> Rno_return_async (pos p)
+  | Rret_fun_kind (p, k)   -> Rret_fun_kind (pos p, k)
+  | Rhint p                -> Rhint (pos p)
+  | Rnull_check p          -> Rnull_check (pos p)
+  | Rnot_in_cstr p         -> Rnot_in_cstr (pos p)
+  | Rthrow p               -> Rthrow (pos p)
+  | Rplaceholder p         -> Rplaceholder (pos p)
+  | Rattr p                -> Rattr (pos p)
+  | Rxhp p                 -> Rxhp (pos p)
+  | Rret_div p             -> Rret_div (pos p)
+  | Ryield_gen p           -> Ryield_gen (pos p)
+  | Ryield_asyncgen p      -> Ryield_asyncgen (pos p)
+  | Ryield_asyncnull p     -> Ryield_asyncnull (pos p)
+  | Ryield_send p          -> Ryield_send (pos p)
+  | Rlost_info (s, r1, p2) -> Rlost_info (s, reason r1, pos p2)
+  | Rcoerced (p1, p2, x)   -> Rcoerced (pos p1, pos p2, x)
+  | Rformat (p1, s, r)     -> Rformat (pos p1, s, reason r)
+  | Rclass_class (p, s)    -> Rclass_class (pos p, s)
+  | Runknown_class p       -> Runknown_class (pos p)
+  | Rdynamic_yield (p1, p2, s1, s2) -> Rdynamic_yield(pos p1, pos p2, s1, s2)
+  | Rmap_append p          -> Rmap_append (pos p)
+  | Rvar_param p           -> Rvar_param (pos p)
+  | Runpack_param p        -> Runpack_param (pos p)
+  | Rinstantiate (r1,x,r2) -> Rinstantiate (reason r1, x, reason r2)
+  | Rarray_filter (p, r)   -> Rarray_filter (pos p, reason r)
+  | Rtype_access (r1, x, r2) -> Rtype_access (reason r1, x, reason r2)
+  | Rexpr_dep_type (r, p, n) -> Rexpr_dep_type (reason r, pos p, n)
+  | Rnullsafe_op p           -> Rnullsafe_op (pos p)
+  | Rtconst_no_cstr (p, s)   -> Rtconst_no_cstr (pos p, s)
+  | Rused_as_map p           -> Rused_as_map (pos p)
+  | Rused_as_shape p         -> Rused_as_shape (pos p)
+  | Rpredicated (p, f)       -> Rpredicated (pos p, f)
+  | Rinstanceof (p, f)       -> Rinstanceof (pos p, f)
+let string_id (p, x) = pos p, x
+
+let rec ty (p, x) =
+  reason p, ty_ x
 
   and ty_: decl ty_ -> decl ty_ = function
     | Tany
@@ -103,7 +103,7 @@ module TraversePos(ImplementPos: sig val pos: Pos.t -> Pos.t end) = struct
         Taccess (ty root_ty, List.map ids string_id)
     | Tshape (fields_known, fdm) ->
         Tshape (shape_fields_known fields_known,
-          ShapeMap.map_and_rekey fdm shape_field_name ty)
+          ShapeFieldMap.map_and_rekey fdm shape_field_name ty)
 
   and ty_opt x = Option.map x ty
 

hphp/hack/src/typing/type_mapper.ml

@@ -49,7 +49,11 @@ class type type_mapper_type = object
   method on_tclass : env -> Reason.t -> Nast.sid -> locl ty list -> result
   method on_tobject : env -> Reason.t -> result
   method on_tshape :
-    env -> Reason.t -> shape_fields_known -> locl ty Nast.ShapeMap.t -> result
+    env
+      -> Reason.t
+      -> shape_fields_known
+      -> locl shape_field_type Nast.ShapeMap.t
+      -> result
 
   method on_type : env -> locl ty -> result
 end
@@ -179,7 +183,7 @@ class deep_type_mapper = object(this)
     let env, tyl = List.map_env env tyl this#on_type in
     env, (r, Tclass (x, tyl))
   method! on_tshape env r fields_known fdm =
-    let env, fdm = Nast.ShapeMap.map_env this#on_type env fdm in
+    let env, fdm = ShapeFieldMap.map_env this#on_type env fdm in
     env, (r, Tshape (fields_known, fdm))
 
   method private on_opt_type env x = match x with

hphp/hack/src/typing/type_visitor.ml

@@ -31,7 +31,11 @@ class type ['a] type_visitor_type = object
   method on_tunresolved : 'a -> Reason.t -> locl ty list -> 'a
   method on_tobject : 'a -> Reason.t -> 'a
   method on_tshape :
-    'a -> Reason.t -> shape_fields_known -> 'b ty Nast.ShapeMap.t -> 'a
+    'a
+      -> Reason.t
+      -> shape_fields_known
+      -> 'b shape_field_type Nast.ShapeMap.t
+      -> 'a
   method on_taccess : 'a -> Reason.t -> taccess_type -> 'a
   method on_tclass : 'a -> Reason.t -> Nast.sid -> locl ty list -> 'a
   method on_tarraykind : 'a -> Reason.t -> array_kind -> 'a
@@ -77,9 +81,9 @@ class virtual ['a] type_visitor : ['a] type_visitor_type = object(this)
   method on_tunresolved acc _ tyl = List.fold_left tyl ~f:this#on_type ~init:acc
   method on_tobject acc _ = acc
   method on_tshape: type a. _ -> Reason.t -> shape_fields_known
-    -> a ty Nast.ShapeMap.t -> _ =
+    -> a shape_field_type Nast.ShapeMap.t -> _ =
     fun acc _ _ fdm ->
-    let f _ v acc = this#on_type acc v in
+    let f _ { sft_ty; _ } acc = this#on_type acc sft_ty in
     Nast.ShapeMap.fold f fdm acc
   method on_tclass acc _ _ tyl =
     List.fold_left tyl ~f:this#on_type ~init:acc

hphp/hack/src/typing/typing.ml

@@ -163,7 +163,7 @@ let rec check_memoizable env param ty =
   | _, Tshape (_, fdm) ->
     ShapeMap.iter begin fun name _ ->
       match ShapeMap.get name fdm with
-        | Some ty -> check_memoizable env param ty
+        | Some { sft_ty; _ } -> check_memoizable env param sft_ty
         | None ->
             let ty_str = Typing_print.error (snd ty) in
             let msgl = Reason.to_string ("This is "^ty_str) (fst ty) in
@@ -1621,9 +1621,12 @@ and expr_
           (fun env e -> let env, te, ty = expr env e in env, (te,ty))
           env fdm in
       let env, fdm =
-        ShapeMap.map_env
-          (fun env (_,ty) -> TUtils.unresolved env ty)
-          env tfdm in
+        let convert_expr_and_type_to_shape_field_type env (_, ty) =
+          let env, sft_ty = TUtils.unresolved env ty in
+          (* An expression evaluation always corresponds to a shape_field_type
+             with sft_optional = false. *)
+          env, { sft_optional = false; sft_ty } in
+        ShapeMap.map_env convert_expr_and_type_to_shape_field_type env tfdm in
       let env = check_shape_keys_validity env p (ShapeMap.keys fdm) in
       (* Fields are fully known, because this shape is constructed
        * using shape keyword and we know exactly what fields are set. *)
@@ -2962,7 +2965,7 @@ and array_get is_lvalue p env ty1 e2 ty2 =
           Errors.undefined_field
             p (TUtils.get_printable_shape_field_name field);
           env, (Reason.Rwitness p, Terr)
-        | Some ty -> env, ty)
+        | Some { sft_ty; _ } -> env, sft_ty)
     )
   | Toption _ ->
       Errors.null_container p

hphp/hack/src/typing/typing_arrays.ml

@@ -203,7 +203,13 @@ let update_array_type p access_type ~lvar_assignment env ty =
     method! on_tshape env r fields_known fdm =
       match access_type with
         | AKshape_key field_name when lvar_assignment ->
-          let env, tv = Env.fresh_unresolved_type env in
+          let env, sft_ty = Env.fresh_unresolved_type env in
+          (* When we assign to a shape, like:
+           *
+           *   $shape['field'] = // some type
+           *
+           * We want to infer the shape field as non-optional. *)
+          let tv = { sft_optional = false; sft_ty } in
           let fdm = ShapeMap.add field_name tv fdm in
           env, (Reason.Rwitness p, Tshape (fields_known, fdm))
         | _ ->

hphp/hack/src/typing/typing_defs.ml

@@ -30,6 +30,20 @@ type decl = private DeclPhase
 type locl = private LoclPhase
 
 type 'phase ty = Reason.t * 'phase ty_
+
+(* A shape may specify whether or not fields are required. For example, consider
+   this typedef:
+
+     type ShapeWithOptionalField = shape(?'a' => ?int);
+
+   With this definition, the field 'a' may be unprovided in a shape. In this
+   case, the field 'a' would have sf_optional set to true.
+   *)
+and 'phase shape_field_type = {
+  sft_optional : bool;
+  sft_ty : 'phase ty;
+}
+
 and _ ty_ =
   (*========== Following Types Exist Only in the Declared Phase ==========*)
   (* The late static bound type of a class *)
@@ -108,7 +122,9 @@ and _ ty_ =
   (* Whether all fields of this shape are known, types of each of the
    * known arms.
    *)
-  | Tshape : shape_fields_known * ('phase ty Nast.ShapeMap.t) -> 'phase ty_
+  | Tshape
+    : shape_fields_known * ('phase shape_field_type Nast.ShapeMap.t)
+      -> 'phase ty_
 
   (*========== Below Are Types That Cannot Be Declared In User Code ==========*)
 
@@ -493,6 +509,43 @@ module AbstractKind = struct
        String.concat "::" (dt::ids)
 end
 
+module ShapeFieldMap = struct
+  include Nast.ShapeMap
+
+  let map_and_rekey shape_map key_f value_f =
+    let f_over_shape_field_type ({ sft_ty; _ } as shape_field_type) =
+      { shape_field_type with sft_ty = value_f sft_ty } in
+    Nast.ShapeMap.map_and_rekey
+      shape_map
+      key_f
+      f_over_shape_field_type
+
+  let map_env f env shape_map =
+    let f_over_shape_field_type env ({ sft_ty; _ } as shape_field_type) =
+      let env, sft_ty = f env sft_ty in
+      env, { shape_field_type with sft_ty } in
+    Nast.ShapeMap.map_env f_over_shape_field_type env shape_map
+
+  let map f shape_map = map_and_rekey shape_map (fun x -> x) f
+
+  let iter f shape_map =
+    let f_over_shape_field_type shape_map_key { sft_ty; _ } =
+      f shape_map_key sft_ty in
+    Nast.ShapeMap.iter f_over_shape_field_type shape_map
+
+  let iter_values f = iter (fun _ -> f)
+end
+
+module ShapeFieldList = struct
+  include Core.List
+
+  let map_env env xs ~f =
+    let f_over_shape_field_type env ({ sft_ty; _ } as shape_field_type) =
+      let env, sft_ty = f env sft_ty in
+      env, { shape_field_type with sft_ty } in
+    Core.List.map_env env xs ~f:f_over_shape_field_type
+end
+
 (*****************************************************************************)
 (* Suggest mode *)
 (*****************************************************************************)

hphp/hack/src/typing/typing_generic.ml

@@ -60,7 +60,7 @@ end = struct
     | Tunresolved tyl -> List.iter tyl ty
     | Tobject -> ()
     | Tshape (_, fdm) ->
-        ShapeMap.iter (fun _ v -> ty v) fdm
+        ShapeFieldMap.iter (fun _ v -> ty v) fdm
 
   and ty_opt = function None -> () | Some x -> ty x
 

hphp/hack/src/typing/typing_phase.ml

@@ -173,7 +173,7 @@ let rec localize_with_env ~ety_env env (dty: decl ty) =
       let env, root_ty = localize ~ety_env env root_ty in
       TUtils.expand_typeconst ety_env env r root_ty ids
   | r, Tshape (fields_known, tym) ->
-      let env, tym = ShapeMap.map_env (localize ~ety_env) env tym in
+      let env, tym = ShapeFieldMap.map_env (localize ~ety_env) env tym in
       env, (ety_env, (r, Tshape (fields_known, tym)))
 
 and localize ~ety_env env ty =