Something went wrong. Try again.
My own corner of monopam
Something went wrong. Try again.
35 kB · 886 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887(*--------------------------------------------------------------------------- Copyright (c) 2026 Thomas Gazagnaire. All rights reserved. SPDX-License-Identifier: ISC ---------------------------------------------------------------------------*)
open Ast
(* Everything below asks the schema four questions and nothing else: which columns a relation publishes, which collating sequence a column declares, what a column can hold, and which columns a table-valued function produces. A rewrite that answered the name of a relation from its rows could not run before the rows exist, and every one of these runs first. *)type env = { columns : string -> string list; collation : string -> string -> string option; affinity : string -> string -> Catalog.Value_ops.affinity option; table_function_columns : string -> string list; has_rowid : string -> bool;}
let explicit_collation = Collation.explicit
(* The column a result expression names, for the implicit name a derived table publishes it under: the reference itself, or one under a [COLLATE]. sqlite3 skips a COLLATE here (sqlite3ColumnsFromExprList, src/select.c) because the wrapper names a sequence and not a column, so [x COLLATE NOCASE] publishes [x] and a reader of the derived table finds it there. *)let rec named_column = function | Col (_, c) -> Some c | Collate (e, _) -> named_column e | _ -> None
(* The output column names of a select, for use as a derived table's columns: the explicit alias, else the bare column name, else a positional name. A [SELECT *] expands to every column in scope -- the FROM table plus each joined table, recursing into a derived (subquery) operand. *)let rec select_columns env0 s = (* every select carries its own [WITH] into its own resolution, so a caller hands over the scope the select sits in and not one it has extended *) let env = with_ctes env0 s in let table_cols (tr : table_ref) = match tr.subquery with | Some q -> select_columns env q | None -> env.columns tr.name in let star_cols () = let from_cols = match s.from with | Unit -> [] | Table tr -> table_cols tr | Select { fs_select; _ } -> select_columns env fs_select | Values (r :: _) -> List.mapi (fun j _ -> Fmt.str "column%d" (j + 1)) r | Values [] -> [] | Table_function { tf_name; _ } -> env.table_function_columns tf_name in from_cols @ List.concat_map (fun (j : join) -> table_cols j.table) s.joins in List.concat (List.mapi (fun i (rc : result_col) -> match rc.expr with | Star -> star_cols () | Qualified_star q -> env.columns q | _ -> ( match rc.alias with | Some a -> [ a ] | None -> ( match named_column rc.expr with | Some c -> [ c ] | None -> [ Fmt.str "column%d" (i + 1) ]))) s.cols)
(* The column names a [WITH] table expression publishes: the list its declaration names, else the output columns of its body. @raise Failure when the body reads a relation [env] does not have. *)and cte_columns env (c : cte) = match c.columns with [] -> select_columns env c.query | cs -> cs
and with_ctes env (q : select) = if q.ctes = [] then env else let self = ref env in let resolving = ref [] in let columns name = match List.find_opt (fun (c : cte) -> ident_equal c.name name) q.ctes with | None -> env.columns name | Some c -> if List.exists (ident_equal c.name) !resolving then Fmt.failwith "circular reference: %s" c.name else ( resolving := c.name :: !resolving; Fun.protect ~finally:(fun () -> resolving := List.tl !resolving) (fun () -> cte_columns !self c)) in self := { env with columns }; !self
(* The columns a source of [s] publishes, for a caller that only needs to know which names are real ones. A source naming one of [s]'s own [WITH] table expressions publishes that relation's columns: the catalog has it only once the CTE is materialised, and this is read before that. A name neither has -- a derived table, or a body reading an earlier CTE -- publishes none. *)let source_columns env (s : select) (tr : table_ref) = match tr.subquery with | Some _ -> [] | None -> ( match List.find_opt (fun (c : cte) -> ident_equal c.name tr.name) s.ctes with | Some c -> ( try cte_columns env c with Failure _ | Catalog.Error.Prepare _ -> []) | None -> env.columns tr.name)
(* Each FROM source of [s] as (alias, its column names) -- the column scope a subquery body resolves against. A name that does not resolve (e.g. a CTE absent from the base catalog) contributes no columns, so a subquery using it reads as correlated and is left to run per outer row rather than wrongly hoisted. *)let from_scope env (s : select) : (string * string list) list = let cols_of name = try env.columns name with Failure _ | Catalog.Error.Prepare _ -> [] in let alias_or_name (tr : table_ref) = match tr.alias with Some a -> a | None -> tr.name in let of_ref (tr : table_ref) = match tr.subquery with | Some q -> (alias_or_name tr, select_columns env q) | None -> (alias_or_name tr, cols_of tr.name) in let leading = match s.from with | Table tr -> [ of_ref tr ] | Select { fs_select; fs_alias } -> [ (Option.value fs_alias ~default:"", select_columns env fs_select) ] | Values tuples -> let n = match tuples with r :: _ -> List.length r | [] -> 0 in [ ("", List.init n (fun i -> Fmt.str "column%d" (i + 1))) ] (* A table-valued function binds its output columns under its alias, else its own name -- the same names the scan publishes them under. Missing them would read every one as free, making any subquery over a function look correlated. *) | Table_function { tf_name; tf_alias; _ } -> let cols = try env.table_function_columns tf_name with Failure _ | Catalog.Error.Prepare _ -> [] in [ (Option.value tf_alias ~default:tf_name, cols) ] | Unit -> [] in leading @ List.map (fun (j : join) -> of_ref j.table) s.joins
(* Every column name [s]'s own FROM binds. {!from_scope} reads a derived table, a VALUES list and a table-valued function; {!source_columns} reads a source naming one of [s]'s own [WITH] table expressions, which the catalog has not got until the CTE is materialised. Neither answers for the other's sources, so a caller asking which names are already taken here asks both. *)let bound_columns env (s : select) = let named (tr : table_ref) = if tr.subquery = None then source_columns env s tr else [] in List.concat_map snd (from_scope env s) @ (match s.from with Table tr -> named tr | _ -> []) @ List.concat_map (fun (j : join) -> named j.table) s.joins
(* [s]'s own [WITH] is in scope for every arm of its compound and every subquery under it, none of which carries the clause itself, so it extends [env] before anything is resolved. *)let rec alias_rewrite env inherited (s : select) = let env = with_ctes env s in let real_cols = bound_columns env s in let unshadowed (a, _) = not (List.exists (ident_equal a) real_cols) in let own = List.filter_map (fun (rc : result_col) -> match rc.alias with Some a -> Some (a, rc.expr) | None -> None) s.cols in let own = List.filter unshadowed own in (* What an expression of this select sees: the inherited bindings this select's FROM does not rebind, and -- in a clause a select's own alias may stand in -- its own aliases before them. *) let outer = List.filter unshadowed inherited in let keys = own @ List.filter (fun (a, _) -> Catalog.Ident.assoc_opt a own = None) outer in let rec sub bindings e = match e with | Col (None, name) -> ( match Catalog.Ident.assoc_opt name bindings with | Some e' -> e' | None -> e) | e -> Ast.map_expr ~select:(alias_rewrite env bindings) (sub bindings) e in { s with cols = List.map (fun (rc : result_col) -> { rc with expr = sub outer rc.expr }) s.cols; where = Option.map (sub keys) s.where; order_by = List.map (fun (e, d) -> (sub keys e, d)) s.order_by; group_by = List.map (sub outer) s.group_by; having = Option.map (sub outer) s.having; joins = List.map (fun (j : join) -> { j with on = sub outer j.on }) s.joins; compound = List.map (fun (op, arm) -> (op, alias_rewrite env outer arm)) s.compound; }
let where_aliases env (s : select) = alias_rewrite env [] s
(* The output expressions of [s] in order, expanding [*]/[t.*] to a column reference per underlying column. Used to resolve an ORDER BY ordinal to the expression of that output column. *)let output_exprs env (s : select) = let star () = select_columns env { s with cols = [ { expr = Star; alias = None } ] } in List.concat_map (fun (rc : result_col) -> match rc.expr with | Star -> List.map (fun c -> Col (None, c)) (star ()) | Qualified_star q -> List.map (fun c -> Col (Some q, c)) (env.columns q) | e -> [ e ]) s.cols
(* The output expression an in-range 1-based ordinal names, among [outs]. Unary [+] is looked through and does not survive: sqlite3 tests an ORDER BY / GROUP BY term for an integer through it (src/expr.c, sqlite3ExprIsInteger), so [ORDER BY +2] is the second output column, exactly as [ORDER BY 2] is. *)let rec ordinal_expr outs = function | Lit (Int i) when i >= 1L && Int64.to_int i <= Array.length outs -> Some outs.(Int64.to_int i - 1) | Unary_plus e -> ordinal_expr outs e | _ -> None
(* sqlite3 lets ORDER BY and GROUP BY use a 1-based output-column ordinal ([ORDER BY 2] / [GROUP BY 2] use the second result column). Replace each integer-literal key with the expression of that output column, so the normal machinery uses it; an out-of-range or non-integer key is left as is. *)let ordinals env (s : select) = if s.order_by = [] && s.group_by = [] then s else let outs = Array.of_list (output_exprs env s) in let ordinal = ordinal_expr outs in (* [ORDER BY k COLLATE c] parses as a [Collate] around the ordinal, so look through it (the collation stays, wrapping the resolved column). A term that is no ordinal is left as written, unary [+] and all. *) let rec nth e = match ordinal e with | Some out -> out | None -> ( match e with Collate (e, c) -> Collate (nth e, c) | e -> e) in (* An ORDER BY key may name an explicit output-column alias; the alias takes precedence over an input column (sqlite3), so resolve it to that output expression -- this is how [ORDER BY n] reaches an aggregate aliased [n]. *) let alias_expr name = List.find_map (fun (rc : result_col) -> match rc.alias with | Some a when ident_equal a name -> Some rc.expr | _ -> None) s.cols in let rec order_key e = match ordinal e with | Some out -> out | None -> ( match e with | Collate (e, c) -> Collate (order_key e, c) | Unary_plus e -> Unary_plus (order_key e) | Col (None, name) -> ( match alias_expr name with Some x -> x | None -> nth e) | e -> nth e) in (* GROUP BY also accepts an output-column alias, but with the opposite precedence to ORDER BY: sqlite3 resolves the bare name against the input columns first and only falls back to the select-list alias when no input column carries it. [SELECT y AS x ... GROUP BY x] therefore groups by the input [x], while [SELECT y AS g ... GROUP BY g] groups by [y]. *) let input_cols = lazy (try select_columns env { s with cols = [ { expr = Star; alias = None } ] } with Failure _ | Catalog.Error.Prepare _ -> []) in let group_key = function | Col (None, name) as e when not (List.mem name (Lazy.force input_cols)) -> ( match alias_expr name with Some x -> x | None -> nth e) | e -> nth e in { s with order_by = List.map (fun (e, d) -> (order_key e, d)) s.order_by; group_by = List.map group_key s.group_by; }
type source = { bound_as : string; (** the name the source is in scope under *) publishes : string list Lazy.t; (** its columns, matched by an unqualified reference *) declares : string -> string option; (** a column's declared sequence *) holds : string -> Catalog.Value_ops.affinity option; (** what a column can hold -- its affinity *)}
let rec collation_for sources e = match e with | Col (Some q, name) -> ( match List.find_opt (fun s -> ident_equal s.bound_as q) sources with | Some s -> s.declares name | None -> None) | Col (None, name) -> ( let holds s = List.exists (ident_equal name) (Lazy.force s.publishes) in match List.find_opt holds sources with | Some s -> s.declares name | None -> None) | Cast (e, _) | Unary_plus e -> collation_for sources e | _ -> None
(* The affinity a column reference carries, read off the source it names. Unlike the collating sequence, no spine is looked through: sec.3.2 leaves any operator applied to a column name -- the no-op unary [+] included -- with no affinity at all, and a CAST takes its target type's, so {!expr_affinity} answers both rather than walking past them to a column here. *)let affinity_for sources e = match e with | Col (Some q, name) -> ( match List.find_opt (fun s -> ident_equal s.bound_as q) sources with | Some s -> s.holds name | None -> None) | Col (None, name) -> ( let holds s = List.exists (ident_equal name) (Lazy.force s.publishes) in match List.find_opt holds sources with | Some s -> s.holds name | None -> None) | _ -> None
let rec from_sources env (s : select) : source list = let named bound_as name = { bound_as; publishes = lazy (try env.columns name with Failure _ | Catalog.Error.Prepare _ -> []); declares = env.collation name; holds = env.affinity name; } in let derived bound_as sub = { bound_as; publishes = lazy (try select_columns env sub with Failure _ | Catalog.Error.Prepare _ -> []); declares = column_collation env sub; holds = column_affinity env sub; } in let of_ref (tr : table_ref) = let bound_as = Option.value tr.alias ~default:tr.name in match tr.subquery with | None -> [ named bound_as tr.name ] | Some sub -> [ derived bound_as sub ] in (match s.from with | Table tr -> of_ref tr | Select { fs_select; fs_alias } -> [ derived (Option.value fs_alias ~default:"") fs_select ] | Unit | Values _ | Table_function _ -> []) @ List.concat_map (fun (j : join) -> of_ref j.table) s.joins
(* The sequence the output column named [name] of [s] carries. *)and column_collation env (s : select) name = let published = try select_columns env s with Failure _ | Catalog.Error.Prepare _ -> [] in Option.bind (Catalog.Ident.index name published) (output_collation env s)
(* The affinity the output column named [name] of [s] carries. *)and column_affinity env (s : select) name = let published = try select_columns env s with Failure _ | Catalog.Error.Prepare _ -> [] in Option.bind (Catalog.Ident.index name published) (output_affinity env s)
and output_collation env (s : select) i = match List.nth_opt (try output_exprs env s with Failure _ | Catalog.Error.Prepare _ -> []) i with | None -> None | Some e -> ( match explicit_collation e with | Some _ as c -> c | None -> collation_for (from_sources env s) e)
and expr_affinity env sources e = match e with | Col _ -> affinity_for sources e | Collate (e, _) -> expr_affinity env sources e | Cast (_, ty) -> Some (Catalog.Value_ops.affinity_of_type ty) | Scalar_select sub -> output_affinity env sub 0 | _ -> None
and expr_data_type env sources e = match e with | Collate (e, _) | Unary_plus e -> expr_data_type env sources e | Lit Null -> 0x00 | Lit (Text _) -> 0x02 | Lit (Blob _) -> 0x04 | Binary (Concat, _, _) -> 0x06 | Param _ | Func _ | Distinct_agg _ | Ordered_agg _ | Filter _ -> 0x07 | Col _ | Cast _ | Scalar_select _ -> ( match expr_affinity env sources e with | Some (`Numeric | `Integer | `Real) -> 0x05 | Some `Text -> 0x06 | Some `Blob | None -> 0x07) | Case (_, branches, els) -> List.fold_left (fun acc (_, r) -> acc lor expr_data_type env sources r) (match els with Some e -> expr_data_type env sources e | None -> 0x00) branches | _ -> 0x01
and output_affinity env (s : select) i = let arms = s :: List.map snd s.compound in let item (a : select) = List.nth_opt (try output_exprs env a with Failure _ | Catalog.Error.Prepare _ -> []) i in let arm_affinity a = Option.bind (item a) (expr_affinity env (from_sources env a)) in let arm_data_type a = match item a with | Some e -> expr_data_type env (from_sources env a) e | None -> 0x00 in let rec pick k = function | [] -> (None, k) | a :: rest -> ( match arm_affinity a with None -> pick (k + 1) rest | aff -> (aff, k)) in let chosen, k = pick 0 arms in match chosen with | Some (`Text | `Numeric | `Integer | `Real) as aff when List.length arms > 1 -> let others = List.fold_left (fun acc a -> acc lor arm_data_type a) 0x00 (List.filteri (fun j _ -> j <> k) arms) in if chosen = Some `Text && others land 0x01 <> 0 then Some `Blob else if chosen <> Some `Text && others land 0x02 <> 0 then Some `Blob else aff | aff -> aff
(* Whether [e] counts as a column for rule 2 above -- a reference, or a CAST or a unary [+] of one. *)let rec is_col_expr = function | Col _ -> true | Cast (e, _) | Unary_plus e -> is_col_expr e | _ -> false
(* [e] with the sequence it already assigns hoisted to its outermost node, so every later reader finds it there rather than having to walk for it. *)let hoist_collation e c = match e with Collate _ -> e | e -> Collate (e, c)
let collation_cmp_operands col_coll ~written:(wa, wb) a b = match (explicit_collation wa, explicit_collation wb) with (* rule 1: an explicit assignment wins wherever it sits, the left operand's first *) | Some c, _ -> (hoist_collation a c, b) | None, Some c -> (a, hoist_collation b c) (* rule 2: else a column operand's declared sequence, the left one's first *) | None, None -> if is_col_expr wa then match col_coll wa with Some c -> (Collate (a, c), b) | None -> (a, b) else if is_col_expr wb then match col_coll wb with Some c -> (a, Collate (b, c)) | None -> (a, b) else (a, b)
let collation_lhs col_coll ~written e = match explicit_collation written with | Some c -> hoist_collation e c | None -> ( match col_coll written with Some c -> Collate (e, c) | None -> e)
let arm_collation env (s : select) i = match List.nth_opt (try output_exprs env s with Failure _ | Catalog.Error.Prepare _ -> []) i with | None -> None | Some e -> ( match output_collation env s i with | Some _ as c -> c | None -> if is_col_expr e then Some "BINARY" else None)
let compound_collations env (s : select) ncols = let arms = s :: List.map snd s.compound in List.init ncols (fun i -> List.find_map (fun a -> arm_collation env a i) arms)
(* The arm of a compound whose result columns an [IN (SELECT ...)] compares against: the last one. sqlite3 builds a compound with its rightmost arm as the head of the chain and reads the result list off it here without walking [pPrior] back (src/expr.c, sqlite3CodeRhsOfIN) -- the opposite end from the one that types a derived table. *)let in_select_arm (sub : select) = match List.rev sub.compound with [] -> sub | (_, arm) :: _ -> arm
let in_select_lhs env col_coll ~written a sub = match explicit_collation written with | Some c -> hoist_collation a c | None -> ( let arm = in_select_arm sub in let rhs = match try output_exprs env arm with Failure _ | Catalog.Error.Prepare _ -> [] with | e :: _ -> Some e | [] -> None in let seq = match Option.bind rhs explicit_collation with | Some _ as c -> c | None -> if is_col_expr written then col_coll written else output_collation env arm 0 in match seq with Some c -> Collate (a, c) | None -> a)
let in_select_affinity env sub = output_affinity env (in_select_arm sub) 0
let sort_keys col_coll e = let lhs k = collation_lhs col_coll ~written:k k in let key (k, dir) = (lhs k, dir) in match e with | Ordered_agg (agg, keys) -> Ordered_agg (agg, List.map key keys) | Window (f, w) -> Window ( f, { w with partition = List.map lhs w.partition; order = List.map key w.order; } ) | e -> e
let rec collation_expr env col_coll e = let rw = collation_expr env col_coll in match e with | Binary (((Eq | Neq | Lt | Le | Gt | Ge) as op), a, b) -> let a, b = collation_cmp_operands col_coll ~written:(a, b) (rw a) (rw b) in Binary (op, a, b) | Binary (op, a, b) -> Binary (op, rw a, rw b) (* [a IS b] is a comparison and reads a sequence exactly as [a = b] does (sqlite3 routes both through sqlite3BinaryCompareCollSeq, src/expr.c); only its answer differs, being 1/0 where a comparison's is NULL. *) | Is (a, b) -> let a, b = collation_cmp_operands col_coll ~written:(a, b) (rw a) (rw b) in Is (a, b) (* [x IN ..] uses the left operand's collation, like [x = ..]. *) | In_list (a, l) -> In_list (collation_lhs col_coll ~written:a (rw a), List.map rw l) | In_select (a, sub) -> In_select (in_select_lhs env col_coll ~written:a (rw a) sub, sub) (* A DISTINCT aggregate folds each argument tuple once, and which tuples are one is decided under a sequence -- sqlite3 keys the dedup on the argument list's own sequences (sqlite3KeyInfoFromExprList, src/select.c). *) | Distinct_agg (name, a) -> Distinct_agg (name, collation_lhs col_coll ~written:a (rw a)) | Func (name, [ a ]) when Collation.fold_compares name -> Func (name, [ collation_lhs col_coll ~written:a (rw a) ]) | Func (name, args) when Collation.compares_its_arguments name -> Func (name, List.map (fun a -> collation_lhs col_coll ~written:a (rw a)) args) | Ordered_agg _ | Window _ -> sort_keys col_coll (Ast.map_expr ~select:Fun.id rw e) | Case (Some base, branches, els) -> let rbase = rw base in let branch (c, r) = let l, c = collation_cmp_operands col_coll ~written:(base, c) rbase (rw c) in (Binary (Eq, l, c), rw r) in Case (None, List.map branch branches, Option.map rw els) | e -> Ast.map_expr ~select:Fun.id rw e
let collations env (s : select) = (* The rewrite runs even for a select with no source of its own to read a declared sequence from: an [IN (SELECT ...)] takes one from the subquery, so [SELECT 'x' IN (SELECT c FROM t)] has a sequence to find though its own FROM offers none. *) let col_coll = collation_for (from_sources env s) in let rw = collation_expr env col_coll in let lhs_coll e = collation_lhs col_coll ~written:e (rw e) in let order_key (e, dir) = (lhs_coll e, dir) in (* A DISTINCT dedups its output columns under the sequences they carry, so each result expression is a key like a GROUP BY's and takes the same rewrite. It stays the same column to a reader: {!named_column} looks through the wrapper this puts on. *) let result_col (rc : result_col) = { rc with expr = (if s.distinct then lhs_coll rc.expr else rw rc.expr) } in { s with cols = List.map result_col s.cols; where = Option.map rw s.where; having = Option.map rw s.having; group_by = List.map lhs_coll s.group_by; order_by = List.map order_key s.order_by; joins = List.map (fun (j : join) -> { j with on = rw j.on }) s.joins; }
(* The same rewrite over a bare expression, for a statement that has no FROM to read its sources from: a DELETE's or an UPDATE's WHERE, whose one row is in scope under the name the statement gives it. [bases] pairs that name with the table the row came from, which is what carries the declared sequence. *)let collate_over env bases e = let source (bound_as, name) = { bound_as; publishes = lazy (try env.columns name with Failure _ | Catalog.Error.Prepare _ -> []); declares = env.collation name; holds = env.affinity name; } in collation_expr env (collation_for (List.map source bases)) e
(* [from_scope] with the hidden rowid slot appended to each source that has one: a table, not a view, a derived table or a [WITHOUT ROWID] table. A correlated subquery's names are bound here before they are looked for outside, so an unqualified [rowid] names the innermost source that has one, as sqlite3's lookupName does, and only a subquery whose sources have none reads an enclosing row's. *)let binding_scope env (s : select) = let has_rowid (tr : table_ref) = tr.subquery = None && env.has_rowid tr.name in let rowid_sources = (match s.from with | Table tr -> [ has_rowid tr ] | Select _ | Values _ | Table_function _ -> [ false ] | Unit -> []) @ List.map (fun (j : join) -> has_rowid j.table) s.joins in List.map2 (fun (alias, cols) rowid -> (alias, if rowid then cols @ [ rowid_sentinel ] else cols)) (from_scope env s) rowid_sources
(* Whether a source of [own] binds the column [name] under [qual]. A declared column comes first, so a column named [rowid] is that column; a rowid name no column declares binds the hidden slot. *)let scope_binds own qual name = let declares (_, cols) = List.exists (ident_equal name) cols in match qual with | Some q -> List.exists (fun (a, _) -> ident_equal q a) own | None -> List.exists declares own || is_rowid_name name && List.exists (fun (_, cols) -> List.mem rowid_sentinel cols) own
let rec correlated env bound (s : select) = let env = with_ctes env s in let scope = bound @ binding_scope env s in let col_free = function | Col (qual, name) -> not (scope_binds scope qual name) | _ -> false in (* A nested subquery extends the scope rather than closing it, so it is asked the same question under [scope]; everything else is an expression of this select and is looked into. *) let rec free e = match e with | Col _ -> col_free e | e -> Ast.fold_expr ~select:(fun acc sub -> acc || correlated env scope sub) (fun acc x -> acc || free x) false e in List.exists (fun (rc : result_col) -> free rc.expr) s.cols || Option.fold ~none:false ~some:free s.where || Option.fold ~none:false ~some:free s.having || List.exists free s.group_by || List.exists (fun (e, _) -> free e) s.order_by || List.exists (fun (j : join) -> free j.on) s.joins || List.exists (fun (_, arm) -> correlated env bound arm) s.compound
exception Subst_hard(** Raised by {!subst_expr} on a node the simple substituter does not descend into (a nested subquery or a window), so the caller falls back. *)
(* Rebuild [e], applying [replace qual name e] to each column reference and recursing structurally everywhere else. A nested subquery / window raises {!Subst_hard}. *)let rec subst_expr ~replace e = match e with | Col (qual, name) -> replace qual name e | Window _ -> raise Subst_hard | e -> Ast.map_expr ~select:(fun _ -> raise Subst_hard) (subst_expr ~replace) e
(* A FROM or join operand of [q] that is itself a correlated subquery. The substitution does not descend into a FROM operand, so leaving one as written would leave a free column behind, and the whole rewrite falls back instead. @raise Subst_hard on one. *)let refuse_lateral env (q : select) = let operand fs = if correlated env [] fs then raise Subst_hard in (match q.from with Select { fs_select; _ } -> operand fs_select | _ -> ()); List.iter (fun (j : join) -> Option.iter operand j.table.subquery) q.joins
let rec scope_value scope qual name = match scope with | [] -> None | (alias, cols) :: rest -> ( match qual with | Some q when not (ident_equal q alias) -> scope_value rest qual name | _ -> ( match Catalog.Ident.assoc_opt name cols with | Some v -> Some v | None -> ( match if is_rowid_name name then List.assoc_opt rowid_sentinel cols else None with | Some v -> Some v | None -> scope_value rest qual name)))
let substitute_scope env scope (s : select) : select option = let rec sub env own e = match e with | Col (qual, name) when not (scope_binds own qual name) -> ( match scope_value scope qual name with | Some v -> Lit v | None -> raise Subst_hard) | Window _ -> raise Subst_hard | e -> Ast.map_expr ~select:(sub_select env own) (sub env own) e and sub_select env own (q : select) = let env = with_ctes env q in refuse_lateral env q; let own = own @ binding_scope env q in let sub = sub env own in let col (rc : Ast.result_col) = { rc with expr = sub rc.expr } in { q with cols = List.map col q.cols; where = Option.map sub q.where; group_by = List.map sub q.group_by; having = Option.map sub q.having; order_by = List.map (fun (e, d) -> (sub e, d)) q.order_by; joins = List.map (fun (j : join) -> { j with on = sub j.on }) q.joins; compound = List.map (fun (op, arm) -> (op, sub_select env own arm)) q.compound; } in try Some (sub_select env [] s) with Subst_hard -> None
(* The [FROM] list is left-associative, so the join at position [p] takes source [p + 1] against the sources before it: [leading layout p] is what a NATURAL or USING join at that position may equate against. *)let leading (layout : (string * string list) list) p = List.filteri (fun ci _ -> ci <= p) layout
(* The source of [leading] that owns the column [c] -- the left-most one that has it, which is the rule sqlite3 reads a common column by (lang_select.html sec.3). The hidden rowid slot is not a user column: every source carries one, so it would otherwise match them all spuriously. *)let owner_of leading c = if c = rowid_sentinel then None else List.find_map (fun (a, cs) -> if List.exists (ident_equal c) cs then Some a else None) leading
(* A NATURAL join's match columns (or the [USING] list): the columns of the source at [p] that some earlier source already has. A layout with no source there describes a scan the [FROM] list does not, and equates nothing. *)let common_columns (layout : (string * string list) list) p (j : Ast.join) = if j.using <> [] then j.using else let leading = leading layout (p - 1) in match List.nth_opt layout p with | None -> [] | Some (_, jcols) -> List.filter (fun c -> owner_of leading c <> None) jcols
let equated_columns (layout : (string * string list) list) (s : select) = let equated_of p (j : join) = if not (j.natural || j.using <> []) then [] else let ci = p + 1 in match List.nth_opt layout ci with | None -> [] | Some (_, jcols) -> List.filter_map (fun c -> Option.map (fun i -> (ci, i)) (Catalog.Ident.index c jcols)) (common_columns layout ci j) in List.concat (List.mapi equated_of s.joins)
type layout_kind = Sources of (int * int) list | Frames
(* The refusal a name two sources publish earns, by the name as written: a qualified reference carries its qualifier into the message and a bare one does not. *)let ambiguous qual name = match qual with | Some q -> Catalog.Error.fail_prepare "ambiguous column name: %s.%s" q name | None -> Catalog.Error.fail_prepare "ambiguous column name: %s" name
let layout_slot kind (layout : (string * string list) list) qual name = let bears a = match qual with None -> true | Some q -> ident_equal q a in let equated = match kind with Sources e -> e | Frames -> [] in let published name = let rec go ci found = function | [] -> List.rev found | (a, cols) :: t -> let found = match if bears a then Catalog.Ident.index name cols else None with | Some j when found <> [] && List.mem (ci, j) equated -> found | Some j -> (ci, j) :: found | None -> found in go (ci + 1) found t in go 0 [] layout in let found = match published name with | [] when is_rowid_name name -> published rowid_sentinel | found -> found in match (found, kind) with | [], _ -> None | slot :: _, Frames | [ slot ], Sources _ -> Some slot | _ :: _ :: _, Sources _ -> ambiguous qual name
(* Whether [layout] has a place for the column reference [qual].[name]: the same lookup, asked for an answer rather than for a position. *)let layout_publishes kind layout qual name = Option.is_some (layout_slot kind layout qual name)
let check_columns layout (s : select) = let kind = Sources (equated_columns layout s) in let unknown qual name = match qual with | Some q -> Catalog.Error.fail_prepare "no such column: %s.%s" q name | None -> Catalog.Error.fail_prepare "no such column: %s" name in let rec check e = match e with | Col (qual, name) -> if not (layout_publishes kind layout qual name) then unknown qual name (* A subquery reads sources of its own, which [layout] does not describe, and a column free in it is the enclosing query's rather than an unknown one. Neither question can be settled from here, so both are left to the lowering, which has the whole scope. *) | e -> Ast.fold_expr ~select:(fun () _ -> ()) (fun () x -> check x) () e in List.iter (fun (rc : result_col) -> check rc.expr) s.cols; Option.iter check s.where; List.iter check s.group_by; Option.iter check s.having; List.iter (fun (e, _) -> check e) s.order_by; List.iter (fun (j : join) -> check j.on) s.joins