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

feat(compiler): language-integrated query — scan/where/select (9b slice)

Browse source 
- Ast.Query node + parser: `from <v> in <src> where* [group..into] [order
  by] [take] select <e>`, positional `from` trigger so it stays a usable
  identifier; select stays grammar-owned (no DbStub conflict)
- typecheck: range var bound to the source table class; a table-class
  value is its row id at runtime but TYPES as the class, so `e.field`
  checks against the class fields; result is `multi <select-type>`;
  group/order/take/navigation diagnosed WO-E250 not-yet (honest edge)
- emit: `from/where/select` lowers to a bytecode LOOP over DB_SCAN's
  materialized id list — DB_GET_FIELD per column read, where-guards skip
  the push, select projects, result is a fresh multi; no plan tree, no
  SQL text (disassembly-provable)
- field access on a @table-class value routes to DB_GET_FIELD instead of
  GETF (clsrec.cr_is_table + is_table_class); non-table classes unchanged
  so log-watcher is unaffected
- the ASan-caught bug kept in a comment: a table-class query element is a
  SCALAR id, not an OWNED pointer — tagging the result multi OWNED dropped
  an id as a pointer (SEGV in wo_drop_obj)
- fixture run/db-query-scan (where-filter + select-whole + select-field);
  oop-e2e 74/0, woc-test 566/0, log-watcher 7/0
- SLICE scope: group-by aggregation, order/take, and ref/backlink
  navigation are the next chunk (employee report/staff/raise need them)

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
This commit is contained in:
shoney.arickathil 2026-08-15 22:28:09 +02:00
parent 5830e69999
commit 4df9a0108b
8 changed files with 360 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
compiler/src/ast.ml
View file

@ -279,6 +279,31 @@ and expr_kind =
ename : string;
handler : stmt list;
}
(* iteration 9b: a language-integrated query. `from <var> in <source>
where <e>* [group <e> by <k> into <g>] [order by <e> [desc]] [take <e>]
select <e>` — lowered to a bytecode loop over engine cursor builtins,
never SQL text. A table-class value is its row id at runtime, so field
access on a range variable reads through the engine. Slice scope today:
from/where/order/take/select and group-by aggregation; join is later. *)
| Query of query
and query_source =
| QTable of string (* a table class by name: `from e in Employee` *)
| QNav of expr (* a backlink/multi navigation: `from s in d.staff` *)
and query = {
q_var : string;
q_src : query_source;
q_wheres : expr list;
(* group <key_expr> by ... into <gvar>: present iff this is an aggregating
query. q_group_key is the whole grouped element (`e`), q_group_by the
key, q_gvar the group binding whose `.f` columns feed aggregates. *)
q_group : (string * expr) option; (* (gvar, key_expr) *)
q_order : (expr * bool) option; (* (key, desc?) *)
q_take : expr option;
q_select : expr;
q_pos : pos;
}
(* ---- statements (Task 5) ---------------------------------------------

8
compiler/src/dump.ml
View file

@ -226,6 +226,14 @@ let rec expr_str (e : Ast.expr) : string =
Printf.sprintf "INSERT %s { %s }" name
(String.concat ", "
(List.map (fun (fname, fval) -> Printf.sprintf "%s: %s" fname (expr_str fval)) fields))
| Ast.Query q ->
let src = match q.Ast.q_src with Ast.QTable cn -> cn | Ast.QNav e -> expr_str e in
Printf.sprintf "QUERY from %s in %s%s%s select %s" q.Ast.q_var src
(String.concat "" (List.map (fun w -> " where " ^ expr_str w) q.Ast.q_wheres))
(match q.Ast.q_group with
| Some (g, k) -> Printf.sprintf " group by %s into %s" (expr_str k) g
| None -> "")
(expr_str q.Ast.q_select)
| Ast.DbStub toks -> Printf.sprintf "DB_STUB(%s)" (dbstub_tokens_str toks)
| Ast.Interp inner -> Printf.sprintf "INTERP(%s)" (expr_str inner)
| Ast.ListLit items -> Printf.sprintf "[%s]" (String.concat ", " (List.map expr_str items))

142
compiler/src/emit.ml
View file

@ -354,6 +354,7 @@ type clsrec = {
unique single-column entry per `@unique` field. Serialized as the v3
class-record tail; the engine builds its runtime indexes from this. *)
cr_indexes : (bool * int array) list;
cr_is_table : bool; (* has @table — its instances are row ids (iteration 9b) *)
}
type ifacerec = {
@ -778,6 +779,15 @@ let field_kind (p : pctx) (ft : Ast.field_ty) : int =
let class_of_name (p : pctx) (n : string) : int option = SM.find_opt n p.p_class_id
(* iteration 9b: a @table class's instances are row ids, so field access on
one reads through the engine (DB_GET_FIELD) rather than GETF. *)
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_db_scan = 64
let b_db_get_field = 65
let b_db_probe = 66
let field_of (p : pctx) (cid : int) (fname : string) : (int * Ast.field_ty) option =
let fs = p.p_classes.(cid).cr_fields in
let rec go i = if i >= Array.length fs then None else
@ -947,6 +957,23 @@ let variant_tag_value (p : pctx) (u : Types.union_info) (vi : Types.variant_info
| None -> 0 (* unreachable: pass 1 registers every payload-union variant *)
else vi.Types.vi_tag
(* iteration 9b: a query's element type, as the name a `Multi` carries.
`select x` yields the source class (a row id typed as the class);
`select x.field` yields that field's type; anything else falls back to
Int (the slice's shapes are these two). *)
let query_elem_scalar (p : pctx) (_f : fstate) (q : Ast.query) : string =
let src_class = match q.Ast.q_src with Ast.QTable cn -> Some cn | Ast.QNav _ -> None in
match (q.Ast.q_select.Ast.kind, src_class) with
| Ast.Ident v, Some cn when v = q.Ast.q_var -> cn
| Ast.Field ({ Ast.kind = Ast.Ident v; _ }, fname), Some cn when v = q.Ast.q_var -> (
match class_of_name p cn with
| Some cid -> (
match field_of p cid fname with
| Some (_, ty) -> ( match unwrap ty with Scalar n -> n | _ -> "Int")
| None -> "Int")
| None -> "Int")
| _ -> "Int"
let rec ty_of_expr (p : pctx) (f : fstate) (e : Ast.expr) : Ast.field_ty option =
match e.kind with
| IntLit _ -> Some (Scalar "Int")
@ -1061,6 +1088,7 @@ let rec ty_of_expr (p : pctx) (f : fstate) (e : Ast.expr) : Ast.field_ty option
| Add | Sub | Mul | Div | Mod -> ( match ty_of_expr p f l with Some t -> Some t | None -> Some (Scalar "Int")))
| Ctor (cn, _) -> Some (Scalar cn)
| Insert _ -> Some (Scalar "Int")
| Query q -> Some (Multi (query_elem_scalar p f q))
| Interp _ -> Some (Scalar "Text")
| DbStub _ -> None
| Switch (subject, arms) -> (
@ -1610,7 +1638,17 @@ let rec emit_expr (p : pctx) (f : fstate) (v : views) ~(dst : int) ?expected (e
f.f_stmt_drops <- g :: f.f_stmt_drops;
f.f_esc_drops <- g :: f.f_esc_drops
end;
put f (ins_abc op_getf dst b (check_field_idx p f e.pos idx))
if is_table_class p cid then begin
(* a table-class value is its row id; read the column from the
engine. Window: [class-id, id, field-idx]. *)
let w = alloc_temps p f e.pos 3 in
put f (ins_abx op_loadk w (check_bx p f e.pos "constant" (const_int p cid)));
put f (ins_abc op_move (w + 1) b 0);
put f (ins_abx op_loadk (w + 2) (check_bx p f e.pos "constant" (const_int p idx)));
sync_mask p f v e.id;
put f (ins_abc op_builtin dst w b_db_get_field)
end
else put f (ins_abc op_getf dst b (check_field_idx p f e.pos idx))
| None ->
err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos
~message:(Printf.sprintf "`%s` has no field `%s`" cn fname);
@ -1662,6 +1700,7 @@ let rec emit_expr (p : pctx) (f : fstate) (v : views) ~(dst : int) ?expected (e
| Binary (op, l, r) -> emit_binary p f v ~dst op l r
| Ctor (cn, fields) -> emit_ctor p f v ~dst e cn fields
| Insert (cn, fields) -> emit_insert p f v ~dst e cn fields
| Query q -> emit_query p f v ~dst e q
| Interp inner -> (
(* haxe-parity Task 2: the type-directed half of the interpolation
desugar (parser.ml's own doc comment on Ast.Interp) — a Text
@ -2364,6 +2403,100 @@ and emit_ctor (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) (c
nullable scalar, the zero word otherwise). The engine COPIES every
value at the row API, so after the builtin every freshly built
argument is still this frame's to drop — same reap as push/set. *)
and emit_query (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr)
(q : Ast.query) : unit =
(* iteration 9b slice: from/where/select over a table scan. group/order/
take/navigation are diagnosed in types.ml, so a written image never
reaches this with them set. Lowered to an ordinary bytecode loop over
DB_SCAN's materialized id list — no plan tree, no text. *)
let cn = match q.Ast.q_src with Ast.QTable cn -> cn | Ast.QNav _ -> "" in
match class_of_name p cn with
| None ->
err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos
~message:(Printf.sprintf "query over `%s`, which is not a declared table class" cn);
put f (ins_abx op_loadk dst (const_int p 0))
| Some cid ->
let elem_name = query_elem_scalar p f q in
let elem = Scalar elem_name in
(* a table-class element is a row ID (a scalar), not a heap pointer — so
the result container is SCALAR-kinded even though the element TYPES as
the class; getting this wrong drops an id as a pointer (ASan SEGV) *)
let elem_kind =
match class_of_name p elem_name with
| Some ecid when is_table_class p ecid -> 0 (* WO_K_SCALAR *)
| _ -> field_kind p elem
in
(* reserve dst past the loop's working registers (same guard emit_ctor
uses): dst holds the result multi every push writes into *)
let outer = f.f_temp in
if f.f_temp <= dst then f.f_temp <- dst + 1;
(* loop-carried registers, allocated once above dst, never reset *)
let scan = alloc_temp p f e.pos in
let idx = alloc_temp p f e.pos in
let len = alloc_temp p f e.pos in
let idreg = alloc_temp p f e.pos in
let body_base = f.f_temp in
(* scan -> multi of ids; result multi -> dst *)
sync_mask p f v e.id;
f.f_cur_line <- e.pos.line;
put f (ins_abx op_loadk scan (check_bx p f e.pos "constant" (const_int p cid)));
put f (ins_abc op_builtin scan scan b_db_scan);
put f (ins_abc op_builtin dst elem_kind b_multi_new);
put f (ins_abc op_builtin len scan b_len);
put f (ins_abx op_loadk idx (check_bx p f e.pos "constant" (const_int p 0)));
(* bind the range var to the current id (typed as the class), so field
access inside where/select routes through DB_GET_FIELD *)
let saved_env = f.f_env in
f.f_env <- (q.Ast.q_var, (idreg, Scalar cn)) :: f.f_env;
ignore body_base;
let top = here f in
f.f_temp <- body_base;
let tc = alloc_temp p f e.pos in
put f (ins_abc op_lt tc idx len);
let jz_exit = here f in
put f (ins_asbx op_jz tc 0);
(* id = multi_get(scan, idx) *)
let w = alloc_temps p f e.pos 2 in
put f (ins_abc op_move w scan 0);
put f (ins_abc op_move (w + 1) idx 0);
put f (ins_abc op_builtin idreg w b_multi_get);
(* where guards: any false skips the push *)
let skips = ref [] in
List.iter
(fun w_expr ->
let save = f.f_temp in
let wr = emit_operand p f v w_expr in
skips := here f :: !skips;
put f (ins_asbx op_jz wr 0);
f.f_temp <- save)
q.Ast.q_wheres;
(* select -> push into dst (copying a Text element the container owns) *)
let save = f.f_temp in
let sel = alloc_temp p f e.pos in
emit_expr p f v ~dst:sel q.Ast.q_select;
if elem_kind = 3 then put f (ins_abc op_builtin sel sel b_text_copy);
let pw = alloc_temps p f e.pos 2 in
put f (ins_abc op_move pw dst 0);
put f (ins_abc op_move (pw + 1) sel 0);
put f (ins_abc op_builtin pw pw b_multi_push);
f.f_temp <- save;
(* skip target: increment and loop *)
let cont = here f in
List.iter (fun pc -> patch_jump p f ~file:f.f_file ~pos:e.pos pc cont) !skips;
f.f_temp <- body_base;
let one = alloc_temp p f e.pos in
put f (ins_abx op_loadk one (check_bx p f e.pos "constant" (const_int p 1)));
put f (ins_abc op_add idx idx one);
let back = here f in
put f (ins_asbx op_jmp 0 0);
patch_jump p f ~file:f.f_file ~pos:e.pos back top;
let exit_pc = here f in
patch_jump p f ~file:f.f_file ~pos:e.pos jz_exit exit_pc;
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);
f.f_temp <- outer
and emit_insert (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) (cn : string)
(fields : (string * Ast.expr) list) : unit =
match class_of_name p cn with
@ -4047,7 +4180,8 @@ let emit ~(syms : Types.symbols) ~(module_of : string -> string)
cr_fields =
Array.of_list (List.map (fun (fl : Ast.field) -> (fl.name, fl.ty)) c.fields);
cr_methods = List.map (fun (m : Ast.method_decl) -> m.name) c.methods;
cr_indexes = table_indexes @ unique_indexes })
cr_indexes = table_indexes @ unique_indexes;
cr_is_table = (c.Ast.table <> None) })
:: !classes
end
| Ast.Union (ud : Ast.union_decl) ->
@ -4067,7 +4201,7 @@ let emit ~(syms : Types.symbols) ~(module_of : string -> string)
class_id := SM.add key cid !class_id;
incr nclasses;
classes :=
{ cr_name = key; cr_gc = false; cr_indexes = [];
{ cr_name = key; cr_gc = false; cr_indexes = []; cr_is_table = false;
cr_fields = Array.of_list vd.Ast.v_fields;
cr_methods = [] }
:: !classes
@ -4111,7 +4245,7 @@ let emit ~(syms : Types.symbols) ~(module_of : string -> string)
incr nclasses;
classes :=
{ cr_name = name; cr_gc = false; cr_fields = Array.of_list fields; cr_methods = [];
cr_indexes = [] }
cr_indexes = []; cr_is_table = false }
:: !classes
end)
Types.predeclared_records;

12
compiler/src/owner.ml
View file

@ -561,6 +561,7 @@ let rec expr_ty (ctx : ctx) (e : Ast.expr) : Ast.field_ty option =
| Binary _ -> None (* arithmetic/comparison: Copy either way *)
| Ctor (cn, _) -> Some (Scalar cn)
| Insert _ -> Some (Scalar "Int") (* the new row's id — Copy, nothing to drop *)
| Query _ -> Some (Multi "Int") (* a query yields a fresh multi of ids — owned *)
| Interp _ -> Some (Scalar "Text") (* an interpolation always produces Text *)
| DbStub _ -> None
| Switch (subject, arms) ->
@ -1179,6 +1180,17 @@ let rec read_expr (ctx : ctx) (e : Ast.expr) : unit =
| DbStub _ ->
(* trap-capable: the frame needs its drop map here *)
record_drop ctx ~node:e.id ~pos:e.pos ~kind:DLiveMask ~items:(mask_items (live_holders ctx))
| Query q ->
(* iteration 9b: the sub-expressions only READ (engine field-reads copy
out at the boundary); the query is trap-capable (engine faults), so
the frame needs its drop map here, exactly like DbStub. *)
(match q.q_src with QNav e2 -> read_expr ctx e2 | QTable _ -> ());
List.iter (read_expr ctx) q.q_wheres;
(match q.q_group with Some (_, k) -> read_expr ctx k | None -> ());
(match q.q_order with Some (k, _) -> read_expr ctx k | None -> ());
(match q.q_take with Some t -> read_expr ctx t | None -> ());
read_expr ctx q.q_select;
record_drop ctx ~node:e.id ~pos:e.pos ~kind:DLiveMask ~items:(mask_items (live_holders ctx))
| Switch (subject, arms) -> analyze_switch ctx e.id subject arms
(* The root of a place expression is already accounted for by use_place;

95
compiler/src/parser.ml
View file

@ -1022,8 +1022,89 @@ and parse_insert_expr (st : state) : Ast.expr =
| Ast.Ctor (cn, fields) -> { lit with Ast.pos; kind = Ast.Insert (cn, fields) }
| _ -> lit (* unreachable: parse_ctor_literal only builds Ctor *))
and is_query_trigger (st : state) : bool =
(* `from <ident> in` — positional, so `from` stays a usable identifier
everywhere else (same discipline as insert/select) *)
(match peek st with Token.Ident "from" -> true | _ -> false)
&& (match (tok_at st (st.pos + 1)).kind with Token.Ident _ -> true | _ -> false)
&& (tok_at st (st.pos + 2)).kind = Token.KwIn
and parse_query_expr (st : state) : Ast.expr =
let pos = peek_pos st in
let id = fresh_id st in
ignore (advance st) (* from *);
let var = expect_ident st "query range variable" in
expect st Token.KwIn "`in`";
(* source: a bare class name is a table scan; any other expression is a
navigation (`d.staff`). One token of lookahead: Ident not followed by a
`.`/`(`/`[` and sitting where a clause keyword follows is a table name. *)
let src =
match peek st with
| Token.Ident cn
when (match (tok_at st (st.pos + 1)).kind with
| Token.Dot | Token.LParen | Token.LBracket -> false
| _ -> true) ->
ignore (advance st);
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
let wheres = ref [] in
while clause "where" do
ignore (advance st);
wheres := parse_expr_no_brace st :: !wheres
done;
let group =
if clause "group" then begin
ignore (advance st);
let key_elem = parse_expr_no_brace st in
ignore key_elem (* the grouped element is the range var; `group e by k` *);
if not (clause "by") then fail st (peek_pos st) syntax_code "expected `by` in a group clause";
ignore (advance st);
let key = parse_expr_no_brace st in
if not (clause "into") then fail st (peek_pos st) syntax_code "expected `into` in a group clause";
ignore (advance st);
let gvar = expect_ident st "group variable" in
Some (gvar, key)
end
else None
in
let order =
if clause "order" then begin
ignore (advance st);
if not (clause "by") then fail st (peek_pos st) syntax_code "expected `by` after `order`";
ignore (advance st);
let key = parse_expr_no_brace st in
let desc = clause "desc" in
if desc then ignore (advance st);
Some (key, desc)
end
else None
in
let take = if clause "take" 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
{
Ast.id;
pos;
kind =
Ast.Query
{
Ast.q_var = var;
q_src = src;
q_wheres = List.rev !wheres;
q_group = group;
q_order = order;
q_take = take;
q_select = sel;
q_pos = pos;
};
}
and parse_primary (st : state) : Ast.expr =
match peek st with
| _ when is_query_trigger st -> parse_query_expr st
| k when is_select_trigger k -> parse_dbstub_expr st
| k when is_insert_trigger k -> parse_insert_expr st
| Token.KwSwitch -> parse_switch_expr st
@ -1801,6 +1882,20 @@ let rec subst_expr (consts : Ast.expr StringMap.t) (bound : StringSet.t) (e : As
{ e with Ast.kind = Ast.Ctor (cn, List.map (fun (n, v) -> (n, subst_expr consts bound v)) fields) }
| Ast.Insert (cn, fields) ->
{ e with Ast.kind = Ast.Insert (cn, List.map (fun (n, v) -> (n, subst_expr consts bound v)) fields) }
| Ast.Query q ->
(* the range/group vars shadow consts inside the query body *)
let bound' = StringSet.add q.Ast.q_var bound in
let bound' = match q.Ast.q_group with Some (g, _) -> StringSet.add g bound' | None -> bound' in
let sub = subst_expr consts bound' in
{ e with Ast.kind = Ast.Query {
q with Ast.q_src = (match q.Ast.q_src with
| Ast.QTable cn -> Ast.QTable cn
| Ast.QNav e2 -> Ast.QNav (subst_expr consts bound e2));
q_wheres = List.map sub q.Ast.q_wheres;
q_group = (match q.Ast.q_group with Some (g, k) -> Some (g, sub k) | None -> None);
q_order = (match q.Ast.q_order with Some (k, d) -> Some (sub k, d) | None -> None);
q_take = (match q.Ast.q_take with Some t -> Some (sub t) | None -> None);
q_select = sub q.Ast.q_select } }
| Ast.Interp inner -> { e with Ast.kind = Ast.Interp (subst_expr consts bound inner) }
| Ast.ListLit items -> { e with Ast.kind = Ast.ListLit (List.map (subst_expr consts bound) items) }
| Ast.MapLit | Ast.NilLit -> e

54
compiler/src/types.ml
View file

@ -412,6 +412,7 @@ let unknown_fn_code = Diag.types_prefix ^ "04"
let unsatisfied_interface_code = Diag.types_prefix ^ "05"
let incomplete_ctor_code = Diag.types_prefix ^ "06"
let unknown_type_code = Diag.types_prefix ^ "07"
let query_code = Diag.types_prefix ^ "50" (* WO-E250: query surface (iteration 9b) *)
let non_exhaustive_switch_code = Diag.types_prefix ^ "08"
let invalid_builtin_code = Diag.types_prefix ^ "09"
let module_not_imported_code = Diag.types_prefix ^ "10"
@ -1168,6 +1169,7 @@ let typecheck_program ~file ~(module_of : string -> string)
| Insert _ ->
(* the new row's id — the one thing an insert produces *)
Some (TScalar "Int")
| Query _ -> None (* a query's type is chased only by typecheck_expr *)
| Unary _ | Binary _ | DbStub _ ->
(* Not chased: the arithmetic-ladder `Binary` ops have no reliable
per-node type in this pass at all (see above); `Unary`/`DbStub`
@ -1432,6 +1434,49 @@ let typecheck_program ~file ~(module_of : string -> string)
(Diag.error ~code:unknown_type_code ~file ~line:e.pos.line ~col:e.pos.col
~message:(Printf.sprintf "unknown type `%s` in insert" class_name) ());
{ typ = TScalar "Int"; is_nil = false })
| Query q ->
(* iteration 9b slice: from/where/select over a table class. The
range variable is bound to the class type; a table-class value is
its row id at runtime but types AS the class, so `e.field` checks
against the class's fields exactly like a heap instance. group /
order / take / navigation sources are diagnosed as not-yet so the
surface is honest about its edge. *)
let elem_err () =
{ typ = TMulti (TScalar "Int"); is_nil = false }
in
(match q.q_src with
| Ast.QNav _ ->
Diag.Collector.add collector
(Diag.error ~code:query_code ~file ~line:q.q_pos.line ~col:q.q_pos.col
~message:"query over a navigation source is not supported yet (table scans only)" ());
elem_err ()
| Ast.QTable cn ->
if not (StringMap.mem cn syms.classes) then begin
Diag.Collector.add collector
(Diag.error ~code:query_code ~file ~line:q.q_pos.line ~col:q.q_pos.col
~message:(Printf.sprintf "`from %s in %s`: `%s` is not a declared table class"
q.q_var cn cn) ());
elem_err ()
end
else begin
(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-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;
let sel = typecheck_expr env' cenv' q.q_select in
{ typ = TMulti sel.typ; is_nil = false }
end)
| DbStub _ -> { typ = TVoid; is_nil = false }
| Switch (subject, arms) -> typecheck_switch ~want_value:true env cenv subject arms
| ListLit items ->
@ -2139,6 +2184,15 @@ and walk_expr (bound : StringSet.t) (visit : StringSet.t -> expr -> unit) (e : e
walk_expr bound visit body;
walk_block (StringSet.add ename bound) visit handler
| DbStub _ -> ()
| Query q ->
(match q.q_src with QNav e -> walk_expr bound visit e | QTable _ -> ());
let b = StringSet.add q.q_var bound in
let b = match q.q_group with Some (g, _) -> StringSet.add g b | None -> b in
List.iter (walk_expr b visit) q.q_wheres;
(match q.q_group with Some (_, k) -> walk_expr b visit k | None -> ());
(match q.q_order with Some (k, _) -> walk_expr b visit k | None -> ());
(match q.q_take with Some t -> walk_expr b visit t | None -> ());
walk_expr b visit q.q_select
| Switch (subject, arms) ->
walk_expr bound visit subject;
List.iter

6
tests/corpus/run/db-query-scan/fixture.out Normal file
View file

@ -0,0 +1,6 @@
asha
bram
--
asha
bram
chidi

22
tests/corpus/run/db-query-scan/fixture.wo Normal file
View file

@ -0,0 +1,22 @@
-- iteration 9b: language-integrated query, from/where/select over a table
-- scan, lowered to a bytecode loop over engine cursors (no SQL text). A
-- table-class value is its row id; `e.name` reads the column via the engine.
@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: 200, dept: 1 }
insert Emp { name: "chidi", salary: 50, dept: 2 }
for e in from x in Emp where x.salary >= 100 select x {
print(e.name)
}
print("--")
for n in from x in Emp select x.name {
print(n)
}
}