-
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathcodegen_deno.ml
More file actions
1008 lines (945 loc) · 44.2 KB
/
Copy pathcodegen_deno.ml
File metadata and controls
1008 lines (945 loc) · 44.2 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(* SPDX-License-Identifier: PMPL-1.0-or-later *)
(* SPDX-FileCopyrightText: 2026 Jonathan D.A. Jewell *)
(** Deno-ESM Emit Mode (issue #122, Refs #35 #103).
A *direct* AffineScript-AST → ES-module transpiler. Unlike
{!Codegen_node} (which wraps a compiled [Wasm.wasm_module] in a CJS
shim), this backend emits standalone ES2020 module source — no wasm,
no [require], no handle table — so the output is a drop-in [.js] /
[.mjs] ES module a Deno (or Node ESM) consumer can [import] directly.
Why a direct transpiler and not a wasm-wrapping ESM shim: the
motivating consumer ([hyperpolymath/ubicity]'s [storage.ts] /
[wasm-bridge.ts]) is pure JS-value orchestration — it [JSON.stringify]s
arbitrary opaque objects, [JSON.parse]s file contents back into JS
objects, and returns those objects to JS callers. AffineScript's wasm
ABI is i32-only ([Codegen]: params/ret all [I32]); an opaque JS object
and [JSON.stringify(obj)] cannot cross that boundary. There is
essentially no computation here that belongs in wasm. The correct tool
is therefore source-to-source emission, where [extern fn]s lower to
direct host calls ([Deno.writeTextFileSync], [JSON.stringify], ...) and
a struct + its [impl] block lower to a real [export class].
Relationship to the other JS-ish backends:
- {!Js_codegen} — standalone ES2020 from AST, but CommonJS-flavoured,
uses [require("fs")], and *erases* [impl] blocks
([// impl block (erased)]). This module reuses its proven
expression/statement/pattern lowering shape but: emits ESM
([export] / no [require]); emits [export class] for struct+impl;
and lowers [extern fn] to direct Deno/JS host calls.
- {!Codegen_node} — wasm-wrapping CJS shim (issue #35). Distinct track.
Out of scope (documented future work on #122 / #103): an async-extern
ABI. Not needed here — every Deno FS op used by the motivating consumer
has a synchronous form ([*Sync]); [await] on a synchronously-returned
value is valid JS so [async]-looking consumer code keeps working. *)
open Ast
(* ============================================================================
Code-generation context
============================================================================ *)
type codegen_ctx = {
output : Buffer.t;
indent : int;
symbols : Symbol.t;
(* Names declared as [extern fn] (after import flattening these arrive as
[TopExternFn]). A call to one of these lowers via {!deno_builtin}
rather than as an ordinary AffineScript function call. *)
externs : (string, unit) Hashtbl.t;
(* When emitting a method body, the receiver parameter is rewritten to
[this]; this holds that parameter's source name (if any). *)
self_name : string option;
(* Associated-function name -> emitted method name. A call to one of
these whose first argument is the active receiver lowers to
[this.<method>(rest)]; with any other first argument it lowers to
[(<arg0>).<method>(rest)] (a call on another instance). Lets the
receiver-first free-function source style (the only form the current
grammar accepts — no [self]/inherent-[impl]) read as real methods. *)
assoc : (string, string) Hashtbl.t;
(* Top-level functions/consts defined in this program. A user
definition shadows a same-named host intrinsic ({!deno_builtins}),
so e.g. a user `fn len(xs: IntList)` is NOT lowered to `.length`. *)
local_fns : (string, unit) Hashtbl.t;
(* Top-level functions declared with an `Async` effect row. A call to
one of these is a Promise; from an async context the call site must
`await` it (e.g. `get(u).status` would otherwise read `.status` off
a pending Promise). Populated in {!generate}. *)
async_fns : (string, unit) Hashtbl.t;
(* True while emitting a synthesised `async` method body. The
expression-position IIFE wrappers (block/try/match/let/return) must
then be `async` and awaited, because they may contain an awaited
associated call (`(await this.m(...))`) — `await` inside a plain
`(() => {...})()` is a SyntaxError ("Unexpected reserved word"). *)
in_async : bool;
}
let create_ctx symbols = {
output = Buffer.create 1024;
indent = 0;
symbols;
externs = Hashtbl.create 32;
self_name = None;
assoc = Hashtbl.create 32;
local_fns = Hashtbl.create 64;
async_fns = Hashtbl.create 32;
in_async = false;
}
(* Expression-position IIFE wrapper. In an async method body it must be
`(await (async () => { ... })())` so a contained `await` is legal;
elsewhere a plain `(() => { ... })()`. *)
let iife ctx (inner : string) : string =
if ctx.in_async then "(await (async () => { " ^ inner ^ " })())"
else "(() => { " ^ inner ^ " })()"
let emit ctx str = Buffer.add_string ctx.output str
let emit_line ctx str =
Buffer.add_string ctx.output (String.make (ctx.indent * 2) ' ');
Buffer.add_string ctx.output str;
Buffer.add_char ctx.output '\n'
let increase_indent ctx = { ctx with indent = ctx.indent + 1 }
(* True if an effect row mentions `Async`. A function whose declared
effect row includes Async compiles to an `async function`, and its
body is emitted in async context (`in_async`) so an awaited host
call (e.g. the `http_request` -> `await fetch(...)` lowering for
issue #160) is legal JS. This is the free-function analogue of the
unconditionally-async synthesised methods (`gen_class`). *)
let rec eff_has_async : effect_expr -> bool = function
| EffVar id | EffCon (id, _) -> id.name = "Async"
| EffUnion (a, b) -> eff_has_async a || eff_has_async b
let fd_is_async (fd : fn_decl) : bool =
match fd.fd_eff with Some e -> eff_has_async e | None -> false
(* ============================================================================
Runtime prelude (ESM, Deno-flavoured)
Emitted once at the top of every module. No library deps, no [require]:
`deno run foo.js` / an ESM `import` is enough. `print` uses Deno.stdout
(Node ESM also exposes a `Deno` global only under compat, so consumers
that need Node should target the .cjs backend instead).
============================================================================ *)
let prelude = {|// ---- AffineScript Deno-ESM runtime ----
const Some = (value) => ({ tag: "Some", value });
const None = { tag: "None" };
const Ok = (value) => ({ tag: "Ok", value });
const Err = (error) => ({ tag: "Err", error });
const Unit = null;
const print = (s) => { Deno.stdout.writeSync(new TextEncoder().encode(String(s))); };
const println = (s) => { console.log(String(s)); };
// ---- Deno host shims (extern fn lowering targets, issue #122) ----
// Kept tiny + inlined so emitted modules are genuinely drop-in (no extra
// package to publish or resolve). The same surface is mirrored, for
// standalone `deno test`, by packages/affine-deno/mod.js.
const __as_ensureDir = (p) => {
try { Deno.mkdirSync(p, { recursive: true }); }
catch (e) { if (!(e instanceof Deno.errors.AlreadyExists)) throw e; }
};
const __as_pathJoin = (a, b) => {
if (a.length === 0) return b;
const sep = a.endsWith("/") || a.endsWith("\\") ? "" : "/";
return a + sep + b;
};
const __as_readDirNames = (p) => {
const names = [];
for (const entry of Deno.readDirSync(p)) {
if (entry.isFile) names.push(entry.name);
}
return names;
};
const __as_isNotFound = (e) => (e instanceof Deno.errors.NotFound);
const __as_wasmInstance = (bytes) =>
new WebAssembly.Instance(new WebAssembly.Module(bytes)).exports;
// `++` is overloaded (string concat / array concat); `a + b` would
// stringify arrays. Dispatch on shape so stdlib/string.affine's
// `result ++ [x]` and `a ++ b` are both correct.
const __as_concat = (a, b) => Array.isArray(a) ? a.concat(b) : (a + b);
// Honest host/runtime primitives underpinning the AffineScript-level
// stdlib/string.affine (its is_empty/starts_with/ends_with/split/join/
// replace/... are real AffineScript on top of these).
const __as_strSub = (s, start, n) => String(s).slice(start, start + n);
const __as_strGet = (s, i) => String(s)[i];
const __as_strFind = (s, n) => String(s).indexOf(n);
const __as_charToInt = (c) => String(c).codePointAt(0);
const __as_intToChar = (n) => String.fromCodePoint(n);
const __as_parseInt = (s) => {
const n = parseInt(String(s), 10);
return Number.isNaN(n) ? None : Some(n);
};
const __as_parseFloat = (s) => {
const n = parseFloat(String(s));
return Number.isNaN(n) ? None : Some(n);
};
const __as_show = (v) => (typeof v === "string" ? v : JSON.stringify(v));
// ---- Http (issue #160): portable fetch round-trip ----
// `headers` crosses the boundary as an AffineScript [(String, String)]
// assoc list == JS array of [name, value] pairs. `body` is an
// AffineScript Option<String> == { tag: "Some", value } | { tag: "None" }.
// The result is the `Response` record shape { status, headers, body }.
const __as_httpHeadersToObject = (pairs) => {
const o = {};
for (const kv of (pairs || [])) o[kv[0]] = kv[1];
return o;
};
const __as_httpHeadersFromResponse = (res) => {
const out = [];
res.headers.forEach((value, key) => out.push([key, value]));
return out;
};
const __as_httpFetch = async (url, method, headers, bodyOpt) => {
const init = { method, headers: __as_httpHeadersToObject(headers) };
if (bodyOpt && bodyOpt.tag === "Some") init.body = bodyOpt.value;
// `globalThis.fetch` explicitly: the stdlib `Http.fetch` compiles to a
// module-level `function fetch`, which would otherwise shadow the host.
const res = await globalThis.fetch(url, init);
const text = await res.text();
return {
status: res.status,
headers: __as_httpHeadersFromResponse(res),
body: text,
};
};
// ---- end runtime ----
|}
(* Lowering table: extern-fn name -> a function from rendered-arg list to a
JS expression string. Covers the Deno FS / JSON / Wasm / string surface
declared by stdlib/Deno.affine (issue #122). An extern not in this table
is assumed to be a host symbol of the same name already in scope (e.g.
imported by a hand-written shim); it lowers as a plain call. *)
let deno_builtins :
(string, string list -> string) Hashtbl.t = Hashtbl.create 32
let () =
let b name f = Hashtbl.replace deno_builtins name f in
let arg n a = List.nth a n in
(* ---- filesystem (synchronous; see module docstring re: async) ---- *)
b "writeTextFile" (fun a -> Printf.sprintf "Deno.writeTextFileSync(%s, %s)" (arg 0 a) (arg 1 a));
b "readTextFile" (fun a -> Printf.sprintf "Deno.readTextFileSync(%s)" (arg 0 a));
b "readFileBytes" (fun a -> Printf.sprintf "Deno.readFileSync(%s)" (arg 0 a));
b "removePath" (fun a -> Printf.sprintf "Deno.removeSync(%s)" (arg 0 a));
b "mkdirRecursive" (fun a -> Printf.sprintf "Deno.mkdirSync(%s, { recursive: true })" (arg 0 a));
b "ensureDir" (fun a -> Printf.sprintf "__as_ensureDir(%s)" (arg 0 a));
b "readDirNames" (fun a -> Printf.sprintf "__as_readDirNames(%s)" (arg 0 a));
b "statSize" (fun a -> Printf.sprintf "Deno.statSync(%s).size" (arg 0 a));
b "pathJoin" (fun a -> Printf.sprintf "__as_pathJoin(%s, %s)" (arg 0 a) (arg 1 a));
b "isNotFound" (fun a -> Printf.sprintf "__as_isNotFound(%s)" (arg 0 a));
(* ---- JSON ---- *)
b "jsonStringify" (fun a -> Printf.sprintf "JSON.stringify(%s)" (arg 0 a));
b "jsonStringifyPretty" (fun a -> Printf.sprintf "JSON.stringify(%s, null, 2)" (arg 0 a));
b "jsonParse" (fun a -> Printf.sprintf "JSON.parse(%s)" (arg 0 a));
b "jsonNull" (fun _ -> "null");
(* Opaque-object field/index read (the boundary primitive for treating
an arbitrary JS value as data — ubicity's `experience.id` etc.). *)
b "jsonGet" (fun a -> Printf.sprintf "(%s)[%s]" (arg 0 a) (arg 1 a));
b "jsonGetStr" (fun a -> Printf.sprintf "String((%s)[%s])" (arg 0 a) (arg 1 a));
(* Nullish default — preserves a JS default parameter when the arg is
omitted (`new ExperienceStorage()` -> './ubicity-data'). *)
b "orDefault" (fun a -> Printf.sprintf "(%s ?? %s)" (arg 0 a) (arg 1 a));
(* Kilobyte display string: `(n/1024).toFixed(2)` — runtime number
formatting is an honest host primitive in every language. *)
b "kbString" (fun a -> Printf.sprintf "(Number(%s) / 1024).toFixed(2)" (arg 0 a));
(* ---- misc host ---- *)
b "dateNow" (fun _ -> "Date.now()");
b "wasmInstance" (fun a -> Printf.sprintf "__as_wasmInstance(%s)" (arg 0 a));
(* Generic JS array push helper (returns the array, fluent). *)
b "arrayPush" (fun a -> Printf.sprintf "(%s.push(%s), %s)" (arg 0 a) (arg 1 a) (arg 0 a));
(* ---- honest string/number primitives underpinning the
AffineScript-level stdlib/string.affine. These are intrinsics (no
AffineScript definition exists; the interpreter binds them too),
not externs — endsWith/stripSuffix/pathJoin/etc. are NOT here:
they are real AffineScript built on `ends_with`/`substring`/`++`. *)
b "len" (fun a -> Printf.sprintf "((%s).length)" (arg 0 a));
b "slice" (fun a -> Printf.sprintf "((%s).slice(%s, %s))"
(arg 0 a) (arg 1 a) (arg 2 a));
b "string_length" (fun a -> Printf.sprintf "((%s).length)" (arg 0 a));
b "string_get" (fun a -> Printf.sprintf "__as_strGet(%s, %s)" (arg 0 a) (arg 1 a));
b "string_sub" (fun a -> Printf.sprintf "__as_strSub(%s, %s, %s)" (arg 0 a) (arg 1 a) (arg 2 a));
b "string_find" (fun a -> Printf.sprintf "__as_strFind(%s, %s)" (arg 0 a) (arg 1 a));
b "to_lowercase" (fun a -> Printf.sprintf "String(%s).toLowerCase()" (arg 0 a));
b "to_uppercase" (fun a -> Printf.sprintf "String(%s).toUpperCase()" (arg 0 a));
b "trim" (fun a -> Printf.sprintf "String(%s).trim()" (arg 0 a));
b "int_to_string" (fun a -> Printf.sprintf "String(%s)" (arg 0 a));
b "float_to_string" (fun a -> Printf.sprintf "String(%s)" (arg 0 a));
b "parse_int" (fun a -> Printf.sprintf "__as_parseInt(%s)" (arg 0 a));
b "parse_float" (fun a -> Printf.sprintf "__as_parseFloat(%s)" (arg 0 a));
b "char_to_int" (fun a -> Printf.sprintf "__as_charToInt(%s)" (arg 0 a));
b "int_to_char" (fun a -> Printf.sprintf "__as_intToChar(%s)" (arg 0 a));
b "show" (fun a -> Printf.sprintf "__as_show(%s)" (arg 0 a));
b "panic" (fun a -> Printf.sprintf "(() => { throw new Error(%s); })()" (arg 0 a));
(* ---- Http (issue #160) ---- *)
(* `await` is legal: every caller of `http_request` is declared
`/ Net, Async` and so is emitted as an `async function`
(see {!fd_is_async}). *)
b "http_request" (fun a ->
Printf.sprintf "(await __as_httpFetch(%s, %s, %s, %s))"
(arg 0 a) (arg 1 a) (arg 2 a) (arg 3 a))
(* ============================================================================
Identifier sanitisation (JS reserved words -> trailing underscore)
============================================================================ *)
(* Real ECMAScript reserved words + strict-mode (ES modules are strict)
future-reserved words + restricted names. Deliberately excludes the
Java-ism primitives ([double], [int], [boolean], [byte], [char],
[float], [long], [short], [abstract], [final], [native], ...) that
{!Js_codegen} carries: those are valid JS identifiers, and mangling
them would silently corrupt a consumer's required ESM export surface
(issue #122 requires the *exact* surface, e.g. ubicity). *)
let js_reserved = [
"arguments"; "await"; "break"; "case"; "catch"; "class"; "const";
"continue"; "debugger"; "default"; "delete"; "do"; "else"; "enum";
"eval"; "export"; "extends"; "false"; "finally"; "for"; "function";
"if"; "implements"; "import"; "in"; "instanceof"; "interface"; "let";
"new"; "null"; "package"; "private"; "protected"; "public"; "return";
"static"; "super"; "switch"; "this"; "throw"; "true"; "try"; "typeof";
"var"; "void"; "while"; "with"; "yield";
]
let mangle (name : string) : string =
if List.mem name js_reserved then name ^ "_" else name
(* Resolve a variable reference, honouring the active [self] rename. *)
let resolve_var ctx (name : string) : string =
match ctx.self_name with
| Some s when s = name -> "this"
| _ -> mangle name
(* ============================================================================
Expression code generation
Shape adapted from {!Js_codegen}; the divergences are: variable
resolution goes through {!resolve_var} (for [self] -> [this]); and a
call whose head is a known [extern fn] lowers via {!deno_builtins}.
============================================================================ *)
let rec gen_expr ctx (expr : expr) : string =
match expr with
| ExprLit lit -> gen_literal lit
| ExprVar name -> resolve_var ctx name.name
| ExprApp (func, args) ->
(match func with
| ExprVar id when Hashtbl.mem ctx.assoc id.name && args <> [] ->
(* Receiver-first associated call -> method call. *)
let m = Hashtbl.find ctx.assoc id.name in
let recv =
match List.hd args with
| ExprVar v
when (match ctx.self_name with Some s -> s = v.name | None -> false) ->
"this"
| other -> "(" ^ gen_expr ctx other ^ ")"
in
let rest = List.map (gen_expr ctx) (List.tl args) in
(* Synthesised methods are all [async]; an associated call is
an expression sub-term, so await it (valid: it only occurs
inside the [async] method bodies we emit). *)
"(await " ^ recv ^ "." ^ m ^ "(" ^ String.concat ", " rest ^ "))"
| ExprVar id
when Hashtbl.mem deno_builtins id.name
&& not (Hashtbl.mem ctx.local_fns id.name) ->
(* Honest host/runtime intrinsic (FS/JSON/Date/Wasm extern or
a string/number primitive underpinning stdlib/string.affine).
Applied to ANY matching call head, not only declared externs,
so AffineScript-level stdlib compiled here resolves — but a
same-named user definition shadows it (e.g. a user `len`). *)
(Hashtbl.find deno_builtins id.name) (List.map (gen_expr ctx) args)
| ExprVar id when Hashtbl.mem ctx.externs id.name ->
(* Declared extern with no intrinsic lowering: assume a
same-named host symbol is in scope. *)
let arg_strs = List.map (gen_expr ctx) args in
mangle id.name ^ "(" ^ String.concat ", " arg_strs ^ ")"
| _ ->
let arg_strs = List.map (gen_expr ctx) args in
let call =
gen_expr ctx func ^ "(" ^ String.concat ", " arg_strs ^ ")" in
(match func with
| ExprVar id
when Hashtbl.mem ctx.async_fns id.name && ctx.in_async ->
(* Async free fn returns a Promise; await at the call
site so `get(u).status` reads the resolved value. *)
"(await " ^ call ^ ")"
| _ -> call))
| ExprBinary (e1, OpConcat, e2) ->
(* `++` is string- OR array-concat; dispatch on shape at runtime so
`a ++ b` (string) and `acc ++ [x]` (array) are both correct. *)
"__as_concat(" ^ gen_expr ctx e1 ^ ", " ^ gen_expr ctx e2 ^ ")"
| ExprBinary (e1, op, e2) ->
let op_str = match op with
| OpAdd -> "+" | OpSub -> "-" | OpMul -> "*" | OpDiv -> "/"
| OpMod -> "%" | OpEq -> "===" | OpNe -> "!==" | OpLt -> "<"
| OpLe -> "<=" | OpGt -> ">" | OpGe -> ">=" | OpAnd -> "&&"
| OpOr -> "||" | OpBitAnd -> "&" | OpBitOr -> "|" | OpBitXor -> "^"
| OpShl -> "<<" | OpShr -> ">>" | OpConcat -> "+" (* unreachable *)
in
"(" ^ gen_expr ctx e1 ^ " " ^ op_str ^ " " ^ gen_expr ctx e2 ^ ")"
| ExprUnary (op, e) ->
(match op with
| OpNeg -> "(-" ^ gen_expr ctx e ^ ")"
| OpNot -> "(!" ^ gen_expr ctx e ^ ")"
| OpBitNot -> "(~" ^ gen_expr ctx e ^ ")"
| OpRef -> "({ get: () => " ^ gen_expr ctx e ^ ", set: (_) => {} })"
| OpDeref -> "(" ^ gen_expr ctx e ^ ".get())")
| ExprIf { ei_cond; ei_then; ei_else } ->
let else_str = match ei_else with
| Some e -> gen_expr ctx e | None -> "Unit"
in
"(" ^ gen_expr ctx ei_cond ^ " ? " ^ gen_expr ctx ei_then ^ " : "
^ else_str ^ ")"
| ExprLet { el_pat; el_value; el_body; el_mut; el_quantity = _; el_ty = _ } ->
let pat_str = gen_pattern ctx el_pat in
let val_str = gen_expr ctx el_value in
let kw = if el_mut then "let" else "const" in
(match el_body with
| Some body ->
iife ctx (kw ^ " " ^ pat_str ^ " = " ^ val_str ^ "; return "
^ gen_expr ctx body ^ ";")
| None ->
iife ctx (kw ^ " " ^ pat_str ^ " = " ^ val_str
^ "; return Unit;"))
| ExprTuple exprs | ExprArray exprs ->
"[" ^ String.concat ", " (List.map (gen_expr ctx) exprs) ^ "]"
| ExprIndex (arr, idx) ->
gen_expr ctx arr ^ "[" ^ gen_expr ctx idx ^ "]"
| ExprTupleIndex (e, n) ->
gen_expr ctx e ^ "[" ^ string_of_int n ^ "]"
| ExprRecord { er_fields; er_spread } ->
let field_strs = List.map (fun (name, e_opt) ->
let v = match e_opt with
| Some e -> gen_expr ctx e
| None -> resolve_var ctx name.name
in
mangle name.name ^ ": " ^ v
) er_fields in
let spread_str = match er_spread with
| Some e -> "...(" ^ gen_expr ctx e ^ "), " | None -> ""
in
"({ " ^ spread_str ^ String.concat ", " field_strs ^ " })"
| ExprField (record, field) ->
gen_expr ctx record ^ "." ^ mangle field.name
| ExprMatch { em_scrutinee; em_arms } ->
gen_match ctx em_scrutinee em_arms
| ExprBlock block -> gen_block_expr ctx block
| ExprReturn (Some e) -> iife ctx ("return " ^ gen_expr ctx e ^ ";")
| ExprReturn None -> iife ctx "return Unit;"
| ExprLambda { elam_params; elam_body; elam_ret_ty = _ } ->
let ps = List.map (fun (p : param) -> mangle p.p_name.name) elam_params in
"((" ^ String.concat ", " ps ^ ") => " ^ gen_expr ctx elam_body ^ ")"
| ExprTry { et_body; et_catch; et_finally } ->
gen_try ctx et_body et_catch et_finally
| ExprVariant (ty, ctor) ->
(match ty.name, ctor.name with
| _, "None" -> "None" | _, "Some" -> "Some"
| _, "Ok" -> "Ok" | _, "Err" -> "Err"
| _, name -> Printf.sprintf "({ tag: %S })" name)
| ExprSpan (inner, _) -> gen_expr ctx inner
| ExprRowRestrict (e, _) -> gen_expr ctx e
| ExprHandle { eh_body; eh_handlers = _ } -> gen_expr ctx eh_body
| ExprResume (Some e) -> gen_expr ctx e
| ExprResume None -> "Unit"
| ExprUnsafe _ ->
iife ctx "throw new Error('unsafe op not supported in Deno-ESM backend');"
and gen_literal (lit : literal) : string =
match lit with
| LitInt (n, _) -> string_of_int n
| LitFloat (f, _) ->
let s = string_of_float f in
if String.length s > 0 && s.[String.length s - 1] = '.' then s ^ "0" else s
| LitBool (true, _) -> "true"
| LitBool (false, _) -> "false"
| LitString (s, _) -> "\"" ^ String.escaped s ^ "\""
| LitChar (c, _) -> "\"" ^ Char.escaped c ^ "\""
| LitUnit _ -> "Unit"
and gen_pattern ctx (pat : pattern) : string =
match pat with
| PatWildcard _ -> "_"
| PatVar name -> mangle name.name
| PatLit _ -> "_"
| PatTuple pats ->
"[" ^ String.concat ", " (List.map (gen_pattern ctx) pats) ^ "]"
| PatRecord (fields, _) ->
let strs = List.map (fun (n, sub) ->
match sub with
| None -> mangle n.name
| Some sub -> mangle n.name ^ ": " ^ gen_pattern ctx sub
) fields in
"{ " ^ String.concat ", " strs ^ " }"
| PatAs (id, _) -> mangle id.name
| PatCon (id, _) -> mangle id.name
| PatOr (p, _) -> gen_pattern ctx p
and gen_match ctx scrutinee arms =
let scrutinee_str = gen_expr ctx scrutinee in
let scrut_var = "__scrut" in
let rec gen_arms = function
| [] -> "throw new Error(\"non-exhaustive match\");"
| arm :: rest ->
let cond = gen_pattern_test scrut_var arm.ma_pat in
let bindings = gen_pattern_bindings scrut_var arm.ma_pat in
let body = gen_expr ctx arm.ma_body in
let prefix =
if bindings = "" then
let guard = match arm.ma_guard with
| Some g -> " && (" ^ gen_expr ctx g ^ ")" | None -> ""
in
"if (" ^ cond ^ guard ^ ") { return " ^ body ^ "; }"
else if arm.ma_guard = None then
"if (" ^ cond ^ ") { " ^ bindings ^ " return " ^ body ^ "; }"
else
"if (" ^ cond ^ ") { " ^ bindings ^ " if ("
^ (match arm.ma_guard with Some g -> gen_expr ctx g | None -> "true")
^ ") { return " ^ body ^ "; } }"
in
prefix ^ " " ^ gen_arms rest
in
if ctx.in_async then
"(await (async (" ^ scrut_var ^ ") => { " ^ gen_arms arms ^ " })("
^ scrutinee_str ^ "))"
else
"((" ^ scrut_var ^ ") => { " ^ gen_arms arms ^ " })(" ^ scrutinee_str ^ ")"
and gen_pattern_test scrut pat =
match pat with
| PatWildcard _ | PatVar _ -> "true"
| PatLit lit -> scrut ^ " === " ^ gen_literal lit
| PatCon (id, _) -> scrut ^ ".tag === " ^ Printf.sprintf "%S" id.name
| PatTuple pats ->
let conds = List.mapi (fun i p ->
gen_pattern_test (scrut ^ "[" ^ string_of_int i ^ "]") p) pats in
String.concat " && " (("Array.isArray(" ^ scrut ^ ")") :: conds)
| PatRecord (fields, _) ->
let conds = List.map (fun (n, sub) ->
match sub with
| None -> "true"
| Some sub -> gen_pattern_test (scrut ^ "." ^ mangle n.name) sub
) fields in
String.concat " && " conds
| PatAs (_, p) -> gen_pattern_test scrut p
| PatOr (p1, p2) ->
"((" ^ gen_pattern_test scrut p1 ^ ") || ("
^ gen_pattern_test scrut p2 ^ "))"
and gen_pattern_bindings scrut pat =
let buf = Buffer.create 64 in
let rec walk path = function
| PatWildcard _ | PatLit _ -> ()
| PatVar id ->
Buffer.add_string buf ("const " ^ mangle id.name ^ " = " ^ path ^ "; ")
| PatTuple pats ->
List.iteri (fun i p -> walk (path ^ "[" ^ string_of_int i ^ "]") p) pats
| PatRecord (fields, _) ->
List.iter (fun (n, sub) ->
let sub_path = path ^ "." ^ mangle n.name in
match sub with
| None -> Buffer.add_string buf
("const " ^ mangle n.name ^ " = " ^ sub_path ^ "; ")
| Some sub -> walk sub_path sub
) fields
| PatCon (_, args) ->
(match args with
| [] -> ()
| [single] -> walk (path ^ ".value") single
| many -> List.iteri (fun i p ->
walk (path ^ ".values[" ^ string_of_int i ^ "]") p) many)
| PatAs (id, sub) ->
Buffer.add_string buf ("const " ^ mangle id.name ^ " = " ^ path ^ "; ");
walk path sub
| PatOr (p, _) -> walk path p
in
walk scrut pat;
Buffer.contents buf
and gen_block_expr ctx block =
let body = Buffer.create 64 in
List.iter (fun s ->
Buffer.add_string body (gen_stmt ctx s);
Buffer.add_string body " ") block.blk_stmts;
let result = match block.blk_expr with
| Some e -> "return " ^ gen_expr ctx e ^ ";"
| None -> "return Unit;"
in
iife ctx (Buffer.contents body ^ result)
and gen_try ctx body catch finally =
let body_str = gen_block_expr ctx body in
let catch_str = match catch with
| None | Some [] -> "catch (__e) { throw __e; }"
| Some (arm :: _) ->
let bind = match arm.ma_pat with
| PatVar id -> "const " ^ mangle id.name ^ " = __e; "
| _ -> ""
in
"catch (__e) { " ^ bind ^ "return " ^ gen_expr ctx arm.ma_body ^ "; }"
in
let finally_str = match finally with
| None -> ""
| Some blk -> " finally { " ^ gen_block_expr ctx blk ^ "; }"
in
iife ctx ("try { return " ^ body_str ^ "; } " ^ catch_str ^ finally_str)
(* Unwrap span markers to inspect an expression's real head. *)
and unspan = function
| ExprSpan (e, _) -> unspan e
| e -> e
(* Lower an expression in STATEMENT position, where `return` and control
flow are real JS statements (not IIFE-wrapped — that was the inherited
js_codegen bug: a statement-position `return e;` became
`(() => { return e; })();`, discarding the value, so the enclosing
function returned undefined). [gen_expr] keeps the IIFE form for the
genuine expression-position cases. *)
and gen_stmt_expr ctx (e : expr) : string =
match unspan e with
| ExprReturn (Some e) -> "return " ^ gen_expr ctx e ^ ";"
| ExprReturn None -> "return;"
| ExprIf { ei_cond; ei_then; ei_else } ->
let elseb = match ei_else with
| Some e -> " else { " ^ gen_branch ctx e ^ " }"
| None -> ""
in
"if (" ^ gen_expr ctx ei_cond ^ ") { " ^ gen_branch ctx ei_then
^ " }" ^ elseb
| ExprBlock blk -> gen_stmt_seq ctx blk
| ExprMatch { em_scrutinee; em_arms } ->
gen_match_stmt ctx em_scrutinee em_arms
| ExprTry { et_body; et_catch; et_finally } ->
gen_try_stmt ctx et_body et_catch et_finally
| other -> gen_expr ctx other ^ ";"
(* An if/try/match branch body: splice a block's statements, else treat
the expression as a single statement. *)
and gen_branch ctx e =
match unspan e with
| ExprBlock blk -> gen_stmt_seq ctx blk
| other -> gen_stmt_expr ctx other
and gen_stmt_seq ctx blk =
let b = Buffer.create 64 in
List.iter (fun s ->
Buffer.add_string b (gen_stmt ctx s);
Buffer.add_char b ' ') blk.blk_stmts;
(match blk.blk_expr with
| Some e -> Buffer.add_string b (gen_stmt_expr ctx e)
| None -> ());
Buffer.contents b
and gen_match_stmt ctx scrut arms =
let sv = "__scrut" in
let rec arms_js = function
| [] -> "throw new Error(\"non-exhaustive match\");"
| arm :: rest ->
let cond = gen_pattern_test sv arm.ma_pat in
let binds = gen_pattern_bindings sv arm.ma_pat in
let guard = match arm.ma_guard with
| Some g -> " && (" ^ gen_expr ctx g ^ ")" | None -> "" in
"if (" ^ cond ^ guard ^ ") { " ^ binds
^ gen_branch ctx arm.ma_body ^ " } else " ^ arms_js rest
in
"{ const " ^ sv ^ " = " ^ gen_expr ctx scrut ^ "; " ^ arms_js arms ^ " }"
and gen_try_stmt ctx body catch finally =
let b = gen_stmt_seq ctx body in
let c = match catch with
| None | Some [] -> "catch (__e) { throw __e; }"
| Some (arm :: _) ->
let bind = match arm.ma_pat with
| PatVar id -> "const " ^ mangle id.name ^ " = __e; " | _ -> ""
in
"catch (__e) { " ^ bind ^ gen_branch ctx arm.ma_body ^ " }"
in
let f = match finally with
| None -> "" | Some blk -> " finally { " ^ gen_stmt_seq ctx blk ^ " }"
in
"try { " ^ b ^ " } " ^ c ^ f
and gen_stmt ctx (stmt : stmt) : string =
match stmt with
| StmtLet { sl_pat; sl_value; sl_mut; sl_quantity = _; sl_ty = _ } ->
let kw = if sl_mut then "let" else "const" in
kw ^ " " ^ gen_pattern ctx sl_pat ^ " = " ^ gen_expr ctx sl_value ^ ";"
| StmtExpr e -> gen_stmt_expr ctx e
| StmtAssign (lhs, op, rhs) ->
let op_str = match op with
| AssignEq -> "=" | AssignAdd -> "+=" | AssignSub -> "-="
| AssignMul -> "*=" | AssignDiv -> "/="
in
gen_expr ctx lhs ^ " " ^ op_str ^ " " ^ gen_expr ctx rhs ^ ";"
| StmtWhile (cond, body) ->
"while (" ^ gen_expr ctx cond ^ ") { "
^ String.concat " " (List.map (gen_stmt ctx) body.blk_stmts)
^ (match body.blk_expr with
| Some e -> " " ^ gen_stmt_expr ctx e | None -> "")
^ " }"
| StmtFor (pat, iter, body) ->
"for (const " ^ gen_pattern ctx pat ^ " of " ^ gen_expr ctx iter ^ ") { "
^ String.concat " " (List.map (gen_stmt ctx) body.blk_stmts)
^ (match body.blk_expr with
| Some e -> " " ^ gen_stmt_expr ctx e | None -> "")
^ " }"
(* ============================================================================
Top-level declarations + class emission
============================================================================ *)
let visibility_is_public = function
| Public | PubCrate | PubSuper | PubIn _ -> true
| Private -> false
(* Render a method/function body (block or expr) into [ctx]. *)
let gen_body ctx (fb : fn_body) : unit =
match fb with
| FnExpr e ->
emit_line ctx ("return " ^ gen_expr ctx e ^ ";")
| FnBlock block ->
List.iter (fun s -> emit_line ctx (gen_stmt ctx s)) block.blk_stmts;
(match block.blk_expr with
| Some e -> emit_line ctx ("return " ^ gen_expr ctx e ^ ";")
| None -> ())
| FnExtern -> ()
let gen_function ctx (fd : fn_decl) : unit =
let name = mangle fd.fd_name.name in
let params =
List.map (fun (p : param) -> mangle p.p_name.name) fd.fd_params in
let is_async = fd_is_async fd in
let async_kw = if is_async then "async " else "" in
let kw =
if visibility_is_public fd.fd_vis
then "export " ^ async_kw ^ "function"
else async_kw ^ "function" in
emit_line ctx
(Printf.sprintf "%s %s(%s) {" kw name (String.concat ", " params));
let body_ctx = increase_indent ctx in
let body_ctx =
if is_async then { body_ctx with in_async = true } else body_ctx in
gen_body body_ctx fd.fd_body;
emit_line ctx "}";
emit ctx "\n"
(* Head name of a (possibly ref/own/mut/applied) type expression. *)
let rec type_expr_name : type_expr -> string option = function
| TyCon id | TyVar id -> Some id.name
| TyApp (id, _) -> Some id.name
| TyOwn t | TyRef t | TyMut t -> type_expr_name t
| _ -> None
(* The struct (if any, among [known]) that [fd]'s first parameter is typed
as — i.e. [fd] is a receiver-first method of that struct. *)
let receiver_struct ~(known : (string, 'a) Hashtbl.t) (fd : fn_decl)
: (string * string) option =
match fd.fd_params with
| p :: _ ->
(match type_expr_name p.p_ty with
| Some s when Hashtbl.mem known s -> Some (s, p.p_name.name)
| _ -> None)
| [] -> None
(* The struct (if any, among [known]) that [fd] returns — a constructor
candidate for that struct. *)
let returns_struct ~(known : (string, 'a) Hashtbl.t) (fd : fn_decl)
: string option =
match fd.fd_ret_ty with
| Some t ->
(match type_expr_name t with
| Some s when Hashtbl.mem known s -> Some s | _ -> None)
| None -> None
let ctor_name_hint (n : string) : bool =
let n = String.lowercase_ascii n in
List.exists (fun k ->
let kl = String.length k and nl = String.length n in
n = k
|| (nl > kl && String.sub n 0 (kl + 1) = k ^ "_")
|| (nl > kl && String.sub n (nl - kl - 1) (kl + 1) = "_" ^ k))
["new"; "make"; "create"; "init"; "from"]
(* Emitted method name: strip a leading "<Struct>_" prefix (case-insensitive
on the struct name) from the source fn name if present. *)
let method_js_name ~(struct_name : string) (fn : string) : string =
let pfx = struct_name ^ "_" in
let lc = String.lowercase_ascii in
if String.length fn > String.length pfx
&& lc (String.sub fn 0 (String.length pfx)) = lc pfx then
String.sub fn (String.length pfx) (String.length fn - String.length pfx)
else fn
(* Emit a class method from a receiver-first free function: the receiver
parameter is dropped from the JS signature and rewritten to [this].
All methods are emitted [async] — the motivating consumer's surface is
entirely [async] and callers [await]; [await] on a synchronously
returned value is valid JS, so this preserves the exact consumer API
with no async ABI (issue #122 scope; async-extern #103 not required). *)
let gen_method ctx ~(recv_name : string) ~(js_name : string)
(fd : fn_decl) : unit =
let rest_params = match fd.fd_params with _ :: t -> t | [] -> [] in
let params =
List.map (fun (p : param) -> mangle p.p_name.name) rest_params in
let ctx_m = { ctx with self_name = Some recv_name; in_async = true } in
emit_line ctx_m
(Printf.sprintf "async %s(%s) {" (mangle js_name)
(String.concat ", " params));
gen_body (increase_indent ctx_m) fd.fd_body;
emit_line ctx_m "}";
emit ctx_m ""
(* Constructor from a free function returning the struct: a returned record
literal becomes [this.f = e;] assignments. *)
let gen_constructor ctx (fd : fn_decl) : unit =
let params =
List.map (fun (p : param) -> mangle p.p_name.name) fd.fd_params in
emit_line ctx
(Printf.sprintf "constructor(%s) {" (String.concat ", " params));
let body_ctx = increase_indent ctx in
let rec assign_record e =
match e with
| ExprSpan (inner, _) -> assign_record inner
| ExprRecord { er_fields; er_spread = _ } ->
List.iter (fun (name, e_opt) ->
let v = match e_opt with
| Some e -> gen_expr body_ctx e
| None -> resolve_var body_ctx name.name
in
emit_line body_ctx
(Printf.sprintf "this.%s = %s;" (mangle name.name) v)
) er_fields;
true
| _ -> false
in
let handled =
match fd.fd_body with
| FnExpr e -> assign_record e
| FnBlock { blk_stmts; blk_expr = Some e } ->
List.iter (fun s -> emit_line body_ctx (gen_stmt body_ctx s)) blk_stmts;
assign_record e
| _ -> false
in
if not handled then gen_body body_ctx fd.fd_body;
emit_line ctx "}";
emit ctx ""
(* Synthesised constructor when the struct has methods but no fn returns
it: one parameter per field, assigned positionally. *)
let gen_default_constructor ctx (fields : struct_field list) : unit =
let ps = List.map (fun (sf : struct_field) -> mangle sf.sf_name.name) fields in
emit_line ctx (Printf.sprintf "constructor(%s) {" (String.concat ", " ps));
let b = increase_indent ctx in
List.iter (fun (sf : struct_field) ->
let f = mangle sf.sf_name.name in
emit_line b (Printf.sprintf "this.%s = %s;" f f)) fields;
emit_line ctx "}";
emit ctx ""
(* Emit `export class Name { ... }`. [ctor] is the constructor fn (or a
field-wise default is synthesised); [methods] are (recv_name, js_name,
fn) receiver-first associated functions. *)
let gen_class ctx ~(name : string) ~(fields : struct_field list)
~(ctor : fn_decl option)
~(methods : (string * string * fn_decl) list) : unit =
emit_line ctx (Printf.sprintf "export class %s {" name);
let cls = increase_indent ctx in
(match ctor with
| Some fd -> gen_constructor cls fd
| None -> gen_default_constructor cls fields);
List.iter (fun (recv_name, js_name, fd) ->
gen_method cls ~recv_name ~js_name fd) methods;
emit_line ctx "}";
emit ctx "\n"
let gen_type_decl ctx (td : type_decl) : unit =
match td.td_body with
| TyEnum variants ->
let exp = if visibility_is_public td.td_vis then "export " else "" in
List.iter (fun (vd : variant_decl) ->
let name = mangle vd.vd_name.name in
let arity = List.length vd.vd_fields in
if arity = 0 then
emit_line ctx
(Printf.sprintf "%sconst %s = { tag: \"%s\" };" exp name
vd.vd_name.name)
else if arity = 1 then
emit_line ctx
(Printf.sprintf "%sconst %s = (value) => ({ tag: \"%s\", value });"
exp name vd.vd_name.name)
else
let ps = List.init arity (fun i -> "v" ^ string_of_int i) in
emit_line ctx
(Printf.sprintf
"%sconst %s = (%s) => ({ tag: \"%s\", values: [%s] });"
exp name (String.concat ", " ps) vd.vd_name.name
(String.concat ", " ps))
) variants;
emit ctx "\n"
| TyStruct _ | TyAlias _ | TyExtern ->
(* Struct shape surfaces via {!gen_class} when an impl block exists;
a bare struct/alias/extern type carries no runtime value. *)
emit_line ctx (Printf.sprintf "// type %s" td.td_name.name)
let generate (program : program) (symbols : Symbol.t) : string =
let ctx = create_ctx symbols in
(* Register extern names so calls lower via the builtin table, and
user-defined top-level names so they shadow host intrinsics. *)
List.iter (function
| TopExternFn { ef_name; _ } ->
Hashtbl.replace ctx.externs ef_name.name ()
| TopFn fd when fd.fd_body = FnExtern ->
Hashtbl.replace ctx.externs fd.fd_name.name ()
| TopFn fd ->
Hashtbl.replace ctx.local_fns fd.fd_name.name ();
if fd_is_async fd then
Hashtbl.replace ctx.async_fns fd.fd_name.name ()
| TopConst { tc_name; _ } ->
Hashtbl.replace ctx.local_fns tc_name.name ()
| TopImpl ib ->
List.iter (function
| ImplFn fd -> Hashtbl.replace ctx.local_fns fd.fd_name.name ()
| ImplType _ -> ()) ib.ib_items
| _ -> ()) program.prog_decls;
emit_line ctx "// Generated by AffineScript compiler (Deno-ESM target, issue #122)";
emit_line ctx "// SPDX-License-Identifier: PMPL-1.0-or-later";
emit ctx prelude;
(* Collect structs. AffineScript's grammar accepts neither inherent
[impl Type {}] nor a [self] expression (SELF_KW has no expression
production — even stdlib/traits.affine fails to parse), so an
"instance method" is necessarily a free function taking the struct
as its first parameter. We synthesise `export class` from a struct
plus its receiver-first / struct-returning free functions. *)
let structs = Hashtbl.create 16 in
List.iter (function
| TopType ({ td_body = TyStruct fields; _ } as td) ->
Hashtbl.replace structs td.td_name.name fields
| _ -> ()) program.prog_decls;
(* methods_of : struct -> (recv_name, js_name, fd) list (decl order)
ctors_of : struct -> fd list (struct-returning candidates)
consumed : fn names emitted inside a class, not as free functions *)
let methods_of = Hashtbl.create 16 in
let ctors_of = Hashtbl.create 16 in
let consumed = Hashtbl.create 32 in
let push tbl k v =
Hashtbl.replace tbl k (v :: (try Hashtbl.find tbl k with Not_found -> [])) in
List.iter (function
| TopFn fd when fd.fd_body <> FnExtern ->
(match receiver_struct ~known:structs fd with
| Some (s, rn) ->
let js = method_js_name ~struct_name:s fd.fd_name.name in
push methods_of s (rn, js, fd);
Hashtbl.replace ctx.assoc fd.fd_name.name js;
Hashtbl.replace consumed fd.fd_name.name ()
| None ->
(match returns_struct ~known:structs fd with
| Some s ->
push ctors_of s fd;
Hashtbl.replace consumed fd.fd_name.name ()
| None -> ()))
| _ -> ()) program.prog_decls;
let methods_for s =
List.rev (try Hashtbl.find methods_of s with Not_found -> []) in
let ctor_for s =
match (try Hashtbl.find ctors_of s with Not_found -> []) with
| [] -> None
| cs ->
let cs = List.rev cs in
(match List.find_opt
(fun fd -> ctor_name_hint fd.fd_name.name) cs with
| Some fd -> Some fd
| None -> Some (List.hd cs))
in
let is_class s =
Hashtbl.mem methods_of s || Hashtbl.mem ctors_of s in
let emitted_class = Hashtbl.create 16 in
let emit_class_for s fields =
if not (Hashtbl.mem emitted_class s) then begin
gen_class ctx ~name:s ~fields ~ctor:(ctor_for s)
~methods:(methods_for s);
Hashtbl.replace emitted_class s ()
end
in
List.iter (fun top ->
match top with
| TopFn fd when fd.fd_body <> FnExtern ->
if not (Hashtbl.mem consumed fd.fd_name.name) then
gen_function ctx fd
| TopFn _ -> () (* extern-as-fn: lowered at call sites *)
| TopExternFn _ | TopExternType _ -> () (* lowered at call sites *)
| TopType td ->
(match td.td_body with
| TyStruct fields when is_class td.td_name.name ->
emit_class_for td.td_name.name fields
| _ -> gen_type_decl ctx td)
| TopImpl ib ->
(* Inherent/trait impls don't parse in the current grammar; this
is a defensive fallback only. *)
List.iter (function
| ImplFn fd -> gen_function ctx fd
| ImplType _ -> ()) ib.ib_items
| TopConst { tc_vis; tc_name; tc_value; _ } ->
let exp = if visibility_is_public tc_vis then "export " else "" in
emit_line ctx
(Printf.sprintf "%sconst %s = %s;" exp (mangle tc_name.name)
(gen_expr ctx tc_value))
| TopEffect _ -> emit_line ctx "// effect declaration (erased)"
| TopTrait _ -> emit_line ctx "// trait declaration (erased)"
) program.prog_decls;
(* If a `main` exists, invoke it (await — it may be async-shaped). *)
let has_main = List.exists (function
| TopFn fd -> fd.fd_name.name = "main" | _ -> false)
program.prog_decls in
if has_main then emit_line ctx "await main();";