diff --git a/src/parameterizedGrammar.ml b/src/parameterizedGrammar.ml index 7a036a868ddf45b0d9efb4f4e03f865646e6ee57..881da1df0e2c37cf67632186011946b4a7a3b5b1 100644 --- a/src/parameterizedGrammar.ml +++ b/src/parameterizedGrammar.ml @@ -229,7 +229,7 @@ let check positions env k expected_type = (* An identifier can be used either in a total application or as a - higher-order non terminal (no partial application is allowed). *) + higher-order nonterminal (no partial application is allowed). *) let rec parameter_type env = function | ParameterVar x -> lookup x.value env @@ -248,6 +248,10 @@ let rec parameter_type env = function [Star] otherwise it is the flexible variable. *) star_variable + | ParameterAnonymous _ -> + (* Anonymous rules are eliminated early on. *) + assert false + let check_grammar (p_grammar : Syntax.grammar) = (* [n] is the grammar size. *) let n = StringMap.cardinal p_grammar.p_rules in @@ -446,14 +450,23 @@ let rec subst_parameter subst = function | ParameterApp _ -> (* Type-checking ensures that we cannot do partial - application. Consequently, if an higher-order non terminal + application. Consequently, if a higher-order nonterminal is an actual argument, it cannot be the result of a partial application. *) assert false + | ParameterAnonymous _ -> + (* Anonymous rules are eliminated early on. *) + assert false + with Not_found -> ParameterApp (x, List.map (subst_parameter subst) ps)) + | ParameterAnonymous _ -> + (* Anonymous rules are eliminated early on. *) + assert false + + let subst_parameters subst = List.map (subst_parameter subst) @@ -513,6 +526,11 @@ let expand p_grammar = (Positions.value x) (separated_list_to_string mangle "," ps) + | ParameterAnonymous _ -> + (* Anonymous rules are eliminated early on. *) + assert false + + in let name_of symbol parameters = let param = ParameterApp (symbol, parameters) in @@ -540,6 +558,10 @@ let expand p_grammar = assert (actual_parameters = []); x, ps + | ParameterAnonymous _ -> + (* Anonymous rules are eliminated early on. *) + assert false + with Not_found -> sym, subst_parameters subst actual_parameters in diff --git a/src/parameters.ml b/src/parameters.ml index 615e7a15841e7fa482f2e8f28adf42e22ee196ee..0d497225c39ea8ae905320a4866ca65beb9ef335 100644 --- a/src/parameters.ml +++ b/src/parameters.ml @@ -10,57 +10,62 @@ let app p ps = | _ -> ParameterApp (p, ps) -let oapp1 o p = - match o with - | None -> - p - | Some var -> - ParameterApp (var, [ p ]) - let unapp = function | ParameterVar x -> (x, []) - | ParameterApp (p, ps) -> (p, ps) + | ParameterAnonymous _ -> + (* Anonymous rules are eliminated early on. *) + assert false let rec map f = function | ParameterVar x -> ParameterVar (f x) - | ParameterApp (p, ps) -> ParameterApp (f p, List.map (map f) ps) - + | ParameterAnonymous _ -> + (* Anonymous rules are eliminated early on. *) + assert false let rec fold f init = function | ParameterVar x -> f init x - | ParameterApp (p, ps) -> f (List.fold_left (fold f) init ps) p + | ParameterAnonymous _ -> + (* Anonymous rules are eliminated early on. *) + assert false let identifiers m p = - fold (fun acu x -> StringMap.add x.value x.position acu) m p + fold (fun accu x -> StringMap.add x.value x.position accu) m p type t = parameter let rec equal x y = match x, y with - | ParameterVar x, ParameterVar y when x.value = y.value -> - true + | ParameterVar x, ParameterVar y -> + x.value = y.value | ParameterApp (p1, p2), ParameterApp (p1', p2') -> p1.value = p1'.value && List.for_all2 equal p2 p2' - | _ -> false + | _ -> + (* Anonymous rules are eliminated early on. *) + false let hash = function | ParameterVar x | ParameterApp (x, _) -> Hashtbl.hash (Positions.value x) + | ParameterAnonymous _ -> + (* Anonymous rules are eliminated early on. *) + assert false let position = function | ParameterVar x | ParameterApp (x, _) -> Positions.position x + | ParameterAnonymous bs -> + Positions.position bs let with_pos p = Positions.with_pos (position p) p diff --git a/src/partialGrammar.ml b/src/partialGrammar.ml index a5cb3b54bde9c1c5a69bfa5b634c2ab6d36e5c38..91238de6230bb29b0d5ee25b1d1035064aa81245 100644 --- a/src/partialGrammar.ml +++ b/src/partialGrammar.ml @@ -434,30 +434,25 @@ let iter_on_only_used_symbols f t = let symbols_of grammar (pgrammar : Syntax.partial_grammar) = let tokens = grammar.p_tokens in let symbols_of_rule symbols prule = - let rec store_except_rule_parameters = - fun symbols (symbol, parameters) -> - (* Rule parameters are bound locally, so they are not taken into - account. *) - if List.mem symbol.value prule.pr_parameters then - symbols - else - (* Otherwise, mark this symbol as being used and analyse its - parameters. *) - List.fold_left - (fun symbols -> function - | ParameterApp (symbol, parameters) -> - store_except_rule_parameters symbols (symbol, parameters) - | ParameterVar symbol -> - store_except_rule_parameters symbols (symbol, []) - ) - (store_used_symbol symbol.position tokens symbols symbol.value) parameters + let rec store_except_rule_parameters symbols parameter = + let symbol, parameters = Parameters.unapp parameter in + (* Rule parameters are bound locally, so they are not taken into account. *) + if List.mem symbol.value prule.pr_parameters then + (* TEMPORARY probable BUG: even if the symbol is locally bound, its + parameters should still be examined! *) + symbols + else + (* Otherwise, mark this symbol as used and analyse its parameters. *) + List.fold_left + store_except_rule_parameters + (store_used_symbol symbol.position tokens symbols symbol.value) + parameters in (* Analyse each branch. *) let symbols = List.fold_left (fun symbols branch -> List.fold_left (fun symbols (_, p) -> - let symbol, parameters = Parameters.unapp p in - store_except_rule_parameters symbols (symbol, parameters) + store_except_rule_parameters symbols p ) symbols branch.pr_producers ) symbols prule.pr_branches in @@ -593,18 +588,13 @@ let check_parameterized_grammar_is_well_defined grammar = "the type of the start symbol %s is unspecified." nonterminal; ) grammar.p_start_symbols; - let parameter_head_symb = function - | ParameterVar id -> id - | ParameterApp (id, _) -> id - in - (* Every %type definition has, at its head, a nonterminal symbol. *) (* Same check for %on_error_reduce definitions. *) (* Apparently we do not check the parameters at this point. Maybe this is done later, or not at all. *) let check (kind : string) (ps : Syntax.parameter list) = List.iter (fun p -> - let head_symb = parameter_head_symb p in + let (head_symb, _) = Parameters.unapp p in if not (StringMap.mem (value head_symb) grammar.p_rules) then Error.error [Parameters.position p] "this should be a nonterminal symbol.\n\ diff --git a/src/syntax.mli b/src/syntax.mli index 32e327aedc99e450f076ef6e20581f1148568ff9..9b4a334a23e246249d9b2d40f86f353e40a2fad5 100644 --- a/src/syntax.mli +++ b/src/syntax.mli @@ -72,52 +72,6 @@ type token_properties = (* ------------------------------------------------------------------------ *) -(* A parameter is either just a symbol, or an application of a symbol to - a tuple of parameters. *) - -type parameter = - | ParameterVar of symbol Positions.located - | ParameterApp of symbol Positions.located * parameters - -and parameters = - parameter list - -(* ------------------------------------------------------------------------ *) - -(* A declaration. (Only before joining.) *) - -type declaration = - - (* Raw OCaml code. *) - - | DCode of Stretch.t - - (* Raw OCaml functor parameter. *) - - | DParameter of Stretch.ocamltype (* really a stretch *) - - (* Terminal symbol (token) declaration. *) - - | DToken of Stretch.ocamltype option * terminal - - (* Start symbol declaration. *) - - | DStart of nonterminal - - (* Priority and associativity declaration. *) - - | DTokenProperties of terminal * token_associativity * precedence_level - - (* Type declaration. *) - - | DType of Stretch.ocamltype * parameter - - (* On-error-reduce declaration. *) - - | DOnErrorReduce of parameter - -(* ------------------------------------------------------------------------ *) - (* A [%prec] annotation is optional. A production can carry at most one. If there is one, it is a symbol name. See [ParserAux]. *) @@ -134,17 +88,31 @@ type branch_production_level = (* ------------------------------------------------------------------------ *) +(* A parameter is either just a symbol or an application of a symbol to a + nonempty tuple of parameters. Before anonymous rules have been eliminated, + it can also be an anonymous rule, represented as a list of branches. *) + +type parameter = + | ParameterVar of symbol Positions.located + | ParameterApp of symbol Positions.located * parameters + | ParameterAnonymous of parameterized_branch list Positions.located + +and parameters = + parameter list + +(* ------------------------------------------------------------------------ *) + (* A producer is a pair of identifier and a parameter. In concrete syntax, it could be [e = expr], for instance. *) -type producer = +and producer = identifier Positions.located * parameter (* ------------------------------------------------------------------------ *) (* A branch contains a series of producers and a semantic action. *) -type parameterized_branch = +and parameterized_branch = { pr_branch_position : Positions.t; pr_producers : producer list; @@ -169,6 +137,40 @@ type parameterized_rule = (* ------------------------------------------------------------------------ *) +(* A declaration. (Only before joining.) *) + +type declaration = + + (* Raw OCaml code. *) + + | DCode of Stretch.t + + (* Raw OCaml functor parameter. *) + + | DParameter of Stretch.ocamltype (* really a stretch *) + + (* Terminal symbol (token) declaration. *) + + | DToken of Stretch.ocamltype option * terminal + + (* Start symbol declaration. *) + + | DStart of nonterminal + + (* Priority and associativity declaration. *) + + | DTokenProperties of terminal * token_associativity * precedence_level + + (* Type declaration. *) + + | DType of Stretch.ocamltype * parameter + + (* On-error-reduce declaration. *) + + | DOnErrorReduce of parameter + +(* ------------------------------------------------------------------------ *) + (* A partial grammar. (Only before joining.) *) type partial_grammar =