Allow record extension in presence of temporal projections (links-lan…

…g#1129) * Allow record extension in presence of temporal projections This allows record extension to play nicely with temporal projections. I was forgetting that all arguments to reduce_artifacts are already eta-expanded, so we can work with record literals. Fixes links-lang#1124. * 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.
Orbion-J · Jul 8, 2022 · ad675a0 · ad675a0
1 parent 17d2dbd
commit ad675a0
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 5 deletions.
diff --git a/core/query/query.ml b/core/query/query.ml
@@ -261,13 +261,31 @@ struct
   (* Temporal projection operations *)
   | Q.Apply (Q.Primitive "ttData", [x])
   | Q.Apply (Q.Primitive "vtData", [x]) ->
-    Q.Project (x, 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.Project (x, 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.Project (x, 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 =