diff options
author | 2017-04-15 12:15:13 +0200 | |
---|---|---|
committer | 2017-04-15 12:15:13 +0200 | |
commit | 0147ae6ba6db24d4f9b29ff477d374a6abb103dd (patch) | |
tree | b07f2d41760b7c138fc7b7b6a652320e5169e4f3 /vernac | |
parent | ed09fccb6405fb832cab867919cc4b0be32dea36 (diff) | |
parent | 727ef1bd345f9ad9e08d9e4f136e2db7d034a93d (diff) |
Merge branch 'v8.6' into trunk
Diffstat (limited to 'vernac')
-rw-r--r-- | vernac/command.ml | 3 | ||||
-rw-r--r-- | vernac/metasyntax.ml | 40 | ||||
-rw-r--r-- | vernac/vernacentries.ml | 2 |
3 files changed, 38 insertions, 7 deletions
diff --git a/vernac/command.ml b/vernac/command.ml index 4a5a4312e..5ec708446 100644 --- a/vernac/command.ml +++ b/vernac/command.ml @@ -603,12 +603,13 @@ let interp_mutual_inductive (paramsl,indl) notations poly prv finite = lift_implicits (Context.Rel.nhyps ctx_params) impls) arities in let arities = List.map pi1 arities and aritypoly = List.map pi2 arities in let impls = compute_internalization_env env0 (Inductive params) indnames fullarities indimpls in + let implsforntn = compute_internalization_env env0 Variable indnames fullarities indimpls in let mldatas = List.map2 (mk_mltype_data evdref env_params params) arities indnames in let constructors = Metasyntax.with_syntax_protection (fun () -> (* Temporary declaration of notations and scopes *) - List.iter (Metasyntax.set_notation_for_interpretation impls) notations; + List.iter (Metasyntax.set_notation_for_interpretation implsforntn) notations; (* Interpret the constructor types *) List.map3 (interp_cstrs env_ar_params evdref impls) mldatas arities indl) () in diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml index 7e98d114a..f805eeaa9 100644 --- a/vernac/metasyntax.ml +++ b/vernac/metasyntax.ml @@ -522,11 +522,35 @@ let read_recursive_format sl fmt = let slfmt, fmt = get_head fmt in slfmt, get_tail (slfmt, fmt) +let warn_skip_spaces_curly = + CWarnings.create ~name:"skip-spaces-curly" ~category:"parsing" + (fun () ->strbrk "Skipping spaces inside curly brackets") + +let rec drop_spacing = function + | UnpCut _ as u :: fmt -> warn_skip_spaces_curly (); drop_spacing fmt + | UnpTerminal s' :: fmt when String.equal s' (String.make (String.length s') ' ') -> warn_skip_spaces_curly (); drop_spacing fmt + | fmt -> fmt + +let has_closing_curly_brace symbs fmt = + (* TODO: recognize and fail in case a box overlaps a pair of curly braces *) + let fmt = drop_spacing fmt in + match symbs, fmt with + | NonTerminal s :: symbs, (UnpTerminal s' as u) :: fmt when Id.equal s (Id.of_string s') -> + let fmt = drop_spacing fmt in + (match fmt with + | UnpTerminal "}" :: fmt -> Some (u :: fmt) + | _ -> None) + | _ -> None + let hunks_of_format (from,(vars,typs)) symfmt = + let a = ref None in let rec aux = function | symbs, (UnpTerminal s' as u) :: fmt when String.equal s' (String.make (String.length s') ' ') -> let symbs, l = aux (symbs,fmt) in symbs, u :: l + | symbs, (UnpTerminal "{") :: fmt when (a := has_closing_curly_brace symbs fmt; !a <> None) -> + let newfmt = Option.get !a in + aux (symbs,newfmt) | Terminal s :: symbs, (UnpTerminal s') :: fmt when String.equal s (String.drop_simple_quotes s') -> let symbs, l = aux (symbs,fmt) in symbs, UnpTerminal s :: l @@ -814,6 +838,15 @@ let check_useless_entry_types recvars mainvars etyps = (pr_id x ++ str " is unbound in the notation.") | _ -> () +let check_binder_type recvars etyps = + let l1,l2 = List.split recvars in + let l = l1@l2 in + List.iter (function + | (x,ETBinder b) when not (List.mem x l) -> + CErrors.user_err (str (if b then "binder" else "closed binder") ++ + strbrk " is only for use in recursive notations for binders.") + | _ -> ()) etyps + let not_a_syntax_modifier = function | SetOnlyParsing -> true | SetOnlyPrinting -> true @@ -981,10 +1014,6 @@ let check_curly_brackets_notation_exists () = error "Notations involving patterns of the form \"{ _ }\" are treated \n\ specially and require that the notation \"{ _ }\" is already reserved." -let warn_skip_spaces_curly = - CWarnings.create ~name:"skip-spaces-curly" ~category:"parsing" - (fun () ->strbrk "Skipping spaces inside curly brackets") - (* Remove patterns of the form "{ _ }", unless it is the "{ _ }" notation *) let remove_curly_brackets l = let rec skip_break acc = function @@ -1057,9 +1086,10 @@ let compute_syntax_data df modifiers = let toks = split_notation_string df in let recvars,mainvars,symbols = analyze_notation_tokens toks in let _ = check_useless_entry_types recvars mainvars mods.etyps in + let _ = check_binder_type recvars mods.etyps in (* Notations for interp and grammar *) - let ntn_for_interp = make_notation_key symbols in +let ntn_for_interp = make_notation_key symbols in let symbols' = remove_curly_brackets symbols in let ntn_for_grammar = make_notation_key symbols' in if not onlyprint then check_rule_productivity symbols'; diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index 287584d56..92b1a5956 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -2200,7 +2200,7 @@ let interp ?(verbosely=true) ?proof (loc,c) = current_timeout := Some n; aux ?locality ?polymorphism isprogcmd v | VernacRedirect (s, (_,v)) -> - Topfmt.with_output_to_file s (aux false) v + Topfmt.with_output_to_file s (aux ?locality ?polymorphism isprogcmd) v | VernacTime (_,v) -> System.with_time !Flags.time (aux ?locality ?polymorphism isprogcmd) v; |