From 5ed07e1e5a6223237a3be2272bde1420cb047ba3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gwena=EBl=20Delaval?= <gwenael.delaval@inria.fr>
Date: Tue, 24 Jul 2012 17:09:51 +0200
Subject: [PATCH] Removed systematic qual. of infix op as pervasives

Bug: every infix operator was systematically qualified
as pervasive.
---
 compiler/heptagon/parsing/hept_parsetree.ml   |  2 +-
 .../heptagon/parsing/hept_static_scoping.ml   | 20 +++++++++++++++++--
 2 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/compiler/heptagon/parsing/hept_parsetree.ml b/compiler/heptagon/parsing/hept_parsetree.ml
index c86d38f..7d9dcd4 100644
--- a/compiler/heptagon/parsing/hept_parsetree.ml
+++ b/compiler/heptagon/parsing/hept_parsetree.ml
@@ -266,7 +266,7 @@ let mk_call ?(params=[]) ?(inlined=false) op exps =
   Eapp (mk_app op params inlined, exps)
 
 let mk_op_call ?(params=[]) s exps =
-  mk_call ~params:params (Efun (Q (Names.pervasives_qn s))) exps
+  mk_call ~params:params (Enode (ToQ s)) exps
 
 let mk_iterator_call it ln params n_list pexps exps =
   Eiterator (it, mk_app (Enode ln) params false, n_list, pexps, exps)
diff --git a/compiler/heptagon/parsing/hept_static_scoping.ml b/compiler/heptagon/parsing/hept_static_scoping.ml
index 2569df4..c17dbf5 100644
--- a/compiler/heptagon/parsing/hept_static_scoping.ml
+++ b/compiler/heptagon/parsing/hept_static_scoping.ml
@@ -49,12 +49,28 @@ let static_exp funs local_const se =
     | _ -> ());
   Hept_parsetree_mapfold.static_exp funs local_const se
 
+(** Qualify and check for pervasiveness *)
+let qualify_pervasive q =
+  match q with
+  | ToQ name ->
+      begin
+        try
+          match (Modules.qualify_value name) with
+          | { Names.qual = Names.Pervasives } as qn -> 
+              Q qn
+          | _ -> raise Not_static
+        with Not_found -> raise Not_static
+      end
+  | Q { Names.qual = Names.Pervasives } -> q
+  | _ -> raise Not_static
+
 (** convention : static params are set as the first static args,
     op<a1,a2> (a3) == op <a1> (a2,a3) == op (a1,a2,a3) *)
 let static_app_from_app app args =
   match app.a_op with
-    | Efun ((Q { Names.qual = Names.Pervasives }) as q)
-    | Enode ((Q { Names.qual = Names.Pervasives }) as q) ->
+    | Efun q
+    | Enode q ->
+        let q = qualify_pervasive q in
         q, (app.a_params @ args)
     | _ -> raise Not_static