Something went wrong. Try again.
My own corner of monopam
Something went wrong. Try again.
41 kB · 1025 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026(*--------------------------------------------------------------------------- Copyright (c) 2026 Thomas Gazagnaire. All rights reserved. SPDX-License-Identifier: ISC ---------------------------------------------------------------------------*)
module Ir = Catalog.Irmodule V = Catalog.Value
let unsupported () = raise Ir.Unsupported
(* The kind of a subquery a lowering registers: a correlated scalar value, an [EXISTS] test or an [IN (SELECT)] membership, or the held answer of an uncorrelated membership. *)type subkind = | Scalar | Exists | In of Ir.comparison | Member of Value_op.in_set
type layout = (string * string list) list
type lowering = { layout : layout; affinity : int * int -> Catalog.Value_ops.affinity option; membership : Ast.select -> Query.membership; equated : (int * int) list; kind : Resolve.layout_kind; coalesced : ((int * int) * (int * int)) list; trigger : bool; mutable subs : (subkind * Ast.select) list; mutable nsubs : int;}
let register_sub lw kind sub = let id = lw.nsubs in lw.subs <- (kind, sub) :: lw.subs; lw.nsubs <- id + 1; id
let trigger_domains : Domain.id list Atomic.t = Atomic.make []
(* [Domain.id] is a private int, so one domain is another exactly where the integers are equal; spelling the comparison on the int says which equality this is rather than leaving it to the structural one. *)let same_domain (a : Domain.id) (b : Domain.id) = Int.equal (a :> int) (b :> int)
let rec enter_program d = let held = Atomic.get trigger_domains in if not (Atomic.compare_and_set trigger_domains held (d :: held)) then enter_program d
let rec leave_program d = let held = Atomic.get trigger_domains in (* one entry, not every entry: a program reached from inside another leaves the outer one running *) let rec drop = function | x :: t when same_domain x d -> t | x :: t -> x :: drop t | [] -> [] in if not (Atomic.compare_and_set trigger_domains held (drop held)) then leave_program d
let in_trigger_program f = let d = Domain.self () in enter_program d; Fun.protect ~finally:(fun () -> leave_program d) f
(* Whether this domain is running a trigger program. *)let in_program () = match Atomic.get trigger_domains with | [] -> false | held -> List.exists (same_domain (Domain.self ())) held
(* Compare two values under a collating sequence -- the frontend's own collated comparison, for an [ORDER BY] key that carries a [COLLATE]. The sequence is the resolved one the lowering put in the key, not a name to look up. *)let collate = Catalog.Value_ops.compare_values_coll
(* The IR's value layer is the frontend's own functions, called directly: the frontend and the engine share {!Catalog.Value.t}, so no value conversion sits between them, and a query the IR runs agrees with one the frontend evaluates by sharing the code. Only the operator enums differ, mapped by {!ast_cmp}/{!ast_logic}. *)let ast_cmp : Ir.binop -> Ast.binop = function | Eq -> Eq | Ne -> Neq | Lt -> Lt | Le -> Le | Gt -> Gt | Ge -> Ge | _ -> assert false
let ast_logic : Ir.logicop -> Ast.binop = function | And -> And | Or -> Or | Like -> Like | Glob -> Glob | Concat -> Concat | Json_get -> Json_get | Json_get_text -> Json_get_text
let builtins : Ir.builtins = { call = (fun name coll args -> Func.apply ?coll name args); compare = (fun op (c : Ir.comparison) va vb -> Value_op.compare_op ?aff:c.aff ?coll:c.coll (ast_cmp op) va vb); logic = (fun op va vb -> Value_op.binop_value (ast_logic op) va vb); not_ = Catalog.Value_ops.not_value; is_eq = (fun (c : Ir.comparison) va vb -> Catalog.Value_ops.is_value ?aff:c.aff ?coll:c.coll va vb); in_list = (fun (c : Ir.comparison) v cands -> Value_op.in_list_value ?aff:c.aff ?coll:c.coll v cands); cast = Catalog.Value_ops.cast; subquery = (fun _ _ _ -> unsupported ()); }
(* The comparison, opcode-free, and arithmetic operator groups of [Ast.binop]. *)let is_cmp : Ast.binop -> bool = function | Eq | Neq | Lt | Le | Gt | Ge -> true | _ -> false
let is_logic : Ast.binop -> bool = function | And | Or | Like | Glob | Concat | Json_get | Json_get_text -> true | _ -> false
let ir_cmp : Ast.binop -> Ir.binop = function | Eq -> Eq | Neq -> Ne | Lt -> Lt | Le -> Le | Gt -> Gt | Ge -> Ge | _ -> unsupported ()
let ir_logic : Ast.binop -> Ir.logicop = function | And -> And | Or -> Or | Like -> Like | Glob -> Glob | Concat -> Concat | Json_get -> Json_get | Json_get_text -> Json_get_text | _ -> unsupported ()
let ir_arith : Ast.binop -> Ir.binop = function | Add -> Add | Sub -> Sub | Mul -> Mul | Div -> Div | Mod -> Mod | Bit_and -> Band | Bit_or -> Bor | Shl -> Shl | Shr -> Shr | _ -> unsupported ()
(* The position of the column named [name] in [cols], matched as an identifier. *)let col_index name cols = Catalog.Ident.index name cols
(* The hidden slot a scan publishes for its integer rowid. *)let rowid_sentinel = Ast.rowid_sentinel
(* Where [alias.name] (or a bare [name]) reads its value in the layout, the rowid fallback included. {!Resolve.layout_slot} is the rule, and it is read from there rather than restated: the same reference is resolved by {!Resolve.check_columns} to decide whether the statement resolves at all, and a second copy of the rule is a statement described that cannot run. *)let col = Resolve.layout_slot
let resolve_col lw alias name = (* a qualified reference is named in full, as sqlite3 names it: "no such column: t.nocol", not just the bare column *) match col lw.kind lw.layout alias name with | Some r -> r | None -> ( match alias with | Some a -> Catalog.Error.fail_prepare "no such column: %s.%s" a name | None -> Catalog.Error.fail_prepare "no such column: %s" name)
let collation_of = Collation.sequence
let rec ast_affinity lw = function | Ast.Col (alias, name) -> lw.affinity (resolve_col lw alias name) | Ast.Collate (e, _) -> ast_affinity lw e | Ast.Cast (_, ty) -> Some (Catalog.Value_ops.affinity_of_type ty) | _ -> None
(* The sequence a comparison compares text under: the left operand's if it names one, else the right's (datatype3.html sec.7.1 rule 1). BINARY is the default, so naming it is the same as naming none -- but only after the rule has picked a side, or a left [COLLATE BINARY] would lose to a right [COLLATE NOCASE] it is supposed to beat. *)let comparison_collation a b = match match collation_of a with Some _ as c -> c | None -> collation_of b with | Some Catalog.Collation.Binary -> None | c -> c
(* What a comparison of [a] and [b] applies to both operands: the one affinity {!Catalog.Value_ops.compare_affinity} computes for the pair from the two operands' own, and the sequence the collation rule picks. *)let comparison_of lw a b : Ir.comparison = { aff = Catalog.Value_ops.compare_affinity (ast_affinity lw a) (ast_affinity lw b); coll = comparison_collation a b; }
(* The sequence an operand carries on its own -- a membership's left operand, a sort / group / dedup key. BINARY is the default, so naming it explicitly is the same as naming none. *)let nonbinary_collation e = match collation_of e with | Some Catalog.Collation.Binary | None -> None | c -> c
(* The sequence a call that compares its argument values runs under ({!Collation.call_sequence}): the scalar [min]/[max]/[nullif] and the [min]/[max] aggregate fold make the same read. *)let arguments_collation = Collation.call_sequencelet strip_collate = Collation.strip
(* A scalar call, with the sequence it compares its arguments under.
[min], [max] and [nullif] compare theirs, so the call carries the sequence {!arguments_collation} reads, and the wrappers come off once read, exactly as a comparison's do. Every other function compares nothing and carries none. *)let func_call lower name args : Ir.expr = if not (Collation.compares_its_arguments name) then Func (name, None, List.map lower args) else Func ( name, arguments_collation args, List.map (fun a -> lower (strip_collate a)) args )
let join_column lw (c, j) = match List.assoc_opt (c, j) lw.coalesced with | None -> Ir.Col (c, j) | Some (jc, jj) -> Ir.Func ("coalesce", None, [ Ir.Col (c, j); Ir.Col (jc, jj) ])
let is_expr lw op_of a b : Ir.expr = Is (comparison_of lw a b, op_of (strip_collate a), op_of (strip_collate b))
(* A membership whose subquery reads nothing of the row is answered from its rows, which ran once. A short list is compared in place, as a written one is; past [held_membership] values the rows are held sorted ({!Value_op.in_set}) and each row's operand is looked up, so the outer scan costs a search per row rather than a pass over the inner rows. *)let held_membership = 8
let in_select lw op_of e sub : Ir.expr = let rhs = lw.membership sub in let c : Ir.comparison = { aff = Catalog.Value_ops.compare_affinity (ast_affinity lw e) rhs.Query.states; coll = nonbinary_collation e; } in let left = op_of (strip_collate e) in match rhs.Query.rows with | Some vs when List.compare_length_with vs held_membership > 0 -> let held = Value_op.in_set ?aff:c.aff ?coll:c.coll vs in Subquery (register_sub lw (Member held) sub, Some left) | Some vs -> In (left, c, List.map (fun v -> Ir.Lit v) vs) | None -> Subquery (register_sub lw (In c) sub, Some left)
(* The action a [RAISE()] carries, as the IR spells it. The grammar's raisetype production admits exactly these four (parser.mly, [raise_arg]), so the two remaining conflict clauses -- the unspecified one and REPLACE -- name no raisetype and cannot be written here. *)let raise_action : Ast.insert_conflict -> Ir.raise_action = function | Ignore -> Ignore | Abort -> Abort | Fail -> Fail | Rollback -> Rollback | Unspecified | Replace -> Catalog.Error.fail_prepare "RAISE() takes ABORT, FAIL, ROLLBACK or IGNORE"
let raise_expr lw lower action message : Ir.expr = if not lw.trigger then Catalog.Error.fail_prepare "RAISE() may only be used within a trigger-program" else Raise (raise_action action, Option.map lower message)
let rec expr lw (e : Ast.expr) : Ir.expr = match e with | Lit v -> Lit v (* the sign never came, so the magnitude alone is what the literal denotes: the real no int64 holds *) | Big_int s -> Lit (Ast.number s) | Param i -> Param i | Col (alias, name) -> ( let c, j = resolve_col lw alias name in match alias with Some _ -> Col (c, j) | None -> join_column lw (c, j)) | Unop_not e -> Not (expr lw e) (* Unary [+] is a value no-op, so it lowers to nothing. What it does change -- the operand's affinity and its being a column -- is decided on the AST, by [is_col_ast] and [states_affinity], before the lowering gets here. *) | Unary_plus e -> expr lw e (* Unary [-] computes what a subtraction from zero computes, and is coded as one: sqlite3 keeps the operator only so a literal's text can be read with its sign (codeInteger, src/expr.c) and otherwise emits the same subtraction (OP_Subtract against a zero register). What the node buys is upstream of here -- the text a DEFAULT is stored and reported as. *) | Unary_minus e -> expr lw (Binary (Sub, Lit (Int 0L), e)) | Binary (op, a, b) -> if is_cmp op then cmp_expr lw op a b else if is_logic op then Logic (ir_logic op, expr lw a, expr lw b) else Arith (ir_arith op, expr lw a, expr lw b) | Is_null e -> Null_value (true, expr lw e) | Is_not_null e -> Null_value (false, expr lw e) | Is (a, b) -> is_expr lw (expr lw) a b (* datatype3.html sec.7.1: "the collating sequence used for expressions of the form x IN (y, z, ...) is the collating sequence of x". A COLLATE among the candidates names nothing, so its wrapper is only the value no-op it always is and comes off. *) | In_list (e, cands) -> In ( expr lw (strip_collate e), { aff = ast_affinity lw e; coll = nonbinary_collation e }, List.map (fun c -> expr lw (strip_collate c)) cands ) | Func ("iif", [ c; t; f ]) -> expr lw (Case (None, [ (c, t) ], Some f)) | Func (name, args) when not (Query.is_agg name args) -> func_call (expr lw) name args | Func (name, _) -> Fmt.failwith "%s() is an aggregate function and is only valid as a select item, not \ in WHERE, ON, or ORDER BY" name | Case (base, branches, els) -> let branch (c, r) = let p = match base with | None -> predicate lw c (* the base against this branch's value is an ordinary comparison, so it reads a collating sequence and states its affinity like one *) | Some b -> cmp_pred lw Ast.Eq b c in (p, expr lw r) in Case (List.map branch branches, Option.map (expr lw) els) | Cast (e, ty) -> Cast (expr lw e, ty) (* A correlated subquery becomes an opaque [Subquery] node: register the [Ast.select] and its kind, and (for [IN]) lower the left operand whose value the membership test reads. An uncorrelated one is already folded to a constant before lowering ([Query.hoist_subqueries]), so what reaches here is correlated, run per outer row by the injected runner. *) | Scalar_select sub -> Subquery (register_sub lw Scalar sub, None) | Exists sub -> Subquery (register_sub lw Exists sub, None) (* [Resolve.collations] leaves the sequence the membership compares under on the left operand, whichever end supplied it, so the registration reads it from there exactly as an [In_list] does. *) | In_select (e, sub) -> in_select lw (expr lw) e sub (* A schema this database has not got holds no table and so no column. sqlite3 resolves the qualifier against the attached databases and names the whole reference when it places none; the two contexts that ignore the qualifier instead have dropped it at the parse, so what reaches here is a query's, and a query's is an error. *) | Schema_col (s, t, c) -> Catalog.Error.fail_prepare "no such column: %s.%s.%s" s t c | Raise (action, message) -> raise_expr lw (expr lw) action message | Star | Qualified_star _ | Distinct_agg _ | Filter _ | Ordered_agg _ | Window _ | Collate _ -> unsupported ()
and predicate lw (e : Ast.expr) : Ir.predicate = match e with | Binary (And, a, b) -> And (predicate lw a, predicate lw b) | Binary (Or, a, b) -> Or (predicate lw a, predicate lw b) | Binary (op, a, b) when is_cmp op -> cmp_pred lw op a b | Is_null e -> Null_test (true, expr lw (strip_collate e)) | Is_not_null e -> Null_test (false, expr lw (strip_collate e)) (* a bare [WHERE expr] keeps the truthy rows; [expr] itself rejects a shape the IR cannot model (a subquery, a window), falling the whole predicate back *) | e -> Truthy (expr lw (strip_collate e))
and cmp_expr lw op a b : Ir.expr = Cmp ( ir_cmp op, comparison_of lw a b, expr lw (strip_collate a), expr lw (strip_collate b) )
and cmp_pred lw op a b : Ir.predicate = let c = comparison_of lw a b in match c.coll with | Some _ -> Truthy (cmp_expr lw op a b) | None -> Compare (ir_cmp op, c, expr lw (strip_collate a), expr lw (strip_collate b))
let ir_dir = function Ast.Asc -> Ir.Asc | Ast.Desc -> Ir.Desc
(* Lower an [ORDER BY] key with [lower_key] (over the scan, or the synthetic group row): its expression, direction, and collation. *)let order_key lower_key (e, d) = (lower_key (strip_collate e), ir_dir d, nonbinary_collation e)
(* Expand a select item into its projected expressions: [*] and [t.*] become one column reference per source column. *)let project_item ?(hidden = []) lw (rc : Ast.result_col) : Ir.expr list = match rc.expr with | Star -> (* [*] lists every source column, except a column a NATURAL / USING join hides (the right source's copy of a common column). *) List.concat (List.mapi (fun ci (_, cols) -> List.filter_map (fun j -> if List.mem (ci, j) hidden then None else Some (join_column lw (ci, j))) (List.init (List.length cols) Fun.id)) lw.layout) | Qualified_star q -> (* [t.*] lists [t]'s columns, skipping the hidden rowid slot. *) let rec go ci = function | (al, cols) :: t -> if Ast.ident_equal al q then List.filter_map (fun j -> if List.mem (ci, j) hidden then None else Some (join_column lw (ci, j))) (List.init (List.length cols) Fun.id) else go (ci + 1) t | [] -> unsupported () in go 0 lw.layout (* A projected [COLLATE] (or unary plus) produces the bare value -- the collation governs only comparison/ordering/dedup, captured separately in the query's ORDER BY keys and [distinct_colls]. *) | e -> [ expr lw (strip_collate e) ]
let projection expand (s : Ast.select) = let of_col (rc : Ast.result_col) = let cols = expand rc in if not s.distinct then (cols, []) else let c = nonbinary_collation rc.expr in (cols, List.map (fun _ -> c) cols) in let cols, colls = List.split (List.map of_col s.cols) in (List.concat cols, List.concat colls)
let count_int64 params (e : Ast.expr) = let value = match e with | Ast.Lit v -> Some v | Param i when i >= 0 && i < Array.length params -> Some params.(i) | _ -> None in match value with | None -> None | Some (Ast.Int n) -> Some n | Some (Ast.Float f) when Float.is_integer f && Float.abs f < 9.2e18 (* fits an int64 *) -> Some (Int64.of_float f) | Some (Ast.Null | Ast.Float _ | Ast.Text _ | Ast.Blob _) -> failwith "datatype mismatch"
(* A non-negative row count clamped to a native int: a value beyond the native range exceeds any materialised row count, so [max_int] is exact (keep all for a limit, skip all for an offset) without truncating to a wrong small number. *)let clamp_count n = if Int64.compare n (Int64.of_int max_int) >= 0 then max_int else Int64.to_int n
let natural_on (layout : layout) p (j : Ast.join) = let jalias, jcols = match List.nth_opt layout p with Some s -> s | None -> unsupported () in let leading = Resolve.leading layout (p - 1) in let eq c = let owner = Resolve.owner_of leading c in if j.Ast.using <> [] && (Option.is_none owner || Option.is_none (col_index c jcols)) then Catalog.Error.fail_prepare "cannot join using column %s - column not present in both tables" c; Option.map (fun a -> Ast.Binary (Ast.Eq, Ast.Col (Some a, c), Ast.Col (Some jalias, c))) owner in match List.filter_map eq (Resolve.common_columns layout p j) with | [] -> Ast.Lit (Ast.Int 1L) | e :: rest -> List.fold_left (fun acc x -> Ast.Binary (Ast.And, acc, x)) e rest
(* The hidden rowid slots: any [rowid_sentinel] column a scan published. [Star] drops these so [SELECT *] never returns the implicit rowid. *)let sentinel_columns (layout : layout) = List.concat (List.mapi (fun ci (_, cols) -> List.filter_map (fun (j, c) -> if c = rowid_sentinel then Some (ci, j) else None) (List.mapi (fun j c -> (j, c)) cols)) layout)
(* The [(cursor, column)] positions a [*] does not list: the hidden rowid slots, and the joined source's copy of each column a NATURAL / USING join equated, which the join publishes once (lang_select.html sec.3). What a star stands for is settled by the FROM clause, so the set is the same over the scan and over a group row. *)let hidden_columns lw = lw.equated @ sentinel_columns lw.layout
(* The scan filter: the [WHERE] alone. Every [ON] is its own join's, applied at that join's level -- which is what keeps the [ON]s of the joins before an outer one from re-testing the rows it padded. *)let filter_of lw (s : Ast.select) = match s.where with Some w -> predicate lw w | None -> Ir.Always
(* A negative LIMIT is unbounded ([None]); a huge one clamps to [max_int] (every row kept); a non-literal one falls back (sqlite3). *)let limit_of params (s : Ast.select) = match s.limit with | None -> None | Some e -> ( match count_int64 params e with | None -> unsupported () | Some n when n < 0L -> None | Some n -> Some (clamp_count n))
(* A negative OFFSET is zero; a huge one clamps to [max_int] (every row skipped); a non-literal one falls back (sqlite3). *)let offset_of params (s : Ast.select) = match s.offset with | None -> 0 | Some e -> ( match count_int64 params e with | None -> unsupported () | Some n when n < 0L -> 0 | Some n -> clamp_count n)
let outer_kind_of : Ast.join_type -> Ir.outer_kind option = function | Left -> Some Ir.Left | Right -> Some Ir.Right | Full -> Some Ir.Full | Inner -> None
(* The positions {!join_column} coalesces: for each common column of a NATURAL / USING level that preserves the source it takes, the owner's copy and the joined source's. A [Left] or inner level never pads the owner, so its copy is the answer there and no coalesce is called for. *)let coalesced_columns (layout : layout) (s : Ast.select) = let pairs_of p (j : Ast.join) = let ci = p + 1 in match (outer_kind_of j.Ast.type_, List.nth_opt layout ci) with | Some (Ir.Right | Ir.Full), Some (_, jcols) when j.Ast.natural || j.Ast.using <> [] -> let leading = Resolve.leading layout p in let pair c = match (Resolve.owner_of leading c, col_index c jcols) with | Some a, Some jj -> (* the owner's own copy, asked for a position and not for a name a statement wrote, so the first match is the answer *) Option.map (fun owner -> (owner, (ci, jj))) (col Resolve.Frames layout (Some a) c) | _ -> None in List.filter_map pair (Resolve.common_columns layout ci j) | _ -> [] in List.concat (List.mapi pairs_of s.joins)
(* The predicate a join's level tests: its written [ON], or the implicit one a NATURAL / USING level stands for ({!natural_on}). A comma, a [CROSS] join, an [ON]-less one and a NATURAL level with nothing to equate all come out as the constant-true [1], which is no test at all: normalising it to {!Catalog.Ir.Always} keeps the level from emitting one. *)let join_pred lw p (j : Ast.join) = let on = if j.natural || j.using <> [] then natural_on lw.layout (p + 1) j else j.on in match on with Ast.Lit (Ast.Int 1L) -> Ir.Always | e -> predicate lw e
let conj a b = match a with Ir.Always -> b | _ -> Ir.And (a, b)
let scan_joins lw (s : Ast.select) = let level p (j : Ast.join) = let kind = outer_kind_of j.Ast.type_ in let on = join_pred lw p j in if kind = None && Ir.reach on > p + 1 then ({ Ir.kind; on = Ir.Always }, on) else ({ Ir.kind; on }, Ir.Always) in let joins, deferred = List.split (List.mapi level s.joins) in let unwritten = List.length lw.layout - 1 - List.length joins in let joins = joins @ List.init (max 0 unwritten) (fun _ -> Ir.inner) in (joins, List.fold_left conj (filter_of lw s) deferred)
(* A select carrying nothing but a projection. {!query} reads the layout it is given and never the [FROM], so this is the vehicle for lowering a post-pass over rows the caller already holds: the caller adds the result clauses it wants ([ORDER BY], [DISTINCT], [LIMIT]) and supplies the rows as a cursor. *)let post_select cols : Ast.select = { ctes = []; distinct = false; cols; from = Ast.Unit; joins = []; where = None; group_by = []; having = None; compound = []; order_by = []; limit = None; offset = None; }
(* What the layout handed to a lowering describes. A select's own FROM names one source per entry, and a name two of them publish is an ambiguity; a caller lowering a projection over rows it already holds ({!post_select}) writes no FROM at all, so its frames are not sources and the first match answers. *)let layout_kind_of equated (layout : layout) (s : Ast.select) = match s.Ast.from with | Ast.Unit -> Resolve.Frames | Table _ | Select _ | Values _ | Table_function _ -> if List.length layout = 1 + List.length s.Ast.joins then Resolve.Sources equated else Resolve.Frames
let needs_runner subs = List.exists (function Member _, _ -> false | _ -> true) subs
let member subs id left _scope = match (List.nth subs id, left) with | (Member held, _), Some v -> Value_op.in_set_mem held v | _ -> unsupported ()
let lowering ~affinity ~membership layout s = let equated = Resolve.equated_columns layout s in { layout; affinity; membership; equated; kind = layout_kind_of equated layout s; coalesced = coalesced_columns layout s; trigger = in_program (); subs = []; nsubs = 0; }
let query ?(params = [||]) ?(affinity = fun _ -> None) ?(membership = fun _ -> Query.opaque_membership) (layout : layout) (s : Ast.select) : Ir.query * (subkind * Ast.select) list = if Query.is_aggregate_query s || s.compound <> [] then unsupported (); let lw = lowering ~affinity ~membership layout s in let arities = List.map (fun (_, cols) -> List.length cols) layout in let joins, filter = scan_joins lw s in let hidden = hidden_columns lw in let project, distinct_colls = projection (project_item ~hidden lw) s in let select = { Ir.arities; joins; filter; project } in let order_by = List.map (order_key (expr lw)) s.order_by in let q = { Ir.select; order_by; distinct = s.distinct; distinct_colls; limit = limit_of params s; offset = offset_of params s; } in (q, List.rev lw.subs)
(* The aggregate names this lowers: a star [count], the numeric aggregates, and the string aggregates (group_concat / string_agg). [DISTINCT], a [FILTER] and an in-call [ORDER BY] are decorations {!as_aggregate} peels off any of these, and the engine applies them to the argument stream, so they compile too; a window function does not, and falls back. *)let numeric_aggs = [ "count"; "sum"; "min"; "max"; "avg"; "total" ]let string_aggs = [ "group_concat"; "string_agg" ]
(* A plain aggregate call: a star [count], a numeric aggregate of an argument, or a string aggregate ([group_concat]/[string_agg], with an optional separator argument), optionally [DISTINCT] -- its name, distinctness, and argument expressions ([] for a star count). [None] for anything else. *)let core_aggregate : Ast.expr -> (string * bool * Ast.expr list) option = function | Func ("count", [ Star ]) -> Some ("count", false, []) | Func (name, args) when (List.mem name numeric_aggs || List.mem name string_aggs) && Query.is_agg name args -> Some (name, false, args) | Distinct_agg (name, arg) when List.mem name numeric_aggs || List.mem name string_aggs -> Some (name, true, [ arg ]) | _ -> None
(* A plain aggregate call, peeling any [FILTER (WHERE p)] and [ORDER BY] around the core call: its name, distinctness, arguments, optional FILTER predicate, and ORDER BY keys. [None] for anything that is not an aggregate. *)let as_aggregate e = let rec peel filter order = function | Ast.Filter (inner, p) -> peel (Some p) order inner | Ast.Ordered_agg (inner, ob) -> peel filter ob inner | core -> ( match core_aggregate core with | Some (name, distinct, args) -> Some (name, distinct, args, filter, order) | None -> None) in peel None [] e
(* The value-level aggregate fold injected into {!Catalog.Ir.run_grouped}: the shared {!Catalog.Value_ops.agg_acc}, which the window post-pass folds through too. *)let agg_fold = Catalog.Value_ops.agg_acc
let out_cmp ~lw ~op_of op a b : Ir.expr = Cmp ( ir_cmp op, comparison_of lw a b, op_of (strip_collate a), op_of (strip_collate b) )
let out_cmp_pred ~lw ~op_of op a b : Ir.predicate = let c = comparison_of lw a b in match c.coll with | Some _ -> Truthy (out_cmp ~lw ~op_of op a b) | None -> Compare (ir_cmp op, c, op_of (strip_collate a), op_of (strip_collate b))
(* Lower a HAVING, or a CASE branch's condition, to a filter over the group row. [op_of] is the operand lowering the caller resolves against that row. *)let rec out_pred ~lw ~op_of (e : Ast.expr) : Ir.predicate = match e with | Binary (And, a, b) -> And (out_pred ~lw ~op_of a, out_pred ~lw ~op_of b) | Binary (Or, a, b) -> Or (out_pred ~lw ~op_of a, out_pred ~lw ~op_of b) | Binary (op, a, b) when is_cmp op -> out_cmp_pred ~lw ~op_of op a b | Is_null e -> Null_test (true, op_of (strip_collate e)) | Is_not_null e -> Null_test (false, op_of (strip_collate e)) | e -> Truthy (op_of (strip_collate e))
let rec out_operand ~lw ~nkeys ~ncols ~key_index ~collect ~resolve_bare (e : Ast.expr) : Ir.expr = let recur = out_operand ~lw ~nkeys ~ncols ~key_index ~collect ~resolve_bare in match key_index e with | Some i -> Col (0, i) | None -> ( match as_aggregate e with (* the synthetic row is [keys, representative columns, aggregate results], so an aggregate sits past the [ncols] representative columns *) | Some info -> Col (0, nkeys + ncols + collect e info) | None -> ( match e with | Lit v -> Lit v | Param i -> Param i | Unop_not e -> Not (recur e) | Binary (op, a, b) -> if is_cmp op then out_cmp ~lw ~op_of:recur op a b else if is_logic op then Logic (ir_logic op, recur a, recur b) else Arith (ir_arith op, recur a, recur b) | Is_null e -> Null_value (true, recur e) | Is_not_null e -> Null_value (false, recur e) | Is (a, b) -> is_expr lw recur a b | In_list (e, cands) -> In ( recur (strip_collate e), { aff = ast_affinity lw e; coll = nonbinary_collation e }, List.map (fun c -> recur (strip_collate c)) cands ) | In_select (e, sub) -> in_select lw recur e sub | Func ("iif", [ c; t; f ]) -> recur (Case (None, [ (c, t) ], Some f)) | Func (name, args) when not (Query.is_agg name args) -> func_call recur name args | Cast (e, ty) -> Cast (recur e, ty) (* the branch conditions are predicates over the same group row, so they take the group row's filter lowering; the results are values on it, like every other operand here *) | Case (base, branches, els) -> let branch (c, r) = let p = match base with | None -> out_pred ~lw ~op_of:recur c (* the base against this branch's value is an ordinary comparison, and reads a sequence and states an affinity like one *) | Some b -> out_cmp_pred ~lw ~op_of:recur Ast.Eq b c in (p, recur r) in Case (List.map branch branches, Option.map recur els) (* a trigger program evaluates its output row like any other, so a RAISE() among a group's output columns raises where that group is emitted, its message read off the same row *) | Raise (action, message) -> raise_expr lw recur action message (* a bare (non-key) column reads from the group's representative row *) | Col _ -> resolve_bare e | _ -> unsupported ()))
(* The position of [e] among the group keys (by structural expression, ignoring a [COLLATE] wrapper on either side: [GROUP BY a COLLATE NOCASE] groups by [a], so a projected bare [a] is that key). *)let key_index keys e = let e = strip_collate e in let rec go i = function | k :: _ when Ast.equal_expr (strip_collate k) e -> Some i | _ :: t -> go (i + 1) t | [] -> None in go 0 keys
(* Whether [s]'s output (select list, HAVING, ORDER BY) reads a bare (non-key, non-aggregate) column or a [*] -- the cases that need a representative group row materialised. A column matching a group key (ignoring a [COLLATE] wrapper) or sitting inside an aggregate does not. *)let references_bare_or_star keys (s : Ast.select) = let is_key e = key_index keys e <> None in let rec bare (e : Ast.expr) = if is_key e then false else if as_aggregate e <> None then false else match e with | Star | Qualified_star _ | Col _ -> true (* Not a bare column of any relation here: it resolves nowhere. *) | Schema_col _ -> false | e -> Ast.fold_expr ~select:(fun acc _ -> acc) (fun acc x -> acc || bare x) false e in List.exists (fun (rc : Ast.result_col) -> bare rc.expr) s.cols || (match s.having with Some h -> bare h | None -> false) || List.exists (fun (e, _) -> bare e) s.order_by
let representative_shape layout keys s = let arities = List.map (fun (_, cols) -> List.length cols) layout in let bases = Ir.column_bases arities in let needs_rep = references_bare_or_star keys s in let ncols = if needs_rep then List.fold_left ( + ) 0 arities else 0 in (arities, bases, needs_rep, ncols)
let representative_choice lw needs_rep (s : Ast.select) = if not needs_rep then None else List.find_map (fun (rc : Ast.result_col) -> match rc.expr with | Func ("min", [ a ]) -> Some (false, expr lw a) | Func ("max", [ a ]) -> Some (true, expr lw a) | _ -> None) s.cols
let bare_resolver lw ~nkeys ~bases = function | Ast.Col (alias, name) -> let c, j = resolve_col lw alias name in Ir.Col (0, nkeys + bases.(c) + j) | _ -> unsupported ()
let aggregate_collector lw = let aggs = ref [] and nagg = ref 0 in let collect e info = let rec go i = function | (e', _) :: _ when e' = e -> Some i | _ :: t -> go (i + 1) t | [] -> None in match go 0 (List.rev !aggs) with | Some i -> i | None -> let name, distinct, args, filter, order = info in let agg = { Ir.name; distinct; distinct_colls = (if distinct then List.map nonbinary_collation args else []); (* the sequence is read off the arguments here, wherever in one it was written, so what the fold gets is the compared value with the wrapper spent -- as a comparison operand is lowered *) args = List.map (fun a -> expr lw (strip_collate a)) args; (* A fold that compares its arguments -- [min], [max] -- reads a sequence of its own, off the argument list as a scalar [min]/[max]/[nullif] does. Every other fold orders nothing, so its sequence is spent on the DISTINCT key alone and is carried in [distinct_colls]. *) coll = (if Collation.fold_compares name then arguments_collation args else None); (* the FILTER decides which rows the fold sees and compares nothing of its own, so a [COLLATE] over it is spent nowhere and comes off as it does in a WHERE *) filter = Option.map (fun p -> expr lw (strip_collate p)) filter; (* the in-call ORDER BY sorts the group's rows before the fold sees them, so its keys read a sequence exactly as the query's own ORDER BY keys do -- same key lowering, same wrapper stripped *) order = List.map (order_key (expr lw)) order; } in aggs := (e, agg) :: !aggs; let slot = !nagg in incr nagg; slot in (collect, (fun () -> !nagg), fun () -> List.rev_map snd !aggs)
let aggregate_star_cols layout ~hidden ~nkeys ~bases qopt = List.concat (List.mapi (fun c (al, cols) -> match qopt with | Some q when String.uppercase_ascii q <> String.uppercase_ascii al -> [] | _ -> (* every column of the source is indexed and the hidden ones skipped, exactly as {!project_item} does over the scan: the position a column reads from is its own, and stays its own wherever in the source a hidden column sits *) List.filter_map (fun j -> if List.mem (c, j) hidden then None else Some (Ir.Col (0, nkeys + bases.(c) + j))) (List.init (List.length cols) Fun.id)) layout)
(* {!project_item} over the group row: expand a select item into the expressions it projects there. *)let aggregate_item lw ~hidden ~nkeys ~bases op (rc : Ast.result_col) = let star_cols = aggregate_star_cols lw.layout ~hidden ~nkeys ~bases in match rc.Ast.expr with | Star -> star_cols None | Qualified_star q -> if List.exists (fun (al, _) -> String.uppercase_ascii al = String.uppercase_ascii q) lw.layout then star_cols (Some q) else unsupported () (* a projected COLLATE produces the bare value, as it does over the scan ({!project_item}): the sequence governs comparison, ordering and dedup, and this select's are carried in its ORDER BY keys and [distinct_colls] *) | e -> [ op (strip_collate e) ]
(* The query run over the synthetic per-group row: its projection, the sequences a DISTINCT dedups that projection under, its HAVING and its ORDER BY. *)let aggregate_output ?(params = [||]) ~lw ~nkeys ~ncols ~bases ~nagg op (s : Ast.select) = let hidden = hidden_columns lw in let project, distinct_colls = projection (aggregate_item lw ~hidden ~nkeys ~bases op) s in (* the projection, HAVING and ORDER BY all register their aggregates through [op], so [nagg] (the live count) is read only after all three are lowered -- an aggregate that appears solely in HAVING / ORDER BY still gets a synthetic-row slot. *) let filter = match s.having with Some h -> out_pred ~lw ~op_of:op h | None -> Always in let order_by = List.map (order_key op) s.order_by in let arities = [ nkeys + ncols + nagg () ] in { Ir.select = { arities; joins = []; filter; project }; order_by; distinct = s.distinct; distinct_colls; limit = limit_of params s; offset = offset_of params s; }
let aggregate_scan lw keys (s : Ast.select) = let joins, filter = scan_joins lw s in (joins, filter, List.map (fun e -> expr lw (strip_collate e)) keys)
let aggregate_query ?(params = [||]) ?(affinity = fun _ -> None) ?(membership = fun _ -> Query.opaque_membership) (layout : layout) (s : Ast.select) : Ir.grouped * (subkind * Ast.select) list = if s.compound <> [] then unsupported (); (* a correlated scalar / EXISTS / IN subquery in the scan filter (WHERE / ON) registers here, for the caller to wire a runner -- the per-source-row scope the engine passes matches what the grouped scan sees *) let lw = lowering ~affinity ~membership layout s in let keys = s.group_by in let nkeys = List.length keys in let key_index = key_index keys in let arities, bases, needs_rep, ncols = representative_shape layout keys s in (* sqlite3's companion rule: a bare column takes its value from the row holding a lone min/max in the select list (else an arbitrary, here the first, row) *) let rep = representative_choice lw needs_rep s in let resolve_bare = bare_resolver lw ~nkeys ~bases in (* aggregates in first-seen order, structurally deduped so a repeated aggregate shares one slot *) let collect, nagg, aggs = aggregate_collector lw in let op = out_operand ~lw ~nkeys ~ncols ~key_index ~collect ~resolve_bare in (* [*] (or [t.*]) expands to the representative row's scanned columns, of the matching cursor for a qualified star; an unmatched qualified star is refused, and the resolver reports "no such table". *) let output = aggregate_output ~params ~lw ~nkeys ~ncols ~bases ~nagg op s in (* A single trailing LEFT JOIN null-fills before grouping; its [ON] stays on its own level, the [WHERE] is the scan filter. Otherwise every [ON] folds into the filter, as for an inner join. *) let joins, filter, group_by = aggregate_scan lw keys s in let g = { Ir.arities; joins; filter; group_by; group_colls = List.map nonbinary_collation keys; ncols; rep; aggs = aggs (); output; } in (g, List.rev lw.subs)