Added polymorphic (=) and (<>) operators

These two operators really need to be polymorphic, 
so they cannot be in Pervasives. a <> b is translated
to not (a = b>) at parsing.

compiler/heptagon/analysis/causality.ml

@@ -124,7 +124,7 @@ and apply op e_list =
         let i2 = typing e2 in
         let i3 = typing e3 in
         cseq t1 (cor i2 i3)
-    | (Efun _| Enode _ | Econcat | Eselect_slice
+    | (Eequal | Efun _| Enode _ | Econcat | Eselect_slice
       | Eselect_dyn | Eselect _ | Earray_fill), e_list ->
         ctuplelist (List.map typing e_list)
     | (Earray | Etuple), e_list ->

compiler/heptagon/analysis/typing.ml

@@ -623,6 +623,11 @@ and expect const_env h expected_ty e =
 
 and typing_app const_env h op e_list =
   match op, e_list with
+    | { a_op = Eequal }, [e1;e2] ->
+        let typed_e1, t1 = typing const_env h e1 in
+        let typed_e2 = expect const_env h t1 e2 in
+          Tid Initial.pbool, op, [typed_e1; typed_e2]
+
     | { a_op = Earrow }, [e1;e2] ->
         let typed_e1, t1 = typing const_env h e1 in
         let typed_e2 = expect const_env h t1 e2 in

compiler/heptagon/hept_printer.ml

@@ -102,6 +102,8 @@ and print_call_params ff = function
 
 and print_op ff op params e_list =
   match op, params, e_list with
+    | Eequal, _, [e1; e2] ->
+        fprintf ff "@[<2>%a@ = %a@]" print_exp e1  print_exp e2
     | Earrow, _, [e1;e2] -> print_exp ff e1; fprintf ff " -> "; print_exp ff e2
     | Eifthenelse, _, [e1;e2;e3] ->
         fprintf ff "@["; fprintf ff "if "; print_exp ff e1;

compiler/heptagon/heptagon.ml

@@ -38,6 +38,7 @@ and desc =
 and app = { a_op: op; a_params: static_exp list; a_unsafe: bool }
 
 and op =
+  | Eequal
   | Etuple
   | Efun of fun_name
   | Enode of fun_name

compiler/heptagon/parsing/hept_lexer.mll

@@ -131,6 +131,7 @@ rule token = parse
   | ";"             {SEMICOL}
   | "="             {EQUAL}
   | "=="            {EQUALEQUAL}
+  | "<>"            {LESS_GREATER}
   | "&"             {AMPERSAND}
   | "&&"            {AMPERAMPER}
   | "||"            {BARBAR}

compiler/heptagon/parsing/hept_parser.mly

@@ -10,7 +10,7 @@ open Hept_parsetree
 %}
 
 %token DOT LPAREN RPAREN LBRACE RBRACE COLON SEMICOL
-%token EQUAL EQUALEQUAL BARBAR COMMA BAR ARROW LET TEL
+%token EQUAL EQUALEQUAL LESS_GREATER BARBAR COMMA BAR ARROW LET TEL
 %token <string> Constructor
 %token <string> IDENT
 %token <int> INT
@@ -63,7 +63,7 @@ open Hept_parsetree
 %right ARROW
 %left OR
 %left AMPERSAND
-%left INFIX0 EQUAL
+%left INFIX0 EQUAL LESS_GREATER
 %right INFIX1
 %left INFIX2 SUBTRACTIVE
 %left STAR INFIX3
@@ -425,7 +425,10 @@ _exp:
   | exp INFIX0 exp
       { mk_op_call $2 [$1; $3] }
   | exp EQUAL exp
-      { mk_op_call "=" [$1; $3] }
+      { mk_call Eequal [$1; $3] }
+  | exp LESS_GREATER exp
+      { let e = mk_exp (mk_call Eequal [$1; $3]) (Loc($startpos,$endpos)) in
+          mk_op_call "not" [e] }
   | exp OR exp
       { mk_op_call "or" [$1; $3] }
   | exp STAR exp

compiler/heptagon/parsing/hept_parsetree.ml

@@ -41,6 +41,7 @@ and desc =
 and app = { a_op: op; a_params: exp list; }
 
 and op =
+  | Eequal
   | Etuple
   | Enode of longname
   | Efun of longname

compiler/heptagon/parsing/hept_scoping.ml

@@ -185,6 +185,7 @@ and translate_desc loc const_env env = function
                           app, n, e_list, None)
 
 and translate_op = function
+  | Eequal -> Heptagon.Eequal
   | Earrow -> Heptagon.Earrow
   | Eifthenelse -> Heptagon.Eifthenelse
   | Efield -> Heptagon.Efield

compiler/main/hept2mls.ml

@@ -196,6 +196,7 @@ let translate_iterator_type = function
   | Heptagon.Imapfold -> Imapfold
 
 let rec translate_op env = function
+  | Heptagon.Eequal -> Eequal
   | Heptagon.Eifthenelse -> Eifthenelse
   | Heptagon.Efun f -> Efun f
   | Heptagon.Enode f -> Enode f

compiler/main/mls2obc.ml

@@ -69,6 +69,8 @@ let rec translate map (si, j, s) e =
   let desc = match e.Minils.e_desc with
     | Minils.Econst v -> Econst v
     | Minils.Evar n -> Elhs (var_from_name map n)
+    | Minils.Eapp ({ Minils.a_op = Minils.Eequal }, e_list, _) ->
+        Eop (op_from_string "=", List.map (translate map (si, j, s)) e_list)
     | Minils.Eapp ({ Minils.a_op = Minils.Efun n },
                    e_list, _) when Mls_utils.is_op n ->
         Eop (n, List.map (translate map (si, j, s)) e_list)

compiler/minils/analysis/clocking.ml

@@ -62,7 +62,7 @@ let rec typing h e =
   in (e.e_ck <- ckofct ct; ct)
 
 and typing_op op args h e ck = match op, args with
-  | (Efun _ | Enode _), e_list ->
+  | (Eequal | Efun _ | Enode _), e_list ->
       (List.iter (expect h (Ck ck)) e_list; skeleton ck e.e_ty)
   | Etuple, e_list ->
       Cprod (List.map (typing h) e_list)

compiler/minils/minils.ml

@@ -65,6 +65,7 @@ and app = { a_op: op; a_params: static_exp list; a_unsafe: bool }
         and be delicate about optimizations, !be careful! *)
 
 and op =
+  | Eequal             (** arg1 = arg2 *)
   | Etuple             (** (args) *)
   | Efun of fun_name   (** "Stateless" longname <<a_params>> (args) reset r *)
   | Enode of fun_name  (** "Stateful" longname <<a_params>> (args) reset r *)

compiler/minils/mls_printer.ml

@@ -111,6 +111,8 @@ and print_exp_desc ff = function
         print_every reset
 
 and print_app ff (app, args) = match app.a_op, app.a_params, args with
+  | Eequal, _, [e1; e2] ->
+      fprintf ff "@[<2>%a@ = %a@]" print_exp e1  print_exp e2
   | Etuple, _, a -> print_exp_tuple ff a
   | (Efun(f)|Enode(f)), p, a ->
       fprintf ff "@[%a@,%a@,%a@]"

compiler/minils/transformations/normalize.ml

@@ -146,6 +146,7 @@ let add context expected_kind ({ e_desc = de } as e) =
     | _ , VRef -> true
     | Eapp ({ a_op = Efun n }, _, _),
         (Exp|Act) when is_op n -> false
+    | Eapp ({ a_op = Eequal }, _, _), (Exp|Act) -> false
     | ( Emerge _ | Eapp _ | Eiterator _ | Efby _ ), Exp -> true
     | ( Eapp({ a_op = Efun _ | Enode _ }, _, _)
       | Eiterator _ | Efby _ ), Act -> true
@@ -213,7 +214,7 @@ let rec translate kind context e =
 
 and translate_app kind context op e_list =
   match op, e_list with
-    | (Efun _ | Enode _), e_list ->
+    | (Eequal | Efun _ | Enode _), e_list ->
         let context, e_list =
           translate_list function_args_kind context e_list in
         context, e_list

lib/pervasives.epi

@@ -17,10 +17,6 @@ val fun (<=)(int;int) returns (bool)
 val fun (<=.)(float;float) returns (bool)
 val fun (<)(int;int) returns (bool)
 val fun (<.)(float;float) returns (bool)
-val fun (<>)(int;int) returns (bool)
-val fun (<>.)(float;float) returns (bool)
-val fun (=)(int;int) returns (bool)
-val fun (=.)(float;float) returns (bool)
 val fun (>=)(int;int) returns (bool)
 val fun (>=.)(float;float) returns (bool)
 val fun (>)(int;int) returns (bool)