Resolve bindings with fresh identifiers

test/test_main.ml

@@ -273,11 +273,111 @@ let program_cases =
             check "message is non empty" (String.length diagnostic.Diagnostic.message > 0) );
   ]
 
+let resolve_program text = Resolve.program (Parse.program text)
+
+let resolve_error text =
+  try
+    ignore (resolve_program text);
+    None
+  with Diagnostic.Error diagnostic -> Some diagnostic
+
+let resolve_cases =
+  [
+    ( "the required example resolves to fresh identifiers",
+      fun () ->
+        Ident.reset ();
+        let resolved = resolve_program (read_fixture "expensive_order.delta") in
+        check_equal_string "input binding" "orders" (Ident.name resolved.Resolve.rp_input);
+        check_equal_int "input stamp" 1 (Ident.stamp resolved.Resolve.rp_input) );
+    ( "shadowing binds a new identifier",
+      fun () ->
+        Ident.reset ();
+        let resolved = resolve_program "input rows : collection int\nquery q = let x = 1 in let x = x + 1 in x\n" in
+        let rec collect expr acc =
+          match expr.Resolve.r with
+          | Resolve.RLet (ident, bound, body) -> collect bound (ident :: acc) |> fun acc -> collect body acc
+          | _ -> acc
+        in
+        let binders = collect resolved.Resolve.rp_query_body [] in
+        match binders with
+        | [ outer; inner ] ->
+            check_equal_string "both binders are called x" "x" (Ident.name inner);
+            check "shadowed binders differ" (Ident.stamp outer <> Ident.stamp inner)
+        | _ -> fail "shadowing" "expected two let binders" );
+    ( "an unbound variable is reported with its span",
+      fun () ->
+        match
+          resolve_error "input rows : collection int\nquery q = rows |> filter (fun r -> totl > 1)\n"
+        with
+        | None -> fail "unbound" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message" "unbound variable `totl`" diagnostic.Diagnostic.message;
+            check_equal_string "span" "2:36-2:40" (Location.to_string diagnostic.Diagnostic.span) );
+    ( "the input collection is rejected inside a helper",
+      fun () ->
+        match resolve_error "input rows : collection int\nlet total = sum rows\nquery q = rows\n" with
+        | None -> fail "input use" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message"
+              "the input collection `rows` may only be used in the query, not inside a helper function"
+              diagnostic.Diagnostic.message );
+    ( "duplicate helper names are rejected",
+      fun () ->
+        match resolve_error "input rows : collection int\nlet f n = n\nlet f n = n + 1\nquery q = rows\n" with
+        | None -> fail "duplicate" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message" "duplicate helper function `f`, first declared at 2:1-2:12"
+              diagnostic.Diagnostic.message );
+    ( "duplicate record names are rejected",
+      fun () ->
+        match resolve_error "type r = { a : int }\ntype r = { b : int }\ninput rows : collection r\nquery q = rows\n" with
+        | None -> fail "duplicate" "expected a diagnostic"
+        | Some diagnostic ->
+            check "message is non empty" (String.length diagnostic.Diagnostic.message > 0);
+            check_equal_string "line" "2"
+              (string_of_int diagnostic.Diagnostic.span.Location.start.Location.line) );
+    ( "field labels must be globally unique",
+      fun () ->
+        match resolve_error "type a = { x : int }\ntype b = { x : int }\ninput rows : collection a\nquery q = rows\n" with
+        | None -> fail "labels" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message"
+              "duplicate field label `x`, already declared in record `a`; field labels must be globally unique"
+              diagnostic.Diagnostic.message );
+    ( "recursive helpers are rejected",
+      fun () ->
+        match resolve_error "input rows : collection int\nlet f n = f n\nquery q = rows\n" with
+        | None -> fail "recursion" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message"
+              "helper function `f` is recursive; recursive definitions are not supported"
+              diagnostic.Diagnostic.message );
+    ( "mutually recursive helpers are rejected",
+      fun () ->
+        match resolve_error "input rows : collection int\nlet f n = g n\nlet g n = f n\nquery q = rows\n" with
+        | None -> fail "recursion" "expected a diagnostic"
+        | Some diagnostic ->
+            check "message is non empty" (String.length diagnostic.Diagnostic.message > 0) );
+    ( "duplicate parameters are rejected",
+      fun () ->
+        match resolve_error "input rows : collection int\nlet f n n = n\nquery q = rows\n" with
+        | None -> fail "parameters" "expected a diagnostic"
+        | Some diagnostic -> check_equal_string "message" "duplicate parameter `n`" diagnostic.Diagnostic.message );
+    ( "helpers may call other helpers",
+      fun () ->
+        let resolved =
+          resolve_program
+            "input rows : collection int\nlet double n = n + n\nlet quad n = double (double n)\nquery q = rows |> map (fun r -> quad r)\n"
+        in
+        check_equal_int "two helpers" 2 (List.length resolved.Resolve.rp_helpers) );
+  ]
+
 let () =
   Test_harness.run_suite "location" location_cases;
   Test_harness.run_suite "ident" ident_cases;
   Test_harness.run_suite "diagnostic" diagnostic_cases;
   Test_harness.run_suite "parse" parse_cases;
   Test_harness.run_suite "program" program_cases;
+  Test_harness.run_suite "resolve" resolve_cases;
   Printf.printf "%d cases, %d failures\n" (Test_harness.case_count ()) (Test_harness.failure_count ());
   exit (if Test_harness.failure_count () = 0 then 0 else 1)