summaryrefslogtreecommitdiff
path: root/tools/coqdep_lexer.mll
diff options
context:
space:
mode:
Diffstat (limited to 'tools/coqdep_lexer.mll')
-rw-r--r--tools/coqdep_lexer.mll73
1 files changed, 39 insertions, 34 deletions
diff --git a/tools/coqdep_lexer.mll b/tools/coqdep_lexer.mll
index eb233b8f..ade5e5be 100644
--- a/tools/coqdep_lexer.mll
+++ b/tools/coqdep_lexer.mll
@@ -1,9 +1,11 @@
(************************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* * The Coq Proof Assistant / The Coq Development Team *)
+(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *)
+(* <O___,, * (see CREDITS file for the list of authors) *)
(* \VV/ **************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
{
@@ -25,8 +27,6 @@
exception Fin_fichier
exception Syntax_error of int*int
- let field_name s = String.sub s 1 (String.length s - 1)
-
let unquote_string s =
String.sub s 1 (String.length s - 2)
@@ -39,30 +39,33 @@
let syntax_error lexbuf =
raise (Syntax_error (Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf))
+
+ let check_valid lexbuf s =
+ match Unicode.ident_refutation s with
+ | None -> s
+ | Some _ -> syntax_error lexbuf
+
+ let get_ident lexbuf =
+ let s = Lexing.lexeme lexbuf in check_valid lexbuf s
+
+ let get_field_name lexbuf =
+ let s = Lexing.lexeme lexbuf in
+ check_valid lexbuf (String.sub s 1 (String.length s - 1))
+
+ [@@@ocaml.warning "-3"] (* String.uncapitalize_ascii since 4.03.0 GPR#124 *)
+ let uncapitalize = String.uncapitalize
+ [@@@ocaml.warning "+3"]
}
let space = [' ' '\t' '\n' '\r']
-let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255']
-let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222']
-let identchar =
- ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
+let lowercase = ['a'-'z']
+let uppercase = ['A'-'Z']
+let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
let caml_up_ident = uppercase identchar*
let caml_low_ident = lowercase identchar*
-let coq_firstchar =
- (* This is only an approximation, refer to lib/util.ml for correct def *)
- ['A'-'Z' 'a'-'z' '_'] |
- (* superscript 1 *)
- '\194' '\185' |
- (* utf-8 latin 1 supplement *)
- '\195' ['\128'-'\150'] | '\195' ['\152'-'\182'] | '\195' ['\184'-'\191'] |
- (* utf-8 letters *)
- '\206' (['\145'-'\161'] | ['\163'-'\187'])
- '\226' ('\130' [ '\128'-'\137' ] (* subscripts *)
- | '\129' [ '\176'-'\187' ] (* superscripts *)
- | '\132' ['\128'-'\191'] | '\133' ['\128'-'\143'])
-let coq_identchar = coq_firstchar | ['\'' '0'-'9']
-let coq_ident = coq_firstchar coq_identchar*
+(* This is an overapproximation, we check correctness afterwards *)
+let coq_ident = ['A'-'Z' 'a'-'z' '_' '\128'-'\255'] ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9' '\128'-'\255']*
let coq_field = '.' coq_ident
let dot = '.' ( space+ | eof)
@@ -70,7 +73,9 @@ let dot = '.' ( space+ | eof)
rule coq_action = parse
| "Require" space+
{ require_modifiers None lexbuf }
- | "Local"? "Declare" space+ "ML" space+ "Module" space+
+ | "Local" space+ "Declare" space+ "ML" space+ "Module" space+
+ { modules [] lexbuf }
+ | "Declare" space+ "ML" space+ "Module" space+
{ modules [] lexbuf }
| "Load" space+
{ load_file lexbuf }
@@ -97,7 +102,7 @@ and from_rule = parse
| space+
{ from_rule lexbuf }
| coq_ident
- { let from = coq_qual_id_tail [Lexing.lexeme lexbuf] lexbuf in
+ { let from = coq_qual_id_tail [get_ident lexbuf] lexbuf in
consume_require (Some from) lexbuf }
| eof
{ syntax_error lexbuf }
@@ -154,7 +159,7 @@ and caml_action = parse
| space +
{ caml_action lexbuf }
| "open" space* (caml_up_ident as id)
- { Use_module (String.uncapitalize id) }
+ { Use_module (uncapitalize id) }
| "module" space+ caml_up_ident
{ caml_action lexbuf }
| caml_low_ident { caml_action lexbuf }
@@ -236,7 +241,7 @@ and load_file = parse
parse_dot lexbuf;
Load (unquote_vfile_string s) }
| coq_ident
- { let s = lexeme lexbuf in skip_to_dot lexbuf; Load s }
+ { let s = get_ident lexbuf in skip_to_dot lexbuf; Load s }
| eof
{ syntax_error lexbuf }
| _
@@ -248,7 +253,7 @@ and require_file from = parse
| space+
{ require_file from lexbuf }
| coq_ident
- { let name = coq_qual_id_tail [Lexing.lexeme lexbuf] lexbuf in
+ { let name = coq_qual_id_tail [get_ident lexbuf] lexbuf in
let qid = coq_qual_id_list [name] lexbuf in
parse_dot lexbuf;
Require (from, qid) }
@@ -273,7 +278,7 @@ and coq_qual_id = parse
| space+
{ coq_qual_id lexbuf }
| coq_ident
- { coq_qual_id_tail [Lexing.lexeme lexbuf] lexbuf }
+ { coq_qual_id_tail [get_ident lexbuf] lexbuf }
| _
{ syntax_error lexbuf }
@@ -283,7 +288,7 @@ and coq_qual_id_tail module_name = parse
| space+
{ coq_qual_id_tail module_name lexbuf }
| coq_field
- { coq_qual_id_tail (field_name (Lexing.lexeme lexbuf) :: module_name) lexbuf }
+ { coq_qual_id_tail (get_field_name lexbuf :: module_name) lexbuf }
| eof
{ syntax_error lexbuf }
| _
@@ -296,7 +301,7 @@ and coq_qual_id_list module_names = parse
| space+
{ coq_qual_id_list module_names lexbuf }
| coq_ident
- { let name = coq_qual_id_tail [Lexing.lexeme lexbuf] lexbuf in
+ { let name = coq_qual_id_tail [get_ident lexbuf] lexbuf in
coq_qual_id_list (name :: module_names) lexbuf
}
| eof
@@ -321,12 +326,12 @@ and modules mllist = parse
and qual_id ml_module_name = parse
| '.' [^ '.' '(' '[']
- { Use_module (String.uncapitalize ml_module_name) }
+ { Use_module (uncapitalize ml_module_name) }
| eof { raise Fin_fichier }
| _ { caml_action lexbuf }
and mllib_list = parse
- | caml_up_ident { let s = String.uncapitalize (Lexing.lexeme lexbuf)
+ | caml_up_ident { let s = uncapitalize (Lexing.lexeme lexbuf)
in s :: mllib_list lexbuf }
| "*predef*" { mllib_list lexbuf }
| space+ { mllib_list lexbuf }