more work

Author: jfeser

.envrc

@@ -0,0 +1 @@
+use flake;

eopt/egraph_matcher.ml

@@ -75,7 +75,10 @@ module C = struct
   let list g = mk_query Ast.alist g
   let hash_idx g = mk_query Ast.ahashidx g
   let ordered_idx g = mk_query Ast.aorderedidx g
+  let depjoin g = mk_query Ast.depjoin g
   let tuple g ts k = G.add g (ATuple (ts, k))
+  let scalar g = mk_query Ast.ascalar g
+  let scalar_name g n = scalar g { s_pred = `Name n; s_name = Name.name n }
 end
 
 let to_annot = G.choose_exn

eopt/join_elim_tactics.ml

@@ -1,62 +1,75 @@
-(* open Core *)
-(* open Castor *)
-(* open Ast *)
-(* open Schema *)
-(* open Collections *)
-(* module P = Pred.Infix *)
-(* module A = Abslayout *)
-(* open Match.Query *)
-(* open Egraph_matcher *)
-
-(* let elim_join_nest g _ = *)
-(*   let%bind root, join = M.any_join g in *)
-(*   let scope = Fresh.name Global.fresh "s%d" in *)
-(*   let pred = Pred.scoped (schema r1) scope pred in *)
-(*   let lhs = *)
-(*     let scalars = *)
-(*       Schema.schema r1 |> Schema.scoped scope |> List.map ~f:C.scalar_name *)
-(*     in *)
-(*     A.tuple scalars Cross *)
-(*   and rhs = A.filter pred r2 in *)
-(*   return (root, C.list join.r1 @@ A.tuple [ lhs; rhs ] Cross) *)
-
-(* let elim_join_nest = of_func elim_join_nest ~name:"elim-join-nest" *)
-
-(* let elim_join_hash r = *)
-(*   let open Option.Let_syntax in *)
-(*   let%bind pred, r1, r2 = to_join r in *)
-(*   match pred with *)
-(*   | `Binop (Eq, kl, kr) -> *)
-(*       let join_scope = Fresh.name Global.fresh "s%d" *)
-(*       and hash_scope = Fresh.name Global.fresh "s%d" *)
-(*       and r1_schema = schema r1 in *)
-(*       let key_name = Fresh.name Global.fresh "k%d" in *)
-(*       let layout = *)
-(*         let slist = *)
-(*           let r1_schema = Schema.scoped join_scope r1_schema in *)
-(*           r1_schema @ schema r2 |> Select_list.of_names *)
-(*         in *)
-(*         A.dep_join r1 join_scope @@ A.select slist *)
-(*         @@ A.hash_idx *)
-(*              (A.dedup @@ A.select [ (kr, key_name) ] r2) *)
-(*              hash_scope *)
-(*              (A.filter *)
-(*                 (`Binop *)
-(*                   (Eq, `Name (Name.create ~scope:hash_scope key_name), kr)) *)
-(*                 r2) *)
-(*              [ Pred.scoped r1_schema join_scope kl ] *)
-(*       in *)
-(*       Some layout *)
-(*   | _ -> None *)
-
-(* let elim_join_hash = of_func elim_join_hash ~name:"elim-join-hash" *)
-
-(* let elim_join_filter r = *)
-(*   let open Option.Let_syntax in *)
-(*   let%map pred, r1, r2 = to_join r in *)
-(*   A.filter pred (A.join (`Bool true) r1 r2) *)
-
-(* let elim_join_filter = of_func elim_join_filter ~name:"elim-join-filter" *)
+open Core
+module Subst = Castor.Subst
+module Schema = Castor.Schema
+module Name = Castor.Name
+module Free = Castor.Free
+module Abslayout = Castor.Abslayout
+module Pred = Castor.Pred
+module Select_list = Castor.Select_list
+module Fresh = Castor.Fresh
+module Global = Castor.Global
+module Egraph = Castor.Egraph
+module P = Pred.Infix
+module A = Abslayout
+open Egraph_matcher
+
+let elim_join_nest g _ =
+  let%map root, join = M.any_join g in
+  let lhs_schema = G.schema g join.r1 in
+  let pred =
+    Subst.subst_pred
+      (List.map lhs_schema ~f:(fun n -> (n, `Name (Name.zero n)))
+      |> Map.of_alist_exn (module Name))
+      join.pred
+  in
+  let lhs = C.tuple g (List.map lhs_schema ~f:(C.scalar_name g)) Cross
+  and rhs = C.filter g pred (of_annot g @@ Subst.incr @@ to_annot g join.r2) in
+  (root, C.depjoin g { d_lhs = join.r1; d_rhs = C.tuple g [ lhs; rhs ] Cross })
+
+let elim_join_hash g _ =
+  let%bind root, join = M.any_join g in
+  match join.pred with
+  | `Binop (Eq, kl, kr) ->
+      let r1_schema = G.schema g join.r1 in
+      let kl =
+        Subst.incr_pred kl
+        |> Subst.subst_pred
+             (Map.of_alist_exn (module Name)
+             @@ List.map r1_schema ~f:(fun n -> (n, `Name (Name.zero n))))
+      in
+      let layout =
+        let slist =
+          Select_list.of_names
+            (List.map ~f:Name.zero r1_schema @ G.schema g join.r2)
+        in
+        C.depjoin g
+          {
+            d_lhs = join.r1;
+            d_rhs =
+              C.select g slist
+              @@ C.hash_idx g
+                   {
+                     hi_keys =
+                       C.dedup g
+                       @@ C.select g [ (kr, "key") ]
+                       @@ of_annot g @@ Subst.incr @@ to_annot g join.r2;
+                     hi_values =
+                       C.filter g
+                         (`Binop
+                           (Eq, `Name (Name.zero @@ Name.create "key"), kr))
+                       @@ of_annot g @@ Subst.incr @@ Subst.incr
+                       @@ to_annot g join.r2;
+                     hi_lookup = [ kl ];
+                     hi_key_layout = None;
+                   };
+          }
+      in
+      return (root, layout)
+  | _ -> empty
+
+let elim_join_filter g _ =
+  let%map root, join = M.any_join g in
+  (root, C.filter g join.pred (C.join g (`Bool true) join.r1 join.r2))
 
 (* let hoist_join_param_filter r = *)
 (*   let open Option.Let_syntax in *)
@@ -163,3 +176,8 @@
 (*  *     return *)
 (*  *     @@ A.filter (Pred.conjoin hoist) *)
 (*  *     @@ A.join (Pred.conjoin keep) r1 r2 *\) *)
+
+let () =
+  Ops.register elim_join_nest "elim-join-nest";
+  Ops.register elim_join_hash "elim-join-hash";
+  Ops.register elim_join_hash "elim-join-filter"

eopt/subsumption_tactics.ml

@@ -0,0 +1 @@
+let

flake.nix

@@ -0,0 +1,55 @@
+{
+  inputs = {
+    nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
+    flake-utils.url = "github:numtide/flake-utils";
+    combinat.url = "github:jfeser/combinat";
+    combinat.inputs.nixpkgs.follows = "nixpkgs";
+  };
+  outputs = { self, flake-utils, nixpkgs, combinat }@inputs:
+    flake-utils.lib.eachSystem [ "aarch64-darwin" "x86_64-linux" ] (system:
+      let
+        pkgs = import nixpkgs {
+          inherit system;
+          overlays = [ self.overlay.${system} combinat.overlay.${system} ];
+        };
+      in {
+        overlay = self: super: {
+          ocamlPackages = super.ocaml-ng.ocamlPackages_4_14.overrideScope'
+            (self: super: {
+              ocaml = super.ocaml.override { flambdaSupport = true; };
+              castor = super.buildDunePackage rec {
+                pname = "castor";
+                version = "0.1";
+                duneVersion = "3";
+                minimalOCamlVersion = "4.13";
+                propagatedBuildInputs = [
+                  self.core
+                  self.core_bench
+                  self.core_unix
+                  self.ppx_yojson_conv
+                  self.menhir
+                  self.fmt
+                  self.yojson
+                  self.gen
+                  self.iter
+                  self.bheap
+                  self.logs
+                  self.combinat
+                  self.bitarray
+                  self.vpt
+                  self.base
+                  self.fmt
+                  self.sek
+                ];
+                src = ./.;
+              };
+            });
+        };
+
+        defaultPackage = pkgs.ocamlPackages.symetric;
+        devShell = pkgs.mkShell {
+          nativeBuildInputs = [ pkgs.ocamlformat ];
+          inputsFrom = [ pkgs.ocamlPackages.symetric ];
+        };
+      });
+}

lib/pred.mli

@@ -3,7 +3,7 @@ open Ast
 module Binop = Ast.Binop
 module Unop = Ast.Unop
 
-type t = Ast.t Ast.pred [@@deriving compare, hash, sexp]
+type t = Ast.t Ast.pred [@@deriving compare, equal, hash, sexp]
 
 include Comparator.S with type t := t
 module O : Comparable.Infix with type t := t

lib/sql.ml

@@ -8,7 +8,7 @@ module P = Pred.Infix
 include (val Log.make "castor.sql")
 
 type select_entry = { pred : Pred.t; alias : string; cast : Prim_type.t option }
-[@@deriving compare, sexp_of]
+[@@deriving compare, equal, sexp_of]
 
 type 'r spj = {
   select : select_entry list;
@@ -19,7 +19,7 @@ type 'r spj = {
   group : Pred.t list;
   limit : int option;
 }
-[@@deriving compare, sexp_of]
+[@@deriving compare, equal, sexp_of]
 
 type 'q compound_relation =
   [ `Subquery of 'q | `Table of Relation.t | `Series of Pred.t * Pred.t ]
@@ -297,8 +297,7 @@ let relation Relation.({ r_name = tbl; _ } as rel) =
   let relations = [ (`Table rel, tbl, `Left) ] in
   `Query (create_spj ~relations select_list)
 
-let of_ralgebra_open f r =
-  match r.node with
+let of_query_open f = function
   | Range (p, p') ->
       let alias = Fresh.name Global.fresh "t%d" in
       `Query
@@ -323,16 +322,17 @@ let of_ralgebra_open f r =
   | ATuple (rs, Concat) -> `Union_all (List.map ~f:(fun r -> to_spj (f r)) rs)
   | ATuple ([], _) | AEmpty -> `Query (create_spj ~limit:0 [])
   | AScalar p -> `Query (create_spj [ create_entry p.s_pred ~alias:p.s_name ])
-  | ATuple (_, Zip) ->
-      Error.(create "Unsupported." r [%sexp_of: _ annot] |> raise)
+  | ATuple (_, Zip) -> failwith "zip tuples are unsupported"
   | AList l -> f @@ A.dep_join' (Layout_to_depjoin.list l)
   | AHashIdx h -> f @@ A.dep_join' (Layout_to_depjoin.hash_idx h)
   | AOrderedIdx o -> f @@ A.dep_join' (Layout_to_depjoin.ordered_idx o)
   | _ -> failwith "unsupported"
 
+let of_annot_open f r = of_query_open f r.node
+
 let of_ralgebra x =
-  let rec f x = of_ralgebra_open f x in
-  f (strip_meta x)
+  let rec f x = of_annot_open f x in
+  f x
 
 let name_to_sql (n : Name.t) =
   match n.name with

lib/sql.mli

@@ -12,7 +12,7 @@ type 'r spj = {
   group : Pred.t list;
   limit : int option;
 }
-[@@deriving compare, sexp_of]
+[@@deriving compare, equal, sexp_of]
 
 type 'q compound_relation =
   [ `Subquery of 'q | `Table of Relation.t | `Series of Pred.t * Pred.t ]
@@ -42,7 +42,7 @@ val create_entry_s :
 
 val create_entries_s : string list -> select_entry list
 val src : Logs.Src.t
-val of_ralgebra : < .. > annot -> t
+val of_ralgebra_open : (< > annot -> t) -> < > annot -> t
 val has_aggregates : t -> bool
 val to_schema : t -> string list
 val sample : int -> string -> string

lib/subst.ml

@@ -13,6 +13,10 @@ let decr_pred p =
 
 let decr_pred_exn p = Pred.map_names ~f:(fun n -> `Name (Name.decr_exn n)) p
 
+let rec shift_pred ~cutoff d = function
+  | `Name n -> `Name (Name.shift ~cutoff d n)
+  | p -> Visitors.Map.pred Fun.id (shift_pred ~cutoff d) p
+
 let rec shift ~cutoff d r = { r with node = shift_query ~cutoff d r.node }
 
 and shift_query ~cutoff:c d =
@@ -48,10 +52,6 @@ and shift_lookup ~cutoff d =
 
 and shift_bound ~cutoff d (p, b) = (shift_pred ~cutoff d p, b)
 
-and shift_pred ~cutoff d = function
-  | `Name n -> `Name (Name.shift ~cutoff d n)
-  | p -> Visitors.Map.pred Fun.id (shift_pred ~cutoff d) p
-
 let incr x = shift ~cutoff:0 1 x
 let incr_pred x = shift_pred ~cutoff:0 1 x
 
@@ -60,6 +60,10 @@ let incr_ctx ctx =
   |> List.map ~f:(fun (n, p) -> (Name.incr n, incr_pred p))
   |> Map.of_alist_exn (module Name)
 
+let rec subst_pred ctx = function
+  | `Name n as p -> Map.find ctx n |> Option.value ~default:p
+  | p -> Visitors.Map.pred Fun.id (subst_pred ctx) p
+
 let rec subst ctx r = { r with node = subst_query ctx r.node }
 
 and subst_query ctx = function
@@ -95,7 +99,3 @@ and subst_lookup ctx =
       (Option.map l ~f:(subst_bound ctx), Option.map h ~f:(subst_bound ctx)))
 
 and subst_bound ctx (p, b) = (subst_pred ctx p, b)
-
-and subst_pred ctx = function
-  | `Name n as p -> Map.find ctx n |> Option.value ~default:p
-  | p -> Visitors.Map.pred Fun.id (subst_pred ctx) p

lib/subst.mli

@@ -2,8 +2,9 @@ open Core
 open Ast
 
 val incr : 'm annot -> 'm annot
-val incr_pred : 'm annot pred -> 'm annot pred
+val incr_pred : 'r pred -> 'r pred
 val incr_ctx : 'm annot pred Map.M(Name).t -> 'm annot pred Map.M(Name).t
 val decr_pred : 'a pred -> 'a pred option
 val decr_pred_exn : 'a pred -> 'a pred
+val subst_pred : 'r pred Map.M(Name).t -> 'r pred -> 'r pred
 val subst : 'm annot pred Map.M(Name).t -> 'm annot -> 'm annot

lib/subsumption.ml

@@ -3,6 +3,8 @@ open Collections
 open Ast
 open Sql
 
+type t = (Relation.t * string) spj [@@deriving sexp_of, equal]
+
 module Foreign_key_join_graph = struct
   module Edge = struct
     type t = { l_attr : string; r_attr : string } [@@deriving compare]

test/eopt/dune.inc

@@ -21,6 +21,17 @@
            (run ../bin/eopt.exe)))))
 
 
+(rule
+ (alias runtest)
+ (action (diff elim-join.sexp.expected elim-join.sexp.output)))
+
+(rule
+ (alias runtest)
+ (action (with-stdout-to elim-join.sexp.output
+          (with-stdin-from elim-join.sexp
+           (run ../bin/eopt.exe)))))
+
+
 (rule
  (alias runtest)
  (action (diff hoist-filter-select.sexp.expected hoist-filter-select.sexp.output)))

test/eopt/elim-join.sexp

@@ -0,0 +1,3 @@
+((queries
+  "join(f = g, ascalar(1 as f), ascalar(0 as g))")
+ (transforms elim-join-nest elim-join-hash elim-join-filter))

test/eopt/elim-join.sexp.expected

@@ -0,0 +1,7 @@
+$2:
+  join((f = g), ascalar(1 as f), ascalar(0 as g))
+  depjoin(ascalar(1 as f), atuple([atuple([ascalar(f)], cross),
+                                   filter((0.f = g), ascalar(0 as g))], cross))
+  depjoin(ascalar(1 as f), select([0.f, g], ahashidx(dedup(select([g as key], ascalar(0 as g))), filter((0.key
+                                                                    = g), ascalar(0 as g)), 0.f)))
+  

test/eopt/multi-query.sexp

@@ -1,5 +1,5 @@
 ((queries
   "select([l_shipdate], filter(l_orderkey = param0, lineitem))"
   "join(l_orderkey = o_orderkey, lineitem, orders)")
- (transforms elim-eq-filter)
+ (transforms elim-eq-filter elim-join-hash)
  (db postgresql:///tpch_1k))