Add EML | Usoltsev Daniil & Ostrovskaya Victoria

EML/.gitignore

@@ -0,0 +1,3 @@
+/_build
+/_coverage
+

EML/.ocamlformat

@@ -0,0 +1,3 @@
+version=0.27.0
+profile=janestreet
+

EML/EML.opam

@@ -0,0 +1,36 @@
+opam-version: "2.0"
+synopsis: "A short LLVM demo"
+maintainer: ["Victoria Ostrovskaya & Danil Usoltsev"]
+authors: ["Victoria Ostrovskaya & Danil Usoltsev"]
+license: "LGPL-3.0-or-later WITH OCaml-LGPL-linking-exception"
+homepage: "https://github.com/Kakadu/comp24"
+bug-reports: "https://github.com/Kakadu/comp24/issues"
+depends: [
+  "ocaml"
+  "dune" {>= "3.8" & = "3.19.1"}
+  "angstrom" {= "0.16.0"}
+  "qcheck"
+  "bisect_ppx"
+  "ppx_expect"
+  "llvm" {= "18-shared"}
+  "qcheck" {with-tests}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/Kakadu/comp24.git"
+depexts: [
+  [ "llvm-18-dev" "clang" "gcc-riscv64-linux-gnu" "qemu-user" ] {os-distribution = "ubuntu"}
+]

EML/EML.opam.template

@@ -0,0 +1,7 @@
+depexts: [
+  [ "llvm-18-dev" "clang-18" "gcc-riscv64-linux-gnu" "g++-riscv64-linux-gnu" "qemu-user"] {os-distribution = "ubuntu"}
+]
+pin-depends: [
+  ["ppx_deriving_qcheck.0.6" "git+https://github.com/c-cube/qcheck.git#42429bf06ba12373cad02b1404f50d0ad6238af5"]
+]
+# Don't edit '*.opam' file manually. Use 'dune b @install'

EML/Makefile

@@ -0,0 +1,20 @@
+.PHONY: all test
+all:
+	dune build
+
+test:
+	dune test
+
+TEST_COV_D = /tmp/cov
+COVERAGE_OPTS = --coverage-path $(TEST_COV_D) --expect bin/
+
+.PHONY: test_coverage coverage
+test_coverage: coverage
+coverage:
+	$(RM) -r $(TEST_COV_D)
+	mkdir -p $(TEST_COV_D)
+	BISECT_FILE=$(TEST_COV_D)/language dune runtest --no-print-directory \
+		--instrument-with bisect_ppx --force
+	bisect-ppx-report html $(COVERAGE_OPTS)
+	bisect-ppx-report summary $(COVERAGE_OPTS)
+	@echo "Use 'xdg-open _coverage/index.html' to see coverage report"

EML/bin/EML.ml

@@ -0,0 +1,159 @@
+(** Copyright 2025-2026, Victoria Ostrovskaya & Danil Usoltsev *)
+
+(** SPDX-License-Identifier: LGPL-3.0-or-later *)
+
+open Stdio
+open EML_lib
+open Middleend
+
+type backend =
+  | Ricsv
+  | Llvm
+
+type opts =
+  { input_file : string option
+  ; output_file : string option
+  ; enable_gc : bool
+  ; backend : backend
+  ; infer_only : bool
+  }
+
+let default_opts =
+  { input_file = None
+  ; output_file = None
+  ; enable_gc = false
+  ; backend = Ricsv
+  ; infer_only = false
+  }
+;;
+
+type env = Inferencer.TypeEnv.t
+
+let report_parse_error oc s =
+  Out_channel.output_string oc (Format.asprintf "Parsing error: %s\n" s)
+;;
+
+let report_infer_error oc e =
+  Out_channel.output_string
+    oc
+    (Format.asprintf "Inferencer error: %a\n" Inferencer.pp_error e)
+;;
+
+let with_frontend text oc f_success : (env, unit) Result.t =
+  match Frontend.Runner.run text with
+  | Error (Frontend.Runner.Parse s) ->
+    report_parse_error oc s;
+    Error ()
+  | Ok ast -> f_success ast
+;;
+
+let with_middleend ast env f : (env, unit) Result.t =
+  match Middleend.Runner.run ast env with
+  | Error e_mid ->
+    Format.eprintf "Middleend error: %a\n%!" Middleend.Runner.pp_error e_mid;
+    Error ()
+  | Ok (anf_ast, env') -> f anf_ast env'
+;;
+
+let run_compile text env oc ~backend ~enable_gc : (env, unit) Result.t =
+  with_frontend text oc (fun ast ->
+    with_middleend ast env (fun anf_ast env' ->
+      let ppf = Format.formatter_of_out_channel oc in
+      let res =
+        match backend with
+        | Ricsv -> Backend.Ricsv.Runner.gen_program ~enable_gc ppf anf_ast
+        | Llvm -> Backend.Llvm_ir.Runner.gen_program ~enable_gc ppf anf_ast
+      in
+      match res with
+      | Ok () -> Ok env'
+      | Error msg ->
+        Format.eprintf "Codegen error: %s\n%!" msg;
+        Error ()))
+;;
+
+let run_infer_only text env oc : (env, unit) Result.t =
+  match Frontend.Parser.parse text with
+  | Error s ->
+    report_parse_error oc s;
+    Error ()
+  | Ok ast ->
+    (match Inferencer.ResultMonad.run (Inferencer.infer_structure env ast) with
+     | Error e ->
+       report_infer_error oc e;
+       Error ()
+     | Ok (_subst, env') ->
+       let filtered_env =
+         Base.Map.filter_keys env' ~f:(fun key -> not (Base.Map.mem env key))
+       in
+       Base.Map.iteri filtered_env ~f:(fun ~key ~data ->
+         match data with
+         | Inferencer.Scheme.Scheme (_, ty) ->
+           Out_channel.output_string
+             oc
+             (Format.asprintf "val %s: %a\n" key Frontend.Ast.pp_ty ty));
+       Ok env')
+;;
+
+let compiler opts : (unit, unit) Result.t =
+  let run text env oc =
+    if opts.infer_only
+    then run_infer_only text env oc
+    else run_compile text env oc ~backend:opts.backend ~enable_gc:opts.enable_gc
+  in
+  let env0 =
+    if opts.enable_gc
+    then Middleend.Inferencer.TypeEnv.env_with_gc
+    else Middleend.Inferencer.TypeEnv.initial_env
+  in
+  let with_output f =
+    match opts.output_file with
+    | Some path -> Out_channel.with_file path ~f
+    | None -> f Out_channel.stdout
+  in
+  let input =
+    match opts.input_file with
+    | Some path -> In_channel.read_all path |> String.trim
+    | None -> In_channel.input_all stdin |> String.trim
+  in
+  match with_output (fun oc -> run input env0 oc) with
+  | Ok _env -> Ok ()
+  | Error () -> Error ()
+;;
+
+let parse_args () : (opts, unit) Result.t =
+  let parse_backend = function
+    | "llvm" -> Ok Llvm
+    | "ricsv" -> Ok Ricsv
+    | _ -> Error ()
+  in
+  let rec loop current_opts = function
+    | [] -> Ok current_opts
+    | "-gc" :: rest -> loop { current_opts with enable_gc = true } rest
+    | "-infer" :: rest -> loop { current_opts with infer_only = true } rest
+    | "-fromfile" :: path :: rest ->
+      loop { current_opts with input_file = Some path } rest
+    | "-o" :: path :: rest -> loop { current_opts with output_file = Some path } rest
+    | "-backend" :: backend_name :: rest ->
+      (match parse_backend backend_name with
+       | Ok backend -> loop { current_opts with backend } rest
+       | Error () -> Error ())
+    | argument :: _ when String.length argument > 0 && Char.equal argument.[0] '-' ->
+      Error ()
+    | _positional_argument :: _ -> Error ()
+  in
+  let argv = Array.to_list Sys.argv in
+  match argv with
+  | [] -> Ok default_opts
+  | _program_name :: arguments -> loop default_opts arguments
+;;
+
+let () =
+  match parse_args () with
+  | Error () ->
+    Format.eprintf "Positional arguments are not supported\n";
+    exit 1
+  | Ok opts ->
+    (match compiler opts with
+     | Error () -> exit 1
+     | Ok () -> ())
+;;

EML/bin/dune

@@ -0,0 +1,4 @@
+(executable
+ (name EML)
+ (modes byte exe)
+ (libraries stdio base EML.lib))

EML/dune-project

@@ -0,0 +1,18 @@
+(lang dune 3.8)
+
+(name EML)
+
+(generate_opam_files false)
+
+(source
+ (github Kakadu/comp24))
+
+(authors "Victoria Ostrovskaya & Danil Usoltsev")
+
+(maintainers "Victoria Ostrovskaya & Danil Usoltsev")
+
+(license "LGPL-3.0-or-later WITH OCaml-LGPL-linking-exception")
+
+
+
+; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project

EML/lib/backend/llvm_ir/analysis.ml

@@ -0,0 +1,112 @@
+(** 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 mangle_reserved name =
+    if is_reserved name
+    then "eml_" ^ name
+    else if String.equal name "_start"
+    then "eml_start"
+    else name
+  in
+  let functions, _ =
+    List.fold_left
+      (fun (reversed_functions, counts) (func_name, _arity, params, body, is_rec) ->
+         let base_asm_name = mangle_reserved 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 }
+;;

EML/lib/backend/llvm_ir/analysis.mli

@@ -0,0 +1,20 @@
+(** Copyright 2025-2026, Victoria Ostrovskaya & Danil Usoltsev *)
+
+(** SPDX-License-Identifier: LGPL-3.0-or-later *)
+
+open Middleend.Anf
+
+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
+  }
+
+val analyze : anf_program -> analysis_result