From 144c16b2234fd92fd0caaf23b4a9dac95d60e165 Mon Sep 17 00:00:00 2001 From: "shoney.arickathil" Date: Sun, 16 Aug 2026 05:10:13 +0200 Subject: [PATCH] feat(compiler): ref + backlink navigation in queries (9b cont.) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - `backlink C.f` field type: parsed, typed as `multi C`, and VIRTUAL — filtered out of the stored row layout (no column, omittable in ctor/insert), collected in clsrec.cr_backlinks - reading a backlink (`d.staff`) lowers to DB_PROBE on the source class's index for the backing column (backlink_target resolves the (source class, index number); a backlink with no backing index has no efficient read) - `ref C` navigation (`e.dept.name`) chains: a ref value is the target row's id, so a `Ref C` base navigates into C's fields exactly like a table-class value, routing to DB_GET_FIELD both in typecheck and emit - query navigation source `from s in d.staff`: emit_query evaluates the nav expr to get its id-list instead of DB_SCAN; QNav typechecks with the range var bound to the navigation's element class - fixture run/db-query-relations proves both directions; oop-e2e 75/0, woc-test 566/0, log-watcher 7/0 - still ahead for employee: order/take, group-by aggregates, projection records, delete + update-through-row Co-Authored-By: Claude Opus 5 (1M context) --- compiler/src/ast.ml | 3 + compiler/src/dump.ml | 1 + compiler/src/emit.ml | 129 +++++++++++++++--- compiler/src/owner.ml | 1 + compiler/src/parser.ml | 6 + compiler/src/types.ml | 45 ++++-- .../corpus/run/db-query-relations/fixture.out | 7 + .../corpus/run/db-query-relations/fixture.wo | 30 ++++ 8 files changed, 194 insertions(+), 28 deletions(-) create mode 100644 tests/corpus/run/db-query-relations/fixture.out create mode 100644 tests/corpus/run/db-query-relations/fixture.wo diff --git a/compiler/src/ast.ml b/compiler/src/ast.ml index 3f53b99..92113e3 100644 --- a/compiler/src/ast.ml +++ b/compiler/src/ast.ml @@ -69,6 +69,9 @@ type field_ty = | Ref of string | Multi of string | Map of string * string (* key type, value type: map *) + | Backlink of string * string (* backlink C.f: the computed inverse of a + `ref` — NOT a stored column; reading it + scans C's index on f. Types as multi C. *) | Nullable of field_ty (* ?T wrapper *) (* Parameter passing convention (spec section 3, rule 2): default is an diff --git a/compiler/src/dump.ml b/compiler/src/dump.ml index 6bcd65c..af5dc5d 100644 --- a/compiler/src/dump.ml +++ b/compiler/src/dump.ml @@ -150,6 +150,7 @@ let rec field_ty_str : Ast.field_ty -> string = function | Ast.Ref s -> Printf.sprintf "ref %s" s | Ast.Multi s -> Printf.sprintf "multi %s" s | Ast.Map (k, v) -> Printf.sprintf "map<%s, %s>" k v + | Ast.Backlink (c, f) -> Printf.sprintf "backlink %s.%s" c f | Ast.Nullable t -> "?" ^ field_ty_str t let param_str (p : Ast.param) : string = Printf.sprintf "%s%s: %s" (conv_str p.conv) p.name (field_ty_str p.ty) diff --git a/compiler/src/emit.ml b/compiler/src/emit.ml index 925528c..a79a9ed 100644 --- a/compiler/src/emit.ml +++ b/compiler/src/emit.ml @@ -355,6 +355,10 @@ type clsrec = { 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) *) + (* backlink fields (iteration 9b): name -> (source class, source field). + Virtual — not in cr_fields, no stored column; `d.staff` reads them by + probing the source class's index on the source field. *) + cr_backlinks : (string * (string * string)) list; } type ifacerec = { @@ -788,6 +792,32 @@ let b_db_scan = 64 let b_db_get_field = 65 let b_db_probe = 66 +(* iteration 9b: `d.staff` where staff is `backlink Employee.dept` reads by + probing Employee's index on its `dept` column. Resolve to (source cid, + index number) — None if the source field is not a declared index (a + backlink without a backing index has no efficient read and is rejected). *) +let backlink_target (p : pctx) (base_cid : int) (fname : string) : (int * int) option = + match List.assoc_opt fname p.p_classes.(base_cid).cr_backlinks with + | None -> None + | Some (src_class, src_field) -> ( + match class_of_name p src_class with + | None -> None + | Some scid -> + let sc = p.p_classes.(scid) in + (* stored column index of the source field *) + let col = ref (-1) in + Array.iteri (fun i (n, _) -> if n = src_field then col := i) sc.cr_fields; + if !col < 0 then None + else + (* the index whose single column is that field *) + let rec find n = function + | [] -> None + | (_, cols) :: tl -> + if Array.length cols = 1 && cols.(0) = !col then Some (scid, n) + else find (n + 1) tl + in + find 0 sc.cr_indexes) + 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 @@ -961,12 +991,11 @@ let variant_tag_value (p : pctx) (u : Types.union_info) (vi : Types.variant_info `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 +let query_elem_scalar (p : pctx) (q : Ast.query) ~(src : string) : string = + match q.Ast.q_select.Ast.kind with + | Ast.Ident v when v = q.Ast.q_var -> src (* select the whole row: element = source class *) + | Ast.Field ({ Ast.kind = Ast.Ident v; _ }, fname) when v = q.Ast.q_var -> ( + match class_of_name p src with | Some cid -> ( match field_of p cid fname with | Some (_, ty) -> ( match unwrap ty with Scalar n -> n | _ -> "Int") @@ -1003,10 +1032,17 @@ let rec ty_of_expr (p : pctx) (f : fstate) (e : Ast.expr) : Ast.field_ty option | Field (base, fname) -> ( match ty_of_expr p f base with | Some bt -> ( - match unwrap bt with + (* a `ref C` navigates into C: the target is a table row id *) + match (match unwrap bt with Ref c -> Scalar c | other -> other) with | Scalar cn -> ( match class_of_name p cn with - | Some cid -> ( match field_of p cid fname with Some (_, t) -> Some t | None -> None) + | Some cid -> ( + match field_of p cid fname with + | Some (_, t) -> Some t + | None -> ( + match List.assoc_opt fname p.p_classes.(cid).cr_backlinks with + | Some (sc, _) -> Some (Multi sc) + | None -> None)) | None -> None) | _ -> None) | None -> None) @@ -1088,7 +1124,14 @@ 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)) + | Query q -> + let src = + match q.Ast.q_src with + | Ast.QTable cn -> cn + | Ast.QNav nav -> ( + match ty_of_expr p f nav with Some t -> (match unwrap t with Multi c -> c | Scalar c -> c | _ -> "") | None -> "") + in + Some (Multi (query_elem_scalar p q ~src)) | Interp _ -> Some (Scalar "Text") | DbStub _ -> None | Switch (subject, arms) -> ( @@ -1379,7 +1422,7 @@ let field_class_meta (p : pctx) (ty : Ast.field_ty) : int = match name_of (Ast.Scalar e) with | Some n -> ( match class_of_name p n with Some cid -> cid | None -> wob_none) | None -> wob_none) - | Ast.Ref _ | Ast.Nullable _ -> wob_none + | Ast.Ref _ | Ast.Backlink _ | Ast.Nullable _ -> wob_none let field_elem_meta (p : pctx) (ty : Ast.field_ty) : int = match unwrap ty with @@ -1618,9 +1661,22 @@ let rec emit_expr (p : pctx) (f : fstate) (v : views) ~(dst : int) ?expected (e | Field (base, fname) -> ( match ty_of_expr p f base with | Some bt -> ( - match unwrap bt with + match (match unwrap bt with Ref c -> Scalar c | other -> other) with | Scalar cn -> ( match class_of_name p cn with + | Some cid when is_table_class p cid && backlink_target p cid fname <> None -> ( + (* `d.staff`: probe the source class's index for rows referencing + this row's id. Window: [class, index, key(=base id)]. *) + match backlink_target p cid fname with + | Some (scid, ino) -> + let b = emit_operand p f v base in + 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 scid))); + put f (ins_abx op_loadk (w + 1) (check_bx p f e.pos "constant" (const_int p ino))); + put f (ins_abc op_move (w + 2) b 0); + sync_mask p f v e.id; + put f (ins_abc op_builtin dst w b_db_probe) + | None -> ()) | Some cid -> ( match field_of p cid fname with | Some (idx, _) -> @@ -2409,14 +2465,22 @@ and emit_query (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) 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 + let cn = + match q.Ast.q_src with + | Ast.QTable cn -> cn + | Ast.QNav nav -> ( + (* the source's element type is the range var's class *) + match ty_of_expr p f nav with + | Some t -> ( match unwrap t with Multi c -> c | Scalar c -> c | _ -> "") + | None -> "") + 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_name = query_elem_scalar p q ~src:cn 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 @@ -2439,8 +2503,16 @@ and emit_query (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) (* 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); + (match q.Ast.q_src with + | Ast.QTable _ -> + 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) + | Ast.QNav nav -> + (* the navigation (a backlink) already yields a multi of source ids *) + let save = f.f_temp in + f.f_temp <- scan + 1; + emit_expr p f v ~dst:scan nav; + f.f_temp <- save); 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))); @@ -4129,7 +4201,12 @@ let emit ~(syms : Types.symbols) ~(module_of : string -> string) | Some key -> Hashtbl.replace record_shape key cid | None -> ()); classes := - (let fnames = List.map (fun (fl : Ast.field) -> fl.Ast.name) c.fields in + (let fnames = + List.filter_map + (fun (fl : Ast.field) -> + match fl.Ast.ty with Ast.Backlink _ -> None | _ -> Some fl.Ast.name) + c.fields + in let col_of n = ref_index_of_name fnames n in let is_indexable (fl : Ast.field) = match Types.wob_kind_of_typ p_syms_for_indexes (Types.typ_of_field_ty (unwrap fl.Ast.ty)) with @@ -4178,10 +4255,23 @@ let emit ~(syms : Types.symbols) ~(module_of : string -> string) | None -> ()); { cr_name = c.name; cr_gc = c.is_gc; cr_fields = - Array.of_list (List.map (fun (fl : Ast.field) -> (fl.name, fl.ty)) c.fields); + Array.of_list + (List.filter_map + (fun (fl : Ast.field) -> + match fl.Ast.ty with + | Ast.Backlink _ -> None (* virtual: no stored column *) + | _ -> Some (fl.Ast.name, fl.Ast.ty)) + c.fields); cr_methods = List.map (fun (m : Ast.method_decl) -> m.name) c.methods; cr_indexes = table_indexes @ unique_indexes; - cr_is_table = (c.Ast.table <> None) }) + cr_is_table = (c.Ast.table <> None); + cr_backlinks = + List.filter_map + (fun (fl : Ast.field) -> + match fl.Ast.ty with + | Ast.Backlink (sc, sf) -> Some (fl.Ast.name, (sc, sf)) + | _ -> None) + c.fields }) :: !classes end | Ast.Union (ud : Ast.union_decl) -> @@ -4202,6 +4292,7 @@ let emit ~(syms : Types.symbols) ~(module_of : string -> string) incr nclasses; classes := { cr_name = key; cr_gc = false; cr_indexes = []; cr_is_table = false; + cr_backlinks = []; cr_fields = Array.of_list vd.Ast.v_fields; cr_methods = [] } :: !classes @@ -4245,7 +4336,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_is_table = false } + cr_indexes = []; cr_is_table = false; cr_backlinks = [] } :: !classes end) Types.predeclared_records; diff --git a/compiler/src/owner.ml b/compiler/src/owner.ml index a773a50..90c1cc4 100644 --- a/compiler/src/owner.ml +++ b/compiler/src/owner.ml @@ -439,6 +439,7 @@ let oclass_of (ctx : ctx) (ft : Ast.field_ty) : oclass = | Some u -> if u.Types.u_has_payload then Owned else Copy | None -> Copy (* unknown type: WO-E225 already reported by types.ml *)) | Ref _ -> Copy + | Backlink _ -> Copy (* a virtual collection of row ids read on demand *) | Multi _ | Map _ -> Owned | Nullable _ -> Copy (* unreachable: unwrapped above *) diff --git a/compiler/src/parser.ml b/compiler/src/parser.ml index 81f5546..24baf93 100644 --- a/compiler/src/parser.ml +++ b/compiler/src/parser.ml @@ -356,6 +356,12 @@ let parse_field_ty (st : state) : Ast.field_ty = | Token.Ident "multi" -> ignore (advance st); Ast.Multi (expect_ident st "multi target type") + | Token.Ident "backlink" -> + ignore (advance st); + let cls = expect_ident st "backlink source class" in + expect st Token.Dot "'.'"; + let fld = expect_ident st "backlink source field" in + Ast.Backlink (cls, fld) | Token.Ident "map" -> ignore (advance st); expect st Token.Lt "'<'"; diff --git a/compiler/src/types.ml b/compiler/src/types.ml index b9cf386..44faf2d 100644 --- a/compiler/src/types.ml +++ b/compiler/src/types.ml @@ -306,6 +306,7 @@ let rec has_recursive_structure (cls : class_info) : bool = | Ast.Ref name -> name = cls.name | Ast.Multi name -> name = cls.name (* multi Self *) | Ast.Map (k, v) -> k = cls.name || v = cls.name (* map<_, Self> / map *) + | Ast.Backlink _ -> false | Ast.Nullable inner -> has_recursive_structure_type inner cls.name ) cls.fields @@ -315,6 +316,7 @@ and has_recursive_structure_type (ty : Ast.field_ty) (cls_name : string) : bool | Ast.Ref name -> name = cls_name | Ast.Multi name -> name = cls_name | Ast.Map (k, v) -> k = cls_name || v = cls_name + | Ast.Backlink _ -> false (* a computed inverse holds no owned structure *) | Ast.Nullable inner -> has_recursive_structure_type inner cls_name (* @unique field -> persistent identity (plan's "When NOT to emit": a @@ -363,6 +365,7 @@ let rec typ_of_field_ty (ft : field_ty) : typ = | Ref name -> TRef name | Multi inner_name -> TMulti (TScalar inner_name) | Map (k_name, v_name) -> TMap (TScalar k_name, TScalar v_name) + | Backlink (c, _) -> TMulti (TScalar c) (* reads as a collection of C *) | Nullable inner -> TNullable (typ_of_field_ty inner) (* wob_kind_of_typ: maps internal typ to .wob field kind *) @@ -633,7 +636,7 @@ let rec scalar_name_of (ft : field_ty) : string option = match ft with | Scalar name -> Some name | Nullable inner -> scalar_name_of inner - | Ref _ | Multi _ | Map _ -> None + | Ref _ | Multi _ | Map _ | Backlink _ -> None (* Checked once per field declaration (not at every access/use site), so the diagnostic lands at the field's own declaration position and @@ -1203,7 +1206,7 @@ let typecheck_program ~file ~(module_of : string -> string) with Not_found -> { typ = TScalar "Int"; is_nil = false }) | Field (base, field_name) -> let base_res = typecheck_expr env cenv base in - (match base_res.typ with + (match (match base_res.typ with TRef c -> TScalar c | other -> other) with | TScalar class_name -> (* Only a *declared* class can be checked for a missing field. typecheck_expr falls back to `TScalar "Int"` for everything @@ -1396,7 +1399,8 @@ let typecheck_program ~file ~(module_of : string -> string) the zero word NEW already leaves there). Everything else stays WO-E206, classes and records alike. *) let omittable (default : default_expr option) (fty : field_ty) : bool = - Option.is_some default || (match fty with Nullable _ -> true | _ -> false) + Option.is_some default + || (match fty with Nullable _ | Backlink _ -> true | _ -> false) in List.iter (fun (fname, fty, fdefault, _) -> if not (List.mem fname provided) && not (omittable fdefault fty) then @@ -1420,7 +1424,8 @@ let typecheck_program ~file ~(module_of : string -> string) let cls = StringMap.find class_name syms.classes in let provided = List.map (fun (n, _) -> n) fields in let omittable (default : default_expr option) (fty : field_ty) : bool = - Option.is_some default || (match fty with Nullable _ -> true | _ -> false) + Option.is_some default + || (match fty with Nullable _ | Backlink _ -> true | _ -> false) in List.iter (fun (fname, fty, fdefault, _) -> if not (List.mem fname provided) && not (omittable fdefault fty) then @@ -1445,11 +1450,32 @@ let typecheck_program ~file ~(module_of : string -> string) { 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.QNav nav -> + (* `from s in d.staff`: the navigation yields `multi C`, so the + range var is a C. Reuse the QTable body by resolving C. *) + let nav_res = typecheck_expr env cenv nav in + let cn = + match nav_res.typ with + | TMulti (TScalar c) -> c + | _ -> "" + in + 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:"query navigation source must be a `backlink`/`multi` of a table class" ()); + elem_err () + end + else begin + (if q.q_group <> None || q.q_order <> None || 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:"group/order/take on a navigation query are 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 | Ast.QTable cn -> if not (StringMap.mem cn syms.classes) then begin Diag.Collector.add collector @@ -2452,6 +2478,7 @@ let rec field_ty_str (ft : field_ty) : string = | Ref s -> "ref " ^ s | Multi s -> "multi " ^ s | Map (k, v) -> "map<" ^ k ^ ", " ^ v ^ ">" + | Backlink (c, f) -> "backlink " ^ c ^ "." ^ f | Nullable t -> "?" ^ field_ty_str t let dump_symbols (syms : symbols) : string = diff --git a/tests/corpus/run/db-query-relations/fixture.out b/tests/corpus/run/db-query-relations/fixture.out new file mode 100644 index 0000000..66e1688 --- /dev/null +++ b/tests/corpus/run/db-query-relations/fixture.out @@ -0,0 +1,7 @@ +-- forward (e.dept.name): +eng +eng +ops +-- backward (d.staff): +asha +bram diff --git a/tests/corpus/run/db-query-relations/fixture.wo b/tests/corpus/run/db-query-relations/fixture.wo new file mode 100644 index 0000000..4aebd04 --- /dev/null +++ b/tests/corpus/run/db-query-relations/fixture.wo @@ -0,0 +1,30 @@ +-- iteration 9b: ref + backlink navigation. `e.dept.name` chains a ref to +-- its target row (a point read); `d.staff` reads a backlink by probing the +-- source class's index — both execute in the engine, no join written. +@table(name: "dept", index: [name]) +class Dept { + name: Text + staff: backlink Emp.dept +} +@table(name: "emp", index: [dept]) +class Emp { + name: Text + dept: ref Dept +} +fn main() { + let eng = insert Dept { name: "eng" } + let ops = insert Dept { name: "ops" } + insert Emp { name: "asha", dept: eng } + insert Emp { name: "bram", dept: eng } + insert Emp { name: "dora", dept: ops } + print("-- forward (e.dept.name):") + for e in from x in Emp select x { + print(e.dept.name) + } + print("-- backward (d.staff):") + for d in from x in Dept where x.name == "eng" select x { + for s in from y in d.staff select y { + print(s.name) + } + } +}