Fix handling of intersection of polymoprhic types in regular expression.

parser/ast.ml

@@ -149,3 +149,15 @@ let re_seq e1 e2 =
   Epsilon, _ -> e2
   | _, Epsilon -> e1
   | _ -> Seq (e1, e2)
+
+let rec print_re fmt e =
+  match e with
+    Epsilon -> Format.fprintf fmt "Epsilon"
+  | Elem _ -> Format.fprintf fmt "Elem"
+  | Guard _ -> Format.fprintf fmt "Guard"
+  | Seq (e1, e2) -> Format.fprintf fmt "Seq(%a, %a)" print_re e1 print_re e2
+  | Alt (e1, e2) -> Format.fprintf fmt "Alt(%a, %a)" print_re e1 print_re e2
+  | Star (e0) -> Format.fprintf fmt "Star(%a)" print_re e0
+  | WeakStar (e0) -> Format.fprintf fmt "WeakStar(%a)" print_re e0
+  | SeqCapture (_, e0) -> Format.fprintf fmt "SeqCapture(_, %a)" print_re e0
+  | Arg (e0) -> Format.fprintf fmt "Arg(%a)" print_re e0

parser/parser.ml

@@ -544,8 +544,8 @@ EXTEND Gram
   | [ x = regexp; y = regexp -> re_seq x y ]
   | [ x = regexp ; op = [ "&" -> "&" | "\\" -> "\\" ] ; y = regexp ->
       let rec unseq e = match e with
-        Elem _ -> e
-        | Seq(Elem { descr = PatVar (ids, []); loc}, e0) ->
+          Elem _ -> e
+        | Seq(Elem { descr = PatVar (ids, []); loc}, Arg (e0)) ->
           let ue0 = unseq e0 in begin
             match ue0 with
             | Elem p -> Elem {loc; descr = PatVar(ids, prod_to_list p) }
@@ -553,10 +553,11 @@ EXTEND Gram
           end
         | _ -> e
       in
-      match unseq x, unseq y, op with
-	  |  Elem x, Elem y, "&" -> Elem (mk _loc (And (x,y)))
-          |  Elem x, Elem y, _ -> Elem (mk _loc (Diff (x,y)))
-	  | _ -> error _loc ( op ^ " not allowed in regular expression")
+      match unseq x, unseq y with
+      |  (Elem x | Arg (Elem x)), (Elem y | Arg (Elem y)) ->
+        let res = if op = "&" then And (x, y) else Diff (x, y) in
+        Elem (mk _loc res)
+      | _ -> error _loc ( op ^ " not allowed in regular expression")
     ]
   | "capture" [ a = IDENT; "::"; x = regexp -> SeqCapture ((lop _loc,ident a),x) ]
   | [ x = regexp; "*" -> Star x

typing/typer.ml

@@ -374,18 +374,6 @@ module IType = struct
     | Arg e0 -> clean_re e0
     | _ -> e
 
-  let rec print_re fmt e =
-    match e with
-    Epsilon -> Format.fprintf fmt "Epsilon"
-    | Elem _ -> Format.fprintf fmt "Elem"
-    | Guard _ -> Format.fprintf fmt "Guard"
-    | Seq (e1, e2) -> Format.fprintf fmt "Seq(%a, %a)" print_re e1 print_re e2
-    | Alt (e1, e2) -> Format.fprintf fmt "Alt(%a, %a)" print_re e1 print_re e2
-    | Star (e0) -> Format.fprintf fmt "Star(%a)" print_re e0
-    | WeakStar (e0) -> Format.fprintf fmt "WeakStar(%a)" print_re e0
-    | SeqCapture (_, e0) -> Format.fprintf fmt "SeqCapture(_, %a)" print_re e0
-    | Arg (e0) -> Format.fprintf fmt "Arg(%a)" print_re e0
-
   (* Ast -> symbolic type *)
   let rec derecurs env p =
     match p.descr with