diff options
| author | Pierre-Marie Pédrot | 2018-11-22 11:44:12 +0100 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2018-11-23 13:59:15 +0100 |
| commit | 548dcdc751287274c9cce7d13d779a81346a5af2 (patch) | |
| tree | 4c850e41b9e80c39e94ebdbac752d46c27db8932 | |
| parent | bb4daa4af0515f3041203c5bcc0a1d8cd1123e5a (diff) | |
Remove the unsafe camlp5 API from the Coq codebase.
| -rw-r--r-- | parsing/g_constr.mlg | 6 | ||||
| -rw-r--r-- | parsing/pcoq.ml | 39 | ||||
| -rw-r--r-- | parsing/pcoq.mli | 14 | ||||
| -rw-r--r-- | plugins/funind/g_indfun.mlg | 1 | ||||
| -rw-r--r-- | plugins/ltac/extraargs.mlg | 2 | ||||
| -rw-r--r-- | plugins/ltac/g_ltac.mlg | 2 | ||||
| -rw-r--r-- | plugins/ltac/g_obligations.mlg | 1 | ||||
| -rw-r--r-- | plugins/ltac/g_tactic.mlg | 10 | ||||
| -rw-r--r-- | plugins/ssr/ssrparser.mlg | 28 | ||||
| -rw-r--r-- | plugins/ssrmatching/g_ssrmatching.mlg | 2 | ||||
| -rw-r--r-- | toplevel/coqloop.ml | 2 | ||||
| -rw-r--r-- | vernac/g_vernac.mlg | 2 | ||||
| -rw-r--r-- | vernac/metasyntax.ml | 2 | ||||
| -rw-r--r-- | vernac/pvernac.ml | 4 | ||||
| -rw-r--r-- | vernac/vernacextend.ml | 2 |
15 files changed, 37 insertions, 80 deletions
diff --git a/parsing/g_constr.mlg b/parsing/g_constr.mlg index e25f7aa54f..b3ae24e941 100644 --- a/parsing/g_constr.mlg +++ b/parsing/g_constr.mlg @@ -81,7 +81,7 @@ let err () = raise Stream.Failure (* Hack to parse "(x:=t)" as an explicit argument without conflicts with the *) (* admissible notation "(x t)" *) let lpar_id_coloneq = - Gram.Entry.of_parser "test_lpar_id_coloneq" + Pcoq.Entry.of_parser "test_lpar_id_coloneq" (fun strm -> match stream_nth 0 strm with | KEYWORD "(" -> @@ -96,7 +96,7 @@ let lpar_id_coloneq = | _ -> err ()) let impl_ident_head = - Gram.Entry.of_parser "impl_ident_head" + Pcoq.Entry.of_parser "impl_ident_head" (fun strm -> match stream_nth 0 strm with | KEYWORD "{" -> @@ -109,7 +109,7 @@ let impl_ident_head = | _ -> err ()) let name_colon = - Gram.Entry.of_parser "name_colon" + Pcoq.Entry.of_parser "name_colon" (fun strm -> match stream_nth 0 strm with | IDENT s -> diff --git a/parsing/pcoq.ml b/parsing/pcoq.ml index 01a542b6f3..170df6ad09 100644 --- a/parsing/pcoq.ml +++ b/parsing/pcoq.ml @@ -14,7 +14,6 @@ open Extend open Genarg open Gramlib -let curry f x y = f (x, y) let uncurry f (x,y) = f x y (** Location Utils *) @@ -141,6 +140,9 @@ struct let create = G.Entry.create let parse = G.entry_parse let print = G.Entry.print + let of_parser = G.Entry.of_parser + let name = G.Entry.name + let parse_token_stream = G.Entry.parse_token_stream end @@ -289,22 +291,6 @@ let grammar_delete e reinit (pos,rls) = (G.safe_extend e) (Some ext) [Some lev,Some a,[]] | None -> () -let unsafe_grammar_delete e reinit (pos,rls) = - List.iter - (fun (n,ass,lev) -> - List.iter (fun (pil,_) -> G.delete_rule e pil) (List.rev lev)) - (List.rev rls); - match reinit with - | Some (a,ext) -> - let a = of_coq_assoc a in - let ext = of_coq_position ext in - let lev = match pos with - | Some (Gramext.Level n) -> n - | _ -> assert false - in - (G.extend e) (Some ext) [Some lev,Some a,[]] - | None -> () - (** Extension *) let grammar_extend e reinit ext = @@ -326,25 +312,6 @@ let grammar_extend_sync e reinit ext = module Gram = struct include G - let extend e = - curry - (fun ext -> - camlp5_state := - (ByEXTEND ((fun () -> unsafe_grammar_delete e None ext), - (fun () -> uncurry (G.extend e) ext))) - :: !camlp5_state; - uncurry (G.extend e) ext) - let delete_rule e pil = - (* spiwack: if you use load an ML module which contains GDELETE_RULE - in a section, God kills a kitty. As it would corrupt remove_grammars. - There does not seem to be a good way to undo a delete rule. As deleting - takes fewer arguments than extending. The production rule isn't returned - by delete_rule. If we could retrieve the necessary information, then - ByEXTEND provides just the framework we need to allow this in section. - I'm not entirely sure it makes sense, but at least it would be more correct. - *) - G.delete_rule e pil - let gram_extend e ext = grammar_extend e None ext end (** Remove extensions diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli index 593cf59341..e64c614149 100644 --- a/parsing/pcoq.mli +++ b/parsing/pcoq.mli @@ -17,17 +17,6 @@ open Gramlib (** The parser of Coq *) -(** DO NOT USE EXTENSION FUNCTIONS IN THIS MODULE. - We only have it here to work with Camlp5. Handwritten grammar extensions - should use the safe [Pcoq.grammar_extend] function below. *) -module Gram : sig - - include Grammar.S with type te = Tok.t - - val gram_extend : 'a Entry.e -> 'a Extend.extend_statement -> unit - -end with type 'a Entry.e = 'a Grammar.GMake(CLexer).Entry.e - module Parsable : sig type t @@ -41,6 +30,9 @@ module Entry : sig val create : string -> 'a t val parse : 'a t -> Parsable.t -> 'a val print : Format.formatter -> 'a t -> unit + val of_parser : string -> (Tok.t Stream.t -> 'a) -> 'a t + val parse_token_stream : 'a t -> Tok.t Stream.t -> 'a + val name : 'a t -> string end (** The parser of Coq is built from three kinds of rule declarations: diff --git a/plugins/funind/g_indfun.mlg b/plugins/funind/g_indfun.mlg index 7e707b423a..8f0440a2a4 100644 --- a/plugins/funind/g_indfun.mlg +++ b/plugins/funind/g_indfun.mlg @@ -145,7 +145,6 @@ END { -module Gram = Pcoq.Gram module Vernac = Pvernac.Vernac_ module Tactic = Pltac diff --git a/plugins/ltac/extraargs.mlg b/plugins/ltac/extraargs.mlg index c4c4e51ecc..156ee94a66 100644 --- a/plugins/ltac/extraargs.mlg +++ b/plugins/ltac/extraargs.mlg @@ -332,7 +332,7 @@ END let local_test_lpar_id_colon = let err () = raise Stream.Failure in - Pcoq.Gram.Entry.of_parser "lpar_id_colon" + Pcoq.Entry.of_parser "lpar_id_colon" (fun strm -> match Util.stream_nth 0 strm with | Tok.KEYWORD "(" -> diff --git a/plugins/ltac/g_ltac.mlg b/plugins/ltac/g_ltac.mlg index bd8a097154..338839ee96 100644 --- a/plugins/ltac/g_ltac.mlg +++ b/plugins/ltac/g_ltac.mlg @@ -70,7 +70,7 @@ let _ = (* Hack to parse "[ id" without dropping [ *) let test_bracket_ident = - Gram.Entry.of_parser "test_bracket_ident" + Pcoq.Entry.of_parser "test_bracket_ident" (fun strm -> match stream_nth 0 strm with | KEYWORD "[" -> diff --git a/plugins/ltac/g_obligations.mlg b/plugins/ltac/g_obligations.mlg index e29f78af5b..ef18dd6cdc 100644 --- a/plugins/ltac/g_obligations.mlg +++ b/plugins/ltac/g_obligations.mlg @@ -45,7 +45,6 @@ let with_tac f tac = * Subtac. These entries are named Subtac.<foo> *) -module Gram = Pcoq.Gram module Tactic = Pltac open Pcoq diff --git a/plugins/ltac/g_tactic.mlg b/plugins/ltac/g_tactic.mlg index 0ce0fbd0cd..46ea3819ac 100644 --- a/plugins/ltac/g_tactic.mlg +++ b/plugins/ltac/g_tactic.mlg @@ -39,7 +39,7 @@ let err () = raise Stream.Failure (* Hack to parse "(x:=t)" as an explicit argument without conflicts with the *) (* admissible notation "(x t)" *) let test_lpar_id_coloneq = - Gram.Entry.of_parser "lpar_id_coloneq" + Pcoq.Entry.of_parser "lpar_id_coloneq" (fun strm -> match stream_nth 0 strm with | KEYWORD "(" -> @@ -53,7 +53,7 @@ let test_lpar_id_coloneq = (* Hack to recognize "(x)" *) let test_lpar_id_rpar = - Gram.Entry.of_parser "lpar_id_coloneq" + Pcoq.Entry.of_parser "lpar_id_coloneq" (fun strm -> match stream_nth 0 strm with | KEYWORD "(" -> @@ -67,7 +67,7 @@ let test_lpar_id_rpar = (* idem for (x:=t) and (1:=t) *) let test_lpar_idnum_coloneq = - Gram.Entry.of_parser "test_lpar_idnum_coloneq" + Pcoq.Entry.of_parser "test_lpar_idnum_coloneq" (fun strm -> match stream_nth 0 strm with | KEYWORD "(" -> @@ -84,7 +84,7 @@ open Extraargs (* idem for (x1..xn:t) [n^2 complexity but exceptional use] *) let check_for_coloneq = - Gram.Entry.of_parser "lpar_id_colon" + Pcoq.Entry.of_parser "lpar_id_colon" (fun strm -> let rec skip_to_rpar p n = match List.last (Stream.npeek n strm) with @@ -108,7 +108,7 @@ let check_for_coloneq = | _ -> err ()) let lookup_at_as_comma = - Gram.Entry.of_parser "lookup_at_as_comma" + Pcoq.Entry.of_parser "lookup_at_as_comma" (fun strm -> match stream_nth 0 strm with | KEYWORD (","|"at"|"as") -> () diff --git a/plugins/ssr/ssrparser.mlg b/plugins/ssr/ssrparser.mlg index 7c91860228..2dff0cc84f 100644 --- a/plugins/ssr/ssrparser.mlg +++ b/plugins/ssr/ssrparser.mlg @@ -268,16 +268,16 @@ let negate_parser f x = | Some _ -> raise Stream.Failure let test_not_ssrslashnum = - Pcoq.Gram.Entry.of_parser + Pcoq.Entry.of_parser "test_not_ssrslashnum" (negate_parser test_ssrslashnum10) let test_ssrslashnum00 = - Pcoq.Gram.Entry.of_parser "test_ssrslashnum01" test_ssrslashnum00 + Pcoq.Entry.of_parser "test_ssrslashnum01" test_ssrslashnum00 let test_ssrslashnum10 = - Pcoq.Gram.Entry.of_parser "test_ssrslashnum10" test_ssrslashnum10 + Pcoq.Entry.of_parser "test_ssrslashnum10" test_ssrslashnum10 let test_ssrslashnum11 = - Pcoq.Gram.Entry.of_parser "test_ssrslashnum11" test_ssrslashnum11 + Pcoq.Entry.of_parser "test_ssrslashnum11" test_ssrslashnum11 let test_ssrslashnum01 = - Pcoq.Gram.Entry.of_parser "test_ssrslashnum01" test_ssrslashnum01 + Pcoq.Entry.of_parser "test_ssrslashnum01" test_ssrslashnum01 } @@ -470,7 +470,7 @@ let input_ssrtermkind strm = match Util.stream_nth 0 strm with | Tok.KEYWORD "@" -> xWithAt | _ -> xNoFlag -let ssrtermkind = Pcoq.Gram.Entry.of_parser "ssrtermkind" input_ssrtermkind +let ssrtermkind = Pcoq.Entry.of_parser "ssrtermkind" input_ssrtermkind (* New kinds of terms *) @@ -481,7 +481,7 @@ let input_term_annotation strm = | Tok.KEYWORD "@" :: _ -> `At | _ -> `None let term_annotation = - Gram.Entry.of_parser "term_annotation" input_term_annotation + Pcoq.Entry.of_parser "term_annotation" input_term_annotation (* terms *) @@ -800,7 +800,7 @@ let reject_ssrhid strm = | _ -> ()) | _ -> () -let test_nohidden = Pcoq.Gram.Entry.of_parser "test_ssrhid" reject_ssrhid +let test_nohidden = Pcoq.Entry.of_parser "test_ssrhid" reject_ssrhid } @@ -961,7 +961,7 @@ let accept_ssrfwdid strm = | Tok.IDENT id -> accept_before_syms_or_any_id [":"; ":="; "("] strm | _ -> raise Stream.Failure -let test_ssrfwdid = Gram.Entry.of_parser "test_ssrfwdid" accept_ssrfwdid +let test_ssrfwdid = Pcoq.Entry.of_parser "test_ssrfwdid" accept_ssrfwdid } @@ -1540,7 +1540,7 @@ let accept_ssrseqvar strm = accept_before_syms_or_ids ["["] ["first";"last"] strm | _ -> raise Stream.Failure -let test_ssrseqvar = Gram.Entry.of_parser "test_ssrseqvar" accept_ssrseqvar +let test_ssrseqvar = Pcoq.Entry.of_parser "test_ssrseqvar" accept_ssrseqvar let swaptacarg (loc, b) = (b, []), Some (TacId []) @@ -1628,7 +1628,7 @@ let ssr_id_of_string loc s = ^ "Scripts with explicit references to anonymous variables are fragile.")) end; Id.of_string s -let ssr_null_entry = Gram.Entry.of_parser "ssr_null" (fun _ -> ()) +let ssr_null_entry = Pcoq.Entry.of_parser "ssr_null" (fun _ -> ()) } @@ -1955,7 +1955,7 @@ let accept_ssreqid strm = accept_before_syms [":"] strm | _ -> raise Stream.Failure -let test_ssreqid = Gram.Entry.of_parser "test_ssreqid" accept_ssreqid +let test_ssreqid = Pcoq.Entry.of_parser "test_ssreqid" accept_ssreqid } @@ -2373,7 +2373,7 @@ let test_ssr_rw_syntax = match Util.stream_nth 0 strm with | Tok.KEYWORD key when List.mem key.[0] [lbrace; '['; '/'] -> () | _ -> raise Stream.Failure in - Gram.Entry.of_parser "test_ssr_rw_syntax" test + Pcoq.Entry.of_parser "test_ssr_rw_syntax" test } @@ -2583,7 +2583,7 @@ let accept_idcomma strm = | Tok.IDENT _ | Tok.KEYWORD "_" -> accept_before_syms [","] strm | _ -> raise Stream.Failure -let test_idcomma = Gram.Entry.of_parser "test_idcomma" accept_idcomma +let test_idcomma = Pcoq.Entry.of_parser "test_idcomma" accept_idcomma } diff --git a/plugins/ssrmatching/g_ssrmatching.mlg b/plugins/ssrmatching/g_ssrmatching.mlg index 0dd17dfc15..4ddaeb49fd 100644 --- a/plugins/ssrmatching/g_ssrmatching.mlg +++ b/plugins/ssrmatching/g_ssrmatching.mlg @@ -68,7 +68,7 @@ let input_ssrtermkind strm = match Util.stream_nth 0 strm with | Tok.KEYWORD "(" -> '(' | Tok.KEYWORD "@" -> '@' | _ -> ' ' -let ssrtermkind = Pcoq.Gram.Entry.of_parser "ssrtermkind" input_ssrtermkind +let ssrtermkind = Pcoq.Entry.of_parser "ssrtermkind" input_ssrtermkind } diff --git a/toplevel/coqloop.ml b/toplevel/coqloop.ml index 6d5f049176..4630599229 100644 --- a/toplevel/coqloop.ml +++ b/toplevel/coqloop.ml @@ -245,7 +245,7 @@ let parse_to_dot = | Tok.EOI -> raise Stm.End_of_input | _ -> dot st in - Pcoq.Gram.Entry.of_parser "Coqtoplevel.dot" dot + Pcoq.Entry.of_parser "Coqtoplevel.dot" dot (* If an error occurred while parsing, we try to read the input until a dot token is encountered. diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg index 3cdf81ced0..e3f6a87541 100644 --- a/vernac/g_vernac.mlg +++ b/vernac/g_vernac.mlg @@ -474,7 +474,7 @@ END { let only_starredidentrefs = - Gram.Entry.of_parser "test_only_starredidentrefs" + Pcoq.Entry.of_parser "test_only_starredidentrefs" (fun strm -> let rec aux n = match Util.stream_nth n strm with diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml index 2e5e11bb09..5ab877fae2 100644 --- a/vernac/metasyntax.ml +++ b/vernac/metasyntax.ml @@ -58,7 +58,7 @@ let pr_registered_grammar name = | None -> user_err Pp.(str "Unknown or unprintable grammar entry.") | Some entries -> let pr_one (Pcoq.AnyEntry e) = - str "Entry " ++ str (Pcoq.Gram.Entry.name e) ++ str " is" ++ fnl () ++ + str "Entry " ++ str (Pcoq.Entry.name e) ++ str " is" ++ fnl () ++ pr_entry e in prlist pr_one entries diff --git a/vernac/pvernac.ml b/vernac/pvernac.ml index 4761e4bbc2..f26e0d0885 100644 --- a/vernac/pvernac.ml +++ b/vernac/pvernac.ml @@ -41,8 +41,8 @@ module Vernac_ = let command_entry_ref = ref noedit_mode let command_entry = - Gram.Entry.of_parser "command_entry" - (fun strm -> Gram.Entry.parse_token_stream !command_entry_ref strm) + Pcoq.Entry.of_parser "command_entry" + (fun strm -> Pcoq.Entry.parse_token_stream !command_entry_ref strm) end diff --git a/vernac/vernacextend.ml b/vernac/vernacextend.ml index 3a321ecdb4..35f26cab4d 100644 --- a/vernac/vernacextend.ml +++ b/vernac/vernacextend.ml @@ -190,7 +190,7 @@ let vernac_extend ~command ?classifier ?entry ext = | None -> let e = match entry with | None -> "COMMAND" - | Some e -> Pcoq.Gram.Entry.name e + | Some e -> Pcoq.Entry.name e in let msg = Printf.sprintf "\ Vernac entry \"%s\" misses a classifier. \ |
