summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/_build/reporting_basic.ml4
-rw-r--r--src/_build/reporting_basic.mli2
-rw-r--r--src/lexer.mll36
-rw-r--r--src/parse_ast.ml34
-rw-r--r--src/process_file.ml4
-rw-r--r--src/reporting_basic.ml4
-rw-r--r--src/reporting_basic.mli2
7 files changed, 26 insertions, 60 deletions
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