Commit 5cace08c authored by Kim Nguyễn's avatar Kim Nguyễn

Refine the heurstics used to disambiguate the parsing of types in regular expressions.

Add more test cases to the the pretty printer/parser test suite.
parent 1be14ed0
...@@ -85,6 +85,17 @@ let seq_of_string s = ...@@ -85,6 +85,17 @@ let seq_of_string s =
in in
aux (Encodings.Utf8.start_index s) (Encodings.Utf8.end_index s) aux (Encodings.Utf8.start_index s) (Encodings.Utf8.end_index s)
let rec unseq e = match e with
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) }
| _ -> e
end
| Arg e -> unseq e
| _ -> e
let parse_char loc s = let parse_char loc s =
match seq_of_string s with match seq_of_string s with
| [ c ] -> c | [ c ] -> c
...@@ -538,22 +549,20 @@ EXTEND Gram ...@@ -538,22 +549,20 @@ EXTEND Gram
| _ -> Alt (x, y) | _ -> Alt (x, y)
] ]
| [ x = regexp; y = regexp -> re_seq x y ] | [ x = regexp; y = regexp -> re_seq x y ]
| [ x = regexp ; op = [ "->" -> "->" ] ; y = regexp ->
match unseq x, unseq y with
| Elem x , Elem y -> Elem (mk _loc (Arrow (x, y)))
| _ -> error _loc ( op ^ " not allowed in regular expression")
]
| [ x = regexp ; op = [ "&" -> "&" | "\\" -> "\\" ] ; y = regexp -> | [ x = regexp ; op = [ "&" -> "&" | "\\" -> "\\" ] ; y = regexp ->
let rec unseq e = match e with
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) }
| _ -> e
end
| _ -> e
in
match unseq x, unseq y with match unseq x, unseq y with
| Elem x , Elem y -> | Elem x , Elem y ->
let res = if op = "&" then And (x, y) else Diff (x, y) in let res =
if op = "&" then And (x, y) else Diff (x, y)
in
Elem (mk _loc res) Elem (mk _loc res)
| _ -> error _loc ( op ^ " not allowed in regular expression") | _ ->
error _loc ( op ^ " not allowed in regular expression")
] ]
| "capture" [ a = IDENT; "::"; x = regexp -> SeqCapture ((lop _loc,ident a),x) ] | "capture" [ a = IDENT; "::"; x = regexp -> SeqCapture ((lop _loc,ident a),x) ]
| [ x = regexp; "*" -> Star x | [ x = regexp; "*" -> Star x
......
...@@ -14,6 +14,8 @@ ...@@ -14,6 +14,8 @@
include "prologue.cd" include "prologue.cd"
(* Basic *)
let x000 : Any = raise [] let x000 : Any = raise []
let x001 : Int = raise [] let x001 : Int = raise []
let x002 : Bool = raise [] let x002 : Bool = raise []
...@@ -31,4 +33,21 @@ let x013 : X1 where X1 = [ ( 'a \ [Any*] | X1)* ] = raise [] ...@@ -31,4 +33,21 @@ let x013 : X1 where X1 = [ ( 'a \ [Any*] | X1)* ] = raise []
let x014 : [ ( 'a \ [Any*] )* ] = raise [] let x014 : [ ( 'a \ [Any*] )* ] = raise []
let x015 : X1 where X1 = <a > [ X1* ] | <b foo=Int > [ X1* ] = raise [] let x015 : X1 where X1 = <a > [ X1* ] | <b foo=Int > [ X1* ] = raise []
let x016 : (Atom \ `A \`B) & ('a \ 'b \ 'c) = raise [] let x016 : (Atom \ `A \`B) & ('a \ 'b \ 'c) = raise []
let x017 : Atom \ ((`A | `B | `C)) | `test:A = raise [] let x017 : Atom \ ((`A | `B | `C)) | `test:A = raise []
\ No newline at end of file
(* Precedences *)
let x018 : 'a & 'b | 'c = raise []
let x019 : 'a -> 'b | 'c = raise []
let x020 : 'a -> 'b & 'c = raise []
let x021 : 'a | 'b \ 'c = raise []
let x022 : 'a -> 'b \ 'c = raise []
(* Precedences in regexps *)
let x023 : [ 'a & 'b | 'c ] = raise []
let x024 : [ 'a -> 'b | 'c ] = raise []
let x025 : [ ('a -> 'b) & 'c ] = raise []
let x026 : [ 'a | 'b \ 'c ] = raise []
let x027 : [ 'a -> 'b \ 'c ] = raise []
let x028 : [ 'a -> (T ('a)) & 'c ] = raise []
namespace test = "test" namespace test = "test"
\ No newline at end of file
type T('a) = (Int, 'a)
...@@ -20,7 +20,11 @@ do ...@@ -20,7 +20,11 @@ do
orig=`echo "$line" | sed -e "s/$REGEXP/\1/"` orig=`echo "$line" | sed -e "s/$REGEXP/\1/"`
echo 'include "prologue.cd"' > "$TMP" echo 'include "prologue.cd"' > "$TMP"
echo "$line" >> "$TMP" echo "$line" >> "$TMP"
new=`"$CDUCE" -I "$DIR" --compile --verbose "$TMP" | sed -e 's/val x[0-9]\{3\} ://'` new=`"$CDUCE" -I "$DIR" --compile --verbose "$TMP" | sed -e 's/val x[0-9]\{3\} ://' 2>/dev/null`
if test -z "$new"; then
cat "$TMP"
exit 3
fi
rm -f "$TMP"o "$TMP" rm -f "$TMP"o "$TMP"
for test in "($orig) ($new)" "($new) ($orig)" for test in "($orig) ($new)" "($new) ($orig)"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment