[D] (E) SlarnML

slarnML/.gitignore

@@ -0,0 +1,10 @@
+.vscode
+_build
+_coverage
+trash
+
+*.o
+*.out
+demo/main.S
+test/manytests
+test/manytests_

slarnML/.ocamlformat

@@ -0,0 +1,2 @@
+version=0.26.2
+profile=janestreet

slarnML/Makefile

@@ -0,0 +1,23 @@
+.PHONY: repl tests test fmt lint celan
+
+all:
+	dune build
+
+repl:
+	dune build ./slarn.exe && rlwrap _build/default/slarn.exe
+
+test:
+	dune runtest
+
+clean:
+	@$(RM) -r _build
+
+fmt:
+	dune build @fmt --auto-promote
+
+lint:
+	dune build @lint --force
+
+release:
+	dune build --profile=release
+	dune runtest --profile=release

slarnML/demo/.gdb_history

@@ -0,0 +1,85 @@
+b _start
+c
+ni
+ni
+ni
+ni
+ni
+exit
+c
+b main
+c
+b fac
+c
+b fac_fack
+b fack_fack
+b fack_fac
+c
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+exit
+b fac_fack
+b fack_fac
+c
+c
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+ni
+exit

slarnML/demo/.gdbinit

@@ -0,0 +1,23 @@
+set history save
+set architecture riscv:rv64
+set sysroot /usr/riscv64−linux−gnu
+target remote :1234
+tui enable
+tui new-layout example {-horizontal regs 1 asm 1} 2 status 0 cmd 1
+layout example
+# tui disable
+focus cmd
+b _start
+b .breakpoint0
+b .breakpoint1
+b .breakpoint2
+b .breakpoint3
+b .breakpoint4
+b .breakpoint5
+b .breakpoint6
+b .breakpoint7
+b .breakpoint8
+b .breakpoint9
+b print_int
+# c
+# x/8xg $sp

slarnML/demo/demo.ml

@@ -0,0 +1,23 @@
+open SlarnML_lib.Res
+
+let () =
+  let s = Stdio.In_channel.input_all Stdlib.stdin in
+  let result =
+    match SlarnML_lib.Parser.parser s with
+    | Ok ast ->
+      SlarnML_lib.Clos_conv.clos_conv ast
+      >>= (fun ast -> SlarnML_lib.Lambda_lifting.lambda_lifting ast)
+      >>= fun ast ->
+      Result (SlarnML_lib.Anf_conv.anf ast)
+      >>= (fun anf -> SlarnML_lib.Riscv.asm anf)
+      >>= fun prog ->
+      Result
+        (String.concat
+           "\n"
+           (List.map (SlarnML_lib.Pprint_riscv.pp_instruction "\t") prog))
+    | Error message -> SlarnML_lib.Res.Error message
+  in
+  match result with
+  | SlarnML_lib.Res.Result r -> print_string @@ r
+  | Error e -> Printf.eprintf "%s" e
+;;

slarnML/demo/dune

@@ -0,0 +1,72 @@
+;(rule
+; (targets part_app.o)
+; (deps ../lib/riscv64/part_app.c)
+; (mode
+;  (promote (until-clean)))
+; (action
+;  (run
+;   riscv64-linux-gnu-gcc
+;   -march=rv64gc
+;   -O2
+;   -nostdlib
+;   -nostartfiles
+;   -ffreestanding
+;   -c
+;   %{deps}
+;   -o
+;   %{targets}))
+; (enabled_if
+;  (= %{profile} demo)))
+;
+;(rule
+; (targets main.S)
+; (deps
+;  demo.ml
+;  main.ml)
+; (mode
+;  (promote (until-clean)))
+; (action
+;  (run dune exec demo < main.ml))
+; (enabled_if
+;  (= %{profile} demo)))
+;
+;(rule
+; (targets main.o)
+; (deps main.S)
+; (mode
+;  (promote (until-clean)))
+; (action
+;  (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets}))
+; (enabled_if
+;  (= %{profile} demo)))
+;
+;(rule
+; (targets print.o)
+; (deps ../lib/riscv64/print.S)
+; (mode
+;  (promote (until-clean)))
+; (action
+;  (run riscv64-linux-gnu-as -march=rv64gc %{deps} -o %{targets}))
+; (enabled_if
+;  (= %{profile} demo)))
+;
+;(rule
+; (targets a.out)
+; (deps print.o part_app.o main.o)
+; (mode
+;  (promote (until-clean)))
+; (action
+;  (run riscv64-linux-gnu-ld -lc %{deps} -o %{targets}))
+; (enabled_if
+;  (= %{profile} demo)))
+;
+;(executable
+; (name demo)
+; (public_name demo)
+; (modules demo)
+; (libraries slarnML.lib stdio))
+;
+; (cram
+;  (applies_to riscvDemo)
+;  (deps ./a.out ./demoRiscv.exe))
+;

slarnML/demo/main.ml

@@ -0,0 +1,6 @@
+let fac n =
+  let rec fack n f = if n <= 1 then f 1 else fack (n - 1) (fun x -> x * f n) in
+  fack n (fun x -> x)
+;;
+
+let main = print_int (fac 3)

slarnML/dune-project

@@ -0,0 +1,33 @@
+(lang dune 2.9)
+
+(name slarnML)
+
+(generate_opam_files true)
+
+(cram enable)
+
+(license LGPL-3.0-or-later)
+
+(source
+ (github ioannessh/comp24))
+
+(authors "Ivan Shurenkov")
+
+(maintainers "Ivan Shurenkov")
+
+(package
+ (name slarnML)
+ (synopsis "SlarnML")
+ (version 0.0)
+ (depends 
+  ocaml 
+  dune
+  angstrom
+  base
+  (ppx_inline_test :with-test)
+  ppx_expect
+  ppx_deriving
+  bisect_ppx
+  (odoc :with-doc)
+  (ocamlformat :build)))
+

slarnML/lib/anf/anf_ast.ml

@@ -0,0 +1,35 @@
+(** Copyright 2024-2025, Ivan Shurenkov *)
+
+(** SPDX-License-Identifier: LGPL-2.1-or-later *)
+
+type immexpr =
+  | AId of string
+  | AInt of int
+  | ABool of bool
+  | AUnit
+[@@deriving show { with_path = false }]
+
+type cexpr =
+  | ANot of immexpr
+  | AOr of immexpr * immexpr
+  | AAnd of immexpr * immexpr
+  | AEq of immexpr * immexpr
+  | AGt of immexpr * immexpr
+  | ALt of immexpr * immexpr
+  | AGte of immexpr * immexpr
+  | ALte of immexpr * immexpr
+  | AAdd of immexpr * immexpr
+  | ASub of immexpr * immexpr
+  | AMul of immexpr * immexpr
+  | ADiv of immexpr * immexpr
+  | CImmExpr of immexpr
+  | AIf of immexpr * aexpr * aexpr
+  | AApp of immexpr * immexpr list
+[@@deriving show { with_path = false }]
+
+and aexpr =
+  | ALet of string * cexpr * aexpr
+  | ACExpr of cexpr
+[@@deriving show { with_path = false }]
+
+type afun = AFun of string * string list * aexpr [@@deriving show { with_path = false }]