[r2003-11-27 11:14:38 by afrisch] Eviter collisions avec namespaces + factorisation

Original author: afrisch
Date: 2003-11-27 11:14:38+00:00

parser/parser.ml

@@ -91,6 +91,16 @@ let is_fun_decl =
 	 | _ -> raise Stream.Failure
      )
 
+let pat_true = mknoloc (Internal true_type)
+let pat_false = mknoloc (Internal false_type) 
+let const_true = Const (Types.Atom (true_atom))
+let const_false = Const (Types.Atom (false_atom))
+
+let logical_and e1 e2 = Match (e1, [pat_true,e2; pat_false,const_false])
+let logical_or e1 e2 = Match (e1, [pat_true,const_true; pat_false,e2])
+let logical_not e = Match (e, [pat_true,const_false; pat_false,const_true])
+
+
 EXTEND
   GLOBAL: top_phrases prog expr pat regexp keyword;
 
@@ -228,11 +238,7 @@ EXTEND
 	exp loc (Match (e1, [pat_nil,e2]))
     | "ref"; p = pat; e = expr ->
 	exp loc (Ref (e,p))
-    | "not"; e = expr ->
-	let p1 = mknoloc (Internal true_type)
-	and p2 = mknoloc (Internal false_type) in
-	exp loc (Match (e, [p1,Const (Types.Atom (false_atom)); 
-			     p2,Const (Types.Atom (true_atom))]))       
+    | "not"; e = expr -> exp loc (logical_not e)
     ]
     |
     [ e1 = expr; ":="; e2 = expr ->
@@ -250,19 +256,13 @@ EXTEND
     | 
     [ e1 = expr; op = ["+" | "-" | "@" ]; e2 = expr -> 
 	exp loc (Op (op,[e1;e2]))
-    | e1 = expr; "||"; e2 = expr ->
-	let p1 = mknoloc (Internal true_type)
-	and p2 = mknoloc (Internal false_type) in
-	exp loc (Match (e1, [p1,Const (Types.Atom (true_atom)); p2,e2]))       
+    | e1 = expr; "||"; e2 = expr -> exp loc (logical_or e1 e2)
     | e = expr; "\\"; l = [IDENT | keyword ] -> 
 	exp loc (RemoveField (e, label l)) 
     ]
     |
     [ e1 = expr; op = ["*"]; e2 = expr -> exp loc (Op (op,[e1;e2]))  
-    | e1 = expr; "&&"; e2 = expr ->
-	let p1 = mknoloc (Internal true_type)
-	and p2 = mknoloc (Internal false_type) in
-	exp loc (Match (e1, [p1,e2;p2,Const (Types.Atom (false_atom))]))       
+    | e1 = expr; "&&"; e2 = expr -> exp loc (logical_and e1 e2)
     | e = expr; op = "/"; p = pat ->
 
 	let tag = mk loc (Internal (Types.atom (Atoms.any))) in

parser/parser.mli

@@ -14,4 +14,10 @@ module Hook: sig
   val expr: Ast.pexpr Grammar.Entry.e
   val pat: Ast.ppat Grammar.Entry.e
   val keyword: string Grammar.Entry.e
-end
\ No newline at end of file
+end
+
+(* Helpers *)
+
+val logical_and: Ast.pexpr -> Ast.pexpr -> Ast.pexpr
+val logical_or: Ast.pexpr -> Ast.pexpr -> Ast.pexpr
+val logical_not: Ast.pexpr -> Ast.pexpr

query/query.ml

@@ -25,23 +25,9 @@ let false_type = Types.atom (Atoms.atom false_atom)
 
 
 
-let ou(loc,e1,e2)=
-        let ptrue = mk loc (Internal true_type)
-	and pfalse = mk loc (Internal false_type)
-        in exp loc (Match (e1, [ptrue, exp loc (Atom(U.mk "true")); pfalse,e2]))
-
-let et(loc,e1,e2)=
-        let ptrue = mk loc (Internal true_type)
-	and pfalse = mk loc (Internal false_type)
-	in exp loc (Match (e1, [pfalse,(exp loc
-               (Atom(U.mk "false"))); ptrue,e2]))
-
-let non(loc,e) = 
-	let ptrue = mk loc (Internal true_type)
-	and pfalse = mk loc (Internal false_type)
-	in exp loc (Match(e ,
-	  [pfalse,(exp loc(Atom(U.mk "true")));
-	  ptrue,( exp loc(Atom(U.mk "false")))]))
+let ou (loc,e1,e2)= exp loc (Parser.logical_or e1 e2)
+let et (loc,e1,e2)= exp loc (Parser.logical_and e1 e2)
+let non (loc,e) = exp loc (Parser.logical_not e)
 
 
 type 'a  boolFormula =
@@ -347,7 +333,9 @@ let rec purge e =
 
 (* code pas beau du tout, a reprendre clairement, c est pour evaluer que a="2"
 est equivalent a "2"=a il reste a faire plusieurs petites choses encore...*)
-let rec egal_expr(e1,e2) =
+let rec egal_expr(e1,e2) = e1 == e2
+  (* On desactive cette optimisation pour le moment... *)
+(*
  let egal_expr2(e1,e2)= string_of_pexpr(e1)=string_of_pexpr(e2) || egal_expr(e1,e2)
  in match (purge(e1),purge(e2)) with
   (Var(e1),Var(e2)) -> e1=e2
@@ -356,6 +344,7 @@ let rec egal_expr(e1,e2) =
                     || (op1="=" && (egal_expr2(e1,e4) && egal_expr2(e2,e3))))
        
   |_ -> false
+*)
 
 let rec appartient(t,l) =
 	match (t,l) with