Line data Source code
1 : // wok_reorder -- see wok_reorder.h.
2 : //
3 : // A transliteration of Wok.Reordering's reorderChain / findLoosest /
4 : // combineInfix, not a reimplementation from the doc prose: the Haskell
5 : // source (src/Wok/Reordering.hs) is read alongside every function below, and
6 : // the two are meant to be read side by side. Divergence is a bug, caught by
7 : // the differential test on the Haskell side (test/Spec.hs), not adjudicated
8 : // here.
9 : //
10 : // TABLE-FIRST, TREE-SECOND. Haskell's buildFixityTable runs checkNeighbors
11 : // over the WHOLE table before reorderAst ever looks at an expression: a
12 : // `fixity` relation naming a neighbour that never gets its own `fixity` head
13 : // is a fault of the FILE, not of any particular use site -- it fails a
14 : // module with zero chains just as surely as one with a thousand. wok_reorder
15 : // mirrors that ordering explicitly (check_neighbours, called once at entry,
16 : // before reorder_node takes a single step): a placeholder anywhere in the
17 : // table stops the pass right there. The per-occurrence checks inside
18 : // reorder_chain therefore only ever see a placeholder-free table -- an
19 : // operator reaching that point is either genuinely undeclared (no entry at
20 : // all) or fully declared, never "known but only as someone else's neighbour".
21 : //
22 : // TREE SHAPE. Haskell's combineInfix wraps an already-chained operand in
23 : // EParen before nesting it, because its surface grammar keeps "a chain" and
24 : // "a parenthesized chain used as an operand" as distinct constructors. This
25 : // AST has no such node -- wok_print.h already documents that parentheses are
26 : // RE-DERIVED at print time, never stored -- so an E_Chain nests directly
27 : // wherever EXPR is demanded (E_Chain's own `head` and H_ChainOp's `rhs` both
28 : // declare that family). No wrapper is built; the s-expression dump makes the
29 : // nesting visible through bracket structure alone.
30 :
31 : #include "wok_reorder.h"
32 :
33 : #include <string.h>
34 :
35 : // The walk's working context: the table it consults, the source every span
36 : // in the tree points into, the arena new nodes are built in, and the sink
37 : // diagnostics go to. One instance, threaded by pointer, exactly like R in
38 : // wok_resolve.c -- but this one holds no mutable table-building state,
39 : // because the table already exists by the time this pass runs.
40 : typedef struct {
41 : const WokFixTable *fix;
42 : const char *src;
43 : WokArena *a;
44 : WokDiagSink *d;
45 : } RO;
46 :
47 : #define SPAN(ro, s) (int)(s).len, (ro)->src + (s).off
48 :
49 24 : static bool span_eq(const RO *ro, WokSpan a, WokSpan b) {
50 24 : return a.len == b.len && memcmp(ro->src + a.off, ro->src + b.off, a.len) == 0;
51 : }
52 :
53 : // Linear scan, not a hash index: the table this pass reads is the one file's
54 : // own `fixity` declarations, small by construction (spec: "Performance"),
55 : // and the reorder pass has no need of resolve's NameIdx to get O(1) here.
56 15 : static u32 fix_find(const RO *ro, WokSpan name) {
57 20 : for (u32 i = 0; i < ro->fix->n; i++)
58 18 : if (span_eq(ro, ro->fix->ops[i].name, name)) return i;
59 : return UINT32_MAX;
60 : }
61 :
62 5 : static bool fix_tighter(const RO *ro, u32 i, u32 j) {
63 5 : return (ro->fix->edge[(usize)i * ro->fix->words + j / 64] >> (j % 64) & 1u) !=
64 : 0;
65 : }
66 :
67 : // One flat chain slot, with its rhs ALREADY reordered -- reorder_node walks
68 : // bottom-up, so by the time an E_Chain node is handed to reorder_chain every
69 : // child it owns is done. `fix_idx` is resolved once per chain (checkDeclared,
70 : // mirrored) rather than re-looked-up at every comparison in the scan.
71 : typedef struct {
72 : WokSpan name;
73 : bool backtick;
74 : WokNode *rhs;
75 : u32 fix_idx;
76 : } Tail;
77 :
78 : typedef enum { ORD_TIGHTER, ORD_LOOSER, ORD_EQUAL, ORD_INCOMPARABLE } Order;
79 :
80 : // compareOps, transliterated. Argument order matters: `a` is the occurrence
81 : // under the scan's cursor, `b` is the current loosest-so-far, exactly as
82 : // Haskell's findLoosest calls `compareOps t curName bestName`. Tighter means
83 : // a binds TIGHTER than b (b remains loosest); Looser means a binds LOOSER
84 : // (a becomes the new loosest).
85 6 : static Order compare_ops(const RO *ro, WokSpan a, u32 ai, WokSpan b, u32 bi) {
86 6 : if (span_eq(ro, a, b)) return ORD_EQUAL;
87 4 : if (fix_tighter(ro, ai, bi)) return ORD_TIGHTER;
88 1 : if (fix_tighter(ro, bi, ai)) return ORD_LOOSER;
89 : return ORD_INCOMPARABLE;
90 : }
91 :
92 2 : static void diag_undeclared(RO *ro, WokSpan name) {
93 2 : wok_diag_add(ro->d, WOK_E_FIXITY, name.off, name.len,
94 : "`%.*s` has no `fixity` declaration; reorder mode cannot place "
95 : "it in a chain without one",
96 2 : SPAN(ro, name));
97 2 : }
98 :
99 4 : static void diag_neighbour_only(RO *ro, WokSpan name) {
100 4 : wok_diag_add(ro->d, WOK_E_FIXITY, name.off, name.len,
101 : "`%.*s` is named only as another operator's neighbour and has "
102 : "no `fixity` declaration of its own",
103 4 : SPAN(ro, name));
104 4 : }
105 :
106 : // checkNeighbors, transliterated: a whole-table scan, run ONCE before any
107 : // chain is visited (see the file header). Every placeholder gets its own
108 : // diagnostic -- Haskell's buildFixityTable collects one UnresolvedNeighbor
109 : // per offending relation, and a batch here is truer to that than stopping at
110 : // the first. The anchor is the placeholder's own name span: Haskell anchors
111 : // at the DECLARING head's position instead, but the verdict-level contract
112 : // (spec: "chain-level agreement on the message is NOT required, only the
113 : // verdict") does not ask the two to match spans, and the placeholder's own
114 : // span is the only position this table actually retains for it.
115 13 : static bool check_neighbours(RO *ro) {
116 13 : bool ok = true;
117 33 : for (u32 i = 0; i < ro->fix->n; i++) {
118 20 : if (ro->fix->ops[i].decl_off != UINT32_MAX) continue;
119 4 : diag_neighbour_only(ro, ro->fix->ops[i].name);
120 4 : ok = false;
121 : }
122 13 : return ok;
123 : }
124 :
125 : // The wording shape check_chain uses for its E-FIXITY: both occurrences
126 : // quoted with their own line:col, so the reader does not have to hunt the
127 : // other end of a long chain. The "shield" clause of check_chain's message
128 : // does not apply here -- this fault comes from the greedy scan finding two
129 : // occurrences with no order between them at all, not from a missing looser
130 : // operator between two related ones -- so the repair advice is the general
131 : // one: bracket, or declare an order.
132 0 : static void diag_incomparable(RO *ro, WokSpan best, WokSpan cur) {
133 0 : u32 bl = 0, bc = 0, cl = 0, cc = 0;
134 0 : wok_diag_position(ro->d, best.off, &bl, &bc);
135 0 : wok_diag_position(ro->d, cur.off, &cl, &cc);
136 0 : wok_diag_add(ro->d, WOK_E_FIXITY, cur.off, cur.len,
137 : "`%.*s` (%u:%u) and `%.*s` (%u:%u) have no declared order: "
138 : "bracket the chain, or relate them with `tighter than`",
139 0 : SPAN(ro, best), bl, bc, SPAN(ro, cur), cl, cc);
140 0 : }
141 :
142 : // findLoosest, transliterated. Returns UINT32_MAX when the scan hit an
143 : // incomparable pair -- the diagnostic already fired, and the caller's job is
144 : // only to stop, not to guess a split point a fault has no good answer for.
145 13 : static u32 find_loosest(RO *ro, const Tail *tails, u32 n) {
146 13 : u32 best = 0;
147 19 : for (u32 i = 1; i < n; i++) {
148 6 : Order ord = compare_ops(ro, tails[i].name, tails[i].fix_idx,
149 6 : tails[best].name, tails[best].fix_idx);
150 6 : switch (ord) {
151 : case ORD_TIGHTER:
152 : break; // the running loosest stands
153 1 : case ORD_LOOSER:
154 1 : best = i;
155 1 : break;
156 2 : case ORD_EQUAL:
157 : // Equal means the SAME operator (no cross-operator equivalence
158 : // classes), so its own declared associativity settles the tie:
159 : // left-assoc takes the rightmost occurrence scanned so far,
160 : // right-assoc keeps the leftmost.
161 2 : if (ro->fix->ops[tails[best].fix_idx].assoc == WOK_ASSOC_LEFT)
162 1 : best = i;
163 : break;
164 0 : case ORD_INCOMPARABLE:
165 0 : diag_incomparable(ro, tails[best].name, tails[i].name);
166 0 : return UINT32_MAX;
167 : }
168 : }
169 : return best;
170 : }
171 :
172 : // combineInfix, transliterated (see the file header for why there is no
173 : // EParen step). The synthesized span covers the operands, leftmost start to
174 : // rightmost end, so a diagnostic raised against this node downstream still
175 : // points somewhere sane.
176 13 : static WokNode *combine_infix(RO *ro, WokNode *lhs, WokSpan op, bool backtick,
177 : WokNode *rhs) {
178 13 : u32 start = lhs->off;
179 13 : u32 end = rhs->off + rhs->len;
180 13 : WokNode *opn = wok_node(ro->a, H_ChainOp, op.off, end - op.off);
181 13 : H_ChainOp_set_op(opn, op);
182 13 : H_ChainOp_set_backtick(opn, backtick);
183 13 : H_ChainOp_set_rhs(opn, rhs);
184 13 : WokNode *chain = wok_node(ro->a, E_Chain, start, end - start);
185 13 : E_Chain_set_head(chain, lhs);
186 13 : WokNode *one_op[1] = {opn};
187 13 : E_Chain_set_ops(chain, wok_seq(ro->a, one_op, 1));
188 13 : return chain;
189 : }
190 :
191 : // reorderChain's split-and-recurse, transliterated: find the loosest,
192 : // splitAt there, recurse into both halves over the SAME flat array (never a
193 : // tree already rebuilt by an earlier split), rebuild. A single-tail slice
194 : // still goes through find_loosest (a no-op scan, best = 0) rather than being
195 : // special-cased -- which is exactly why a one-op chain "already resolved"
196 : // needs no separate code path (see wok_reorder.h / the spec's note on it).
197 33 : static WokNode *reorder_split(RO *ro, WokNode *h, const Tail *tails, u32 n) {
198 33 : if (n == 0) return h;
199 13 : u32 idx = find_loosest(ro, tails, n);
200 13 : if (idx == UINT32_MAX) return h;
201 13 : WokNode *left = reorder_split(ro, h, tails, idx);
202 13 : const Tail *split = &tails[idx];
203 13 : WokNode *right = reorder_split(ro, split->rhs, tails + idx + 1, n - idx - 1);
204 13 : return combine_infix(ro, left, split->name, split->backtick, right);
205 : }
206 :
207 : // checkDeclared, transliterated, over every occurrence in the chain -- one
208 : // fault per chain (the codebase's convention, matching check_chain's "one
209 : // chain, one fault"), then find_loosest runs on the validated tails. `n`'s
210 : // head and every op's rhs have already been reordered by the caller.
211 : //
212 : // NO placeholder check here: check_neighbours already rejected the whole
213 : // file, before this walk started, if the table held ANY entry with
214 : // decl_off == UINT32_MAX. So an `idx` reaching this point past the
215 : // no-entry-at-all check names an operator with a winning `fixity`
216 : // declaration of its own -- "known but only as a neighbour" cannot occur by
217 : // the time any chain is visited.
218 9 : static WokNode *reorder_chain(RO *ro, WokNode *n) {
219 9 : WokSeq ops = E_Chain_ops(n);
220 9 : Tail *tails = ops.n ? WOK_NEW_N(ro->a, Tail, ops.n) : nullptr;
221 22 : for (u32 i = 0; i < ops.n; i++) {
222 15 : WokNode *op = ops.items[i];
223 15 : WokSpan name = H_ChainOp_op(op);
224 15 : u32 idx = fix_find(ro, name);
225 15 : if (idx == UINT32_MAX) {
226 2 : diag_undeclared(ro, name);
227 2 : return n;
228 : }
229 26 : tails[i] = (Tail){.name = name, .backtick = H_ChainOp_backtick(op),
230 13 : .rhs = H_ChainOp_rhs(op), .fix_idx = idx};
231 : }
232 7 : return reorder_split(ro, E_Chain_head(n), tails, ops.n);
233 : }
234 :
235 : static WokNode *reorder_node(RO *ro, WokNode *n);
236 :
237 : // The copy-on-write invariant, in one place: the fresh slot block is
238 : // allocated on the FIRST child that actually changes, and starts as a byte
239 : // copy of the original so untouched siblings keep their slots. Both slot
240 : // walkers below write through this, so the allocate-before-first-write
241 : // rule cannot drift between them.
242 17 : static WokSlot *ensure_fresh(RO *ro, const WokNode *n, WokSlot **fresh) {
243 17 : if (!*fresh) {
244 17 : *fresh = WOK_NEW_N(ro->a, WokSlot, n->nslots);
245 17 : memcpy(*fresh, n->slot, (usize)n->nslots * sizeof(WokSlot));
246 : }
247 17 : return *fresh;
248 : }
249 :
250 : // A node's own NODE/OPT field, reordered; a subtree fixity never touches
251 : // costs nothing beyond the pointer comparisons.
252 52 : static void reorder_child_slot(RO *ro, WokNode *n, WokSlot **fresh, u16 i) {
253 52 : WokNode *child = n->slot[i].node;
254 52 : WokNode *rebuilt = reorder_node(ro, child);
255 52 : if (rebuilt == child) return;
256 9 : ensure_fresh(ro, n, fresh)[i].node = rebuilt;
257 : }
258 :
259 58 : static void reorder_seq_slot(RO *ro, WokNode *n, WokSlot **fresh, u16 i) {
260 58 : WokSeq q = wok_seq_unpack(n->slot[i].seq);
261 58 : WokNode **rebuilt = nullptr;
262 107 : for (u32 j = 0; j < q.n; j++) {
263 49 : WokNode *r = reorder_node(ro, q.items[j]);
264 49 : if (r == q.items[j]) continue;
265 8 : if (!rebuilt) {
266 8 : rebuilt = WOK_NEW_N(ro->a, WokNode *, q.n);
267 8 : memcpy(rebuilt, q.items, (usize)q.n * sizeof(WokNode *));
268 : }
269 8 : rebuilt[j] = r;
270 : }
271 58 : if (!rebuilt) return;
272 8 : ensure_fresh(ro, n, fresh)[i].seq = wok_seq(ro->a, rebuilt, q.n).items;
273 : }
274 :
275 : // The generic bottom-up walk. Every NODE/OPT/SEQ child is visited regardless
276 : // of the FAMILY it demands -- a type or a pattern can never hold an E_Chain,
277 : // so recursing into one is a guaranteed no-op, and that is cheaper to accept
278 : // than to hand-enumerate every EXPR-bearing field the schema has (which is
279 : // what the spec's "everything that can contain an E_Chain" is asking for: no
280 : // construct is special-cased into or out of this walk). NAME/TEXT/INT/FLAG
281 : // hold no child. No `default:` -- WOK_FIELD_CLASS_COUNT is listed so a field
282 : // class added later fails the build here, the same discipline wok_resolve.c
283 : // uses in sc_node.
284 111 : static WokNode *reorder_node(RO *ro, WokNode *n) {
285 111 : if (!n) return nullptr;
286 111 : const WokNodeDesc *desc = &wok_node_desc[n->tag];
287 111 : WokSlot *fresh = nullptr;
288 357 : for (u16 i = 0; i < desc->nfields; i++) {
289 246 : switch (desc->fields[i].cls) {
290 52 : case WFC_NODE:
291 : case WFC_OPT:
292 52 : reorder_child_slot(ro, n, &fresh, i);
293 52 : break;
294 58 : case WFC_SEQ:
295 58 : reorder_seq_slot(ro, n, &fresh, i);
296 58 : break;
297 : case WFC_NAME:
298 : case WFC_TEXT:
299 : case WFC_INT:
300 : case WFC_FLAG:
301 : case WOK_FIELD_CLASS_COUNT:
302 : break;
303 : }
304 : }
305 111 : WokNode *base = n;
306 111 : if (fresh) {
307 17 : base = wok_node(ro->a, (WokTag)n->tag, n->off, n->len);
308 17 : memcpy(base->slot, fresh, (usize)n->nslots * sizeof(WokSlot));
309 : }
310 111 : if (base->tag == E_Chain) return reorder_chain(ro, base);
311 : return base;
312 : }
313 :
314 13 : const WokNode *wok_reorder(const WokNode *file, const char *src, WokArena *a,
315 : WokDiagSink *d, const WokFixTable *fix) {
316 13 : RO ro = {.fix = fix, .src = src, .a = a, .d = d};
317 : // Table first, tree second (see the file header): a placeholder anywhere
318 : // in the table faults the whole file before a single node is walked, the
319 : // same way Haskell's buildFixityTable fails before reorderAst runs at all.
320 13 : if (!check_neighbours(&ro)) return file;
321 10 : return reorder_node(&ro, (WokNode *)file);
322 : }
|
