shoney/writeonce
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

feat(compiler): query order-by + take (9b cont.)

Browse source 
- `order by <field> [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) <noreply@anthropic.com>
This commit is contained in:
shoney.arickathil 2026-08-16 05:20:17 +02:00
parent 8817fdec2a
commit 75b35fb456
9 changed files with 199 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

141
compiler/src/emit.ml
View file

@ -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)

14
compiler/src/parser.ml
View file

@ -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

25
compiler/src/types.ml
View file

@ -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)

3
compiler/test/runner.ml
View file

@ -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

4
runtime/src/builtin.c
View file

@ -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]) {

1
runtime/src/loader.c
View file

@ -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,

4
runtime/src/wob.h
View file

@ -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

7
tests/corpus/run/db-query-order/fixture.out Normal file
View file

@ -0,0 +1,7 @@
salary desc:
bram
dora
asha
name asc take 2:
asha
bram

16
tests/corpus/run/db-query-order/fixture.wo Normal file
View file

@ -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) }
}