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
(** Copyright 2025-2026, Victoria Ostrovskaya & Danil Usoltsev *)
(** SPDX-License-Identifier: LGPL-3.0-or-later *)
open Frontend.Ast
open Middleend.Anf
open Runtime.Primitives
type function_layout =
{ func_name : string
; asm_name : string
; params : immediate list
; body : anf_expr
; is_rec : bool
}
type analysis_result =
{ functions : function_layout list
; resolve : int -> string -> (string * int) option
}
let rec params_of_anf = function
| AnfExpr (ComplexLambda (pats, body)) ->
let imms =
List.filter_map
(function
| PatVariable id -> Some (ImmediateVar id)
| _ -> None)
pats
in
let rest, inner = params_of_anf body in
imms @ rest, inner
| other -> [], other
;;
let analyze (program : anf_program) =
let raw =
List.filter_map
(function
| AnfValue (rec_flag, (func_name, arity, body), _) ->
let params, body = params_of_anf body in
Some (func_name, arity, params, body, rec_flag = Rec)
| AnfEval _ -> None)
program
in
let is_valid_linker_ident name =
String.length name > 0
&& String.for_all
(fun c ->
(c >= 'a' && c <= 'z')
|| (c >= 'A' && c <= 'Z')
|| (c >= '0' && c <= '9')
|| Char.equal c '_')
name
in
let mangle_operator_for_linker name =
"op_"
^ Base.String.concat_map name ~f:(function
| '*' -> "_star"
| '+' -> "_plus"
| '-' -> "_minus"
| '/' -> "_slash"
| '=' -> "_eq"
| '<' -> "_lt"
| '>' -> "_gt"
| '!' -> "_bang"
| '&' -> "_amp"
| '|' -> "_bar"
| '^' -> "_hat"
| '@' -> "_at"
| '~' -> "_tilde"
| '?' -> "_q"
| '.' -> "_dot"
| ':' -> "_colon"
| '%' -> "_percent"
| '$' -> "_dollar"
| c
when (c >= 'a' && c <= 'z')
|| (c >= 'A' && c <= 'Z')
|| (c >= '0' && c <= '9')
|| Char.equal c '_' -> String.make 1 c
| c -> "_u" ^ Int.to_string (Char.code c))
in
let mangle_reserved name =
if is_reserved name
then "eml_" ^ name
else if String.equal name "_start"
then "eml_start"
else name
in
let asm_name_for_func func_name =
let base =
if is_valid_linker_ident func_name
then func_name
else mangle_operator_for_linker func_name
in
mangle_reserved base
in
let functions, _ =
List.fold_left
(fun (reversed_functions, counts) (func_name, _arity, params, body, is_rec) ->
let base_asm_name = asm_name_for_func func_name in
let duplicate_index =
Base.Map.find counts func_name |> Option.value ~default:0
in
let updated_counts =
Base.Map.set counts ~key:func_name ~data:(duplicate_index + 1)
in
let asm_name =
if duplicate_index = 0
then base_asm_name
else base_asm_name ^ "_" ^ Int.to_string duplicate_index
in
( { func_name; asm_name; params; body; is_rec } :: reversed_functions
, updated_counts ))
([], Base.Map.empty (module Base.String))
raw
in
let functions = List.rev functions in
let has_main =
List.exists (fun func_layout -> String.equal func_layout.func_name "main") functions
in
let functions =
if has_main
then functions
else (
let synthetic_main =
{ func_name = "main"
; asm_name = "main"
; params = []
; body = AnfExpr (ComplexImmediate (ImmediateConst (ConstInt 0)))
; is_rec = false
}
in
functions @ [ synthetic_main ])
in
let resolver func_index var_name =
let rec find i =
if i < 0
then None
else (
match Base.List.nth functions i with
| None -> None
| Some func_layout when String.equal func_layout.func_name var_name ->
Some (func_layout.asm_name, List.length func_layout.params)
| Some _ -> find (i - 1))
in
let start_index =
match Base.List.nth functions func_index with
| Some func_layout
when func_layout.is_rec && String.equal func_layout.func_name var_name ->
func_index
| _ -> func_index - 1
in
find start_index
in
{ functions; resolve = resolver }
;;