From d7d7552be442d74398ded6af40de97d9006c82ce Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9onard=20G=C3=A9rard?= <leonard.gerard@ens.fr>
Date: Thu, 19 May 2011 14:40:04 +0200
Subject: [PATCH] Fix printing and parsing of clocks

---
 compiler/heptagon/hept_printer.ml         | 9 ++++++---
 compiler/heptagon/parsing/hept_parser.mly | 4 ++--
 compiler/minils/analysis/clocking.ml      | 8 ++++----
 compiler/minils/mls_printer.ml            | 4 ++--
 4 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/compiler/heptagon/hept_printer.ml b/compiler/heptagon/hept_printer.ml
index 61e6be7..cea9782 100644
--- a/compiler/heptagon/hept_printer.ml
+++ b/compiler/heptagon/hept_printer.ml
@@ -63,6 +63,9 @@ let print_const_dec ff c =
     fprintf ff "const %a = %a@."
       print_qualname c.c_name print_static_exp c.c_value
 
+let print_ct_annot ff = function
+  | None -> ()
+  | Some ct -> fprintf ff " :: %a" print_ct ct
 
 let rec print_params ff l =
   fprintf ff "@[<2>%a@]" (print_list_r print_static_exp "<<"","">>") l
@@ -90,9 +93,9 @@ and print_exps ff e_list =
 
 and print_exp ff e =
  if !Compiler_options.full_type_info then
-    fprintf ff "(%a : %a)"
-      print_exp_desc e.e_desc print_type e.e_ty
-  else fprintf ff "%a" print_exp_desc e.e_desc
+    fprintf ff "(%a : %a%a)"
+      print_exp_desc e.e_desc print_type e.e_ty print_ct_annot e.e_ct_annot
+  else fprintf ff "%a%a" print_exp_desc e.e_desc print_ct_annot e.e_ct_annot
 
 and print_exp_desc ff = function
   | Evar x -> print_ident ff x
diff --git a/compiler/heptagon/parsing/hept_parser.mly b/compiler/heptagon/parsing/hept_parser.mly
index 8593d02..75506ae 100644
--- a/compiler/heptagon/parsing/hept_parser.mly
+++ b/compiler/heptagon/parsing/hept_parser.mly
@@ -424,7 +424,7 @@ exps:
 
 simple_exp:
   | e=_simple_exp { mk_exp e (Loc($startpos,$endpos)) }
-  | LPAREN exp RPAREN { $2 }
+  | LPAREN e=exp ct=ct_annot RPAREN { { e with e_ct_annot = ct} }
 _simple_exp:
   | IDENT                            { Evar $1 }
   | const                            { Econst $1 }
@@ -443,7 +443,7 @@ merge_handler:
   | LPAREN c=constructor_or_bool ARROW e=exp RPAREN { (c,e) }
 
 exp:
-  | e=simple_exp ct=ct_annot { { e with e_ct_annot = ct } }
+  | e=simple_exp { e }
   | e=_exp { mk_exp e (Loc($startpos,$endpos)) }
 _exp:
   | simple_exp FBY exp
diff --git a/compiler/minils/analysis/clocking.ml b/compiler/minils/analysis/clocking.ml
index b5edd17..59d5717 100644
--- a/compiler/minils/analysis/clocking.ml
+++ b/compiler/minils/analysis/clocking.ml
@@ -97,7 +97,7 @@ let typing_app h base pat op w_list = match op with
       in
       let env_pat = build_env node.node_outputs pat_id_list [] in
       let env_args = build_env node.node_inputs w_list [] in
-(* implement with Cbase as base, replace name dep by ident dep *)
+      (* implement with Cbase as base, replace name dep by ident dep *)
       let rec sigck_to_ck sck = match sck with
         | Signature.Cbase -> base
         | Signature.Con (sck,c,x) ->
@@ -120,7 +120,7 @@ let typing_app h base pat op w_list = match op with
 
 
 
-let typing_eq h { eq_lhs = pat; eq_rhs = e } =
+let typing_eq h { eq_lhs = pat; eq_rhs = e; eq_loc = loc } =
   (* typing the expression, returns ct, ck_base *)
   let rec typing e =
     let ct,base = match e.e_desc with
@@ -197,12 +197,12 @@ let typing_eq h { eq_lhs = pat; eq_rhs = e } =
      with Unify -> error_message e.e_loc (Etypeclash (actual_ct, expected_ct)));
     base
   in
-  let ct,base = typing e in
+  let ct,_ = typing e in
   let pat_ct = typing_pat h pat in
   (try unify ct pat_ct
     with Unify ->
       eprintf "Incoherent clock between right and left side of the equation.@\n";
-      error_message e.e_loc (Etypeclash (ct, pat_ct)))
+      error_message loc (Etypeclash (ct, pat_ct)))
 
 let typing_eqs h eq_list = List.iter (typing_eq h) eq_list
 
diff --git a/compiler/minils/mls_printer.ml b/compiler/minils/mls_printer.ml
index 138e3de..6e9abfd 100644
--- a/compiler/minils/mls_printer.ml
+++ b/compiler/minils/mls_printer.ml
@@ -29,9 +29,9 @@ let rec print_pat ff = function
       fprintf ff "@[<2>(%a)@]" (print_list_r print_pat """,""") pat_list
 
 let print_vd ff { v_ident = n; v_type = ty; v_clock = ck } =
-  if !Compiler_options.full_type_info then
+ (* if !Compiler_options.full_type_info then*)
     fprintf ff "%a : %a :: %a" print_ident n print_type ty print_ck ck
-  else fprintf ff "%a : %a" print_ident n print_type ty
+  (*else fprintf ff "%a : %a" print_ident n print_type ty*)
 
 let print_local_vars ff = function
   | [] -> ()