From 438b8e30bd7d4e186554a899d9fc86fc4bc65a9e Mon Sep 17 00:00:00 2001
From: Jonathan <jonathan@jonathan-VirtualBox.(none)>
Date: Thu, 9 Jan 2014 17:51:25 +0100
Subject: =?UTF-8?q?Impl=C3=A9mentation=20de=20la=20multiplication=20;=20co?=
 =?UTF-8?q?rrection=20d'un=20bug=20dans=20netlist=5Fgen=20;=20ajout=20de?=
 =?UTF-8?q?=20la=20localisation=20des=20erreurs=20dans=20sched/.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 cpu/netlist_printer.ml | 82 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 82 insertions(+)
 create mode 100644 cpu/netlist_printer.ml

(limited to 'cpu/netlist_printer.ml')

diff --git a/cpu/netlist_printer.ml b/cpu/netlist_printer.ml
new file mode 100644
index 0000000..2c80d70
--- /dev/null
+++ b/cpu/netlist_printer.ml
@@ -0,0 +1,82 @@
+open Netlist_ast
+open Format
+
+let rec print_env print lp sep rp ff env =
+  let first = ref true in
+  fprintf ff "%s" lp;
+  Env.iter
+    (fun x ty ->
+      if !first then
+        (first := false; fprintf ff "%a" print (x, ty))
+      else
+        fprintf ff "%s%a" sep print (x, ty)) env;
+  fprintf ff "%s" rp
+
+let rec print_list print lp sep rp ff = function
+  | [] -> ()
+  | x :: l ->
+      fprintf ff "%s%a" lp print x;
+      List.iter (fprintf ff "%s %a" sep print) l;
+      fprintf ff "%s" rp
+
+let print_ty ff n = 
+  fprintf ff " : %d" n
+
+let print_bool ff b =
+  if b then
+    fprintf ff "1"
+  else
+    fprintf ff "0"
+
+let print_value ff a =
+  Array.iter (print_bool ff) a
+
+let print_arg ff arg = match arg with
+  | Aconst v -> print_value ff v
+  | Avar id -> fprintf ff "%s" id
+
+let print_op ff op = match op with
+  | And -> fprintf ff "AND"
+  | Nand -> fprintf ff "NAND"
+  | Or -> fprintf ff "OR"
+  | Xor -> fprintf ff "XOR"
+
+let print_exp ff e = match e with
+  | Earg a -> print_arg ff a
+  | Ereg x -> fprintf ff "REG %s" x
+  | Enot x -> fprintf ff "NOT %a" print_arg x
+  | Ebinop(op, x, y) -> fprintf ff  "%a %a %a" print_op op  print_arg x  print_arg y
+  | Emux (c, x, y) -> fprintf ff "MUX %a %a %a " print_arg c  print_arg x  print_arg y
+  | Erom (addr, word, ra) -> fprintf ff "ROM %d %d %a" addr word  print_arg ra
+  | Eram (addr, word, ra, we, wa, data) ->
+      fprintf ff "RAM %d %d %a %a %a %a" addr word
+        print_arg ra  print_arg we
+        print_arg wa  print_arg data
+  | Eselect (idx, x) -> fprintf ff "SELECT %d %a" idx print_arg x
+  | Econcat (x, y) ->  fprintf ff  "CONCAT %a %a" print_arg x  print_arg y
+  | Eslice (min, max, x) -> fprintf ff "SLICE %d %d %a" min max print_arg x
+
+let print_eq ff (x, e) =
+  fprintf ff "%s = %a@." x print_exp e
+
+let print_var ff (x, ty) =
+  fprintf ff "@[%s%a@]" x print_ty ty
+
+let print_vars ff env =
+  fprintf ff "@[<v 2>VAR@,%a@]@.IN@,"
+    (print_env print_var "" ", " "") env
+
+let print_idents ff ids =
+  let print_ident ff s = fprintf ff "%s" s in
+  print_list print_ident """,""" ff ids
+
+let print_program oc p =
+  let ff = formatter_of_out_channel oc in
+  fprintf ff "INPUT %a@." print_idents p.p_inputs;
+  fprintf ff "OUTPUT %a@." print_idents p.p_outputs;
+  print_vars ff p.p_vars;
+  List.iter (print_eq ff) p.p_eqs;
+  (* flush *)
+  fprintf ff "@."
+
+
-- 
cgit v1.2.3