Commit bcf40231 authored by Kim Nguyễn's avatar Kim Nguyễn

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
parent b05e438f
......@@ -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
......@@ -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
......
......@@ -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;
......
......@@ -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
......
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