Merge branch 'main' of github.com:UnsignedByte/bril

benchmarks/core/hamming.bril

@@ -0,0 +1,43 @@
+# ARGS: 12 6
+
+@lsb (val : int) : int {
+  two : int = const 2;
+  div : int = div val two;
+  mul : int = mul div two;
+  lsb : int = sub val mul;
+  ret lsb;
+}
+
+@hamm_lsb (a : int, b : int) : int {
+  zero : int = const 0;
+  one : int = const 1;
+  a_lsb : int = call @lsb a;
+  b_lsb : int = call @lsb b;
+  xor : int = add a_lsb b_lsb;
+  guard : bool = eq xor one;
+  br guard .if .else;
+.if:
+  ret one;
+.else:
+  ret zero;
+}
+
+@main (a : int, b : int) {
+  zero : int = const 0;
+  two : int = const 2;
+  dist : int = const 0;
+.while:
+  a_done : bool = eq a zero;
+  b_done : bool = eq b zero;
+  done : bool = and a_done b_done;
+  br done .end .body;
+.body:
+  hamm : int = call @hamm_lsb a b;
+  dist : int = add dist hamm;
+  a : int = div a two;
+  b : int = div b two;
+  jmp .while;
+.end:
+  print dist;
+  ret;
+}

benchmarks/core/hamming.out

@@ -0,0 +1 @@
+2

benchmarks/core/hamming.prof

@@ -0,0 +1 @@
+total_dyn_inst: 117

benchmarks/core/rot13.bril

@@ -0,0 +1,17 @@
+# ARGS: 10
+# Compute the char shifted forward by 13 (0-indexed)
+@main(input: int) {
+  aed: int = call @rot input;
+  print aed;
+}
+@rot(n: int):int{
+  thirteen: int = const 13;
+  twenty_six: int = const 26;
+  shifted: int = add n thirteen;
+  over: bool = ge shifted twenty_six;
+  br over .if .else;
+.if:
+  shifted: int = sub shifted twenty_six;
+.else:
+  ret shifted;
+}

benchmarks/core/rot13.out

@@ -0,0 +1 @@
+23

benchmarks/core/rot13.prof

@@ -0,0 +1 @@
+total_dyn_inst: 8

bril-ocaml/count/count.ml

@@ -2,22 +2,24 @@ open! Core
 open! Bril
 
 let () =
-  let (ints, bools, ptrs) =
+  let (ints, bools, floats, ptrs) =
     In_channel.input_all In_channel.stdin
     |> Yojson.Basic.from_string
     |> Bril.from_json
-    |> List.fold ~init:(0, 0, 0) ~f:(fun (ints, bools, ptrs) func ->
-           func
-           |> Bril.Func.instrs
-           |> List.fold ~init:(ints, bools, ptrs) ~f:(fun (ints, bools, ptrs) -> function
-                | Const ((_, bril_type), _)
-                | Binary ((_, bril_type), _, _, _)
-                | Unary ((_, bril_type), _, _)
-                | Call (Some (_, bril_type), _, _) ->
-                  ( match bril_type with
-                  | IntType -> (ints + 1, bools, ptrs)
-                  | BoolType -> (ints, bools + 1, ptrs)
-                  | PtrType _ -> (ints, bools, ptrs + 1))
-                | _ -> (ints, bools, ptrs)))
+    |> List.fold ~init:(0, 0, 0, 0) ~f:(fun (ints, bools, floats, ptrs) func ->
+      func
+      |> Bril.Func.instrs
+      |> List.fold ~init:(ints, bools, floats, ptrs) ~f:(fun (ints, bools, floats, ptrs) ->
+          function
+          | Const ((_, bril_type), _)
+          | Binary ((_, bril_type), _, _, _)
+          | Unary ((_, bril_type), _, _)
+          | Call (Some (_, bril_type), _, _) ->
+            (match bril_type with
+            | IntType -> (ints + 1, bools, floats, ptrs)
+            | BoolType -> (ints, bools + 1, floats, ptrs)
+            | FloatType -> (ints, bools, floats + 1, ptrs)
+            | PtrType _ -> (ints, bools, floats, ptrs + 1))
+          | _ -> (ints, bools, floats, ptrs)))
   in
-  printf "Ints: %d Bools: %d Pointers: %d \n" ints bools ptrs
+  printf "Ints: %d Bools: %d Floats: %d Pointers: %d \n" ints bools floats ptrs

bril-ocaml/lib/bril_type.ml

@@ -3,6 +3,7 @@ open! Core
 type t =
   | IntType
   | BoolType
+  | FloatType
   | PtrType of t
 [@@deriving compare, equal, sexp_of]
 
@@ -11,6 +12,7 @@ let rec of_json =
   function
   | `String "int" -> IntType
   | `String "bool" -> BoolType
+  | `String "float" -> FloatType
   | `Assoc [ ("ptr", inner) ] -> PtrType (of_json inner)
   | json -> failwithf "invalid type: %s" (json |> to_string) ()
 
@@ -21,9 +23,11 @@ let of_json_opt = function
 let rec to_json = function
   | IntType -> `String "int"
   | BoolType -> `String "bool"
+  | FloatType -> `String "float"
   | PtrType inner -> `Assoc [ ("ptr", to_json inner) ]
 
 let rec to_string = function
   | IntType -> "int"
   | BoolType -> "bool"
+  | FloatType -> "float"
   | PtrType inner -> sprintf "ptr[%s]" (to_string inner)

bril-ocaml/lib/bril_type.mli

@@ -3,6 +3,7 @@ open! Core
 type t =
   | IntType
   | BoolType
+  | FloatType
   | PtrType of t
 [@@deriving compare, equal, sexp_of]
 

bril-ocaml/lib/const.ml

@@ -4,8 +4,10 @@ open! Common
 type t =
   | Int of int
   | Bool of bool
+  | Float of float
 [@@deriving compare, equal, sexp_of]
 
 let to_string = function
   | Int i -> Int.to_string i
   | Bool b -> Bool.to_string b
+  | Float f -> Float.to_string f

bril-ocaml/lib/const.mli

@@ -4,6 +4,7 @@ open! Common
 type t =
   | Int of int
   | Bool of bool
+  | Float of float
 [@@deriving compare, equal, sexp_of]
 
 val to_string : t -> string

bril-ocaml/lib/func.ml

@@ -43,17 +43,17 @@ let process_instrs instrs =
   let order = List.map blocks ~f:fst in
   let succs =
     List.mapi blocks ~f:(fun i (name, block) ->
-        let next =
-          match List.last_exn block with
-          | Jmp label -> [ label ]
-          | Br (_, l1, l2) -> [ l1; l2 ]
-          | Ret _ -> []
-          | _ ->
-            ( match List.nth blocks (i + 1) with
-            | None -> []
-            | Some (name, _) -> [ name ] )
-        in
-        (name, next))
+      let next =
+        match List.last_exn block with
+        | Jmp label -> [ label ]
+        | Br (_, l1, l2) -> [ l1; l2 ]
+        | Ret _ -> []
+        | _ ->
+          (match List.nth blocks (i + 1) with
+          | None -> []
+          | Some (name, _) -> [ name ])
+      in
+      (name, next))
     |> String.Map.of_alist_exn
   in
   let preds =
@@ -83,40 +83,40 @@ let of_json json =
 
 let to_json t =
   `Assoc
-    ( [
-        ("name", `String t.name);
-        ( "args",
-          `List
-            (List.map t.args ~f:(fun (name, bril_type) ->
-                 `Assoc [ ("name", `String name); ("type", Bril_type.to_json bril_type) ])) );
-        ("instrs", `List (instrs t |> List.map ~f:Instr.to_json));
-      ]
-    @ Option.value_map t.ret_type ~default:[] ~f:(fun t -> [ ("type", Bril_type.to_json t) ]) )
+    ([
+       ("name", `String t.name);
+       ( "args",
+         `List
+           (List.map t.args ~f:(fun (name, bril_type) ->
+              `Assoc [ ("name", `String name); ("type", Bril_type.to_json bril_type) ])) );
+       ("instrs", `List (instrs t |> List.map ~f:Instr.to_json));
+     ]
+    @ Option.value_map t.ret_type ~default:[] ~f:(fun t -> [ ("type", Bril_type.to_json t) ]))
 
 let to_string { name; args; ret_type; blocks; order; _ } =
   let header =
     sprintf
       "@%s%s%s {"
       name
-      ( match args with
+      (match args with
       | [] -> ""
       | args ->
         sprintf
           "(%s)"
-          ( List.map args ~f:(fun (name, bril_type) ->
-                sprintf "%s: %s" name (Bril_type.to_string bril_type))
-          |> String.concat ~sep:", " ) )
+          (List.map args ~f:(fun (name, bril_type) ->
+             sprintf "%s: %s" name (Bril_type.to_string bril_type))
+          |> String.concat ~sep:", "))
       (Option.value_map ret_type ~default:"" ~f:Bril_type.to_string)
   in
   let body =
     order
     |> List.concat_map ~f:(Map.find_exn blocks)
     |> List.map ~f:(fun instr ->
-           sprintf
-             ( match instr with
-             | Label _ -> "%s:"
-             | _ -> "  %s;" )
-             (Instr.to_string instr))
+      sprintf
+        (match instr with
+        | Label _ -> "%s:"
+        | _ -> "  %s;")
+        (Instr.to_string instr))
     |> String.concat ~sep:"\n"
   in
   sprintf "%s\n%s\n}" header body
@@ -139,9 +139,9 @@ module Dominance = struct
         ~init:(Map.map preds ~f:(const String.Set.empty))
         ~f:(fun ~key:vertex ~data:vertices succs ->
           Set.fold vertices ~init:succs ~f:(fun succs pred ->
-              Map.update succs pred ~f:(function
-                  | None -> String.Set.singleton vertex
-                  | Some vertices -> Set.add vertices vertex)))
+            Map.update succs pred ~f:(function
+              | None -> String.Set.singleton vertex
+              | Some vertices -> Set.add vertices vertex)))
 
     let dominators ?(strict = false) { order; preds; succs; _ } =
       let rec postorder (visited, vertices) vertex =
@@ -157,21 +157,21 @@ module Dominance = struct
       let rec compute dom =
         let new_dom =
           List.fold vertices ~init:dom ~f:(fun dom vertex ->
-              if String.equal vertex (List.hd_exn order) then dom
-              else
-                let inter =
-                  Map.find_exn preds vertex
-                  |> List.map ~f:(Map.find_exn dom)
-                  |> List.reduce ~f:Set.inter
-                  |> Option.value ~default:String.Set.empty
-                in
-                Map.set dom ~key:vertex ~data:(Set.add inter vertex))
+            if String.equal vertex (List.hd_exn order) then dom
+            else
+              let inter =
+                Map.find_exn preds vertex
+                |> List.map ~f:(Map.find_exn dom)
+                |> List.reduce ~f:Set.inter
+                |> Option.value ~default:String.Set.empty
+              in
+              Map.set dom ~key:vertex ~data:(Set.add inter vertex))
         in
         if String.Map.equal String.Set.equal dom new_dom then dom else compute new_dom
       in
       let init =
         List.mapi order ~f:(fun i vertex ->
-            (vertex, if i = 0 then String.Set.singleton vertex else String.Set.of_list vertices))
+          (vertex, if i = 0 then String.Set.singleton vertex else String.Set.of_list vertices))
         |> String.Map.of_alist_exn
       in
       compute init |> if strict then Map.mapi ~f:(fun ~key ~data -> Set.remove data key) else Fn.id
@@ -182,25 +182,24 @@ module Dominance = struct
       let dominators = dominators ~strict:true func in
       let preds =
         Map.map dominators ~f:(fun doms ->
-            Set.fold doms ~init:doms ~f:(fun doms dom ->
-                Set.diff doms (Map.find_exn dominators dom)))
+          Set.fold doms ~init:doms ~f:(fun doms dom -> Set.diff doms (Map.find_exn dominators dom)))
       in
       (preds, preds_to_succs preds)
 
     let frontier func =
       let dominated = dominated func in
       Map.map dominated ~f:(fun dominated ->
-          Set.fold dominated ~init:String.Set.empty ~f:(fun frontier vertex ->
-              Map.find_exn func.succs vertex
-              |> List.filter ~f:(Fn.non (Set.mem dominated))
-              |> String.Set.of_list
-              |> Set.union frontier))
+        Set.fold dominated ~init:String.Set.empty ~f:(fun frontier vertex ->
+          Map.find_exn func.succs vertex
+          |> List.filter ~f:(Fn.non (Set.mem dominated))
+          |> String.Set.of_list
+          |> Set.union frontier))
 
     let back_edges func =
       let dominators = dominators func in
       Map.mapi func.succs ~f:(fun ~key ~data ->
-          List.filter data ~f:(fun succ -> Set.mem (Map.find_exn dominators key) succ)
-          |> String.Set.of_list)
+        List.filter data ~f:(fun succ -> Set.mem (Map.find_exn dominators key) succ)
+        |> String.Set.of_list)
   end
 
   module Lists : S with type out := string list = struct