diff options
| -rw-r--r-- | gramlib/gramext.ml | 17 | ||||
| -rw-r--r-- | gramlib/gramext.mli | 1 | ||||
| -rw-r--r-- | gramlib/grammar.ml | 106 | ||||
| -rw-r--r-- | gramlib/grammar.mli | 2 | ||||
| -rw-r--r-- | gramlib/ploc.ml | 4 | ||||
| -rw-r--r-- | gramlib/ploc.mli | 7 |
6 files changed, 15 insertions, 122 deletions
diff --git a/gramlib/gramext.ml b/gramlib/gramext.ml index bd2631f747..3b2c3de760 100644 --- a/gramlib/gramext.ml +++ b/gramlib/gramext.ml @@ -41,7 +41,6 @@ and 'te g_symbol = | Scut | Stoken of Plexing.pattern | Stree of 'te g_tree - | Svala of string list * 'te g_symbol and g_action = Obj.t and 'te g_tree = Node of 'te g_node @@ -68,7 +67,6 @@ let rec derive_eps = | Sopt _ | Sflag _ -> true | Sfacto s -> derive_eps s | Stree t -> tree_derive_eps t - | Svala (_, s) -> derive_eps s | Slist1 _ | Slist1sep (_, _, _) | Snterm _ | Snterml (_, _) | Snext | Sself | Scut | Stoken _ -> false @@ -91,7 +89,6 @@ let rec eq_symbol s1 s2 = eq_symbol s1 s2 && eq_symbol sep1 sep2 && b1 = b2 | Sflag s1, Sflag s2 -> eq_symbol s1 s2 | Sopt s1, Sopt s2 -> eq_symbol s1 s2 - | Svala (ls1, s1), Svala (ls2, s2) -> ls1 = ls2 && eq_symbol s1 s2 | Stree _, Stree _ -> false | Sfacto (Stree t1), Sfacto (Stree t2) -> (* The only goal of the node 'Sfacto' is to allow tree comparison @@ -111,16 +108,6 @@ let rec eq_symbol s1 s2 = | _ -> s1 = s2 let is_before s1 s2 = - let s1 = - match s1 with - Svala (_, s) -> s - | _ -> s1 - in - let s2 = - match s2 with - Svala (_, s) -> s - | _ -> s2 - in match s1, s2 with Stoken ("ANY", _), _ -> false | _, Stoken ("ANY", _) -> true @@ -213,7 +200,6 @@ and token_exists_in_symbol f = | Sflag sy -> token_exists_in_symbol f sy | Stoken tok -> f tok | Stree t -> token_exists_in_tree f t - | Svala (_, sy) -> token_exists_in_symbol f sy | Snterm _ | Snterml (_, _) | Snext | Sself | Scut -> false let insert_level entry_name e1 symbols action slev = @@ -347,7 +333,6 @@ Error: entries \"%s\" and \"%s\" do not belong to the same grammar.\n" | Sopt s -> check_gram entry s | Sflag s -> check_gram entry s | Stree t -> tree_check_gram entry t - | Svala (_, s) -> check_gram entry s | Snext | Sself | Scut | Stoken _ -> () and tree_check_gram entry = function @@ -376,7 +361,6 @@ let insert_tokens gram symbols = | Sopt s -> insert s | Sflag s -> insert s | Stree t -> tinsert t - | Svala (_, s) -> insert s | Stoken ("ANY", _) -> () | Stoken tok -> gram.glexer.Plexing.tok_using tok; @@ -511,7 +495,6 @@ let rec decr_keyw_use gram = | Sopt s -> decr_keyw_use gram s | Sflag s -> decr_keyw_use gram s | Stree t -> decr_keyw_use_in_tree gram t - | Svala (_, s) -> decr_keyw_use gram s | Sself | Snext | Scut | Snterm _ | Snterml (_, _) -> () and decr_keyw_use_in_tree gram = function diff --git a/gramlib/gramext.mli b/gramlib/gramext.mli index f012d85bd0..eb2ea7576b 100644 --- a/gramlib/gramext.mli +++ b/gramlib/gramext.mli @@ -39,7 +39,6 @@ and 'te g_symbol = | Scut | Stoken of Plexing.pattern | Stree of 'te g_tree - | Svala of string list * 'te g_symbol and g_action = Obj.t and 'te g_tree = Node of 'te g_node diff --git a/gramlib/grammar.ml b/gramlib/grammar.ml index b38ce59fad..cdc3945323 100644 --- a/gramlib/grammar.ml +++ b/gramlib/grammar.ml @@ -54,7 +54,6 @@ let rec print_symbol ppf = | Sflag s -> fprintf ppf "FLAG %a" print_symbol1 s | Stoken (con, prm) when con <> "" && prm <> "" -> fprintf ppf "%s@ %a" con print_str prm - | Svala (_, s) -> fprintf ppf "V %a" print_symbol s | Snterml (e, l) -> fprintf ppf "%s%s@ LEVEL@ %a" e.ename (if e.elocal then "*" else "") print_str l @@ -71,8 +70,7 @@ and print_symbol1 ppf = | Stoken (con, "") -> pp_print_string ppf con | Stree t -> print_level ppf pp_print_space (flatten_tree t) | Snterml (_, _) | Slist0 _ | Slist0sep (_, _, _) | - Slist1 _ | Slist1sep (_, _, _) | Sopt _ | Sflag _ | Stoken _ | - Svala (_, _) as s -> + Slist1 _ | Slist1sep (_, _, _) | Sopt _ | Sflag _ | Stoken _ as s -> fprintf ppf "(%a)" print_symbol s and print_rule ppf symbols = fprintf ppf "@[<hov 0>"; @@ -147,9 +145,7 @@ let name_of_symbol entry = let rec get_token_list entry rev_tokl last_tok tree = match tree with Node {node = Stoken tok; son = son; brother = DeadEnd} -> - get_token_list entry (last_tok :: rev_tokl) (tok, None) son - | Node {node = Svala (ls, Stoken tok); son = son; brother = DeadEnd} -> - get_token_list entry (last_tok :: rev_tokl) (tok, Some ls) son + get_token_list entry (last_tok :: rev_tokl) tok son | _ -> if rev_tokl = [] then None else Some (rev_tokl, last_tok, tree) let rec name_of_symbol_failed entry = @@ -162,15 +158,13 @@ let rec name_of_symbol_failed entry = | Sopt s -> name_of_symbol_failed entry s | Sflag s -> name_of_symbol_failed entry s | Stree t -> name_of_tree_failed entry t - | Svala (_, s) -> name_of_symbol_failed entry s | s -> name_of_symbol entry s and name_of_tree_failed entry = function Node {node = s; brother = bro; son = son} -> let tokl = match s with - Stoken tok -> get_token_list entry [] (tok, None) son - | Svala (ls, Stoken tok) -> get_token_list entry [] (tok, Some ls) son + Stoken tok -> get_token_list entry [] tok son | _ -> None in begin match tokl with @@ -189,7 +183,7 @@ and name_of_tree_failed entry = txt | Some (rev_tokl, last_tok, son) -> List.fold_left - (fun s (tok, _) -> + (fun s tok -> (if s = "" then "" else s ^ " ") ^ entry.egram.glexer.Plexing.tok_text tok) "" (List.rev (last_tok :: rev_tokl)) @@ -302,7 +296,7 @@ let tree_failed entry prev_symb_result prev_symb tree = let txt1 = name_of_symbol_failed entry sep in txt1 ^ " or " ^ txt ^ " expected" end - | Sopt _ | Sflag _ | Stree _ | Svala (_, _) -> txt ^ " expected" + | Sopt _ | Sflag _ | Stree _ -> txt ^ " expected" | _ -> txt ^ " expected after " ^ name_of_symbol_failed entry prev_symb in if !error_verbose then @@ -410,29 +404,9 @@ let call_and_push ps al strm = let a = ps strm in let al = if !item_skipped then al else a :: al in item_skipped := false; al -let token_ematch gram (tok, vala) = +let token_ematch gram tok = let tematch = gram.glexer.Plexing.tok_match tok in - match vala with - Some al -> - let pa = - match al with - [] -> - let t = "V " ^ fst tok in gram.glexer.Plexing.tok_match (t, "") - | al -> - let rec loop = - function - a :: al -> - let pa = gram.glexer.Plexing.tok_match ("V", a) in - let pal = loop al in - (fun tok -> try pa tok with Stream.Failure -> pal tok) - | [] -> fun tok -> raise Stream.Failure - in - loop al - in - (fun tok -> - try Obj.repr (Ploc.VaAnt (Obj.magic (pa tok : string))) with - Stream.Failure -> Obj.repr (Ploc.VaVal (tematch tok))) - | None -> fun tok -> Obj.repr (tematch tok : string) + fun tok -> Obj.repr (tematch tok : string) let rec parser_of_tree entry nlevn alevn = function @@ -454,8 +428,7 @@ let rec parser_of_tree entry nlevn alevn = | Node {node = s; son = son; brother = DeadEnd} -> let tokl = match s with - Stoken tok -> get_token_list entry [] (tok, None) son - | Svala (ls, Stoken tok) -> get_token_list entry [] (tok, Some ls) son + Stoken tok -> get_token_list entry [] tok son | _ -> None in begin match tokl with @@ -472,24 +445,18 @@ let rec parser_of_tree entry nlevn alevn = raise (Stream.Error (tree_failed entry a s son)) in app act a) - | Some (rev_tokl, (last_tok, svala), son) -> - let lt = - let t = Stoken last_tok in - match svala with - Some l -> Svala (l, t) - | None -> t - in + | Some (rev_tokl, last_tok, son) -> + let lt = Stoken last_tok in let p1 = parser_of_tree entry nlevn alevn son in let p1 = parser_cont p1 entry nlevn alevn lt son in parser_of_token_list entry s son p1 (fun (strm__ : _ Stream.t) -> raise Stream.Failure) rev_tokl - (last_tok, svala) + last_tok end | Node {node = s; son = son; brother = bro} -> let tokl = match s with - Stoken tok -> get_token_list entry [] (tok, None) son - | Svala (ls, Stoken tok) -> get_token_list entry [] (tok, Some ls) son + Stoken tok -> get_token_list entry [] tok son | _ -> None in match tokl with @@ -509,18 +476,13 @@ let rec parser_of_tree entry nlevn alevn = | None -> raise (Stream.Error (tree_failed entry a s son)) end | None -> p2 strm) - | Some (rev_tokl, (last_tok, vala), son) -> - let lt = - let t = Stoken last_tok in - match vala with - Some ls -> Svala (ls, t) - | None -> t - in + | Some (rev_tokl, last_tok, son) -> + let lt = Stoken last_tok in let p2 = parser_of_tree entry nlevn alevn bro in let p1 = parser_of_tree entry nlevn alevn son in let p1 = parser_cont p1 entry nlevn alevn lt son in let p1 = - parser_of_token_list entry lt son p1 p2 rev_tokl (last_tok, vala) + parser_of_token_list entry lt son p1 p2 rev_tokl last_tok in fun (strm__ : _ Stream.t) -> try p1 strm__ with Stream.Failure -> p2 strm__ @@ -696,40 +658,6 @@ and parser_of_symbol entry nlevn = let a = pt strm__ in let ep = Stream.count strm__ in let loc = loc_of_token_interval bp ep in app a loc) - | Svala (al, s) -> - let pa = - match al with - [] -> - let t = - match s with - Sflag _ -> Some "V FLAG" - | Sopt _ -> Some "V OPT" - | Slist0 _ | Slist0sep (_, _, _) -> Some "V LIST" - | Slist1 _ | Slist1sep (_, _, _) -> Some "V LIST" - | Stoken (con, "") -> Some ("V " ^ con) - | _ -> None - in - begin match t with - Some t -> parser_of_token entry (t, "") - | None -> fun (strm__ : _ Stream.t) -> raise Stream.Failure - end - | al -> - let rec loop = - function - a :: al -> - let pa = parser_of_token entry ("V", a) in - let pal = loop al in - (fun (strm__ : _ Stream.t) -> - try pa strm__ with Stream.Failure -> pal strm__) - | [] -> fun (strm__ : _ Stream.t) -> raise Stream.Failure - in - loop al - in - let ps = parser_of_symbol entry nlevn s in - (fun (strm__ : _ Stream.t) -> - match try Some (pa strm__) with Stream.Failure -> None with - Some a -> Obj.repr (Ploc.VaAnt (Obj.magic a : string)) - | _ -> let a = ps strm__ in Obj.repr (Ploc.VaVal a)) | Snterm e -> (fun (strm__ : _ Stream.t) -> e.estart 0 strm__) | Snterml (e, l) -> (fun (strm__ : _ Stream.t) -> e.estart (level_number e l) strm__) @@ -955,7 +883,6 @@ let find_entry e s = | Sopt s -> find_symbol s | Sflag s -> find_symbol s | Stree t -> find_tree t - | Svala (_, s) -> find_symbol s | Sself | Snext | Scut | Stoken _ -> None and find_tree = function @@ -1081,8 +1008,6 @@ module type S = val s_next : ('self, 'self) ty_symbol val s_token : Plexing.pattern -> ('self, string) ty_symbol val s_rules : 'a ty_production list -> ('self, 'a) ty_symbol - val s_vala : - string list -> ('self, 'a) ty_symbol -> ('self, 'a Ploc.vala) ty_symbol val r_stop : ('self, 'r, 'r) ty_rule val r_next : ('self, 'a, 'r) ty_rule -> ('self, 'b) ty_symbol -> @@ -1169,7 +1094,6 @@ module GMake (L : GLexerType) = let s_next = Snext let s_token tok = Stoken tok let s_rules (t : Obj.t ty_production list) = Gramext.srules (Obj.magic t) - let s_vala sl s = Svala (sl, s) let r_stop = [] let r_next r s = r @ [s] let r_cut r = r @ [Scut] diff --git a/gramlib/grammar.mli b/gramlib/grammar.mli index 54b7eb5539..7bbf799938 100644 --- a/gramlib/grammar.mli +++ b/gramlib/grammar.mli @@ -129,8 +129,6 @@ module type S = val s_next : ('self, 'self) ty_symbol val s_token : Plexing.pattern -> ('self, string) ty_symbol val s_rules : 'a ty_production list -> ('self, 'a) ty_symbol - val s_vala : - string list -> ('self, 'a) ty_symbol -> ('self, 'a Ploc.vala) ty_symbol val r_stop : ('self, 'r, 'r) ty_rule val r_next : ('self, 'a, 'r) ty_rule -> ('self, 'b) ty_symbol -> diff --git a/gramlib/ploc.ml b/gramlib/ploc.ml index cb71f72678..6aa7c1a2bb 100644 --- a/gramlib/ploc.ml +++ b/gramlib/ploc.ml @@ -170,7 +170,3 @@ let raise loc exc = match exc with Exc (_, _) -> raise exc | _ -> raise (Exc (loc, exc)) - -type 'a vala = - VaAnt of string - | VaVal of 'a diff --git a/gramlib/ploc.mli b/gramlib/ploc.mli index d2ab62db06..afddefcd6e 100644 --- a/gramlib/ploc.mli +++ b/gramlib/ploc.mli @@ -108,13 +108,6 @@ val from_file : string -> t -> string * int * int * int (* pervasives *) -type 'a vala = - VaAnt of string - | VaVal of 'a - (** Encloser of many abstract syntax tree nodes types, in "strict" mode. - This allow the system of antiquotations of abstract syntax tree - quotations to work when using the quotation kit [q_ast.cmo]. *) - val call_with : 'a ref -> 'a -> ('b -> 'c) -> 'b -> 'c (** [Ploc.call_with r v f a] sets the reference [r] to the value [v], then call [f a], and resets [r] to its initial value. If [f a] raises |