classes d'operateurs 1 2 3 et 4

src/parser/lexer.mll

@@ -127,6 +127,14 @@ let int_literal =
   decimal_literal | hex_literal | oct_literal | bin_literal
 let hexadigit = ['0'-'9' 'a'-'f' 'A'-'F']
 
+let op_char_1 = ['=' '<' '>']
+let op_char_2 = ['+' '-']
+let op_char_3 = ['*' '/' '%']
+let op_char_4 = ['!' '$' '&' '?' '@' '^' '~' '.' ':' '|' '#']
+let op_char_34 = op_char_3 | op_char_4
+let op_char_234 = op_char_2 | op_char_34
+let op_char_1234 = op_char_1 | op_char_234
+
 rule token = parse
   | "#" space* ("\"" ([^ '\010' '\013' '"' ]* as file) "\"")?
     space* (digit+ as line) space* (digit+ as char) space* "#"
@@ -168,22 +176,24 @@ rule token = parse
       { ARROW }
   | "<->"
       { LRARROW }
-  | "="
-      { EQUAL }
-  | "<>" | "<" | "<=" | ">" | ">=" as s
-      { OP0 s }
-  | "+" | "-" as c
-      { OP2 (String.make 1 c) }
-  | "*" | "/" | "%" | "!" as c
-      { OP3 (String.make 1 c) }
   | "."
       { DOT }
+  | "|"
+      { BAR }
+  | "="
+      { EQUAL }
   | "["
       { LEFTSQ }
   | "]"
       { RIGHTSQ }
-  | "|"
-      { BAR }
+  | op_char_1234* op_char_1 op_char_1234* as s
+      { OP1 s }
+  | op_char_234*  op_char_2 op_char_234*  as s
+      { OP2 s }
+  | op_char_34*   op_char_3 op_char_34*  as s
+      { OP3 s }
+  | op_char_4+ as s
+      { OP4 s }
   | "\""
       { string_start_loc := loc lexbuf; STRING (string lexbuf) }
   | eof 

src/parser/parser.mly

@@ -40,7 +40,6 @@
 
   let infix s = "infix " ^ s
   let prefix s = "prefix " ^ s
-  let postfix s = "postfix " ^ s
 
 %}
 
@@ -48,7 +47,7 @@
 
 %token <string> LIDENT UIDENT
 %token <string> INTEGER
-%token <string> OP0 OP1 OP2 OP3
+%token <string> OP1 OP2 OP3 OP4
 %token <Ptree.real_constant> FLOAT
 %token <string> STRING
 
@@ -88,12 +87,11 @@
 %right OR 
 %right AND 
 %nonassoc NOT
-%left EQUAL OP0
-%left OP1
+%left EQUAL OP1
 %left OP2
 %left OP3
+%left OP4
 %nonassoc prefix_op
-%nonassoc postfix_op
 
 /* Entry points */
 
@@ -148,23 +146,21 @@ lident_rich:
     { { id = infix $3; id_loc = loc () } }
 | LEFTPAR lident_op UNDERSCORE RIGHTPAR 
     { { id = prefix $2; id_loc = loc () } }
-/*
-| LEFTPAR UNDERSCORE lident_op RIGHTPAR 
-    { { id = postfix $3; id_loc = loc () } }
-*/
 ;
 
 lident_op:
-| OP0   { $1 }
+| OP1   { $1 }
 | OP2   { $1 }
 | OP3   { $1 }
+| OP4   { $1 }
 | EQUAL { "=" }
 ;
 
 any_op:
-| OP0   { $1 }
+| OP1   { $1 }
 | OP2   { $1 }
 | OP3   { $1 }
+| OP4   { $1 }
 ;
 
 uident:
@@ -362,9 +358,6 @@ lexpr:
 | lexpr EQUAL lexpr 
    { let id = { id = infix "="; id_loc = loc_i 2 } in
      mk_pp (PPapp (Qident id, [$1; $3])) }
-| lexpr OP0 lexpr 
-   { let id = { id = infix $2; id_loc = loc_i 2 } in
-     mk_pp (PPapp (Qident id, [$1; $3])) }
 | lexpr OP1 lexpr 
    { let id = { id = infix $2; id_loc = loc_i 2 } in
      mk_pp (PPapp (Qident id, [$1; $3])) }
@@ -374,14 +367,12 @@ lexpr:
 | lexpr OP3 lexpr 
    { let id = { id = infix $2; id_loc = loc_i 2 } in
      mk_pp (PPapp (Qident id, [$1; $3])) }
+| lexpr OP4 lexpr 
+   { let id = { id = infix $2; id_loc = loc_i 2 } in
+     mk_pp (PPapp (Qident id, [$1; $3])) }
 | any_op lexpr %prec prefix_op
    { let id = { id = prefix $1; id_loc = loc_i 2 } in
      mk_pp (PPapp (Qident id, [$2])) }
-/*
-| lexpr any_op %prec postfix_op
-   { let id = { id = postfix $2; id_loc = loc_i 2 } in
-     mk_pp (PPapp (Qident id, [$1])) }
-*/
 | qualid
    { mk_pp (PPvar $1) }
 | qualid LEFTPAR list1_lexpr_sep_comma RIGHTPAR

src/programs/pgm_main.ml

@@ -69,7 +69,7 @@ let type_file file =
     List.fold_left
       (fun uc d -> match d with
 	 | Dlogic dl -> List.fold_left (Typing.add_decl env Mnm.empty) uc dl
-	 | Dcode (id, e) -> ignore (Pgm_typing.code id e); uc)
+	 | Dcode (id, e) -> ignore (Pgm_typing.code uc id e); uc)
       uc p
   in
   ()

src/programs/pgm_parser.mly

@@ -28,8 +28,8 @@
   let loc_i i = (rhs_start_pos i, rhs_end_pos i)
   let loc_ij i j = (rhs_start_pos i, rhs_end_pos j)
 
-  let mk_expr d = { expr_loc = loc (); expr_desc = d }
-  let mk_expr_i i d = { expr_loc = loc_i i; expr_desc = d }
+  let mk_expr d = { expr_loc = loc (); expr_info = (); expr_desc = d }
+  let mk_expr_i i d = { expr_loc = loc_i i; expr_info = (); expr_desc = d }
  
   (* FIXME: factorize with parser/parser.mly *)
   let infix s = "infix " ^ s
@@ -45,10 +45,12 @@
 	Eapply (f, a)
     | a :: l -> 
 	let loc = join f.expr_loc a.expr_loc in 
-	mk_apply { expr_loc = loc; expr_desc = Eapply (f, a) } l
+	mk_apply { expr_loc = loc; expr_info = (); expr_desc = Eapply (f, a) } l
 
   let mk_apply_id id = 
-    let e = { expr_desc = Eident (Qident id); expr_loc = id.id_loc } in
+    let e = 
+      { expr_desc = Eident (Qident id); expr_info = (); expr_loc = id.id_loc } 
+    in
     mk_apply e
       
   let mk_infix e1 op e2 =

src/programs/pgm_ptree.mli

@@ -27,33 +27,36 @@ type constant = Term.constant
 
 type assertion_kind = Aassert | Aassume | Acheck
 
+type lexpr = Ptree.lexpr
+
 type loop_annotation = {
-  loop_invariant : Ptree.lexpr option;
-  loop_variant   : Ptree.lexpr option;
+  loop_invariant : lexpr option;
+  loop_variant   : lexpr option;
 }
 
-type expr = {
-  expr_desc : expr_desc;
+type 'info expr = {
+  expr_desc : 'info expr_desc;
   expr_loc  : loc;
+  expr_info : 'info;
 }
 
-and expr_desc =
+and 'info expr_desc =
   | Econstant of constant
   | Eident of qualid
-  | Eapply of expr * expr
-  | Esequence of expr * expr
-  | Eif of expr * expr * expr
+  | Eapply of 'info expr * 'info expr
+  | Esequence of 'info expr * 'info expr
+  | Eif of 'info expr * 'info expr * 'info expr
   | Eskip 
-  | Eassert of assertion_kind * Ptree.lexpr
-  | Elazy_and of expr * expr
-  | Elazy_or of expr * expr
-  | Elet of ident * expr * expr
-  | Eghost of expr
-  | Elabel of ident * expr
-  | Ewhile of expr * loop_annotation * expr
+  | Eassert of assertion_kind * lexpr
+  | Elazy_and of 'info expr * 'info expr
+  | Elazy_or of 'info expr * 'info expr
+  | Elet of ident * 'info expr * 'info expr
+  | Eghost of 'info expr
+  | Elabel of ident * 'info expr
+  | Ewhile of 'info expr * loop_annotation * 'info expr
 
 type decl =
-  | Dcode  of ident * expr
+  | Dcode  of ident * unit expr
   | Dlogic of Ptree.decl list
 
 type file = decl list

src/programs/pgm_typing.ml

@@ -17,8 +17,38 @@
 (*                                                                        *)
 (**************************************************************************)
 
-let code id e =
-  assert false (*TODO*)
+open Theory
+open Pgm_ptree
+
+type env = {
+  env_uc : theory_uc;
+}
+
+let create_env uc = assert false (*TODO*)
+
+let rec expr env e = 
+  let d, ty = expr_desc env e.expr_loc e.expr_desc in
+  { expr_desc = d; expr_info = ty; expr_loc = e.expr_loc }
+
+and expr_desc env loc = function
+_ -> assert false (*TODO*)
+(*   | Econstant of constant *)
+(*   | Eident of qualid *)
+(*   | Eapply of 'info expr * 'info expr *)
+(*   | Esequence of 'info expr * 'info expr *)
+(*   | Eif of 'info expr * 'info expr * 'info expr *)
+(*   | Eskip  *)
+(*   | Eassert of assertion_kind * lexpr *)
+(*   | Elazy_and of 'info expr * 'info expr *)
+(*   | Elazy_or of 'info expr * 'info expr *)
+(*   | Elet of ident * 'info expr * 'info expr *)
+(*   | Eghost of 'info expr *)
+(*   | Elabel of ident * 'info expr *)
+(*   | Ewhile of 'info expr * loop_annotation * 'info expr *)
+
+let code uc id e =
+  let env = create_env uc in
+  ignore (expr env e)
 
 (*
 Local Variables: 

src/test.why

@@ -27,8 +27,8 @@ end
 
 theory Test_conjunction
        use import prelude.Int
-       goal G : forall x:int. x*x=4 -> ((x*x*x=8 or x*x*x=-8) and x*x*2 = 8)
-       goal G2 : forall x:int. (x+x=4 or x*x=4) -> ((x*x*x=8 or x*x*x=-8) and x*x*2 = 8)
+       goal G : forall x:int. x*x=4 -> ((x*x*x=8 or x*x*x = -8) and x*x*2 = 8)
+       goal G2 : forall x:int. (x+x=4 or x*x=4) -> ((x*x*x=8 or x*x*x = -8) and x*x*2 = 8)
 end
 
 theory Split_conj