Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
128 changes: 77 additions & 51 deletions lib/sql-types.scm
Original file line number Diff line number Diff line change
Expand Up @@ -18,9 +18,9 @@ the query block's result-types fact for the wire/PDO result contract. Nothing
type-related survives into the executable plan.

A descriptor is (FORMULA TYPE COLLATION):
- TYPE: uppercase SQL type name, or "any".
- COLLATION: nil, or a (NAME COERCIBILITY) pair. Lower coercibility wins:
0 = explicit COLLATE, 2 = column, 4 = literal, 5 = numeric/ignorable. */
- TYPE: uppercase SQL type name, or "any".
- COLLATION: nil, or a (NAME COERCIBILITY) pair. Lower coercibility wins:
0 = explicit COLLATE, 2 = column, 4 = literal, 5 = numeric/ignorable. */

(define sql_info (lambda (formula type collation) (list formula type collation)))
(define sql_info_formula car)
Expand Down Expand Up @@ -61,13 +61,13 @@ unicode alias. Returns nil or a (NAME COERCIBILITY) pair. */

(define sql_merge_type (lambda (ta tb)
(if (equal? ta "NULL") tb
(if (equal? tb "NULL") ta
(if (equal? ta "any") "any"
(if (equal? tb "any") "any"
(if (equal? ta tb) ta
(if (or (sql_text_type? ta) (sql_text_type? tb)) "VARCHAR"
(if (or (equal? ta "DOUBLE") (equal? tb "DOUBLE")) "DOUBLE"
(if (and (sql_numeric_type? ta) (sql_numeric_type? tb)) "DECIMAL" "VARCHAR"))))))))))
(if (equal? tb "NULL") ta
(if (equal? ta "any") "any"
(if (equal? tb "any") "any"
(if (equal? ta tb) ta
(if (or (sql_text_type? ta) (sql_text_type? tb)) "VARCHAR"
(if (or (equal? ta "DOUBLE") (equal? tb "DOUBLE")) "DOUBLE"
(if (and (sql_numeric_type? ta) (sql_numeric_type? tb)) "DECIMAL" "VARCHAR"))))))))))

(define sql_merge_info (lambda (a b)
(sql_info nil
Expand Down Expand Up @@ -112,11 +112,11 @@ cache guard by the caller; no captured value enters the result contract. */
/* ---- function return contracts ----

Each entry is (HEAD TYPE MODE):
- "fixed" : result TYPE regardless of arguments
- "first" : result TYPE, collation inherited from the first argument
- "text" : result TYPE, collation merged from all arguments
- "merge" : result type and collation merged from all arguments (COALESCE, …)
- "case" : like "merge" but over the value arms only (IF/searched CASE) */
- "fixed" : result TYPE regardless of arguments
- "first" : result TYPE, collation inherited from the first argument
- "text" : result TYPE, collation merged from all arguments
- "merge" : result type and collation merged from all arguments (COALESCE, …)
- "case" : like "merge" but over the value arms only (IF/searched CASE) */

(define sql_core_function_rules (list
(list (quote sql_compare) "BOOLEAN" "fixed")
Expand Down Expand Up @@ -338,31 +338,35 @@ the conditions are booleans and would otherwise pollute the merge. */
(reduce (cdr infos) (lambda (t i) (sql_type_fuse_arith (sql_arith_op_name head) t (sql_info_type i)))
(sql_info_type (car infos)))
nil)
(if (and (sql_comparison_head? head) (equal? (count infos) 2))
(sql_comparison_info head (car infos) (cadr infos))
(begin
(define rule (sql_function_rule head))
(define rtype (cadr rule))
(define mode (nth rule 2))
(define value_infos (if (equal? mode "case") (sql_case_value_infos infos) infos))
(define merged (sql_merge_infos value_infos))
(define type (if (has? (list "merge" "case") mode) (sql_info_type merged) rtype))
/* fixed: the function owns its result, no operand collation inherited.
first: inherit from the first argument. text/merge/case: merge the
value operands. */
(define collation (if (not (sql_text_type? type)) nil
(if (equal? mode "first")
(if (empty_list? infos) nil (sql_info_collation (car infos)))
(if (has? (list "text" "merge" "case") mode)
(sql_info_collation merged)
nil))))
(sql_info (cons head forms) type collation)))))))
(if (and (sql_comparison_head? head) (equal? (count infos) 2))
(sql_comparison_info head (car infos) (cadr infos))
(begin
(define rule (sql_function_rule head))
(define rtype (cadr rule))
(define mode (nth rule 2))
(define value_infos (if (equal? mode "case") (sql_case_value_infos infos) infos))
(define merged (sql_merge_infos value_infos))
(define type (if (has? (list "merge" "case") mode) (sql_info_type merged) rtype))
/* fixed: the function owns its result, no operand collation inherited.
first: inherit from the first argument. text/merge/case: merge the
value operands. */
(define collation (if (not (sql_text_type? type)) nil
(if (equal? mode "first")
(if (empty_list? infos) nil (sql_info_collation (car infos)))
(if (has? (list "text" "merge" "case") mode)
(sql_info_collation merged)
nil))))
(sql_info (cons head forms) type collation)))))))

(define sql_expr_info (lambda (sources expr)
(match expr
((symbol get_column) tblvar tbl_ic col col_ic) (sql_get_column_info sources tblvar tbl_ic col col_ic)
((quote get_column) tblvar tbl_ic col col_ic) (sql_get_column_info sources tblvar tbl_ic col col_ic)
((symbol quote) _datum) (sql_info expr "any" nil)
/* Frontends attach the declared contract to their conversion formula.
Resolve the operand normally; only its executable formula survives. */
((symbol sql_type_expr) formula type collation)
(sql_info (sql_info_formula (sql_expr_info sources formula)) type collation)
((symbol session) _key) (sql_info expr "any" nil)
((symbol session_globalvar) _key) (sql_info expr "any" nil)
((symbol lambda) _params _body) (sql_info expr "any" nil)
Expand All @@ -375,12 +379,12 @@ relation and operator string are resolved at plan time. */
(define sql_compare (lambda (left right less operator collation)
(if (or (nil? left) (nil? right)) nil
(if (equal? operator "equal??") (and (not (less left right)) (not (less right left)))
(if (equal? operator "equal?") (and (not (less left right)) (not (less right left)))
(if (equal? operator "<") (less left right)
(if (equal? operator ">") (less right left)
(if (equal? operator "<=") (not (less right left))
(if (equal? operator ">=") (not (less left right))
(error "unsupported SQL comparison"))))))))))
(if (equal? operator "equal?") (and (not (less left right)) (not (less right left)))
(if (equal? operator "<") (less left right)
(if (equal? operator ">") (less right left)
(if (equal? operator "<=") (not (less right left))
(if (equal? operator ">=") (not (less left right))
(error "unsupported SQL comparison"))))))))))

/* ---- query-block level type resolution ----

Expand Down Expand Up @@ -421,9 +425,9 @@ always treated as "bin" — get the coercing relation. */
(define info (sql_expr_info sources order_expr))
(define coll (sql_info_collation info))
(if (and (or (equal? order_dir <) (equal? order_dir >))
(not (sql_column_ref? (sql_info_formula info)))
(sql_text_type? (sql_info_type info))
(not (nil? coll)))
(not (sql_column_ref? (sql_info_formula info)))
(sql_text_type? (sql_info_type info))
(not (nil? coll)))
(list (sql_info_formula info) (collate (car coll) (equal? order_dir >)))
(list (sql_info_formula info) order_dir)))
_ item)))
Expand All @@ -432,7 +436,7 @@ always treated as "bin" — get the coercing relation. */
(if (not (query_block? block))
block
(begin
(define sources (qb_sources block))
(define sources (sql_type_lower_annotations (qb_sources block)))
(define outer (coalesceNil outer_sources '()))
(define all_sources (if (empty_list? outer) sources (merge (list sources outer))))
(make_query_block
Expand All @@ -446,15 +450,37 @@ always treated as "bin" — get the coercing relation. */
(if (nil? (qb_having block)) nil (sql_type_formula all_sources (qb_having block)))
(map (coalesceNil (qb_order block) '())
(lambda (order_item) (sql_type_order_item all_sources order_item)))
(qb_limit block) (qb_offset block) (qb_hidden block) (qb_stages block)
(qb_limit block) (qb_offset block) (sql_type_lower_annotations (qb_hidden block)) (sql_type_lower_annotations (qb_stages block))
(qassoc_set (qb_facts block) (quote result-types)
(map_assoc (expand_query_block_fields sources (qb_fields block))
(lambda (rt_title rt_expr) (sql_type_result_descriptor all_sources rt_expr)))))))))

/* Entry point: annotate the root query block of a compiled IR. Group/orc/window
stages and non-query-block roots pass through untouched in this slice. */
/* Rewrite only paths containing frontend expression contracts. nil means
unchanged; a singleton holds the replacement, including a legitimate NULL.
Retain annotation-free sources/stage graphs instead of cloning every node
for frontends that have emitted no contracts. Quoted syntax stays opaque. */
(define sql_type_annotation_replacement (lambda (node)
(match node
((symbol sql_type_expr) _formula _type _collation) (list (sql_type_formula '() node))
((symbol quote) _datum) nil
(cons head tail) (begin
(define rewritten_head (sql_type_annotation_replacement head))
(define rewritten_tail (sql_type_annotation_replacement tail))
(if (and (nil? rewritten_head) (nil? rewritten_tail)) nil
(list (cons
(if (nil? rewritten_head) head (car rewritten_head))
(if (nil? rewritten_tail) tail (car rewritten_tail))))))
_ nil)))

(define sql_type_lower_annotations (lambda (node)
(match (sql_type_annotation_replacement node)
'(formula) formula
_ node)))

/* Entry point: annotate root expressions, then remove remaining expression contracts
from nested logical inputs without inventing storage or planner operations. */
(define sql_type_annotate_ir (lambda (ir)
(if (query_block? (ir_root ir))
(make_ir (ir_kind ir) (sql_type_query_block (ir_root ir) '())
(ir_stages ir) (ir_context_of ir) (ir_return ir))
ir)))
(make_ir (ir_kind ir)
(if (query_block? (ir_root ir))
(sql_type_query_block (ir_root ir) '()) (sql_type_lower_annotations (ir_root ir)))
(sql_type_lower_annotations (ir_stages ir)) (ir_context_of ir) (ir_return ir))))
76 changes: 47 additions & 29 deletions lib/tsql-parser.scm
Original file line number Diff line number Diff line change
Expand Up @@ -127,33 +127,53 @@ runtime and storage hot paths; do not substitute float64 for exact casts. */
(if (int? value) value (intdiv (tsql_numeric_input value) 1))))
(if (or (nil? integer) (< integer minimum) (> integer maximum))
(error "integer conversion overflow") integer)))))
(define tsql_cast_float (lambda (value) (if (nil? value) nil (tsql_numeric_input value))))
(define tsql_cast_float (lambda (value) (if (nil? value) nil (simplify (tsql_numeric_input value)))))
(define tsql_cast_bit (lambda (value)
(if (nil? value) nil
(if (and (string? value) (equal? (toUpper (sql_trim value)) "TRUE")) true
(if (and (string? value) (equal? (toUpper (sql_trim value)) "FALSE")) false
(not (equal? (tsql_numeric_input value) 0)))))))
/* A cast keeps its syntax-declared SQL type until the shared expression
compiler consumes the (expr, type, collation) contract. Runtime values do not
select that type, and no arithmetic operation is needed merely to mark it. */
(define tsql_cast_expr (lambda (value type dimensions) (begin
(define name (toUpper type))
(tsql_decl_dimensions name dimensions)
(match name
"INT" (list (quote intdiv) (list tsql_cast_integer value -2147483648 2147483647) 1)
"INTEGER" (list (quote intdiv) (list tsql_cast_integer value -2147483648 2147483647) 1)
"SMALLINT" (list (quote intdiv) (list tsql_cast_integer value -32768 32767) 1)
"TINYINT" (list (quote intdiv) (list tsql_cast_integer value 0 255) 1)
"BIGINT" (list (quote intdiv) (list tsql_cast_integer value (tsql_parse_integer "-9223372036854775808") (tsql_parse_integer "9223372036854775807")) 1)
"FLOAT" (list (quote if) (list (quote nil?) value) nil (list (quote simplify) (list tsql_cast_float value)))
(define formula (match name
"INT" (list tsql_cast_integer value -2147483648 2147483647)
"INTEGER" (list tsql_cast_integer value -2147483648 2147483647)
"SMALLINT" (list tsql_cast_integer value -32768 32767)
"TINYINT" (list tsql_cast_integer value 0 255)
"BIGINT" (list tsql_cast_integer value (tsql_parse_integer "-9223372036854775808") (tsql_parse_integer "9223372036854775807"))
"FLOAT" (list tsql_cast_float value)
/* Approximate types use native floating precision. Binary32 rounding and
dialect precision boundaries remain noncritical compatibility work. */
"REAL" (list (quote if) (list (quote nil?) value) nil (list (quote simplify) (list tsql_cast_float value)))
"BIT" (list (quote sql_not) (list (quote sql_not) (list tsql_cast_bit value)))
_ (error "unsupported conversion to " name)))))
"REAL" (list tsql_cast_float value)
"BIT" (list tsql_cast_bit value)
_ (error "unsupported conversion to " name)))
(list (quote sql_type_expr) formula name nil))))
/* Window inputs must be plain formulas before the common planner derives
aggregate identities. Consume their expression triples here and keep the
window result contract separately until shared expression compilation. */
(define tsql_window_expr (lambda (name args over) (begin
(define infos (map args (lambda (arg) (sql_expr_info (list) arg))))
(define input_type (if (empty_list? infos) "any" (sql_info_type (car infos))))
(define type (match name
"COUNT" "BIGINT"
"SUM" (match input_type
"TINYINT" "INT" "SMALLINT" "INT" "INTEGER" "INT"
"REAL" "FLOAT" _ input_type)
"MIN" input_type "MAX" input_type
_ "any"))
(define formula (list (quote window_func) name (map infos sql_info_formula) (sql_type_lower_annotations over)))
(if (equal? type "any") formula
(list (quote sql_type_expr) formula type
(if (empty_list? infos) nil (sql_info_collation (car infos))))))))
(define tsql_negate_expr (lambda (value) (begin
/* A constant cast already gives us its value and declared range at compile
time. Diagnose negation overflow here without introducing runtime type tags
or checks into ordinary arithmetic. Dynamic result typing is a follow-up. */
/* Constant operands and the syntax-declared range suffice to diagnose
negation overflow without runtime SQL tags or ordinary arithmetic checks. */
(match value
((symbol intdiv) '(conversion operand minimum maximum) _divisor)
((symbol sql_type_expr) '(conversion operand minimum maximum) _type _collation)
(if (and (equal? conversion tsql_cast_integer) (plain_literal_expr? operand))
(if (and (< minimum 0) (equal? (tsql_cast_integer operand minimum maximum) minimum))
(error "unary integer conversion overflow") true) true)
Expand Down Expand Up @@ -194,15 +214,13 @@ never from the first row. Unknown expression types stay text in this first slice
(define tsql_result_columns (lambda (query) (match query
((symbol query-block) _schema sources fields _where _group _having _order _limit _offset _hidden _stages _facts)
(extract_assoc (expand_query_block_fields sources fields) (lambda (name expression) (begin
/* Native integer division guarantees an integer even when a conversion's
input has no catalog type. Describe that wire result before optimization. */
(define type (match expression
((symbol intdiv) _left _right) "BIGINT"
_ (sql_info_type (sql_expr_info sources expression))))
(define type (sql_info_type (sql_expr_info sources expression)))
(define kind (if (has? '("INT" "INTEGER" "BIGINT" "SMALLINT" "TINYINT") type) 38
(if (has? '("FLOAT" "DOUBLE" "REAL" "DECIMAL" "NUMERIC") type) 109
(if (has? '("BOOLEAN" "BOOL" "BIT") type) 104 231))))
(list "name" name "kind" kind "size" (if (equal? kind 231) 8000 (if (equal? kind 104) 1 8)) "flags" 1))))
(define size (if (equal? kind 231) 8000 (if (equal? kind 104) 1
(match type "TINYINT" 1 "SMALLINT" 2 "INT" 4 "INTEGER" 4 _ 8))))
(list "name" name "kind" kind "size" size "flags" 1))))
((symbol union-block) _mode branches _order _limit _offset _facts) (tsql_result_columns (car branches))
_ (error "unsupported T-SQL result metadata shape"))))

Expand Down Expand Up @@ -332,12 +350,12 @@ never from the first row. Unknown expression types stay text in this first slice

(parser '((atom "CASE" true) (define expr tsql_expression) (define conditions (+ (parser '((atom "WHEN" true) (define a tsql_expression) (atom "THEN" true) (define b tsql_expression)) '(a b)))) (? (atom "ELSE" true) (define elsebranch tsql_expression)) (atom "END" true)) (merge '((quote if)) (merge (extract_assoc (merge conditions) (lambda (a b) '('('equal?? expr a) b)))) '(elsebranch)))

(parser '((atom "COUNT" true) "(" "*" ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") '('window_func "COUNT" '() _over))
(parser '((atom "COUNT" true) "(" (define e tsql_expression) ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") '('window_func "COUNT" (list e) _over))
(parser '((atom "SUM" true) "(" (define s tsql_expression) ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") '('window_func "SUM" (list s) _over))
(parser '((atom "AVG" true) "(" (define s tsql_expression) ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") '('window_func "AVG" (list s) _over))
(parser '((atom "MIN" true) "(" (define s tsql_expression) ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") '('window_func "MIN" (list s) _over))
(parser '((atom "MAX" true) "(" (define s tsql_expression) ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") '('window_func "MAX" (list s) _over))
(parser '((atom "COUNT" true) "(" "*" ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") (tsql_window_expr "COUNT" (list) _over))
(parser '((atom "COUNT" true) "(" (define e tsql_expression) ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") (tsql_window_expr "COUNT" (list e) _over))
(parser '((atom "SUM" true) "(" (define s tsql_expression) ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") (tsql_window_expr "SUM" (list s) _over))
(parser '((atom "AVG" true) "(" (define s tsql_expression) ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") (tsql_window_expr "AVG" (list s) _over))
(parser '((atom "MIN" true) "(" (define s tsql_expression) ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") (tsql_window_expr "MIN" (list s) _over))
(parser '((atom "MAX" true) "(" (define s tsql_expression) ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")") (tsql_window_expr "MAX" (list s) _over))

(parser '((atom "COUNT" true) "(" (atom "DISTINCT" true) (define e tsql_expression) ")") '('count_distinct e))
(parser '((atom "COUNT" true) "(" "*" ")") '((quote aggregate) 1 (quote +) 0))
Expand All @@ -349,7 +367,7 @@ never from the first row. Unknown expression types stay text in this first slice
(parser '((atom "MAX" true) "(" (define s tsql_expression) ")") (begin (define d (sql_aggregates "MAX")) '('aggregate s (car d) (cadr d))))

(parser '((define fn tsql_identifier_unquoted) "(" (define arg tsql_expression) ")" (atom "OVER" true) "(" (define _over tsql_window_spec) ")")
'('window_func (toUpper fn) (list arg) _over))
(tsql_window_expr (toUpper fn) (list arg) _over))

(parser '((atom "SUBSTRING" true) "(" (define s tsql_expression) "," (define start tsql_expression) "," (define len tsql_expression) ")") '((quote sql_substr) s start len))

Expand Down Expand Up @@ -795,7 +813,7 @@ never from the first row. Unknown expression types stay text in this first slice
true (error "INSERT column count does not match value count"))
(if (reduce rows (lambda (found row) (or found (tsql_dataset_contains_inner_select row))) false)
(tsql_insert_select_plan database tbl columns (tsql_values_to_select_query database columns rows))
'('insert '('table database tbl) (cons list columns) (sql_insert_values_expr rows)
'('insert '('table database tbl) (cons list columns) (sql_insert_values_expr (map rows (lambda (row) (map row (lambda (value) (sql_type_formula (list) value))))))
'(list) nil false '('lambda '('id) '('session "last_insert_id" 'id)) (quote tx)))
)))
(define tsql_insert_select (parser '(
Expand Down
4 changes: 3 additions & 1 deletion tests/performance/range-first-aggregate.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,9 @@
# Workload: one cold request plus ten reuses, with no discarded warmup.

metadata:
performance_shard_weight: 2
# Measured JIT verification: about 268 seconds for all seven pairs,
# including process startup; scheduling weights use 15-second units.
performance_shard_weight: 18
version: "1.0"
description: "Range-first scalar values inside a period aggregate"
isolated: true
Expand Down
Loading
Loading