diff options
Diffstat (limited to 'interp')
| -rw-r--r-- | interp/constrintern.ml | 3 | ||||
| -rw-r--r-- | interp/topconstr.ml | 16 |
2 files changed, 13 insertions, 6 deletions
diff --git a/interp/constrintern.ml b/interp/constrintern.ml index e6340646f5..c916fcd886 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -1602,7 +1602,8 @@ let internalize globalenv env allow_patvar (_, ntnvars as lvar) c = let idl_tmp = Array.map (fun ((loc,id),bl,ty,_) -> let (env',rbl) = List.fold_left intern_local_binder (env,[]) bl in - let rbl = List.map (function BDRawDef a -> a | BDPattern _ -> assert false) rbl in + let rbl = List.map (function BDRawDef a -> a | BDPattern _ -> + Loc.raise loc (Stream.Error "pattern with quote not allowed after cofix")) rbl in (List.rev rbl, intern_type env' ty,env')) dl in let idl = Array.map2 (fun (_,_,_,bd) (b,c,env') -> diff --git a/interp/topconstr.ml b/interp/topconstr.ml index 79eeacf354..a397ca82eb 100644 --- a/interp/topconstr.ml +++ b/interp/topconstr.ml @@ -60,6 +60,9 @@ let rec cases_pattern_fold_names f a = function | CPatPrim _ | CPatAtom _ -> a | CPatCast _ -> assert false +let ids_of_pattern = + cases_pattern_fold_names Id.Set.add Id.Set.empty + let ids_of_pattern_list = List.fold_left (Loc.located_fold_left @@ -92,8 +95,9 @@ let rec fold_local_binders g f n acc b = function f n (fold_local_binders g f n' acc b l) t | LocalRawDef ((_,na),t)::l -> f n (fold_local_binders g f (name_fold g na n) acc b l) t - | LocalPattern _::l -> - assert false + | LocalPattern (_,pat,t)::l -> + let acc = fold_local_binders g f (cases_pattern_fold_names g n pat) acc b l in + Option.fold_left (f n) acc t | [] -> f n acc b @@ -172,7 +176,8 @@ let split_at_annot bl na = (List.rev ans, LocalRawAssum (r, k, t) :: rest) end | LocalRawDef _ as x :: rest -> aux (x :: acc) rest - | LocalPattern _ :: rest -> assert false + | LocalPattern (loc,_,_) :: rest -> + Loc.raise loc (Stream.Error "pattern with quote not allowed after fix") | [] -> user_err_loc(loc,"", str "No parameter named " ++ Nameops.pr_id id ++ str".") @@ -195,8 +200,9 @@ let map_local_binders f g e bl = (map_binder g e nal, LocalRawAssum(nal,k,f e ty)::bl) | LocalRawDef((loc,na),ty) -> (name_fold g na e, LocalRawDef((loc,na),f e ty)::bl) - | LocalPattern _ -> - assert false in + | LocalPattern (loc,pat,t) -> + let ids = ids_of_pattern pat in + (Id.Set.fold g ids e, LocalPattern (loc,pat,Option.map (f e) t)::bl) in let (e,rbl) = List.fold_left h (e,[]) bl in (e, List.rev rbl) |