From 379f509dfc832f13ff997af7420899567b61c338 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= <cedric.pasteur@ens.fr>
Date: Mon, 5 Sep 2011 14:50:49 +0200
Subject: [PATCH] Added typing of signatures

This fixes a bug where mapfold would insert
untyped constants in the code.
---
 compiler/heptagon/analysis/typing.ml    | 21 +++++++++++++++++++++
 compiler/heptagon/main/hept_compiler.ml |  3 +++
 compiler/main/heptc.ml                  |  6 +++++-
 3 files changed, 29 insertions(+), 1 deletion(-)

diff --git a/compiler/heptagon/analysis/typing.ml b/compiler/heptagon/analysis/typing.ml
index 2e2247c..7297c61 100644
--- a/compiler/heptagon/analysis/typing.ml
+++ b/compiler/heptagon/analysis/typing.ml
@@ -1197,6 +1197,15 @@ let typing_typedec td =
   in
     { td with t_desc = tydesc }
 
+let typing_signature s =
+  let typing_arg cenv a =
+    { a with a_type = check_type cenv a.a_type }
+  in
+  let typed_params, cenv = build_node_params QualEnv.empty s.sig_params in
+  { s with sig_params = typed_params;
+    sig_inputs = List.map (typing_arg cenv) s.sig_inputs;
+    sig_outputs = List.map (typing_arg cenv) s.sig_outputs; }
+
 let program p =
   let program_desc pd = match pd with
     | Pnode n -> Pnode (node n)
@@ -1204,3 +1213,15 @@ let program p =
     | Ptype t -> Ptype (typing_typedec t)
   in
   { p with p_desc = List.map program_desc p.p_desc }
+
+let interface i =
+  let interface_decl i =
+    let desc = match i.interf_desc with
+      | Iconstdef c -> Iconstdef (typing_const_dec c)
+      | Itypedef t -> Itypedef (typing_typedec t)
+      | Isignature i -> Isignature (typing_signature i)
+      | id -> id
+    in
+    { i with interf_desc = desc }
+  in
+  List.map interface_decl i
diff --git a/compiler/heptagon/main/hept_compiler.ml b/compiler/heptagon/main/hept_compiler.ml
index 4825bd3..4835c4b 100644
--- a/compiler/heptagon/main/hept_compiler.ml
+++ b/compiler/heptagon/main/hept_compiler.ml
@@ -71,3 +71,6 @@ let compile_program p =
   p
 
 
+let compile_interface i =
+  let i = silent_pass "Typing" true Typing.interface i in
+  i
diff --git a/compiler/main/heptc.ml b/compiler/main/heptc.ml
index 72e6e5a..60c81ff 100644
--- a/compiler/main/heptc.ml
+++ b/compiler/main/heptc.ml
@@ -28,8 +28,12 @@ let compile_interface modname source_f =
 
   try
   (* Process the [lexbuf] to an Heptagon AST *)
-    let _ = Hept_parser_scoper.parse_interface modname lexbuf in
+    let p = Hept_parser_scoper.parse_interface modname lexbuf in
     if !print_types then Global_printer.print_interface Format.std_formatter;
+
+    (* Process the interface *)
+    let _ = Hept_compiler.compile_interface p in
+
   (* Output the .epci *)
     output_value epci_c (Modules.current_module ());
     close_all_files ()