Lex and discard comments

8 files changed, 26 insertions, 102 deletions

diff --git a/language/l2_parse.ott b/language/l2_parse.ott
index 18d68a54..90fa544e 100644
--- a/language/l2_parse.ott
+++ b/language/l2_parse.ott
@@ -52,40 +52,6 @@ type 'a annot = l * 'a
 
 exception Parse_error_locn of l * string
 
-type ml_comment = 
-  | Chars of string
-  | Comment of ml_comment list
-
-type lex_skip =
-  | Com of ml_comment
-  | Ws of string
-  | Nl
-
-type lex_skips = lex_skip list option
-
-let pp_lex_skips ppf sk = 
-  match sk with
-    | None -> ()
-    | Some(sks) ->
-        List.iter
-          (fun sk ->
-             match sk with
-               | Com(ml_comment) ->
-                   (* TODO: fix? *)
-                   Format.fprintf ppf "(**)"
-               | Ws(r) ->
-                   Format.fprintf ppf "%s" r (*(Ulib.Text.to_string r)*)
-               | Nl -> Format.fprintf ppf "\\n")
-          sks
-
-let combine_lex_skips s1 s2 =
-  match (s1,s2) with
-    | (None,_) -> s2
-    | (_,None) -> s1
-    | (Some(s1),Some(s2)) -> Some(s2@s1)
-
-type terminal = lex_skips
-
 }}
 
 embed
@@ -98,14 +64,6 @@ type l =
   | Trans of string * option l
   | Range of num * num
 
-type lex_skip =
-  | Com of string
-  | Ws of string
-  | Nl
-
-type lex_skips = option (list lex_skip)
-type terminal = lex_skips
-
 val disjoint : forall 'a . set 'a -> set 'a -> bool
 let disjoint s1 s2 = 
   let diff = s1 inter s2 in
diff --git a/src/_build/reporting_basic.ml b/src/_build/reporting_basic.ml
index 7f207651..a0d53ab0 100644
--- a/src/_build/reporting_basic.ml
+++ b/src/_build/reporting_basic.ml
@@ -144,7 +144,7 @@ type error =
   | Err_todo of Parse_ast.l * string
   | Err_syntax of Lexing.position * string
   | Err_syntax_locn of Parse_ast.l * string
-  | Err_lex of Lexing.position * char
+  | Err_lex of Lexing.position * string
   | Err_type of Parse_ast.l * string
 
 let dest_err = function
@@ -153,7 +153,7 @@ let dest_err = function
   | Err_todo (l, m) -> ("Todo" ^ m, false, Loc l, "")
   | Err_syntax (p, m) -> ("Syntax error", false, Pos p, m)
   | Err_syntax_locn (l, m) -> ("Syntax error", false, Loc l, m)
-  | Err_lex (p, c) -> ("Lexical error", false, Pos p, "unknown character "^(String.make 1 c))
+  | Err_lex (p, s) -> ("Lexical error", false, Pos p, s)
   | Err_type (l, m) -> ("Type error", false, Loc l, m)
 
 exception Fatal_error of error
diff --git a/src/_build/reporting_basic.mli b/src/_build/reporting_basic.mli
index 3cfdf864..8074695b 100644
--- a/src/_build/reporting_basic.mli
+++ b/src/_build/reporting_basic.mli
@@ -83,7 +83,7 @@ type error =
 
   | Err_syntax of Lexing.position * string
   | Err_syntax_locn of Parse_ast.l * string
-  | Err_lex of Lexing.position * char
+  | Err_lex of Lexing.position * string
   | Err_type of Parse_ast.l * string
   
 exception Fatal_error of error
diff --git a/src/lexer.mll b/src/lexer.mll
index 193ba479..3bd4d5a1 100644
--- a/src/lexer.mll
+++ b/src/lexer.mll
@@ -47,7 +47,7 @@
 {
 open Parser
 module M = Map.Make(String)
-exception LexError of char * Lexing.position
+exception LexError of string * Lexing.position
 
 let r = fun s -> s (* Ulib.Text.of_latin1 *)
 (* Available as Scanf.unescaped since OCaml 4.0 but 3.12 is still common *)
@@ -112,14 +112,10 @@ let alphanum = letter|digit
 let startident = letter|'_'
 let ident = alphanum|['_''\'']
 let oper_char = ['!''$''%''&''*''+''-''.''/'':''<''=''>''?''@''^''|''~']
-let safe_com1 = [^'*''('')''\n']
-let safe_com2 = [^'*''(''\n']
-let com_help = "("*safe_com2 | "*"*"("+safe_com2 | "*"*safe_com1
-let com_body = com_help*"*"*
 let escape_sequence = ('\\' ['\\''\"''\'''n''t''b''r']) | ('\\' digit digit digit) | ('\\' 'x' hexdigit hexdigit)
 
 rule token = parse
-  | ws as i
+  | ws
     { token lexbuf }
   | "\n"
     { Lexing.new_line lexbuf;
@@ -202,9 +198,8 @@ rule token = parse
   | "2^"				{ (TwoCarrot(r"2^")) }
 
 
-  | "--"
-    { comment lexbuf;
-      token lexbuf }
+  | "(*"        { comment (Lexing.lexeme_start_p lexbuf) 0 lexbuf; token lexbuf }
+  | "*)"        { raise (LexError("Unbalanced comment", Lexing.lexeme_start_p lexbuf)) }
 
   | startident ident* as i              { if M.mem i kw_table then
                                             (M.find i kw_table) ()
@@ -272,17 +267,22 @@ rule token = parse
   | '"'                                 { (String(
                                            string (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) lexbuf)) }
   | eof                                 { Eof }
-  | _  as c                             { raise (LexError(c, Lexing.lexeme_start_p lexbuf)) }
+  | _  as c                             { raise (LexError(
+                                          Printf.sprintf "Unexpected character: %c" c,
+                                          Lexing.lexeme_start_p lexbuf)) }
 
 
-and comment = parse
-  | (com_body "("* as i) "--"           { let c1 = comment lexbuf in
-                                          let c2 = comment lexbuf in
-                                            Parse_ast.Chars(r i) :: Parse_ast.Comment(c1) :: c2}
-  | (com_body as i) "\n"                { Lexing.new_line lexbuf;
-                                          [Parse_ast.Chars(r i)] }
-  | _  as c                             { raise (LexError(c, Lexing.lexeme_start_p lexbuf)) }
-  | eof                                 { [] }
+and comment pos depth = parse
+  | "(*"                                { comment pos (depth+1) lexbuf }
+  | "*)"                                { if depth = 0 then ()
+                                          else if depth > 0 then comment pos (depth-1) lexbuf
+                                          else assert false }
+  | "\n"                                { Lexing.new_line lexbuf;
+                                          comment pos depth lexbuf }
+  | '"'                                 { ignore(string (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) lexbuf);
+                                          comment pos depth lexbuf }
+  | _                                   { comment pos depth lexbuf }
+  | eof                                 { raise (LexError("Unbalanced comment", pos)) }
 
 and string pos b = parse
   | ([^'"''\n''\\']*'\n' as i)          { Lexing.new_line lexbuf;
diff --git a/src/parse_ast.ml b/src/parse_ast.ml
index 7e65b40f..12a3de3d 100644
--- a/src/parse_ast.ml
+++ b/src/parse_ast.ml
@@ -12,40 +12,6 @@ type 'a annot = l * 'a
 
 exception Parse_error_locn of l * string
 
-type ml_comment = 
-  | Chars of string
-  | Comment of ml_comment list
-
-type lex_skip =
-  | Com of ml_comment
-  | Ws of string
-  | Nl
-
-type lex_skips = lex_skip list option
-
-let pp_lex_skips ppf sk = 
-  match sk with
-    | None -> ()
-    | Some(sks) ->
-        List.iter
-          (fun sk ->
-             match sk with
-               | Com(ml_comment) ->
-                   (* TODO: fix? *)
-                   Format.fprintf ppf "(**)"
-               | Ws(r) ->
-                   Format.fprintf ppf "%s" r (*(Ulib.Text.to_string r)*)
-               | Nl -> Format.fprintf ppf "\\n")
-          sks
-
-let combine_lex_skips s1 s2 =
-  match (s1,s2) with
-    | (None,_) -> s2
-    | (_,None) -> s1
-    | (Some(s1),Some(s2)) -> Some(s2@s1)
-
-type terminal = lex_skips
-
 
 type x = text (* identifier *)
 type ix = text (* infix identifier *)
diff --git a/src/process_file.ml b/src/process_file.ml
index f8bc9786..4284a252 100644
--- a/src/process_file.ml
+++ b/src/process_file.ml
@@ -66,8 +66,8 @@ let parse_file (f : string) : Parse_ast.defs =
            raise (Reporting_basic.Fatal_error (Reporting_basic.Err_syntax (pos, "")))
       | Parse_ast.Parse_error_locn(l,m) ->
           raise (Reporting_basic.Fatal_error (Reporting_basic.Err_syntax_locn (l, m)))
-      | Lexer.LexError(c,p) ->
-          raise (Reporting_basic.Fatal_error (Reporting_basic.Err_lex (p, c)))
+      | Lexer.LexError(s,p) ->
+          raise (Reporting_basic.Fatal_error (Reporting_basic.Err_lex (p, s)))
 
 (* type instances = Types.instance list Types.Pfmap.t
 
diff --git a/src/reporting_basic.ml b/src/reporting_basic.ml
index 7f207651..a0d53ab0 100644
--- a/src/reporting_basic.ml
+++ b/src/reporting_basic.ml
@@ -144,7 +144,7 @@ type error =
   | Err_todo of Parse_ast.l * string
   | Err_syntax of Lexing.position * string
   | Err_syntax_locn of Parse_ast.l * string
-  | Err_lex of Lexing.position * char
+  | Err_lex of Lexing.position * string
   | Err_type of Parse_ast.l * string
 
 let dest_err = function
@@ -153,7 +153,7 @@ let dest_err = function
   | Err_todo (l, m) -> ("Todo" ^ m, false, Loc l, "")
   | Err_syntax (p, m) -> ("Syntax error", false, Pos p, m)
   | Err_syntax_locn (l, m) -> ("Syntax error", false, Loc l, m)
-  | Err_lex (p, c) -> ("Lexical error", false, Pos p, "unknown character "^(String.make 1 c))
+  | Err_lex (p, s) -> ("Lexical error", false, Pos p, s)
   | Err_type (l, m) -> ("Type error", false, Loc l, m)
 
 exception Fatal_error of error
diff --git a/src/reporting_basic.mli b/src/reporting_basic.mli
index 3cfdf864..8074695b 100644
--- a/src/reporting_basic.mli
+++ b/src/reporting_basic.mli
@@ -83,7 +83,7 @@ type error =
 
   | Err_syntax of Lexing.position * string
   | Err_syntax_locn of Parse_ast.l * string
-  | Err_lex of Lexing.position * char
+  | Err_lex of Lexing.position * string
   | Err_type of Parse_ast.l * string
   
 exception Fatal_error of error