Type record projections and collection operators

src/infer.ml

@@ -227,6 +227,13 @@ let rec infer env syntax =
       Typed.make (Typed.TBinop (Syntax.Sub, Typed.make (Typed.TInt 0) Types.TInt span, operand)) Types.TInt span
   | Resolve.RTuple items ->
       let items = List.map (infer env) items in
+      List.iter
+        (fun item ->
+          if contains_collection item.Typed.ty then
+            Diagnostic.error item.Typed.tspan
+              "collections may not appear inside tuples, but this component has type %s"
+              (Types.pp item.Typed.ty))
+        items;
       Typed.make (Typed.TTuple items) (Types.TTuple (List.map (fun item -> item.Typed.ty) items)) span
   | Resolve.RRecord fields -> infer_record env span fields
   | Resolve.RField (record, label) ->
@@ -234,15 +241,32 @@ let rec infer env syntax =
       (match Util.assoc_opt label env.ctx.Types.labels with
       | None -> Diagnostic.error span "no record type declares a field named `%s`" label
       | Some (name, field_ty) ->
-          Types.unify span record.Typed.ty (Types.TRecord name);
+          (match Types.repr record.Typed.ty with
+          | Types.TRecord actual when actual = name -> ()
+          | Types.TVar _ -> Types.unify span record.Typed.ty (Types.TRecord name)
+          | other ->
+              Diagnostic.error span "cannot project field `%s` from a value of type %s" label
+                (Types.pp other));
           Typed.make (Typed.TField (record, label)) field_ty span)
 
+and infer_function env element argument =
+  match argument.Resolve.r with
+  | Resolve.RLambda (ident, body) ->
+      let body = infer (bind env ident (scheme_of element)) body in
+      Typed.make (Typed.TLambda (ident, body)) (Types.TArrow (element, body.Typed.ty))
+        argument.Resolve.rspan
+  | _ ->
+      let fn = infer env argument in
+      let result = Types.fresh_var () in
+      Types.unify argument.Resolve.rspan fn.Typed.ty (Types.TArrow (element, result));
+      fn
+
 and infer_filter env span predicate collection =
   let collection = infer env collection in
   let element = Types.fresh_var () in
   Types.unify collection.Typed.tspan collection.Typed.ty (Types.TCollection element);
   check_element collection.Typed.tspan "filter element" element;
-  let predicate = infer env predicate in
+  let predicate = infer_function env element predicate in
   Types.unify predicate.Typed.tspan predicate.Typed.ty (Types.TArrow (element, Types.TBool));
   Typed.make (Typed.TFilter (collection, predicate)) collection.Typed.ty span
 
@@ -251,7 +275,7 @@ and infer_map env span projection collection =
   let element = Types.fresh_var () in
   Types.unify collection.Typed.tspan collection.Typed.ty (Types.TCollection element);
   check_element collection.Typed.tspan "map element" element;
-  let projection = infer env projection in
+  let projection = infer_function env element projection in
   let result = Types.fresh_var () in
   Types.unify projection.Typed.tspan projection.Typed.ty (Types.TArrow (element, result));
   check_element projection.Typed.tspan "mapped element" result;

test/test_type.ml

@@ -59,7 +59,7 @@ let cases =
             infer_program "input rows : collection int\nlet f n = n + 1\nquery q = rows |> map (fun r -> f \"a\")\n") );
     ( "projection on a non record is rejected",
       fun () ->
-        check_message "projection" "type mismatch: expected order but got int"
+        check_message "projection" "cannot project field `total` from a value of type int"
           (fun () ->
             infer_program
               "type order = { total : int }\ninput rows : collection int\nquery q = rows |> map (fun r -> r.total)\n") );
@@ -157,4 +157,55 @@ let cases =
         Ident.reset ();
         let second = Typed.program_to_string (infer_program (read_fixture "expensive_order.delta")) in
         check_equal_string "identical dumps" first second );
+    ( "nested record projections are typed",
+      fun () ->
+        let program =
+          infer_program
+            "type inner = { amount : int }\ntype outer = { inner : inner; label : string }\ninput rows : collection outer\nquery q = rows |> map (fun r -> (r.inner.amount, r.label))\n"
+        in
+        check_equal_string "query type" "collection (int, string)"
+          (Types.pp program.Typed.tp_query_body.Typed.ty) );
+    ( "projecting a field of another record is rejected",
+      fun () ->
+        check_message "wrong record" "cannot project field `amount` from a value of type outer"
+          (fun () ->
+            infer_program
+              "type inner = { amount : int }\ntype outer = { inner : inner }\ninput rows : collection outer\nquery q = rows |> map (fun r -> r.amount)\n") );
+    ( "projecting from a scalar is rejected",
+      fun () ->
+        check_message "scalar projection" "cannot project field `amount` from a value of type int"
+          (fun () ->
+            infer_program
+              "type inner = { amount : int }\ninput rows : collection int\nquery q = rows |> map (fun r -> r.amount)\n") );
+    ( "a filter predicate must return bool",
+      fun () ->
+        check_message "predicate type" "type mismatch: expected int but got bool"
+          (fun () ->
+            infer_program
+              "type order = { total : int }\ninput rows : collection order\nquery q = rows |> filter (fun r -> r.total)\n") );
+    ( "a map projection may not return a function",
+      fun () ->
+        check_message "function element" "collections of functions are not supported: mapped element"
+          (fun () ->
+            infer_program
+              "input rows : collection int\nquery q = rows |> map (fun r -> fun x -> r + x)\n") );
+    ( "collections may not appear inside tuples",
+      fun () ->
+        check_message "collection in tuple"
+          "collections may not appear inside tuples, but this component has type collection int"
+          (fun () -> infer_program "input rows : collection int\nquery q = (rows, 1)\n") );
+    ( "a collection cannot be stored in a record field",
+      fun () ->
+        check_message "collection in record" "type mismatch: expected collection int but got int"
+          (fun () ->
+            infer_program
+              "type box = { items : int }\ninput rows : collection int\nquery q = rows |> map (fun r -> { items = rows })\n") );
+    ( "filter and map over a helper name are typed",
+      fun () ->
+        let program =
+          infer_program
+            "type order = { total : int }\ninput rows : collection order\nlet big o = o.total > 1000\nlet value o = o.total\nquery q = rows |> filter big |> map value\n"
+        in
+        check_equal_string "query type" "collection int"
+          (Types.pp program.Typed.tp_query_body.Typed.ty) );
   ]