Normalize query expressions into ANF

test/test_type.ml

@@ -324,3 +324,94 @@ let specialize_cases =
         in
         check "no let bindings survive" (not (has_let program.Typed.tp_query_body)) );
   ]
+
+let anf text = Anf.program (specialize text)
+
+let anf_cases =
+  [
+    ( "the example query normalizes to a chain of collection temporaries",
+      fun () ->
+        Ident.reset ();
+        Anf.reset ();
+        let program = anf (read_fixture "expensive_order.delta") in
+        Anf.validate [ program.Anf.ap_input ] program.Anf.ap_query_body;
+        (match program.Anf.ap_query_body with
+        | { Anf.a = Anf.ALet (filter_temp, filter, { Anf.a = Anf.ALet (map_temp, mapper, tail); _ }); _ }
+          ->
+            check "the first temporary is a filter"
+              (match filter.Anf.a with Anf.AFilter _ -> true | _ -> false);
+            check "the second temporary is a map"
+              (match mapper.Anf.a with Anf.AMap _ -> true | _ -> false);
+            check "the query returns the map temporary"
+              (match tail.Anf.a with
+              | Anf.AAtom (Anf.AVar ident) -> Ident.equal ident map_temp
+              | _ -> false);
+            ignore filter_temp
+        | _ -> fail "shape" "expected two collection temporaries") );
+    ( "every operand of a sum is an atom",
+      fun () ->
+        Anf.reset ();
+        let program = anf (read_fixture "revenue.delta") in
+        Anf.validate [ program.Anf.ap_input ] program.Anf.ap_query_body;
+        (match program.Anf.ap_query_body with
+        | { Anf.a = Anf.ALet (_, mapped, { Anf.a = Anf.ALet (_, summed, _); _ }); _ } ->
+            check "map temporary" (match mapped.Anf.a with Anf.AMap _ -> true | _ -> false);
+            check "sum uses an atom operand" (match summed.Anf.a with Anf.ASum _ -> true | _ -> false)
+        | _ -> fail "shape" "expected a map temporary then a sum") );
+    ( "arithmetic arguments are bound to temporaries",
+      fun () ->
+        Anf.reset ();
+        let program = anf "input rows : collection int\nquery q = rows |> map (fun r -> r * 2 + r) |> sum\n" in
+        Anf.validate [ program.Anf.ap_input ] program.Anf.ap_query_body;
+        let dump = Anf.program_to_string program in
+        check "the dump binds a multiplication before the addition"
+          (Util.starts_with "input rows : collection int" dump);
+        check "the dump mentions the map operation" (String.length dump > 0) );
+    ( "anf dumps are deterministic",
+      fun () ->
+        Ident.reset ();
+        Types.reset ();
+        Anf.reset ();
+        let first = Anf.program_to_string (anf (read_fixture "count_large.delta")) in
+        Ident.reset ();
+        Types.reset ();
+        Anf.reset ();
+        let second = Anf.program_to_string (anf (read_fixture "count_large.delta")) in
+        check_equal_string "identical" first second );
+    ( "anf validation rejects duplicated binders",
+      fun () ->
+        let ident = Ident.fresh "x" Location.none in
+        let body =
+          Anf.{
+            a = ALet (ident, { a = AAtom (AInt 1); aty = Types.TInt; aspan = Location.none },
+                      { a = ALet (ident, { a = AAtom (AInt 2); aty = Types.TInt; aspan = Location.none },
+                                  { a = AAtom (AInt 3); aty = Types.TInt; aspan = Location.none });
+                        aty = Types.TInt; aspan = Location.none });
+            aty = Types.TInt;
+            aspan = Location.none;
+          }
+        in
+        (try
+           Anf.validate [] body;
+           fail "validate" "expected the invariant check to fail"
+         with Diagnostic.Error diagnostic ->
+           check "mentions a duplicated binder"
+             (Util.starts_with "anf invariant violated" diagnostic.Diagnostic.message)) );
+    ( "anf validation rejects unbound uses",
+      fun () ->
+        let unbound = Ident.fresh "missing" Location.none in
+        let body =
+          Anf.
+            {
+              a = AAtom (AVar unbound);
+              aty = Types.TInt;
+              aspan = Location.none;
+            }
+        in
+        (try
+           Anf.validate [] body;
+           fail "validate" "expected the invariant check to fail"
+         with Diagnostic.Error diagnostic ->
+           check "mentions an unbound variable"
+             (Util.starts_with "anf invariant violated" diagnostic.Diagnostic.message)) );
+  ]