Add a warning when the lexer encounters the ambiguous ``[ 'a'a ]'' and

suggest to put a space before the second quote.

Move the auxiliary 'warning' function from the typechecker to the
Cduce_loc module.

Re-indent some comments in ulexer.ml

parser/cduce_loc.ml

@@ -13,6 +13,7 @@ let merge_loc ((s1,i1,j1) as loc1) ((s2,i2,j2) as loc2) =
   else loc1
 
 let source = ref `None
+let get_source () = !source
 let source_stack = ref []
 let push_source s = source_stack := !source :: !source_stack; source := s
 let pop_source () = 
@@ -181,3 +182,9 @@ let resolve_filename s =
 
 include Camlp4.PreCast.Loc
 
+let warning loc msg =
+  let v = get_viewport () in
+  let ppf = if Html.is_html v then Html.ppf v else Format.err_formatter in
+  print_loc ppf (loc,`Full);
+  html_hilight (loc,`Full);
+  Format.fprintf ppf "Warning: %s@." msg

parser/cduce_loc.mli

@@ -24,6 +24,7 @@ val raise_loc_generic: loc -> string -> 'a
 
 val push_source: source -> unit
 val pop_source: unit -> unit
+val get_source : unit -> source
 
 val current_dir : unit -> string
 
@@ -45,6 +46,7 @@ val mknoloc: 'a -> 'a located
 
 val loc_of_pos : int * int -> loc
 
+val warning : loc -> string -> unit
 
 (* Are we working in a protected environement (web prototype ...) ? *)
 val set_protected : bool -> unit

parser/ulexer.ml

@@ -189,8 +189,9 @@ let regexp ncname = ( xml_letter ncname_char* ) | ('_' ncname_char+)
 let regexp qname = (ncname ':')? ncname
 
 
-(* We want to write _ \ (xml_letter | '_') but we can't due to a limitation in ulex.
-   we define explicitely this regexp, based on the definition in ulex-1.1
+(* We want to write _ \ (xml_letter | '_') but we can't due to a
+   limitation in ulex.  we define explicitely this regexp, based on
+   the definition in ulex-1.1
 *)
 let regexp not_ncname_letter = [^ (* base_char *)
     0x0041-0x005A 0x0061-0x007A 0x00C0-0x00D6 0x00D8-0x00F6
@@ -259,7 +260,6 @@ let regexp not_ncname_letter = [^ (* base_char *)
    '_'
                     ]
 
-
 let illegal lexbuf =
   error
     (L.lexeme_start lexbuf)
@@ -270,6 +270,10 @@ let in_comment = ref false
 
 let return lexbuf tok = (tok, L.loc lexbuf)
 let return_loc i j tok = (tok, (i,j))
+let warning lexbuf msg =
+  let i, j = L.loc lexbuf in
+  Cduce_loc.warning (Cduce_loc.get_source (), i, j) msg
+
 
 let rec token = lexer
  | xml_blank+ -> token lexbuf
@@ -290,15 +294,22 @@ let rec token = lexer
  | ["?+*"] "?" | "#" ->
      return lexbuf (KEYWORD (L.utf8_lexeme lexbuf))
 
- (* the three followning rules work together and are replicated in the comment lexer *)
+ (* the three followning rules work together and are replicated in the
+    comment lexer *)
 
  | "'" ([^ '\t' '\n' '\r' '\''] | '\\' '\'')* "'" (not_ncname_letter | eof) ->
    (* two single quotes not followed by an xml_letter must be a string
-      we put it back call an auxiliary lexer to consume the first ' and read it as a string.
-   *)
+    we put it back call an auxiliary lexer to consume the first '
+    and read it as a string.  *)
      L.rollback lexbuf;
    do_string lexbuf
 
+ | "'" ncname "'" ncname ->
+   let s = L.utf8_lexeme lexbuf in
+   warning lexbuf
+     (Printf.sprintf "ambiguous sequence of polymorphic variables (%s). Add a space before the second quote." s);
+   L.rollback lexbuf;
+   do_variable lexbuf
 
  | "'" ncname ->
    (* then try to read it as variable *)
@@ -306,8 +317,8 @@ let rec token = lexer
    return lexbuf (PVAR (s))
 
  | ('"' | "'")  ->
-   (* otherwise we will fail for sure, but try to read it character by character as a string
-      to get a decent error message *)
+   (* otherwise we will fail for sure, but try to read it character by
+      character as a string to get a decent error message *)
      L.rollback lexbuf;
    do_string lexbuf
 
@@ -335,6 +346,12 @@ and do_string = lexer
         (if double then STRING2 s else STRING1 s)
     | _ -> assert false
 
+and do_variable = lexer
+    |   "'" ncname ->
+      let s = L.utf8_sub_lexeme lexbuf 1 (L.lexeme_length lexbuf - 1) in
+      return lexbuf (PVAR (s))
+    | _ -> assert false
+
 and comment start = lexer
   | "(*" ->
       comment (L.lexeme_start lexbuf) lexbuf;

typing/typer.ml

@@ -8,13 +8,6 @@ let (<) (x:int) y = x < y
 let (>=) (x:int) y = x >= y
 let (>) (x:int) y = x > y
 
-let warning loc msg =
-  let v = Cduce_loc.get_viewport () in
-  let ppf = if Html.is_html v then Html.ppf v else Format.err_formatter in
-  Cduce_loc.print_loc ppf (loc,`Full);
-  Cduce_loc.html_hilight (loc,`Full);
-  Format.fprintf ppf "Warning: %s@." msg
-
 exception NonExhaustive of Types.descr
 exception Constraint of Types.descr * Types.descr
 exception ShouldHave of Types.descr * string