aboutsummaryrefslogtreecommitdiff
path: root/interp/constrextern.ml
diff options
context:
space:
mode:
Diffstat (limited to 'interp/constrextern.ml')
-rw-r--r--interp/constrextern.ml267
1 files changed, 166 insertions, 101 deletions
diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index 06232b8e1a..4ec9f17c71 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -63,6 +63,28 @@ let print_universes = Detyping.print_universes
(* This suppresses printing of primitive tokens (e.g. numeral) and notations *)
let print_no_symbol = ref false
+(* This tells to skip types if a variable has this type by default *)
+let print_use_implicit_types =
+ Goptions.declare_bool_option_and_ref
+ ~depr:false
+ ~key:["Printing";"Use";"Implicit";"Types"]
+ ~value:true
+
+(**********************************************************************)
+
+let hole = CAst.make @@ CHole (None, IntroAnonymous, None)
+
+let is_reserved_type na t =
+ not !Flags.raw_print && print_use_implicit_types () &&
+ match na with
+ | Anonymous -> false
+ | Name id ->
+ try
+ let pat = Reserve.find_reserved_type id in
+ let _ = match_notation_constr false t ([],pat) in
+ true
+ with Not_found | No_match -> false
+
(**********************************************************************)
(* Turning notations and scopes on and off for printing *)
module IRuleSet = Set.Make(struct
@@ -75,10 +97,10 @@ let inactive_notations_table =
let inactive_scopes_table =
Summary.ref ~name:"inactive_scopes_table" CString.Set.empty
-let show_scope scopt =
- match scopt with
- | None -> str ""
- | Some sc -> spc () ++ str "in scope" ++ spc () ++ str sc
+let show_scope inscope =
+ match inscope with
+ | LastLonelyNotation -> str ""
+ | NotationInScope sc -> spc () ++ str "in scope" ++ spc () ++ str sc
let _show_inactive_notations () =
begin
@@ -97,8 +119,8 @@ let _show_inactive_notations () =
let _ = Feedback.msg_notice (str "Inactive notations:") in
IRuleSet.iter
(function
- | NotationRule (scopt, ntn) ->
- Feedback.msg_notice (pr_notation ntn ++ show_scope scopt)
+ | NotationRule (inscope, ntn) ->
+ Feedback.msg_notice (pr_notation ntn ++ show_scope inscope)
| SynDefRule kn -> Feedback.msg_notice (str (string_of_qualid (Nametab.shortest_qualid_of_syndef Id.Set.empty kn))))
!inactive_notations_table
@@ -107,18 +129,19 @@ let deactivate_notation nr =
| SynDefRule kn ->
(* shouldn't we check whether it is well defined? *)
inactive_notations_table := IRuleSet.add nr !inactive_notations_table
- | NotationRule (scopt, ntn) ->
- match availability_of_notation (scopt, ntn) (scopt, []) with
+ | NotationRule (inscope, ntn) ->
+ let scopt = match inscope with NotationInScope sc -> Some sc | LastLonelyNotation -> None in
+ match availability_of_notation (inscope, ntn) (scopt, []) with
| None -> user_err ~hdr:"Notation"
(pr_notation ntn ++ spc () ++ str "does not exist"
- ++ (match scopt with
- | None -> spc () ++ str "in the empty scope."
- | Some _ -> show_scope scopt ++ str "."))
+ ++ (match inscope with
+ | LastLonelyNotation -> spc () ++ str "in the empty scope."
+ | NotationInScope _ -> show_scope inscope ++ str "."))
| Some _ ->
if IRuleSet.mem nr !inactive_notations_table then
Feedback.msg_warning
(str "Notation" ++ spc () ++ pr_notation ntn ++ spc ()
- ++ str "is already inactive" ++ show_scope scopt ++ str ".")
+ ++ str "is already inactive" ++ show_scope inscope ++ str ".")
else inactive_notations_table := IRuleSet.add nr !inactive_notations_table
let reactivate_notation nr =
@@ -127,9 +150,9 @@ let reactivate_notation nr =
IRuleSet.remove nr !inactive_notations_table
with Not_found ->
match nr with
- | NotationRule (scopt, ntn) ->
+ | NotationRule (inscope, ntn) ->
Feedback.msg_warning (str "Notation" ++ spc () ++ pr_notation ntn ++ spc ()
- ++ str "is already active" ++ show_scope scopt ++
+ ++ str "is already active" ++ show_scope inscope ++
str ".")
| SynDefRule kn ->
let s = string_of_qualid (Nametab.shortest_qualid_of_syndef Id.Set.empty kn) in
@@ -157,8 +180,8 @@ let reactivate_scope sc =
let is_inactive_rule nr =
IRuleSet.mem nr !inactive_notations_table ||
match nr with
- | NotationRule (Some sc, ntn) -> CString.Set.mem sc !inactive_scopes_table
- | NotationRule (None, ntn) -> false
+ | NotationRule (NotationInScope sc, ntn) -> CString.Set.mem sc !inactive_scopes_table
+ | NotationRule (LastLonelyNotation, ntn) -> false
| SynDefRule _ -> false
(* args: notation, scope, activate/deactivate *)
@@ -169,10 +192,13 @@ let toggle_scope_printing ~scope ~activate =
deactivate_scope scope
let toggle_notation_printing ?scope ~notation ~activate =
+ let inscope = match scope with
+ | None -> LastLonelyNotation
+ | Some sc -> NotationInScope sc in
if activate then
- reactivate_notation (NotationRule (scope, notation))
+ reactivate_notation (NotationRule (inscope, notation))
else
- deactivate_notation (NotationRule (scope, notation))
+ deactivate_notation (NotationRule (inscope, notation))
(* This governs printing of projections using the dot notation symbols *)
let print_projections = ref false
@@ -254,11 +280,11 @@ let insert_pat_alias ?loc p = function
let rec insert_coercion ?loc l c = match l with
| [] -> c
- | ntn::l -> CAst.make ?loc @@ CNotation (ntn,([insert_coercion ?loc l c],[],[],[]))
+ | (inscope,ntn)::l -> CAst.make ?loc @@ CNotation (Some inscope,ntn,([insert_coercion ?loc l c],[],[],[]))
let rec insert_pat_coercion ?loc l c = match l with
| [] -> c
- | ntn::l -> CAst.make ?loc @@ CPatNotation (ntn,([insert_pat_coercion ?loc l c],[]),[])
+ | (inscope,ntn)::l -> CAst.make ?loc @@ CPatNotation (Some inscope,ntn,([insert_pat_coercion ?loc l c],[]),[])
(**********************************************************************)
(* conversion of references *)
@@ -348,19 +374,19 @@ let make_notation_gen loc ntn mknot mkprim destprim l bl =
| None -> mknot (loc,ntn,l,bl) end
| _ -> mknot (loc,ntn,l,bl)
-let make_notation loc ntn (terms,termlists,binders,binderlists as subst) =
+let make_notation loc (inscope,ntn) (terms,termlists,binders,binderlists as subst) =
if not (List.is_empty termlists) || not (List.is_empty binderlists) then
- CAst.make ?loc @@ CNotation (ntn,subst)
+ CAst.make ?loc @@ CNotation (Some inscope,ntn,subst)
else
make_notation_gen loc ntn
- (fun (loc,ntn,l,bl) -> CAst.make ?loc @@ CNotation (ntn,(l,[],bl,[])))
+ (fun (loc,ntn,l,bl) -> CAst.make ?loc @@ CNotation (Some inscope,ntn,(l,[],bl,[])))
(fun (loc,p) -> CAst.make ?loc @@ CPrim p)
destPrim terms binders
-let make_pat_notation ?loc ntn (terms,termlists as subst) args =
- if not (List.is_empty termlists) then (CAst.make ?loc @@ CPatNotation (ntn,subst,args)) else
+let make_pat_notation ?loc (inscope,ntn) (terms,termlists as subst) args =
+ if not (List.is_empty termlists) then (CAst.make ?loc @@ CPatNotation (Some inscope,ntn,subst,args)) else
make_notation_gen loc ntn
- (fun (loc,ntn,l,_) -> CAst.make ?loc @@ CPatNotation (ntn,(l,[]),args))
+ (fun (loc,ntn,l,_) -> CAst.make ?loc @@ CPatNotation (Some inscope,ntn,(l,[]),args))
(fun (loc,p) -> CAst.make ?loc @@ CPatPrim p)
destPatPrim terms []
@@ -377,6 +403,36 @@ let pattern_printable_in_both_syntax (ind,_ as c) =
(List.for_all is_status_implicit params)&&(List.for_all (fun x -> not (is_status_implicit x)) args)
) impl_st
+let extern_record_pattern cstrsp args =
+ try
+ if !Flags.raw_print then raise Exit;
+ let projs = Recordops.lookup_projections (fst cstrsp) in
+ if PrintingRecord.active (fst cstrsp) then
+ ()
+ else if PrintingConstructor.active (fst cstrsp) then
+ raise Exit
+ else if not (get_record_print ()) then
+ raise Exit;
+ let rec ip projs args acc =
+ match projs, args with
+ | [], [] -> acc
+ | proj :: q, pat :: tail ->
+ let acc =
+ match proj, pat with
+ | _, { CAst.v = CPatAtom None } ->
+ (* we don't want to have 'x := _' in our patterns *)
+ acc
+ | Some c, _ ->
+ let loc = pat.CAst.loc in
+ (extern_reference ?loc Id.Set.empty (GlobRef.ConstRef c), pat) :: acc
+ | _ -> raise No_match in
+ ip q tail acc
+ | _ -> assert false
+ in
+ Some (List.rev (ip projs args []))
+ with
+ Not_found | No_match | Exit -> None
+
(* Better to use extern_glob_constr composed with injection/retraction ?? *)
let rec extern_cases_pattern_in_scope (custom,scopes as allscopes) vars pat =
try
@@ -411,27 +467,9 @@ let rec extern_cases_pattern_in_scope (custom,scopes as allscopes) vars pat =
| PatCstr(cstrsp,args,na) ->
let args = List.map (extern_cases_pattern_in_scope allscopes vars) args in
let p =
- try
- if !Flags.raw_print then raise Exit;
- let projs = Recordops.lookup_projections (fst cstrsp) in
- let rec ip projs args acc =
- match projs, args with
- | [], [] -> acc
- | proj :: q, pat :: tail ->
- let acc =
- match proj, pat with
- | _, { CAst.v = CPatAtom None } ->
- (* we don't want to have 'x := _' in our patterns *)
- acc
- | Some c, _ ->
- ((extern_reference ?loc Id.Set.empty (GlobRef.ConstRef c), pat) :: acc)
- | _ -> raise No_match in
- ip q tail acc
- | _ -> assert false
- in
- CPatRecord(List.rev (ip projs args []))
- with
- Not_found | No_match | Exit ->
+ match extern_record_pattern cstrsp args with
+ | Some l -> CPatRecord l
+ | None ->
let c = extern_reference Id.Set.empty (GlobRef.ConstructRef cstrsp) in
if Constrintern.get_asymmetric_patterns () then
if pattern_printable_in_both_syntax cstrsp
@@ -447,15 +485,15 @@ let rec extern_cases_pattern_in_scope (custom,scopes as allscopes) vars pat =
in
insert_pat_coercion coercion pat
-and apply_notation_to_pattern ?loc gr ((subst,substlist),(nb_to_drop,more_args))
+and apply_notation_to_pattern ?loc gr ((subst,substlist),(no_implicit,nb_to_drop,more_args))
(custom, (tmp_scope, scopes) as allscopes) vars =
function
- | NotationRule (sc,ntn) ->
+ | NotationRule (_,ntn as specific_ntn) ->
begin
match availability_of_entry_coercion custom (fst ntn) with
| None -> raise No_match
| Some coercion ->
- match availability_of_notation (sc,ntn) (tmp_scope,scopes) with
+ match availability_of_notation specific_ntn (tmp_scope,scopes) with
(* Uninterpretation is not allowed in current context *)
| None -> raise No_match
(* Uninterpretation is allowed in current context *)
@@ -470,16 +508,20 @@ and apply_notation_to_pattern ?loc gr ((subst,substlist),(nb_to_drop,more_args))
let subscope = (subentry,(scopt,scl@scopes')) in
List.map (extern_cases_pattern_in_scope subscope vars) c)
substlist in
- let l2 = List.map (extern_cases_pattern_in_scope allscopes vars) more_args in
+ let subscopes = find_arguments_scope gr in
+ let more_args_scopes = try List.skipn nb_to_drop subscopes with Failure _ -> [] in
+ let more_args = fill_arg_scopes more_args more_args_scopes allscopes in
+ let l2 = List.map (fun (c,allscopes) -> extern_cases_pattern_in_scope allscopes vars c) more_args in
let l2' = if Constrintern.get_asymmetric_patterns () || not (List.is_empty ll) then l2
else
- match drop_implicits_in_patt gr nb_to_drop l2 with
+ if no_implicit then l2 else
+ match drop_implicits_in_patt gr nb_to_drop l2 with
|Some true_args -> true_args
|None -> raise No_match
in
insert_pat_coercion coercion
(insert_pat_delimiters ?loc
- (make_pat_notation ?loc ntn (l,ll) l2') key)
+ (make_pat_notation ?loc specific_ntn (l,ll) l2') key)
end
| SynDefRule kn ->
match availability_of_entry_coercion custom InConstrEntrySomeLevel with
@@ -490,10 +532,14 @@ and apply_notation_to_pattern ?loc gr ((subst,substlist),(nb_to_drop,more_args))
List.rev_map (fun (c,(subentry,(scopt,scl))) ->
extern_cases_pattern_in_scope (subentry,(scopt,scl@scopes)) vars c)
subst in
- let l2 = List.map (extern_cases_pattern_in_scope allscopes vars) more_args in
+ let subscopes = find_arguments_scope gr in
+ let more_args_scopes = try List.skipn nb_to_drop subscopes with Failure _ -> [] in
+ let more_args = fill_arg_scopes more_args more_args_scopes allscopes in
+ let l2 = List.map (fun (c,allscopes) -> extern_cases_pattern_in_scope allscopes vars c) more_args in
let l2' = if Constrintern.get_asymmetric_patterns () then l2
else
- match drop_implicits_in_patt gr (nb_to_drop + List.length l1) l2 with
+ if no_implicit then l2 else
+ match drop_implicits_in_patt gr nb_to_drop l2 with
|Some true_args -> true_args
|None -> raise No_match
in
@@ -716,7 +762,7 @@ let extern_applied_ref inctx impl (cf,f) us args =
let extern_applied_syntactic_definition n extraimpl (cf,f) syndefargs extraargs =
try
let syndefargs = List.map (fun a -> (a,None)) syndefargs in
- let extraargs = adjust_implicit_arguments false (List.length extraargs) 1 extraargs extraimpl in
+ let extraargs = adjust_implicit_arguments false n (n-List.length extraargs+1) extraargs extraimpl in
let args = syndefargs @ extraargs in
if args = [] then cf else CApp ((None, CAst.make cf), args)
with Expl ->
@@ -736,8 +782,10 @@ let extern_applied_notation n impl f args =
if List.is_empty args then
f.CAst.v
else
- let args = adjust_implicit_arguments false (List.length args) 1 args impl in
+ try
+ let args = adjust_implicit_arguments false n (n-List.length args+1) args impl in
mkFlattenedCApp (f,args)
+ with Expl -> raise No_match
let extern_args extern env args =
let map (arg, argscopes) = lazy (extern argscopes env arg) in
@@ -786,17 +834,21 @@ let rec flatten_application c = match DAst.get c with
end
| a -> c
+let same_binder_type ty nal c =
+ match nal, DAst.get c with
+ | _::_, GProd (_,_,ty',_) -> glob_constr_eq ty ty'
+ | [], _ -> true
+ | _ -> assert false
+
(**********************************************************************)
(* mapping glob_constr to numerals (in presence of coercions, choose the *)
(* one with no delimiter if possible) *)
let extern_possible_prim_token (custom,scopes) r =
let (sc,n) = uninterp_prim_token r in
- let coercion =
- if entry_has_prim_token n custom then [] else
- match availability_of_entry_coercion custom InConstrEntrySomeLevel with
- | None -> raise No_match
- | Some coercion -> coercion in
+ match availability_of_entry_coercion custom InConstrEntrySomeLevel with
+ | None -> raise No_match
+ | Some coercion ->
match availability_of_prim_token n sc scopes with
| None -> raise No_match
| Some key -> insert_coercion coercion (insert_delimiters (CAst.make ?loc:(loc_of_glob_constr r) @@ CPrim n) key)
@@ -937,12 +989,10 @@ let rec extern inctx scopes vars r =
extern inctx scopes (add_vname vars na) c)
| GProd (na,bk,t,c) ->
- let t = extern_typ scopes vars t in
- factorize_prod scopes (add_vname vars na) na bk t c
+ factorize_prod scopes vars na bk t c
| GLambda (na,bk,t,c) ->
- let t = extern_typ scopes vars t in
- factorize_lambda inctx scopes (add_vname vars na) na bk t c
+ factorize_lambda inctx scopes vars na bk t c
| GCases (sty,rtntypopt,tml,eqns) ->
let vars' =
@@ -971,17 +1021,19 @@ let rec extern inctx scopes vars r =
) x))
tml
in
- let eqns = List.map (extern_eqn inctx scopes vars) (factorize_eqns eqns) in
+ let eqns = List.map (extern_eqn (inctx || rtntypopt <> None) scopes vars) (factorize_eqns eqns) in
CCases (sty,rtntypopt',tml,eqns)
| GLetTuple (nal,(na,typopt),tm,b) ->
- CLetTuple (List.map CAst.make nal,
+ let inctx = inctx || typopt <> None in
+ CLetTuple (List.map CAst.make nal,
(Option.map (fun _ -> (make na)) typopt,
Option.map (extern_typ scopes (add_vname vars na)) typopt),
sub_extern false scopes vars tm,
extern inctx scopes (List.fold_left add_vname vars nal) b)
| GIf (c,(na,typopt),b1,b2) ->
+ let inctx = inctx || typopt <> None in
CIf (sub_extern false scopes vars c,
(Option.map (fun _ -> (CAst.make na)) typopt,
Option.map (extern_typ scopes (add_vname vars na)) typopt),
@@ -1004,7 +1056,7 @@ let rec extern inctx scopes vars r =
| Some x -> Some (CAst.make @@ CStructRec (CAst.make @@ Name.get_id (List.nth assums x)))
in
((CAst.make fi), n, bl, extern_typ scopes vars0 ty,
- extern false scopes vars1 def)) idv
+ sub_extern true scopes vars1 def)) idv
in
CFix (CAst.(make ?loc idv.(n)), Array.to_list listdecl)
| GCoFix n ->
@@ -1015,7 +1067,7 @@ let rec extern inctx scopes vars r =
let vars0 = List.fold_right (Name.fold_right Id.Set.add) ids vars in
let vars1 = List.fold_right (Name.fold_right Id.Set.add) ids vars' in
((CAst.make fi),bl,extern_typ scopes vars0 tyv.(i),
- sub_extern false scopes vars1 bv.(i))) idv
+ sub_extern true scopes vars1 bv.(i))) idv
in
CCoFix (CAst.(make ?loc idv.(n)),Array.to_list listdecl))
@@ -1041,7 +1093,10 @@ and extern_typ (subentry,(_,scopes)) =
and sub_extern inctx (subentry,(_,scopes)) = extern inctx (subentry,(None,scopes))
-and factorize_prod scopes vars na bk aty c =
+and factorize_prod scopes vars na bk t c =
+ let implicit_type = is_reserved_type na t in
+ let aty = extern_typ scopes vars t in
+ let vars = add_vname vars na in
let store, get = set_temporary_memory () in
match na, DAst.get c with
| Name id, GCases (Constr.LetPatternStyle, None, [(e,(Anonymous,None))],(_::_ as eqns))
@@ -1058,18 +1113,25 @@ and factorize_prod scopes vars na bk aty c =
| _ -> CProdN ([binder],b))
| _ -> assert false)
| _, _ ->
- let c = extern_typ scopes vars c in
- match na, c.v with
+ let c' = extern_typ scopes vars c in
+ match na, c'.v with
| Name id, CProdN (CLocalAssum(nal,Default bk',ty)::bl,b)
- when binding_kind_eq bk bk' && constr_expr_eq aty ty
- && not (occur_var_constr_expr id ty) (* avoid na in ty escapes scope *) ->
- CProdN (CLocalAssum(make na::nal,Default bk,aty)::bl,b)
+ when binding_kind_eq bk bk'
+ && not (occur_var_constr_expr id ty) (* avoid na in ty escapes scope *)
+ && (constr_expr_eq aty ty || (constr_expr_eq ty hole && same_binder_type t nal c)) ->
+ let ty = if implicit_type then ty else aty in
+ CProdN (CLocalAssum(make na::nal,Default bk,ty)::bl,b)
| _, CProdN (bl,b) ->
- CProdN (CLocalAssum([make na],Default bk,aty)::bl,b)
+ let ty = if implicit_type then hole else aty in
+ CProdN (CLocalAssum([make na],Default bk,ty)::bl,b)
| _, _ ->
- CProdN ([CLocalAssum([make na],Default bk,aty)],c)
+ let ty = if implicit_type then hole else aty in
+ CProdN ([CLocalAssum([make na],Default bk,ty)],c')
-and factorize_lambda inctx scopes vars na bk aty c =
+and factorize_lambda inctx scopes vars na bk t c =
+ let implicit_type = is_reserved_type na t in
+ let aty = extern_typ scopes vars t in
+ let vars = add_vname vars na in
let store, get = set_temporary_memory () in
match na, DAst.get c with
| Name id, GCases (Constr.LetPatternStyle, None, [(e,(Anonymous,None))],(_::_ as eqns))
@@ -1086,16 +1148,20 @@ and factorize_lambda inctx scopes vars na bk aty c =
| _ -> CLambdaN ([binder],b))
| _ -> assert false)
| _, _ ->
- let c = sub_extern inctx scopes vars c in
- match c.v with
+ let c' = sub_extern inctx scopes vars c in
+ match c'.v with
| CLambdaN (CLocalAssum(nal,Default bk',ty)::bl,b)
- when binding_kind_eq bk bk' && constr_expr_eq aty ty
- && not (occur_name na ty) (* avoid na in ty escapes scope *) ->
+ when binding_kind_eq bk bk'
+ && not (occur_name na ty) (* avoid na in ty escapes scope *)
+ && (constr_expr_eq aty ty || (constr_expr_eq ty hole && same_binder_type t nal c)) ->
+ let aty = if implicit_type then ty else aty in
CLambdaN (CLocalAssum(make na::nal,Default bk,aty)::bl,b)
| CLambdaN (bl,b) ->
- CLambdaN (CLocalAssum([make na],Default bk,aty)::bl,b)
+ let ty = if implicit_type then hole else aty in
+ CLambdaN (CLocalAssum([make na],Default bk,ty)::bl,b)
| _ ->
- CLambdaN ([CLocalAssum([make na],Default bk,aty)],c)
+ let ty = if implicit_type then hole else aty in
+ CLambdaN ([CLocalAssum([make na],Default bk,ty)],c')
and extern_local_binder scopes vars = function
[] -> ([],[],[])
@@ -1109,15 +1175,17 @@ and extern_local_binder scopes vars = function
Option.map (extern false scopes vars) ty) :: l)
| GLocalAssum (na,bk,ty) ->
+ let implicit_type = is_reserved_type na ty in
let ty = extern_typ scopes vars ty in
(match extern_local_binder scopes (Name.fold_right Id.Set.add na vars) l with
(assums,ids,CLocalAssum(nal,k,ty')::l)
- when constr_expr_eq ty ty' &&
+ when (constr_expr_eq ty ty' || implicit_type && constr_expr_eq ty' hole) &&
match na with Name id -> not (occur_var_constr_expr id ty')
| _ -> true ->
(na::assums,na::ids,
CLocalAssum(CAst.make na::nal,k,ty')::l)
| (assums,ids,l) ->
+ let ty = if implicit_type then hole else ty in
(na::assums,na::ids,
CLocalAssum([CAst.make na],Default bk,ty) :: l))
@@ -1161,35 +1229,32 @@ and extern_notation (custom,scopes as allscopes) vars t rules =
[], [] in
(* Adjust to the number of arguments expected by the notation *)
let (t,args,argsscopes,argsimpls) = match n with
- | Some n when nallargs >= n && nallargs > 0 ->
+ | Some n when nallargs >= n ->
let args1, args2 = List.chop n args in
let args2scopes = try List.skipn n argsscopes with Failure _ -> [] in
- let args2impls = try List.skipn n argsimpls with Failure _ -> [] in
- (* Note: NApp(NRef f,[]), hence n=0, encodes @f *)
- (if Int.equal n 0 then f else DAst.make @@ GApp (f,args1)),
- args2, args2scopes, args2impls
- | None when nallargs > 0 ->
+ let args2impls =
+ if n = 0 then
+ (* Note: NApp(NRef f,[]), hence n=0, encodes @f and
+ conventionally deactivates implicit arguments *)
+ []
+ else try List.skipn n argsimpls with Failure _ -> [] in
+ DAst.make @@ GApp (f,args1), args2, args2scopes, args2impls
+ | None ->
begin match DAst.get f with
| GRef (ref,us) -> f, args, argsscopes, argsimpls
| _ -> t, [], [], []
end
- | Some 0 when nallargs = 0 ->
- begin match DAst.get f with
- | GRef (ref,us) -> DAst.make @@ GApp (t,[]), [], [], []
- | _ -> t, [], [], []
- end
- | None -> t, [], [], []
| _ -> raise No_match in
(* Try matching ... *)
let terms,termlists,binders,binderlists =
match_notation_constr !print_universes t pat in
(* Try availability of interpretation ... *)
match keyrule with
- | NotationRule (sc,ntn) ->
+ | NotationRule (_,ntn as specific_ntn) ->
(match availability_of_entry_coercion custom (fst ntn) with
| None -> raise No_match
| Some coercion ->
- match availability_of_notation (sc,ntn) scopes with
+ match availability_of_notation specific_ntn scopes with
(* Uninterpretation is not allowed in current context *)
| None -> raise No_match
(* Uninterpretation is allowed in current context *)
@@ -1212,7 +1277,7 @@ and extern_notation (custom,scopes as allscopes) vars t rules =
List.map (fun (bl,(subentry,(scopt,scl))) ->
pi3 (extern_local_binder (subentry,(scopt,scl@scopes')) vars bl))
binderlists in
- let c = make_notation loc ntn (l,ll,bl,bll) in
+ let c = make_notation loc specific_ntn (l,ll,bl,bll) in
let c = insert_coercion coercion (insert_delimiters c key) in
let args = fill_arg_scopes args argsscopes allscopes in
let args = extern_args (extern true) vars args in