Something went wrong. Try again.
My own corner of monopam
Something went wrong. Try again.
6.9 kB · 187 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188(*--------------------------------------------------------------------------- Copyright (c) 2026 Thomas Gazagnaire. All rights reserved. SPDX-License-Identifier: ISC ---------------------------------------------------------------------------*)
open Ast
(* Map a list left to right, one element finished before the next is begun. [List.map] leaves the order of its applications unspecified, and every traversal here reads it: [next] is a monotonic counter, so an element mapped out of turn takes a number the text gives another. Every list a statement writes side by side goes through this rather than through [List.map]. *)let rec ordered_map f = function | [] -> [] | x :: rest -> let y = f x in y :: ordered_map f rest
let rec renum_expr next e = match e with | Param i -> Param (next i) | e -> Ast.map_expr ~select:(renum_select next) (renum_expr next) e
(* A [WITH] clause is written before whatever reads it -- a SELECT, but also a DELETE or an UPDATE, which is why this is its own function. *)and renum_ctes next ctes = ordered_map (fun (c : cte) -> { c with query = renum_select next c.query }) ctes
and renum_from next = function | (Unit | Table _) as f -> f | Select fs -> Select { fs with fs_select = renum_select next fs.fs_select } | Values rows -> Values (ordered_map (ordered_map (renum_expr next)) rows) | Table_function tf -> Table_function { tf with tf_args = ordered_map (renum_expr next) tf.tf_args }
and renum_joins next joins = ordered_map (fun (j : join) -> let table = match j.table.subquery with | Some q -> { j.table with subquery = Some (renum_select next q) } | None -> j.table in { j with table; on = renum_expr next j.on }) joins
(* Source order: SELECT cols, FROM (subquery), JOINs, WHERE, ORDER BY, LIMIT. *)and renum_select next (s : select) = let ctes = renum_ctes next s.ctes in let cols = ordered_map (fun (rc : result_col) -> { rc with expr = renum_expr next rc.expr }) s.cols in let from = renum_from next s.from in let joins = renum_joins next s.joins in let where = Option.map (renum_expr next) s.where in let group_by = ordered_map (renum_expr next) s.group_by in let having = Option.map (renum_expr next) s.having in let compound = ordered_map (fun (op, arm) -> (op, renum_select next arm)) s.compound in let order_by = ordered_map (fun (e, d) -> (renum_expr next e, d)) s.order_by in let limit = Option.map (renum_expr next) s.limit in let offset = Option.map (renum_expr next) s.offset in { s with ctes; cols; from; joins; where; group_by; having; compound; order_by; limit; offset; }
(* A list of expressions written side by side -- the tuple of an INSERT, the arguments of a call -- numbered in the order it is written. *)let renum_exprs next = ordered_map (renum_expr next)
(* Whether the query holds a [?] at all, answered by the numbering traversal rather than by a walk of its own: the numbering already reaches every expression a select can hold, and a second traversal would be one more thing to keep in step with the AST. *)let select_has_param s = let found = ref false in let next _ = found := true; 0 in ignore (renum_select next s); !found
let rec renum_stmt next stmt = let e = renum_expr next and es = renum_exprs next in let rcs l = ordered_map (fun (rc : result_col) -> { rc with expr = e rc.expr }) l in match stmt with | Select s -> Select (renum_select next s) | Insert (i : insert) -> let source = match i.source with | Values rows -> Values (ordered_map es rows) | Select s -> Select (renum_select next s) | Default_values -> Default_values in let upsert = Option.map (fun (u : upsert) -> (* The target's own WHERE is numbered before the DO UPDATE's, since that is the order the statement writes them in. *) let target_where = Option.map e u.target_where in match u.action with | Nothing -> { u with target_where } | Update (sets, w) -> let sets = ordered_map (fun (c, x) -> (c, e x)) sets in { u with target_where; action = Update (sets, Option.map e w) }) i.upsert in let returning = rcs i.returning in Insert { i with source; upsert; returning } | Delete d -> let ctes = renum_ctes next d.ctes in let where = Option.map e d.where in Delete { d with ctes; where; returning = rcs d.returning } | Update u -> let ctes = renum_ctes next u.ctes in let sets = ordered_map (fun (c, x) -> (c, e x)) u.sets in (* [UPDATE t SET ... FROM u JOIN v ON ...]: written after the assignments and before the WHERE, and its operands carry placeholders like any other FROM. *) let from = Option.map (fun (f, joins) -> (renum_from next f, renum_joins next joins)) u.from in let where = Option.map e u.where in Update { u with ctes; sets; from; where; returning = rcs u.returning } | Create_table_as cta -> Create_table_as { cta with query = renum_select next cta.query } (* An EXPLAIN takes no parameters of its own, and the statement it describes numbers its own from one -- the same numbering it would get run alone, so that describing a statement and running it bind the same values. *) | Explain e -> Explain { e with explained = renum_stmt next e.explained } (* A trigger's own body and WHEN are not numbered: a stored program has no statement to bind a placeholder in, and {!stmt_has_param} is what refuses one there. The rest declare no expression a caller binds. *) | ( Create_table _ | Create_index _ | Create_view _ | Create_trigger _ | Drop _ | Alter_table _ | Pragma _ | Begin _ | Commit | Rollback | Savepoint _ | Release _ | Rollback_to _ | Vacuum | Analyze ) as s -> s
let number_params stmt = (* the number before the first, so the first bare [?] takes 0 *) let largest = ref (-1) in let next written = let i = if written < 0 then !largest + 1 else written in if i > !largest then largest := i; i in renum_stmt next stmt
(* Whether [f] writes a [?] anywhere, answered by the numbering traversal it is given rather than by a walk of its own: the numbering already reaches every expression, and a second traversal would be one more thing to keep in step with the AST. *)let holds_param f = let found = ref false in let next _ = found := true; 0 in ignore (f next); !found
let stmt_has_param stmt = holds_param (fun next -> renum_stmt next stmt)let expr_has_param e = holds_param (fun next -> renum_expr next e)