aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2018-11-22 11:44:12 +0100
committerPierre-Marie Pédrot2018-11-23 13:59:15 +0100
commit548dcdc751287274c9cce7d13d779a81346a5af2 (patch)
tree4c850e41b9e80c39e94ebdbac752d46c27db8932
parentbb4daa4af0515f3041203c5bcc0a1d8cd1123e5a (diff)
Remove the unsafe camlp5 API from the Coq codebase.
-rw-r--r--parsing/g_constr.mlg6
-rw-r--r--parsing/pcoq.ml39
-rw-r--r--parsing/pcoq.mli14
-rw-r--r--plugins/funind/g_indfun.mlg1
-rw-r--r--plugins/ltac/extraargs.mlg2
-rw-r--r--plugins/ltac/g_ltac.mlg2
-rw-r--r--plugins/ltac/g_obligations.mlg1
-rw-r--r--plugins/ltac/g_tactic.mlg10
-rw-r--r--plugins/ssr/ssrparser.mlg28
-rw-r--r--plugins/ssrmatching/g_ssrmatching.mlg2
-rw-r--r--toplevel/coqloop.ml2
-rw-r--r--vernac/g_vernac.mlg2
-rw-r--r--vernac/metasyntax.ml2
-rw-r--r--vernac/pvernac.ml4
-rw-r--r--vernac/vernacextend.ml2
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. \