From 309174646753239e1d24d120fc7c330f62b4134d Mon Sep 17 00:00:00 2001 From: sneeker Date: Thu, 9 Feb 2017 09:54:00 +0000 Subject: [PATCH] Type record projections and collection operators --- src/infer.ml | 30 ++++++++++++++++++++++++--- test/test_type.ml | 53 ++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 79 insertions(+), 4 deletions(-) diff --git a/src/infer.ml b/src/infer.ml index 4404a18..1cecdee 100644 --- a/src/infer.ml +++ b/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; diff --git a/test/test_type.ml b/test/test_type.ml index b1abc53..c703945 100644 --- a/test/test_type.ml +++ b/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) ); ]