1use super::types::{
6 BigarrayKind, BigarrayLayout, DuneExecutable, DuneLibrary, OCamlAnalysisCache,
7 OCamlConstantFoldingHelper, OCamlDepGraph, OCamlDominatorTree, OCamlLivenessInfo,
8 OCamlPassConfig, OCamlPassPhase, OCamlPassRegistry, OCamlPassStats, OCamlWorklist,
9 OcamlBackend, OcamlDefinition, OcamlEffect, OcamlExpr, OcamlFunctor, OcamlGadt,
10 OcamlLetBinding, OcamlLit, OcamlModule, OcamlPattern, OcamlPpxAttr, OcamlRecordField,
11 OcamlSigItem, OcamlSignature, OcamlTestCase, OcamlTestSuite, OcamlType, OcamlTypeDecl,
12 OcamlTypeDef,
13};
14
15pub(super) fn format_ocaml_expr(expr: &OcamlExpr, indent: usize) -> std::string::String {
16 let pad = " ".repeat(indent);
17 let ipad = " ".repeat(indent + 2);
18 match expr {
19 OcamlExpr::Lit(lit) => lit.to_string(),
20 OcamlExpr::Var(name) => name.clone(),
21 OcamlExpr::BinOp(op, lhs, rhs) => {
22 format!(
23 "({} {} {})",
24 format_ocaml_expr(lhs, indent),
25 op,
26 format_ocaml_expr(rhs, indent)
27 )
28 }
29 OcamlExpr::UnaryOp(op, expr) => {
30 format!("({} {})", op, format_ocaml_expr(expr, indent))
31 }
32 OcamlExpr::App(func, args) => {
33 let mut s = format!("({}", format_ocaml_expr(func, indent));
34 for arg in args {
35 s.push(' ');
36 s.push_str(&format_ocaml_expr(arg, indent));
37 }
38 s.push(')');
39 s
40 }
41 OcamlExpr::Lambda(params, body) => {
42 format!(
43 "(fun {} -> {})",
44 params.join(" "),
45 format_ocaml_expr(body, indent)
46 )
47 }
48 OcamlExpr::Let(name, val, body) => {
49 format!(
50 "let {} = {} in\n{}{}",
51 name,
52 format_ocaml_expr(val, indent),
53 ipad,
54 format_ocaml_expr(body, indent + 2)
55 )
56 }
57 OcamlExpr::LetRec(name, params, val, body) => {
58 let param_str = if params.is_empty() {
59 std::string::String::new()
60 } else {
61 format!(" {}", params.join(" "))
62 };
63 format!(
64 "let rec {}{} = {} in\n{}{}",
65 name,
66 param_str,
67 format_ocaml_expr(val, indent),
68 ipad,
69 format_ocaml_expr(body, indent + 2)
70 )
71 }
72 OcamlExpr::IfThenElse(cond, then_e, else_e) => {
73 format!(
74 "if {} then\n{}{}\n{}else\n{}{}",
75 format_ocaml_expr(cond, indent),
76 ipad,
77 format_ocaml_expr(then_e, indent + 2),
78 pad,
79 ipad,
80 format_ocaml_expr(else_e, indent + 2)
81 )
82 }
83 OcamlExpr::Match(scrutinee, arms) => {
84 let mut s = format!("match {} with\n", format_ocaml_expr(scrutinee, indent));
85 for (pat, body) in arms {
86 s.push_str(&format!(
87 "{}| {} -> {}\n",
88 ipad,
89 pat,
90 format_ocaml_expr(body, indent + 2)
91 ));
92 }
93 s
94 }
95 OcamlExpr::Tuple(elems) => {
96 let parts: Vec<_> = elems.iter().map(|e| format_ocaml_expr(e, indent)).collect();
97 format!("({})", parts.join(", "))
98 }
99 OcamlExpr::List(elems) => {
100 let parts: Vec<_> = elems.iter().map(|e| format_ocaml_expr(e, indent)).collect();
101 format!("[{}]", parts.join("; "))
102 }
103 OcamlExpr::Record(fields) => {
104 let mut s = "{ ".to_string();
105 for (i, (name, val)) in fields.iter().enumerate() {
106 if i > 0 {
107 s.push_str("; ");
108 }
109 s.push_str(&format!("{} = {}", name, format_ocaml_expr(val, indent)));
110 }
111 s.push_str(" }");
112 s
113 }
114 OcamlExpr::Field(obj, field) => {
115 format!("{}.{}", format_ocaml_expr(obj, indent), field)
116 }
117 OcamlExpr::Module(path, expr) => {
118 format!("{}.{}", path, format_ocaml_expr(expr, indent))
119 }
120 OcamlExpr::Begin(exprs) => {
121 let parts: Vec<_> = exprs
122 .iter()
123 .map(|e| format!("{}{}", ipad, format_ocaml_expr(e, indent + 2)))
124 .collect();
125 format!("begin\n{}\n{}end", parts.join(";\n"), pad)
126 }
127 }
128}
129#[cfg(test)]
130mod tests {
131 use super::*;
132 #[test]
133 pub(super) fn test_ocaml_type_primitives() {
134 assert_eq!(OcamlType::Int.to_string(), "int");
135 assert_eq!(OcamlType::Float.to_string(), "float");
136 assert_eq!(OcamlType::Bool.to_string(), "bool");
137 assert_eq!(OcamlType::Char.to_string(), "char");
138 assert_eq!(OcamlType::String.to_string(), "string");
139 assert_eq!(OcamlType::Unit.to_string(), "unit");
140 }
141 #[test]
142 pub(super) fn test_ocaml_type_list() {
143 let t = OcamlType::List(Box::new(OcamlType::Int));
144 assert_eq!(t.to_string(), "int list");
145 }
146 #[test]
147 pub(super) fn test_ocaml_type_option() {
148 let t = OcamlType::Option(Box::new(OcamlType::String));
149 assert_eq!(t.to_string(), "string option");
150 }
151 #[test]
152 pub(super) fn test_ocaml_type_result() {
153 let t = OcamlType::Result(Box::new(OcamlType::Int), Box::new(OcamlType::String));
154 assert_eq!(t.to_string(), "(int, string) result");
155 }
156 #[test]
157 pub(super) fn test_ocaml_type_fun() {
158 let t = OcamlType::Fun(Box::new(OcamlType::Int), Box::new(OcamlType::Bool));
159 assert_eq!(t.to_string(), "int -> bool");
160 }
161 #[test]
162 pub(super) fn test_ocaml_type_fun_chain() {
163 let t = OcamlType::Fun(
164 Box::new(OcamlType::Int),
165 Box::new(OcamlType::Fun(
166 Box::new(OcamlType::Int),
167 Box::new(OcamlType::Int),
168 )),
169 );
170 assert_eq!(t.to_string(), "int -> int -> int");
171 }
172 #[test]
173 pub(super) fn test_ocaml_type_tuple() {
174 let t = OcamlType::Tuple(vec![OcamlType::Int, OcamlType::String, OcamlType::Bool]);
175 assert_eq!(t.to_string(), "int * string * bool");
176 }
177 #[test]
178 pub(super) fn test_ocaml_type_polymorphic() {
179 let t = OcamlType::Polymorphic("a".to_string());
180 assert_eq!(t.to_string(), "'a");
181 }
182 #[test]
183 pub(super) fn test_ocaml_type_array() {
184 let t = OcamlType::Array(Box::new(OcamlType::Float));
185 assert_eq!(t.to_string(), "float array");
186 }
187 #[test]
188 pub(super) fn test_ocaml_lit_int() {
189 assert_eq!(OcamlLit::Int(42).to_string(), "42");
190 assert_eq!(OcamlLit::Int(-7).to_string(), "-7");
191 }
192 #[test]
193 pub(super) fn test_ocaml_lit_float() {
194 assert_eq!(OcamlLit::Float(3.14).to_string(), "3.14");
195 assert_eq!(OcamlLit::Float(1.0).to_string(), "1.0");
196 }
197 #[test]
198 pub(super) fn test_ocaml_lit_string() {
199 assert_eq!(OcamlLit::Str("hello".to_string()).to_string(), "\"hello\"");
200 assert_eq!(OcamlLit::Str("a\"b".to_string()).to_string(), "\"a\\\"b\"");
201 }
202 #[test]
203 pub(super) fn test_ocaml_lit_bool_unit() {
204 assert_eq!(OcamlLit::Bool(true).to_string(), "true");
205 assert_eq!(OcamlLit::Bool(false).to_string(), "false");
206 assert_eq!(OcamlLit::Unit.to_string(), "()");
207 }
208 #[test]
209 pub(super) fn test_ocaml_pattern_wildcard() {
210 assert_eq!(OcamlPattern::Wildcard.to_string(), "_");
211 }
212 #[test]
213 pub(super) fn test_ocaml_pattern_var() {
214 assert_eq!(OcamlPattern::Var("x".to_string()).to_string(), "x");
215 }
216 #[test]
217 pub(super) fn test_ocaml_pattern_tuple() {
218 let p = OcamlPattern::Tuple(vec![
219 OcamlPattern::Var("a".to_string()),
220 OcamlPattern::Var("b".to_string()),
221 ]);
222 assert_eq!(p.to_string(), "(a, b)");
223 }
224 #[test]
225 pub(super) fn test_ocaml_pattern_cons() {
226 let p = OcamlPattern::Cons(
227 Box::new(OcamlPattern::Var("h".to_string())),
228 Box::new(OcamlPattern::Var("t".to_string())),
229 );
230 assert_eq!(p.to_string(), "h :: t");
231 }
232 #[test]
233 pub(super) fn test_ocaml_pattern_ctor_with_args() {
234 let p = OcamlPattern::Ctor("Some".to_string(), vec![OcamlPattern::Var("x".to_string())]);
235 assert_eq!(p.to_string(), "Some x");
236 }
237 #[test]
238 pub(super) fn test_ocaml_pattern_ctor_no_args() {
239 let p = OcamlPattern::Ctor("None".to_string(), vec![]);
240 assert_eq!(p.to_string(), "None");
241 }
242 #[test]
243 pub(super) fn test_ocaml_pattern_list() {
244 let p = OcamlPattern::List(vec![
245 OcamlPattern::Const(OcamlLit::Int(1)),
246 OcamlPattern::Const(OcamlLit::Int(2)),
247 ]);
248 assert_eq!(p.to_string(), "[1; 2]");
249 }
250 #[test]
251 pub(super) fn test_ocaml_pattern_or() {
252 let p = OcamlPattern::Or(
253 Box::new(OcamlPattern::Const(OcamlLit::Int(0))),
254 Box::new(OcamlPattern::Const(OcamlLit::Int(1))),
255 );
256 assert_eq!(p.to_string(), "0 | 1");
257 }
258 #[test]
259 pub(super) fn test_ocaml_expr_lambda() {
260 let e = OcamlExpr::Lambda(
261 vec!["x".to_string(), "y".to_string()],
262 Box::new(OcamlExpr::BinOp(
263 "+".to_string(),
264 Box::new(OcamlExpr::Var("x".to_string())),
265 Box::new(OcamlExpr::Var("y".to_string())),
266 )),
267 );
268 assert_eq!(e.to_string(), "(fun x y -> (x + y))");
269 }
270 #[test]
271 pub(super) fn test_ocaml_expr_if_then_else() {
272 let e = OcamlExpr::IfThenElse(
273 Box::new(OcamlExpr::Var("b".to_string())),
274 Box::new(OcamlExpr::Lit(OcamlLit::Int(1))),
275 Box::new(OcamlExpr::Lit(OcamlLit::Int(0))),
276 );
277 let s = e.to_string();
278 assert!(s.contains("if b then"));
279 assert!(s.contains("else"));
280 }
281 #[test]
282 pub(super) fn test_ocaml_expr_match() {
283 let e = OcamlExpr::Match(
284 Box::new(OcamlExpr::Var("x".to_string())),
285 vec![
286 (
287 OcamlPattern::Ctor(
288 "Some".to_string(),
289 vec![OcamlPattern::Var("v".to_string())],
290 ),
291 OcamlExpr::Var("v".to_string()),
292 ),
293 (
294 OcamlPattern::Ctor("None".to_string(), vec![]),
295 OcamlExpr::Lit(OcamlLit::Int(0)),
296 ),
297 ],
298 );
299 let s = e.to_string();
300 assert!(s.contains("match x with"));
301 assert!(s.contains("| Some v ->"));
302 assert!(s.contains("| None ->"));
303 }
304 #[test]
305 pub(super) fn test_ocaml_expr_tuple() {
306 let e = OcamlExpr::Tuple(vec![
307 OcamlExpr::Lit(OcamlLit::Int(1)),
308 OcamlExpr::Lit(OcamlLit::Bool(true)),
309 ]);
310 assert_eq!(e.to_string(), "(1, true)");
311 }
312 #[test]
313 pub(super) fn test_ocaml_expr_list() {
314 let e = OcamlExpr::List(vec![
315 OcamlExpr::Lit(OcamlLit::Int(1)),
316 OcamlExpr::Lit(OcamlLit::Int(2)),
317 OcamlExpr::Lit(OcamlLit::Int(3)),
318 ]);
319 assert_eq!(e.to_string(), "[1; 2; 3]");
320 }
321 #[test]
322 pub(super) fn test_ocaml_expr_record() {
323 let e = OcamlExpr::Record(vec![
324 (
325 "name".to_string(),
326 OcamlExpr::Lit(OcamlLit::Str("Alice".to_string())),
327 ),
328 ("age".to_string(), OcamlExpr::Lit(OcamlLit::Int(30))),
329 ]);
330 let s = e.to_string();
331 assert!(s.contains("name = \"Alice\""));
332 assert!(s.contains("age = 30"));
333 }
334 #[test]
335 pub(super) fn test_ocaml_typedef_variant() {
336 let td = OcamlTypeDef {
337 name: "expr".to_string(),
338 type_params: vec![],
339 decl: OcamlTypeDecl::Variant(vec![
340 ("Lit".to_string(), vec![OcamlType::Int]),
341 (
342 "Add".to_string(),
343 vec![
344 OcamlType::Custom("expr".to_string()),
345 OcamlType::Custom("expr".to_string()),
346 ],
347 ),
348 (
349 "Mul".to_string(),
350 vec![
351 OcamlType::Custom("expr".to_string()),
352 OcamlType::Custom("expr".to_string()),
353 ],
354 ),
355 ]),
356 };
357 let s = td.to_string();
358 assert!(s.contains("type expr ="));
359 assert!(s.contains("| Lit of int"));
360 assert!(s.contains("| Add of expr * expr"));
361 assert!(s.contains("| Mul of expr * expr"));
362 }
363 #[test]
364 pub(super) fn test_ocaml_typedef_record() {
365 let td = OcamlTypeDef {
366 name: "person".to_string(),
367 type_params: vec![],
368 decl: OcamlTypeDecl::Record(vec![
369 OcamlRecordField {
370 name: "name".to_string(),
371 ty: OcamlType::String,
372 mutable: false,
373 },
374 OcamlRecordField {
375 name: "age".to_string(),
376 ty: OcamlType::Int,
377 mutable: true,
378 },
379 ]),
380 };
381 let s = td.to_string();
382 assert!(s.contains("type person = {"));
383 assert!(s.contains("name: string;"));
384 assert!(s.contains("mutable age: int;"));
385 }
386 #[test]
387 pub(super) fn test_ocaml_typedef_polymorphic() {
388 let td = OcamlTypeDef {
389 name: "tree".to_string(),
390 type_params: vec!["a".to_string()],
391 decl: OcamlTypeDecl::Variant(vec![
392 ("Leaf".to_string(), vec![]),
393 (
394 "Node".to_string(),
395 vec![
396 OcamlType::Custom("'a tree".to_string()),
397 OcamlType::Polymorphic("a".to_string()),
398 OcamlType::Custom("'a tree".to_string()),
399 ],
400 ),
401 ]),
402 };
403 let s = td.to_string();
404 assert!(s.contains("'a tree"));
405 assert!(s.contains("| Leaf"));
406 assert!(s.contains("| Node"));
407 }
408 #[test]
409 pub(super) fn test_ocaml_let_binding_basic() {
410 let lb = OcamlLetBinding {
411 is_rec: false,
412 name: "pi".to_string(),
413 params: vec![],
414 body: OcamlExpr::Lit(OcamlLit::Float(3.14)),
415 type_annotation: Some(OcamlType::Float),
416 };
417 let s = lb.to_string();
418 assert!(s.contains("let pi : float ="));
419 assert!(s.contains("3.14"));
420 }
421 #[test]
422 pub(super) fn test_ocaml_let_binding_recursive() {
423 let lb = OcamlLetBinding {
424 is_rec: true,
425 name: "fib".to_string(),
426 params: vec![("n".to_string(), Some(OcamlType::Int))],
427 body: OcamlExpr::IfThenElse(
428 Box::new(OcamlExpr::BinOp(
429 "<=".to_string(),
430 Box::new(OcamlExpr::Var("n".to_string())),
431 Box::new(OcamlExpr::Lit(OcamlLit::Int(1))),
432 )),
433 Box::new(OcamlExpr::Var("n".to_string())),
434 Box::new(OcamlExpr::BinOp(
435 "+".to_string(),
436 Box::new(OcamlExpr::App(
437 Box::new(OcamlExpr::Var("fib".to_string())),
438 vec![OcamlExpr::BinOp(
439 "-".to_string(),
440 Box::new(OcamlExpr::Var("n".to_string())),
441 Box::new(OcamlExpr::Lit(OcamlLit::Int(1))),
442 )],
443 )),
444 Box::new(OcamlExpr::App(
445 Box::new(OcamlExpr::Var("fib".to_string())),
446 vec![OcamlExpr::BinOp(
447 "-".to_string(),
448 Box::new(OcamlExpr::Var("n".to_string())),
449 Box::new(OcamlExpr::Lit(OcamlLit::Int(2))),
450 )],
451 )),
452 )),
453 ),
454 type_annotation: Some(OcamlType::Int),
455 };
456 let s = lb.to_string();
457 assert!(s.contains("let rec fib"));
458 assert!(s.contains("(n : int)"));
459 }
460 #[test]
461 pub(super) fn test_ocaml_signature() {
462 let sig = OcamlSignature {
463 name: "STACK".to_string(),
464 items: vec![
465 OcamlSigItem::Type(OcamlTypeDef {
466 name: "t".to_string(),
467 type_params: vec!["a".to_string()],
468 decl: OcamlTypeDecl::Abstract,
469 }),
470 OcamlSigItem::Val(
471 "push".to_string(),
472 OcamlType::Fun(
473 Box::new(OcamlType::Polymorphic("a".to_string())),
474 Box::new(OcamlType::Fun(
475 Box::new(OcamlType::Custom("'a t".to_string())),
476 Box::new(OcamlType::Custom("'a t".to_string())),
477 )),
478 ),
479 ),
480 OcamlSigItem::Val(
481 "pop".to_string(),
482 OcamlType::Fun(
483 Box::new(OcamlType::Custom("'a t".to_string())),
484 Box::new(OcamlType::Option(Box::new(OcamlType::Tuple(vec![
485 OcamlType::Polymorphic("a".to_string()),
486 OcamlType::Custom("'a t".to_string()),
487 ])))),
488 ),
489 ),
490 ],
491 };
492 let s = sig.to_string();
493 assert!(s.contains("module type STACK = sig"));
494 assert!(s.contains("val push :"));
495 assert!(s.contains("val pop :"));
496 assert!(s.contains("end"));
497 }
498 #[test]
499 pub(super) fn test_ocaml_module_emit() {
500 let mut m = OcamlModule::new("Math");
501 m.add(OcamlDefinition::Let(OcamlLetBinding {
502 is_rec: false,
503 name: "square".to_string(),
504 params: vec![("x".to_string(), Some(OcamlType::Int))],
505 body: OcamlExpr::BinOp(
506 "*".to_string(),
507 Box::new(OcamlExpr::Var("x".to_string())),
508 Box::new(OcamlExpr::Var("x".to_string())),
509 ),
510 type_annotation: Some(OcamlType::Int),
511 }));
512 let src = m.emit();
513 assert!(src.contains("let square"));
514 assert!(src.contains("(x : int)"));
515 assert!(src.contains(": int ="));
516 }
517 #[test]
518 pub(super) fn test_ocaml_backend_make_adt() {
519 let backend = OcamlBackend::new("Ast");
520 let td = backend.make_adt(
521 "token",
522 vec![],
523 vec![
524 ("Int", vec![OcamlType::Int]),
525 ("Ident", vec![OcamlType::String]),
526 ("Plus", vec![]),
527 ("Minus", vec![]),
528 ],
529 );
530 let s = td.to_string();
531 assert!(s.contains("type token ="));
532 assert!(s.contains("| Int of int"));
533 assert!(s.contains("| Ident of string"));
534 assert!(s.contains("| Plus"));
535 assert!(s.contains("| Minus"));
536 }
537 #[test]
538 pub(super) fn test_ocaml_backend_emit_mli() {
539 let mut backend = OcamlBackend::new("MyLib");
540 backend.add_definition(OcamlDefinition::Let(OcamlLetBinding {
541 is_rec: false,
542 name: "add".to_string(),
543 params: vec![
544 ("a".to_string(), Some(OcamlType::Int)),
545 ("b".to_string(), Some(OcamlType::Int)),
546 ],
547 body: OcamlExpr::BinOp(
548 "+".to_string(),
549 Box::new(OcamlExpr::Var("a".to_string())),
550 Box::new(OcamlExpr::Var("b".to_string())),
551 ),
552 type_annotation: Some(OcamlType::Int),
553 }));
554 let mli = backend.emit_mli();
555 assert!(mli.contains("val add :"));
556 }
557 #[test]
558 pub(super) fn test_ocaml_nested_module() {
559 let mut inner = OcamlModule::new("Inner");
560 inner.is_top_level = false;
561 inner.add(OcamlDefinition::Let(OcamlLetBinding {
562 is_rec: false,
563 name: "x".to_string(),
564 params: vec![],
565 body: OcamlExpr::Lit(OcamlLit::Int(42)),
566 type_annotation: None,
567 }));
568 let s = inner.emit();
569 assert!(s.contains("module Inner = struct"));
570 assert!(s.contains("let x"));
571 assert!(s.contains("end"));
572 }
573 #[test]
574 pub(super) fn test_ocaml_exception() {
575 let def = OcamlDefinition::Exception("ParseError".to_string(), Some(OcamlType::String));
576 assert_eq!(def.to_string(), "exception ParseError of string");
577 }
578 #[test]
579 pub(super) fn test_ocaml_open() {
580 let def = OcamlDefinition::Open("List".to_string());
581 assert_eq!(def.to_string(), "open List");
582 }
583 #[test]
584 pub(super) fn test_ocaml_begin_end() {
585 let e = OcamlExpr::Begin(vec![
586 OcamlExpr::Lit(OcamlLit::Unit),
587 OcamlExpr::Lit(OcamlLit::Int(42)),
588 ]);
589 let s = e.to_string();
590 assert!(s.contains("begin"));
591 assert!(s.contains("end"));
592 }
593}
594#[allow(dead_code)]
596pub fn emit_ocaml_pack_module(module_name: &str, module_type: &str) -> std::string::String {
597 format!("(module {} : {})", module_name, module_type)
598}
599#[allow(dead_code)]
601pub fn emit_ocaml_unpack_module(expr: &str, module_type: &str, name: &str) -> std::string::String {
602 format!("let (module {}) = ({} : {}) in", name, expr, module_type)
603}
604#[allow(dead_code)]
606pub fn emit_ocaml_lazy(expr: &str) -> std::string::String {
607 format!("lazy ({})", expr)
608}
609#[allow(dead_code)]
611pub fn emit_ocaml_lazy_force(var: &str) -> std::string::String {
612 format!("Lazy.force {}", var)
613}
614#[allow(dead_code)]
616pub fn emit_ocaml_memoize(
617 fn_name: &str,
618 key_type: &OcamlType,
619 val_type: &OcamlType,
620) -> std::string::String {
621 format!(
622 "let {name}_memo : ({key}, {val}) Hashtbl.t = Hashtbl.create 16\n\
623 let {name} key =\n match Hashtbl.find_opt {name}_memo key with\n \
624 | Some v -> v\n | None ->\n let v = {name}_impl key in\n \
625 Hashtbl.add {name}_memo key v; v\n",
626 name = fn_name,
627 key = key_type,
628 val = val_type
629 )
630}
631#[allow(dead_code)]
633pub fn emit_ocaml_cps_fn(fn_name: &str, params: &[&str], body: &str) -> std::string::String {
634 let params_with_k: Vec<std::string::String> = params
635 .iter()
636 .map(|p| p.to_string())
637 .chain(std::iter::once("k".to_string()))
638 .collect();
639 format!(
640 "let {name} {params} = {body}\n",
641 name = fn_name,
642 params = params_with_k.join(" "),
643 body = body
644 )
645}
646#[allow(dead_code)]
648pub fn emit_ocaml_cps_call(fn_name: &str, args: &[&str], cont: &str) -> std::string::String {
649 let all_args: Vec<std::string::String> = args
650 .iter()
651 .map(|a| a.to_string())
652 .chain(std::iter::once(format!("(fun result -> {})", cont)))
653 .collect();
654 format!("{} {}", fn_name, all_args.join(" "))
655}
656#[allow(dead_code)]
658pub fn emit_ocaml_seq_of_list(list_expr: &str) -> std::string::String {
659 format!("List.to_seq ({})", list_expr)
660}
661#[allow(dead_code)]
663pub fn emit_ocaml_seq_map(fn_expr: &str, seq_expr: &str) -> std::string::String {
664 format!("Seq.map ({}) ({})", fn_expr, seq_expr)
665}
666#[allow(dead_code)]
668pub fn emit_ocaml_seq_filter(pred_expr: &str, seq_expr: &str) -> std::string::String {
669 format!("Seq.filter ({}) ({})", pred_expr, seq_expr)
670}
671#[allow(dead_code)]
673pub fn emit_ocaml_seq_fold(fn_expr: &str, init: &str, seq_expr: &str) -> std::string::String {
674 format!("Seq.fold_left ({}) ({}) ({})", fn_expr, init, seq_expr)
675}
676#[allow(dead_code)]
678pub fn emit_ocaml_printf(fmt: &str, args: &[&str]) -> std::string::String {
679 if args.is_empty() {
680 format!("Format.printf \"{}\"", fmt)
681 } else {
682 format!("Format.printf \"{}\" {}", fmt, args.join(" "))
683 }
684}
685#[allow(dead_code)]
687pub fn emit_ocaml_asprintf(fmt: &str, args: &[&str]) -> std::string::String {
688 if args.is_empty() {
689 format!("Format.asprintf \"{}\"", fmt)
690 } else {
691 format!("Format.asprintf \"{}\" {}", fmt, args.join(" "))
692 }
693}
694#[allow(dead_code)]
696pub fn emit_ocaml_list_map(param: &str, body: &str, list: &str) -> std::string::String {
697 format!("List.map (fun {} -> {}) ({})", param, body, list)
698}
699#[allow(dead_code)]
701pub fn emit_ocaml_list_filter(param: &str, pred: &str, list: &str) -> std::string::String {
702 format!("List.filter (fun {} -> {}) ({})", param, pred, list)
703}
704#[allow(dead_code)]
706pub fn emit_ocaml_list_fold(
707 acc: &str,
708 elem: &str,
709 body: &str,
710 init: &str,
711 list: &str,
712) -> std::string::String {
713 format!(
714 "List.fold_left (fun {} {} -> {}) ({}) ({})",
715 acc, elem, body, init, list
716 )
717}
718#[allow(dead_code)]
720pub fn emit_ocaml_string_concat(sep: &str, list_expr: &str) -> std::string::String {
721 format!("String.concat \"{}\" ({})", sep, list_expr)
722}
723#[allow(dead_code)]
725pub fn emit_ocaml_array_init(n: &str, fn_expr: &str) -> std::string::String {
726 format!("Array.init ({}) ({})", n, fn_expr)
727}
728#[allow(dead_code)]
730pub fn emit_ocaml_hashtbl_find_opt(tbl: &str, key: &str) -> std::string::String {
731 format!("Hashtbl.find_opt {} {}", tbl, key)
732}
733#[allow(dead_code)]
735pub fn emit_ocaml_bigarray1_create(
736 kind: BigarrayKind,
737 layout: BigarrayLayout,
738 size: &str,
739) -> std::string::String {
740 format!(
741 "Bigarray.Array1.create {} {} ({})",
742 kind.kind_name(),
743 layout.layout_name(),
744 size
745 )
746}
747#[allow(dead_code)]
749pub fn emit_ocaml_bigarray2_create(
750 kind: BigarrayKind,
751 layout: BigarrayLayout,
752 rows: &str,
753 cols: &str,
754) -> std::string::String {
755 format!(
756 "Bigarray.Array2.create {} {} ({}) ({})",
757 kind.kind_name(),
758 layout.layout_name(),
759 rows,
760 cols
761 )
762}
763#[cfg(test)]
764mod ocaml_extended_tests {
765 use super::*;
766 #[test]
767 pub(super) fn test_ocaml_effect_decl() {
768 let eff = OcamlEffect::new("Read", vec![OcamlType::String], OcamlType::Int);
769 let decl = eff.emit_decl();
770 assert!(decl.contains("Effect.t"), "missing Effect.t: {}", decl);
771 assert!(decl.contains("Read"), "missing name: {}", decl);
772 assert!(decl.contains("string"), "missing param: {}", decl);
773 }
774 #[test]
775 pub(super) fn test_ocaml_effect_perform() {
776 let eff = OcamlEffect::new("Get", vec![], OcamlType::Int);
777 let perform = eff.emit_perform(&[]);
778 assert!(
779 perform.contains("Effect.perform Get"),
780 "wrong perform: {}",
781 perform
782 );
783 let eff2 = OcamlEffect::new("Put", vec![OcamlType::Int], OcamlType::Unit);
784 let perform2 = eff2.emit_perform(&["42"]);
785 assert!(
786 perform2.contains("Effect.perform (Put 42)"),
787 "wrong perform: {}",
788 perform2
789 );
790 }
791 #[test]
792 pub(super) fn test_ocaml_gadt_emit() {
793 let gadt = OcamlGadt::new("expr", vec!["a"])
794 .add_variant("Int", vec![OcamlType::Int], "'a expr")
795 .add_variant("Bool", vec![OcamlType::Bool], "'a expr")
796 .add_variant(
797 "Add",
798 vec![
799 OcamlType::Custom("int expr".to_string()),
800 OcamlType::Custom("int expr".to_string()),
801 ],
802 "int expr",
803 );
804 let s = gadt.emit();
805 assert!(s.contains("type"), "missing type: {}", s);
806 assert!(s.contains("| Int"), "missing Int: {}", s);
807 assert!(s.contains("| Bool"), "missing Bool: {}", s);
808 assert!(s.contains("| Add"), "missing Add: {}", s);
809 }
810 #[test]
811 pub(super) fn test_ocaml_functor_emit() {
812 let f = OcamlFunctor::new("Make")
813 .add_param("K", "Map.OrderedType")
814 .add_param("V", "sig type t end")
815 .add_def(OcamlDefinition::Open("K".to_string()));
816 let s = f.emit();
817 assert!(s.contains("module Make"), "missing module: {}", s);
818 assert!(
819 s.contains("(K : Map.OrderedType)"),
820 "missing param K: {}",
821 s
822 );
823 assert!(s.contains("open K"), "missing open: {}", s);
824 assert!(s.contains("end"), "missing end: {}", s);
825 }
826 #[test]
827 pub(super) fn test_ocaml_ppx_attr() {
828 let deriving = OcamlPpxAttr::deriving(&["show", "eq", "ord"]);
829 let s = deriving.emit();
830 assert!(s.contains("[@deriving"), "missing attr: {}", s);
831 assert!(s.contains("show"), "missing show: {}", s);
832 assert!(s.contains("eq"), "missing eq: {}", s);
833 let inline = OcamlPpxAttr::new("inline").emit_double();
834 assert!(inline.contains("[@@inline]"), "wrong inline: {}", inline);
835 }
836 #[test]
837 pub(super) fn test_dune_library_emit() {
838 let lib = DuneLibrary::new("mylib")
839 .public_name("my-package.mylib")
840 .add_module("Foo")
841 .add_module("Bar")
842 .add_dep("core")
843 .add_dep("async")
844 .add_ppx("ppx_deriving.show")
845 .with_inline_tests();
846 let s = lib.emit();
847 assert!(s.contains("(library"), "missing library: {}", s);
848 assert!(s.contains("(name mylib)"), "missing name: {}", s);
849 assert!(
850 s.contains("(public_name my-package.mylib)"),
851 "missing public: {}",
852 s
853 );
854 assert!(s.contains("core"), "missing dep: {}", s);
855 assert!(s.contains("(inline_tests)"), "missing tests: {}", s);
856 }
857 #[test]
858 pub(super) fn test_dune_executable_emit() {
859 let exe = DuneExecutable::new("main")
860 .add_dep("mylib")
861 .add_dep("cmdliner");
862 let s = exe.emit();
863 assert!(s.contains("(executable"), "missing exe: {}", s);
864 assert!(s.contains("(name main)"), "missing name: {}", s);
865 assert!(s.contains("mylib"), "missing dep: {}", s);
866 }
867 #[test]
868 pub(super) fn test_ounit2_test_case_emit() {
869 let tc = OcamlTestCase::assert_equal("test_add", "42", "add 20 22");
870 let s = tc.emit_ounit();
871 assert!(s.contains("\"test_add\""), "missing name: {}", s);
872 assert!(s.contains("assert_equal"), "missing assert: {}", s);
873 assert!(s.contains("(42)"), "missing expected: {}", s);
874 assert!(s.contains("add 20 22"), "missing actual: {}", s);
875 }
876 #[test]
877 pub(super) fn test_ounit2_suite_emit() {
878 let suite = OcamlTestSuite::new("arithmetic")
879 .add(OcamlTestCase::assert_equal("add", "4", "2 + 2"))
880 .add(OcamlTestCase::new("true_is_true", "assert_bool \"\" true"));
881 let s = suite.emit_ounit();
882 assert!(s.contains("open OUnit2"), "missing open: {}", s);
883 assert!(s.contains("let suite"), "missing suite: {}", s);
884 assert!(s.contains("arithmetic"), "missing name: {}", s);
885 assert!(s.contains("run_test_tt_main"), "missing runner: {}", s);
886 }
887 #[test]
888 pub(super) fn test_ocaml_list_helpers() {
889 let map = emit_ocaml_list_map("x", "x * 2", "numbers");
890 assert!(map.contains("List.map"), "missing map: {}", map);
891 assert!(map.contains("fun x ->"), "missing fun: {}", map);
892 let filter = emit_ocaml_list_filter("x", "x > 0", "numbers");
893 assert!(filter.contains("List.filter"), "missing filter: {}", filter);
894 let fold = emit_ocaml_list_fold("acc", "x", "acc + x", "0", "numbers");
895 assert!(fold.contains("List.fold_left"), "missing fold: {}", fold);
896 }
897 #[test]
898 pub(super) fn test_ocaml_bigarray_create() {
899 let code =
900 emit_ocaml_bigarray1_create(BigarrayKind::Float32, BigarrayLayout::CLayout, "1024");
901 assert!(
902 code.contains("Bigarray.Array1.create"),
903 "missing create: {}",
904 code
905 );
906 assert!(code.contains("float32"), "missing kind: {}", code);
907 assert!(code.contains("c_layout"), "missing layout: {}", code);
908 assert!(code.contains("1024"), "missing size: {}", code);
909 }
910 #[test]
911 pub(super) fn test_ocaml_memoize_emit() {
912 let code = emit_ocaml_memoize("fib", &OcamlType::Int, &OcamlType::Int);
913 assert!(code.contains("fib_memo"), "missing memo tbl: {}", code);
914 assert!(code.contains("Hashtbl.create"), "missing create: {}", code);
915 assert!(code.contains("Hashtbl.find_opt"), "missing find: {}", code);
916 assert!(code.contains("Hashtbl.add"), "missing add: {}", code);
917 }
918 #[test]
919 pub(super) fn test_ocaml_cps_helpers() {
920 let fn_code = emit_ocaml_cps_fn("add_cps", &["x", "y"], "k (x + y)");
921 assert!(fn_code.contains("add_cps"), "missing fn name: {}", fn_code);
922 assert!(fn_code.contains(" k"), "missing continuation: {}", fn_code);
923 assert!(fn_code.contains("k (x + y)"), "missing body: {}", fn_code);
924 let call_code = emit_ocaml_cps_call("add_cps", &["2", "3"], "print_int result");
925 assert!(call_code.contains("add_cps"), "missing fn: {}", call_code);
926 assert!(
927 call_code.contains("fun result ->"),
928 "missing cont: {}",
929 call_code
930 );
931 }
932 #[test]
933 pub(super) fn test_ocaml_seq_helpers() {
934 let s = emit_ocaml_seq_of_list("[1;2;3]");
935 assert!(s.contains("List.to_seq"), "missing to_seq: {}", s);
936 let m = emit_ocaml_seq_map("fun x -> x * 2", "my_seq");
937 assert!(m.contains("Seq.map"), "missing Seq.map: {}", m);
938 let f = emit_ocaml_seq_fold("fun acc x -> acc + x", "0", "my_seq");
939 assert!(f.contains("Seq.fold_left"), "missing Seq.fold_left: {}", f);
940 }
941 #[test]
942 pub(super) fn test_bigarray_kind_names() {
943 assert_eq!(BigarrayKind::Float32.kind_name(), "Bigarray.float32");
944 assert_eq!(BigarrayKind::Float64.kind_name(), "Bigarray.float64");
945 assert_eq!(BigarrayKind::Int32.element_type(), "int32");
946 assert_eq!(
947 BigarrayLayout::FortranLayout.layout_name(),
948 "Bigarray.fortran_layout"
949 );
950 }
951}
952#[cfg(test)]
953mod OCaml_infra_tests {
954 use super::*;
955 #[test]
956 pub(super) fn test_pass_config() {
957 let config = OCamlPassConfig::new("test_pass", OCamlPassPhase::Transformation);
958 assert!(config.enabled);
959 assert!(config.phase.is_modifying());
960 assert_eq!(config.phase.name(), "transformation");
961 }
962 #[test]
963 pub(super) fn test_pass_stats() {
964 let mut stats = OCamlPassStats::new();
965 stats.record_run(10, 100, 3);
966 stats.record_run(20, 200, 5);
967 assert_eq!(stats.total_runs, 2);
968 assert!((stats.average_changes_per_run() - 15.0).abs() < 0.01);
969 assert!((stats.success_rate() - 1.0).abs() < 0.01);
970 let s = stats.format_summary();
971 assert!(s.contains("Runs: 2/2"));
972 }
973 #[test]
974 pub(super) fn test_pass_registry() {
975 let mut reg = OCamlPassRegistry::new();
976 reg.register(OCamlPassConfig::new("pass_a", OCamlPassPhase::Analysis));
977 reg.register(OCamlPassConfig::new("pass_b", OCamlPassPhase::Transformation).disabled());
978 assert_eq!(reg.total_passes(), 2);
979 assert_eq!(reg.enabled_count(), 1);
980 reg.update_stats("pass_a", 5, 50, 2);
981 let stats = reg.get_stats("pass_a").expect("stats should exist");
982 assert_eq!(stats.total_changes, 5);
983 }
984 #[test]
985 pub(super) fn test_analysis_cache() {
986 let mut cache = OCamlAnalysisCache::new(10);
987 cache.insert("key1".to_string(), vec![1, 2, 3]);
988 assert!(cache.get("key1").is_some());
989 assert!(cache.get("key2").is_none());
990 assert!((cache.hit_rate() - 0.5).abs() < 0.01);
991 cache.invalidate("key1");
992 assert!(!cache.entries["key1"].valid);
993 assert_eq!(cache.size(), 1);
994 }
995 #[test]
996 pub(super) fn test_worklist() {
997 let mut wl = OCamlWorklist::new();
998 assert!(wl.push(1));
999 assert!(wl.push(2));
1000 assert!(!wl.push(1));
1001 assert_eq!(wl.len(), 2);
1002 assert_eq!(wl.pop(), Some(1));
1003 assert!(!wl.contains(1));
1004 assert!(wl.contains(2));
1005 }
1006 #[test]
1007 pub(super) fn test_dominator_tree() {
1008 let mut dt = OCamlDominatorTree::new(5);
1009 dt.set_idom(1, 0);
1010 dt.set_idom(2, 0);
1011 dt.set_idom(3, 1);
1012 assert!(dt.dominates(0, 3));
1013 assert!(dt.dominates(1, 3));
1014 assert!(!dt.dominates(2, 3));
1015 assert!(dt.dominates(3, 3));
1016 }
1017 #[test]
1018 pub(super) fn test_liveness() {
1019 let mut liveness = OCamlLivenessInfo::new(3);
1020 liveness.add_def(0, 1);
1021 liveness.add_use(1, 1);
1022 assert!(liveness.defs[0].contains(&1));
1023 assert!(liveness.uses[1].contains(&1));
1024 }
1025 #[test]
1026 pub(super) fn test_constant_folding() {
1027 assert_eq!(OCamlConstantFoldingHelper::fold_add_i64(3, 4), Some(7));
1028 assert_eq!(OCamlConstantFoldingHelper::fold_div_i64(10, 0), None);
1029 assert_eq!(OCamlConstantFoldingHelper::fold_div_i64(10, 2), Some(5));
1030 assert_eq!(
1031 OCamlConstantFoldingHelper::fold_bitand_i64(0b1100, 0b1010),
1032 0b1000
1033 );
1034 assert_eq!(OCamlConstantFoldingHelper::fold_bitnot_i64(0), -1);
1035 }
1036 #[test]
1037 pub(super) fn test_dep_graph() {
1038 let mut g = OCamlDepGraph::new();
1039 g.add_dep(1, 2);
1040 g.add_dep(2, 3);
1041 g.add_dep(1, 3);
1042 assert_eq!(g.dependencies_of(2), vec![1]);
1043 let topo = g.topological_sort();
1044 assert_eq!(topo.len(), 3);
1045 assert!(!g.has_cycle());
1046 let pos: std::collections::HashMap<u32, usize> =
1047 topo.iter().enumerate().map(|(i, &n)| (n, i)).collect();
1048 assert!(pos[&1] < pos[&2]);
1049 assert!(pos[&1] < pos[&3]);
1050 assert!(pos[&2] < pos[&3]);
1051 }
1052}