ocaml: merge yanaijepeux

ocaml/dune-project

@@ -12,7 +12,10 @@
   (synopsis "The compiler for Yanais")
   (description "The compiler for Yanais")
   (depends
+    (alcotest (>= 1.7 :with-test))
+    (bwd (>= 2.3))
     (cmdliner (>= 1.1))
+    (fmt (>= 0.8.7))
     (gen (>= 0.5))
     (integers (>= 0.2))
     (menhir (>= 20220210))

ocaml/lib/dune

@@ -2,6 +2,6 @@
   (name yanais_core)
   (public_name yanais.yanais_core)
   (synopsis "The compiler for Yanais")
-  (libraries integers yanais_syntax))
+  (libraries integers yanais_syntax yanaijepeux))
 
 (documentation)

ocaml/libutils/Layout.ml

@@ -1,11 +1,15 @@
+(** a memory layout *)
 type t = {
     size : int;
-    (* alignment = 1 << align_exp *)
+
     align_exp : char;
+    (** alignment = 1 << align_exp *)
   }
 
 open Int
 
+let show x = "Layout { size = " ^ (string_of_int x.size) ^ "; align_exp = " ^ (Char.code x.align_exp |> string_of_int) ^ "}"
+
 let alignment_of_exp x = shift_left 1 (Char.code x)
 
 let alignment x = alignment_of_exp x.align_exp
@@ -15,9 +19,11 @@ let max_size_for_align_exp x =
   let isz_max_sc = shift_right max_int 1 |> succ in
   isz_max_sc - y
 
-(** appends a layout to this one, returns new layout and the offset **)
+(** appends a layout to this one, returns new layout and the offset *)
 let push orig next =
   let align_exp = max (Char.code orig.align_exp) (Char.code next.align_exp) |> Char.chr in
+  let align_exp_cc = Char.code align_exp in
+  if (align_exp_cc >= 32) || (align_exp_cc < 0) then Option.none else
 
   (* fill up ourselves so that the other element is correctly aligned *)
   let smask_sh = alignment next in
@@ -35,4 +41,5 @@ let push orig next =
     then Option.some ({ size; align_exp; }, offset)
     else Option.none
 
+(** finishes a layout by inserting padding at the end to ensure alignment *)
 let finish orig = push orig { size = 0; align_exp = orig.align_exp }

ocaml/libutils/Layout.mli

@@ -0,0 +1,17 @@
+(** a memory layout *)
+type t = {
+    size : int;
+
+    align_exp : char;
+    (** alignment = 1 << align_exp *)
+  }
+
+val show : t -> string
+
+val alignment : t -> int
+
+(** appends a layout to this one, returns new layout and the offset *)
+val push : t -> t -> (t * int) option
+
+(** finishes a layout by inserting padding at the end to ensure alignment (might fail when overflowing) *)
+val finish : t -> (t * int) option

ocaml/libutils/StackAction.ml

@@ -1,4 +1,4 @@
-(* A stack action (pop is run first, then push sequentially) *)
+(** A stack action (pop is run first, then push sequentially) *)
 type 'a t =
   { pop  : int
   ; push : 'a list
@@ -14,3 +14,5 @@ let merge lhs rhs =
   { pop = lhs.pop + pop; push = List.append push rhs.push; }
 
 let empty = { pop = 0; push = []; }
+
+let map f sta = { pop = sta.pop; push = List.map f sta.push; }

ocaml/libutils/StackAction.mli

@@ -0,0 +1,11 @@
+(** A stack action (pop is run first, then push sequentially) *)
+type 'a t =
+  { pop  : int
+  ; push : 'a list
+  }
+
+val merge : 'a t -> 'a t -> 'a t
+
+val empty : 'a t
+
+val map : ('a -> 'b) -> 'a t -> 'b t

ocaml/libutils/dune

@@ -0,0 +1,7 @@
+(library
+  (name yanaijepeux)
+  (public_name yanais.yanaijepeux)
+  (synopsis "Yanais-associated utilities")
+  (libraries bwd))
+
+(documentation)

ocaml/test/dune

@@ -0,0 +1,3 @@
+(tests
+  (names layout00)
+  (libraries alcotest fmt yanaijepeux))

ocaml/test/layout00.ml

@@ -0,0 +1,33 @@
+module Layout = Yanaijepeux.Layout
+
+let layout_ao_check =
+  let layout_and_offs = Alcotest.testable (fun fmt (lt, offs) -> Fmt.pf fmt "%S, %i" (Layout.show lt) offs) ( = ) in
+  Alcotest.check layout_and_offs "same layout"
+
+let test_00 () =
+  layout_ao_check ({ Layout.size = 8; Layout.align_exp = '\002'; }, 4) (
+    Layout.push
+      { Layout.size = 4; Layout.align_exp = '\002'; }
+      { Layout.size = 4; Layout.align_exp = '\002'; }
+    |> Option.get
+  )
+
+let test_01_fillup () =
+  layout_ao_check ({ Layout.size = 5; Layout.align_exp = '\002'; }, 4) (
+    Layout.push
+      { Layout.size = 1; Layout.align_exp = '\002'; }
+      { Layout.size = 1; Layout.align_exp = '\002'; }
+    |> Option.get
+  )
+
+let test_02_fillup () =
+  layout_ao_check ({ Layout.size = 8; Layout.align_exp = '\002'; }, 8) (
+    Layout.finish { Layout.size = 5; Layout.align_exp = '\002'; } |> Option.get
+  )
+
+let () =
+  let open Alcotest in
+  run "Layout" [
+    "push", [test_case "no padding" `Quick test_00; test_case "with padding" `Quick test_01_fillup];
+    "finish", [test_case "with padding" `Quick test_02_fillup];
+  ]