Allow extension to work with (shallow) temporal projections

We don't have the full generality due to links-lang#1130, but this patch should allow record extension to be used on temporal projections on variables / record literals.
SimonJF · Apr 1, 2022 · 3383fe3 · 3383fe3
1 parent 2b5d2ae
commit 3383fe3
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 10 deletions.
diff --git a/core/query/query.ml b/core/query/query.ml
@@ -259,20 +259,33 @@ struct
   | Q.Apply (Q.Primitive "AsListT", [xs])
   | Q.Apply (Q.Primitive "AsListV", [xs]) -> xs
   (* Temporal projection operations *)
-  (* Note: These should already all be eta-expanded, so we can
-     treat them as record literals. *)
   | Q.Apply (Q.Primitive "ttData", [x])
   | Q.Apply (Q.Primitive "vtData", [x]) ->
-        Q.unbox_record x
-        |> StringMap.find TemporalField.data_field
+    begin
+        match x with
+            | Q.Record r ->
+                StringMap.find TemporalField.data_field r
+            | _ ->
+                Q.Project (x, TemporalField.data_field)
+    end
   | Q.Apply (Q.Primitive "ttFrom", [x])
   | Q.Apply (Q.Primitive "vtFrom", [x]) ->
-        Q.unbox_record x
-        |> StringMap.find TemporalField.from_field
+      begin
+        match x with
+            | Q.Record r ->
+                StringMap.find TemporalField.from_field r
+            | _ ->
+                Q.Project (x, TemporalField.from_field)
+      end
   | Q.Apply (Q.Primitive "ttTo", [x])
   | Q.Apply (Q.Primitive "vtTo", [x]) ->
-        Q.unbox_record x
-        |> StringMap.find TemporalField.to_field
+      begin
+        match x with
+            | Q.Record r ->
+                StringMap.find TemporalField.to_field r
+            | _ ->
+                Q.Project (x, TemporalField.to_field)
+      end
   | u -> u
 
   let rec xlate env : Ir.value -> Q.t = let open Ir in function

diff --git a/core/query/temporalQuery.ml b/core/query/temporalQuery.ml
@@ -784,18 +784,23 @@ module TemporalJoin = struct
 
       method private set_tables tbls = {< tables = tbls >}
 
+      method private project tbl field =
+          match tbl with
+            | Q.Record x -> StringMap.find field x
+            | _ -> Q.Project (tbl, field)
+
       (* Start time: maximum of all start times *)
       method start_time =
         let open Q in
         List.fold_right (fun (tbl_var, start_time, _) expr ->
-          Apply (Primitive "greatest", [Project (tbl_var, start_time); expr])
+          Apply (Primitive "greatest", [o#project tbl_var start_time; expr])
         ) tables (Constant Constant.DateTime.beginning_of_time)
 
       (* End time: minimum of all end times *)
       method end_time =
         let open Q in
         List.fold_right (fun (tbl_var, _, end_time) expr ->
-          Apply (Primitive "least", [Project (tbl_var, end_time); expr])
+          Apply (Primitive "least", [o#project tbl_var end_time; expr])
         ) tables (Q.Constant forever_const)
 
       method! query =