From ad675a06ee2b416cb87b9a34f58c17d6723c892b Mon Sep 17 00:00:00 2001
From: Simon Fowler <simon@simonjf.com>
Date: Fri, 1 Jul 2022 16:22:13 +0100
Subject: [PATCH] Allow record extension in presence of temporal projections
 (#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 #1124.

* Allow extension to work with (shallow) temporal projections

We don't have the full generality due to #1130, but this patch should
allow record extension to be used on temporal projections on variables /
record literals.
---
 core/query/query.ml         | 24 +++++++++++++++++++++---
 core/query/temporalQuery.ml |  9 +++++++--
 2 files changed, 28 insertions(+), 5 deletions(-)

diff --git a/core/query/query.ml b/core/query/query.ml
index 57f65f850..408425660 100644
--- 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
index f04081851..913fd2e1b 100644
--- 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 =