From ac134c9a3b905cbe376c068836231dd021514616 Mon Sep 17 00:00:00 2001 From: "shoney.arickathil" Date: Sun, 16 Aug 2026 05:20:17 +0200 Subject: [PATCH] feat(compiler): query order-by + take (9b cont.) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - `order by [desc]` on whole-row queries: a selection sort over the result multi, re-reading the key per element via the range var (DB_GET_FIELD); O(n^2), KISS, no cost planner — the result sets are small by design - Text order keys use a new WO_B_STR_LT builtin (content compare, reusing the WO_B_SORT elem_cmp); scalar keys use the LT opcode. The bug this fixes: op_lt on two Text pointers compares ADDRESSES - `take N`: clamp to count, slice [0,N). `take` is the KwTake keyword, not an Ident — matched as the token - two bugs found + fixed while testing: multi-line query clauses (skip the separating newlines) and the key-kind read (must bind the range var BEFORE ty_of_expr of the order key, or a Text key silently uses op_lt); Index typechecks to the container's element type (`ds[0]`) - fixture run/db-query-order; oop-e2e 75/0, woc-test 566/0, 15 runtime suites, log-watcher 7/0 - employee `seed`/`list`/`staff` modes now compile and run; report (group-by+projection), raise (update), drop (delete) remain Co-Authored-By: Claude Opus 5 (1M context) --- compiler/src/emit.ml | 141 ++++++++++++++++++++ compiler/src/parser.ml | 14 +- compiler/src/types.ml | 25 ++-- compiler/test/runner.ml | 3 +- runtime/src/builtin.c | 4 + runtime/src/loader.c | 1 + runtime/src/wob.h | 4 +- tests/corpus/run/db-query-order/fixture.out | 7 + tests/corpus/run/db-query-order/fixture.wo | 16 +++ 9 files changed, 199 insertions(+), 16 deletions(-) create mode 100644 tests/corpus/run/db-query-order/fixture.out create mode 100644 tests/corpus/run/db-query-order/fixture.wo diff --git a/compiler/src/emit.ml b/compiler/src/emit.ml index a79a9ed..0c13528 100644 --- a/compiler/src/emit.ml +++ b/compiler/src/emit.ml @@ -788,6 +788,7 @@ let class_of_name (p : pctx) (n : string) : int option = SM.find_opt n p.p_class let is_table_class (p : pctx) (cid : int) : bool = cid >= 0 && cid < Array.length p.p_classes && p.p_classes.(cid).cr_is_table +let b_str_lt = 67 let b_db_scan = 64 let b_db_get_field = 65 let b_db_probe = 66 @@ -2567,6 +2568,146 @@ and emit_query (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) f.f_env <- saved_env; (* the scan's id list was this query's own, dropped now *) put f (ins_abc op_drop scan 0 0); + (* ---- order by (whole-row selection sort) ---------------------------- + Elements of dst are row ids; the key re-reads a field through the + range var. Selection sort is O(n^2) but the result sets here are + small and this is KISS by design (no cost planner). Only the + whole-row + field-key shape is supported; grouped/projection ordering + lands with group-by. *) + (match q.Ast.q_order with + | Some (key, desc) -> + f.f_temp <- body_base; + let n = alloc_temp p f e.pos in + put f (ins_abc op_builtin n dst b_count); + let i = alloc_temp p f e.pos in + let j = alloc_temp p f e.pos in + let best = alloc_temp p f e.pos in + let elem_j = alloc_temp p f e.pos in + let elem_b = alloc_temp p f e.pos in + let sort_scratch = f.f_temp in + put f (ins_abx op_loadk i (check_bx p f e.pos "constant" (const_int p 0))); + let oi = here f in (* outer: while i < n *) + let oc = alloc_temp p f e.pos in + put f (ins_abc op_lt oc i n); + let ojz = here f in + put f (ins_asbx op_jz oc 0); + put f (ins_abc op_move best i 0); + let oneA = alloc_temp p f e.pos in + put f (ins_abx op_loadk oneA (check_bx p f e.pos "constant" (const_int p 1))); + put f (ins_abc op_add j i oneA); + let ij = here f in (* inner: while j < n *) + let ic = alloc_temp p f e.pos in + put f (ins_abc op_lt ic j n); + let ijz = here f in + put f (ins_asbx op_jz ic 0); + (* elem_j = multi_get(dst,j); elem_b = multi_get(dst,best) *) + let gw = alloc_temps p f e.pos 2 in + put f (ins_abc op_move gw dst 0); + put f (ins_abc op_move (gw + 1) j 0); + put f (ins_abc op_builtin elem_j gw b_multi_get); + put f (ins_abc op_move (gw + 1) best 0); + put f (ins_abc op_builtin elem_b gw b_multi_get); + (* keys: bind range var to elem_j / elem_b, eval key expr *) + let saved_env2 = f.f_env in + f.f_temp <- sort_scratch; + f.f_env <- (q.Ast.q_var, (elem_j, Scalar cn)) :: saved_env2; + (* key kind must be read with the range var BOUND — else ty_of_expr of + `x.name` sees x unbound, returns None, and a Text key silently falls + to the pointer-comparing op_lt (the wrong-order bug) *) + let key_is_text = + match ty_of_expr p f key with Some t -> field_kind p t = 3 | None -> false + in + let kj = alloc_temp p f e.pos in + emit_expr p f v ~dst:kj key; + f.f_env <- (q.Ast.q_var, (elem_b, Scalar cn)) :: saved_env2; + let kb = alloc_temp p f e.pos in + emit_expr p f v ~dst:kb key; + f.f_env <- saved_env2; + (* cmp: for asc, kj < kb -> best=j; for desc, kj > kb (== kb < kj). *) + let cmp = alloc_temp p f e.pos in + let lt a b = + if key_is_text then begin + let save = f.f_temp in + let w = alloc_temps p f e.pos 2 in + put f (ins_abc op_move w a 0); + put f (ins_abc op_move (w + 1) b 0); + put f (ins_abc op_builtin cmp w b_str_lt); + f.f_temp <- save + end + else put f (ins_abc op_lt cmp a b) + in + if desc then lt kb kj else lt kj kb; + let cjz = here f in + put f (ins_asbx op_jz cmp 0); + put f (ins_abc op_move best j 0); + let after = here f in + patch_jump p f ~file:f.f_file ~pos:e.pos cjz after; + f.f_temp <- sort_scratch; + let oneB = alloc_temp p f e.pos in + put f (ins_abx op_loadk oneB (check_bx p f e.pos "constant" (const_int p 1))); + put f (ins_abc op_add j j oneB); + let iback = here f in + put f (ins_asbx op_jmp 0 0); + patch_jump p f ~file:f.f_file ~pos:e.pos iback ij; + let iexit = here f in + patch_jump p f ~file:f.f_file ~pos:e.pos ijz iexit; + (* swap dst[i], dst[best]: read both, multi_set both *) + f.f_temp <- sort_scratch; + let vi = alloc_temp p f e.pos in + let vb = alloc_temp p f e.pos in + let sw = alloc_temps p f e.pos 3 in + put f (ins_abc op_move sw dst 0); + put f (ins_abc op_move (sw + 1) i 0); + put f (ins_abc op_builtin vi sw b_multi_get); + put f (ins_abc op_move (sw + 1) best 0); + put f (ins_abc op_builtin vb sw b_multi_get); + (* dst[i] = vb *) + put f (ins_abc op_move sw dst 0); + put f (ins_abc op_move (sw + 1) i 0); + put f (ins_abc op_move (sw + 2) vb 0); + put f (ins_abc op_builtin sw sw b_multi_set); + (* dst[best] = vi *) + put f (ins_abc op_move sw dst 0); + put f (ins_abc op_move (sw + 1) best 0); + put f (ins_abc op_move (sw + 2) vi 0); + put f (ins_abc op_builtin sw sw b_multi_set); + f.f_temp <- sort_scratch; + let oneC = alloc_temp p f e.pos in + put f (ins_abx op_loadk oneC (check_bx p f e.pos "constant" (const_int p 1))); + put f (ins_abc op_add i i oneC); + let oback = here f in + put f (ins_asbx op_jmp 0 0); + patch_jump p f ~file:f.f_file ~pos:e.pos oback oi; + let oexit = here f in + patch_jump p f ~file:f.f_file ~pos:e.pos ojz oexit + | None -> ()); + (* ---- take N: slice dst to [0, N) --------------------------------- *) + (match q.Ast.q_take with + | Some tk -> + f.f_temp <- body_base; + let nreg = alloc_temp p f e.pos in + emit_expr p f v ~dst:nreg tk; + (* clamp N to count(dst) so slice never runs past the end *) + let cnt = alloc_temp p f e.pos in + put f (ins_abc op_builtin cnt dst b_count); + let over = alloc_temp p f e.pos in + put f (ins_abc op_lt over cnt nreg); (* count < N ? use count *) + let jz2 = here f in + put f (ins_asbx op_jz over 0); + put f (ins_abc op_move nreg cnt 0); + let aft = here f in + patch_jump p f ~file:f.f_file ~pos:e.pos jz2 aft; + let sw = alloc_temps p f e.pos 3 in + let zero = alloc_temp p f e.pos in + put f (ins_abx op_loadk zero (check_bx p f e.pos "constant" (const_int p 0))); + put f (ins_abc op_move sw dst 0); + put f (ins_abc op_move (sw + 1) zero 0); + put f (ins_abc op_move (sw + 2) nreg 0); + let sliced = alloc_temp p f e.pos in + put f (ins_abc op_builtin sliced sw b_slice); + put f (ins_abc op_drop dst 0 0); (* the pre-slice multi is discarded *) + put f (ins_abc op_move dst sliced 0) + | None -> ()); f.f_temp <- outer and emit_insert (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) (cn : string) diff --git a/compiler/src/parser.ml b/compiler/src/parser.ml index 24baf93..10c83a1 100644 --- a/compiler/src/parser.ml +++ b/compiler/src/parser.ml @@ -1054,7 +1054,12 @@ and parse_query_expr (st : state) : Ast.expr = Ast.QTable cn | _ -> Ast.QNav (parse_expr_no_brace st) in - let clause name = match peek st with Token.Ident n when n = name -> true | _ -> false in + (* clauses may sit on their own lines; skip the separating newlines when + looking for the next clause keyword (the query is one expression) *) + let clause name = + skip_newlines st; + match peek st with Token.Ident n when n = name -> true | _ -> false + in let wheres = ref [] in while clause "where" do ignore (advance st); @@ -1087,7 +1092,12 @@ and parse_query_expr (st : state) : Ast.expr = end else None in - let take = if clause "take" then (ignore (advance st); Some (parse_expr_no_brace st)) else None in + (* `take` is a reserved keyword (KwTake, the param convention), not an + Ident — so match the token, not the name *) + skip_newlines st; + let take = + if peek st = Token.KwTake then (ignore (advance st); Some (parse_expr_no_brace st)) else None + in if not (clause "select") then fail st (peek_pos st) syntax_code "a query must end in `select`"; ignore (advance st); let sel = parse_expr st in diff --git a/compiler/src/types.ml b/compiler/src/types.ml index 44faf2d..17dab1a 100644 --- a/compiler/src/types.ml +++ b/compiler/src/types.ml @@ -1230,9 +1230,14 @@ let typecheck_program ~file ~(module_of : string -> string) { typ = TScalar "Int"; is_nil = false })) | _ -> { typ = TScalar "Int"; is_nil = false }) | Index (base, idx) -> - let _ = typecheck_expr env cenv base in + let base_res = typecheck_expr env cenv base in let _ = typecheck_expr env cenv idx in - { typ = TScalar "Int"; is_nil = false } + (* `xs[i]` yields the container's element type — a `multi C` indexed + is a C (iteration 9b: query results are indexed to pick a row) *) + (match base_res.typ with + | TMulti et -> { typ = et; is_nil = false } + | TMap (_, vt) -> { typ = vt; is_nil = false } + | _ -> { typ = TScalar "Int"; is_nil = false }) | Call (callee, args) -> List.iter (fun arg -> ignore (typecheck_expr env cenv arg)) args; (match callee.kind with @@ -1466,13 +1471,15 @@ let typecheck_program ~file ~(module_of : string -> string) elem_err () end else begin - (if q.q_group <> None || q.q_order <> None || q.q_take <> None then + (if q.q_group <> None then Diag.Collector.add collector (Diag.error ~code:query_code ~file ~line:q.q_pos.line ~col:q.q_pos.col - ~message:"group/order/take on a navigation query are not supported yet" ())); + ~message:"group-by on a navigation query is not supported yet" ())); let env' = StringMap.add q.q_var (TScalar cn) env in let cenv' = StringMap.add q.q_var (TScalar cn) cenv in List.iter (fun w -> ignore (typecheck_expr env' cenv' w)) q.q_wheres; + (match q.q_order with Some (k, _) -> ignore (typecheck_expr env' cenv' k) | None -> ()); + (match q.q_take with Some t -> ignore (typecheck_expr env cenv t) | None -> ()); let sel = typecheck_expr env' cenv' q.q_select in { typ = TMulti sel.typ; is_nil = false } end @@ -1489,17 +1496,11 @@ let typecheck_program ~file ~(module_of : string -> string) Diag.Collector.add collector (Diag.error ~code:query_code ~file ~line:q.q_pos.line ~col:q.q_pos.col ~message:"group-by aggregation is not supported yet" ())); - (if q.q_order <> None then - Diag.Collector.add collector - (Diag.error ~code:query_code ~file ~line:q.q_pos.line ~col:q.q_pos.col - ~message:"`order by` is not supported yet" ())); - (if q.q_take <> None then - Diag.Collector.add collector - (Diag.error ~code:query_code ~file ~line:q.q_pos.line ~col:q.q_pos.col - ~message:"`take` is not supported yet" ())); let env' = StringMap.add q.q_var (TScalar cn) env in let cenv' = StringMap.add q.q_var (TScalar cn) cenv in List.iter (fun w -> ignore (typecheck_expr env' cenv' w)) q.q_wheres; + (match q.q_order with Some (k, _) -> ignore (typecheck_expr env' cenv' k) | None -> ()); + (match q.q_take with Some t -> ignore (typecheck_expr env cenv t) | None -> ()); let sel = typecheck_expr env' cenv' q.q_select in { typ = TMulti sel.typ; is_nil = false } end) diff --git a/compiler/test/runner.ml b/compiler/test/runner.ml index 1d3846b..8d644a5 100644 --- a/compiler/test/runner.ml +++ b/compiler/test/runner.ml @@ -2604,7 +2604,7 @@ let validate_image (img : string) : string list = golden lowering suite actually emits; 61 = DB_INSERT (arity 1: the class-id slot — field slots are runtime-validated, same as the C loader) *) - if c > 12 && (c < 61 || c > 66) then + if c > 12 && (c < 61 || c > 67) then fail (Printf.sprintf "method %d pc %d: builtin out of range" i pc) else if c = 4 then begin if b > 5 then fail (Printf.sprintf "method %d pc %d: bad element kind" i pc) @@ -2626,6 +2626,7 @@ let validate_image (img : string) : string list = | 64 -> 1 | 65 -> 3 | 66 -> 3 + | 67 -> 2 | _ -> 0 in if arity > 0 then begin diff --git a/runtime/src/builtin.c b/runtime/src/builtin.c index 659ef56..c062bca 100644 --- a/runtime/src/builtin.c +++ b/runtime/src/builtin.c @@ -252,6 +252,10 @@ int wo_builtin(wo_vm *vm, uint64_t *R, uint32_t ins, const char **msg) { } return 0; } + case WO_B_STR_LT: { + R[A] = elem_cmp(WO_K_TEXT, R[B], R[B + 1]) < 0 ? 1 : 0; + return 0; + } case WO_B_TEXT_COPY: { /* nil copies to nil: a `?Text` crosses this boundary * exactly like a Text does */ if (!R[B]) { diff --git a/runtime/src/loader.c b/runtime/src/loader.c index 33ed884..f475af8 100644 --- a/runtime/src/loader.c +++ b/runtime/src/loader.c @@ -47,6 +47,7 @@ static const uint8_t b_arity[WO_B_MAX + 1] = { [WO_B_DB_SCAN] = 1, [WO_B_DB_GET_FIELD] = 3, [WO_B_DB_PROBE] = 3, + [WO_B_STR_LT] = 2, [WO_B_NOW] = 0, [WO_B_PRINT] = 1, [WO_B_PRINT_INT] = 1, [WO_B_WORDS] = 1, [WO_B_MULTI_NEW] = 0, [WO_B_MULTI_PUSH] = 2, [WO_B_MULTI_GET] = 2, [WO_B_COUNT] = 1, [WO_B_LATEST] = 1, diff --git a/runtime/src/wob.h b/runtime/src/wob.h index 8b0d427..aa31af3 100644 --- a/runtime/src/wob.h +++ b/runtime/src/wob.h @@ -317,8 +317,10 @@ enum { WO_B_DB_SCAN = 64, WO_B_DB_GET_FIELD = 65, WO_B_DB_PROBE = 66, + WO_B_STR_LT = 67, /* (a, b) text -> 1 if a < b by content, else 0 (query + * order-by on a Text key; scalars use the LT opcode) */ }; -#define WO_B_MAX 66u +#define WO_B_MAX 67u /* ids at or above this one live in sysio.c, not builtin.c */ #define WO_B_SYS_FIRST WO_B_FS_EXISTS diff --git a/tests/corpus/run/db-query-order/fixture.out b/tests/corpus/run/db-query-order/fixture.out new file mode 100644 index 0000000..bd92ed8 --- /dev/null +++ b/tests/corpus/run/db-query-order/fixture.out @@ -0,0 +1,7 @@ +salary desc: +bram +dora +asha +name asc take 2: +asha +bram diff --git a/tests/corpus/run/db-query-order/fixture.wo b/tests/corpus/run/db-query-order/fixture.wo new file mode 100644 index 0000000..9ea7610 --- /dev/null +++ b/tests/corpus/run/db-query-order/fixture.wo @@ -0,0 +1,16 @@ +-- iteration 9b: order by (whole-row selection sort, Text-aware) + take. +@table(name: "emp", index: [dept]) +class Emp { + name: Text + salary: Int + dept: Int +} +fn main() { + insert Emp { name: "asha", salary: 100, dept: 1 } + insert Emp { name: "bram", salary: 300, dept: 1 } + insert Emp { name: "dora", salary: 200, dept: 1 } + print("salary desc:") + for e in from x in Emp order by x.salary desc select x { print(e.name) } + print("name asc take 2:") + for e in from x in Emp order by x.name take 2 select x { print(e.name) } +}