diff options
Diffstat (limited to 'interp/notation.ml')
| -rw-r--r-- | interp/notation.ml | 40 |
1 files changed, 24 insertions, 16 deletions
diff --git a/interp/notation.ml b/interp/notation.ml index c35ba44aa5..d6002d71b5 100644 --- a/interp/notation.ml +++ b/interp/notation.ml @@ -400,12 +400,12 @@ let cases_pattern_key c = match DAst.get c with | _ -> Oth let notation_constr_key = function (* Rem: NApp(NRef ref,[]) stands for @ref *) - | NApp (NRef ref,args) -> RefKey(canonical_gr ref), AppBoundedNotation (List.length args) - | NList (_,_,NApp (NRef ref,args),_,_) - | NBinderList (_,_,NApp (NRef ref,args),_,_) -> + | NApp (NRef (ref,_),args) -> RefKey(canonical_gr ref), AppBoundedNotation (List.length args) + | NList (_,_,NApp (NRef (ref,_),args),_,_) + | NBinderList (_,_,NApp (NRef (ref,_),args),_,_) -> RefKey (canonical_gr ref), AppBoundedNotation (List.length args) - | NRef ref -> RefKey(canonical_gr ref), NotAppNotation - | NApp (NList (_,_,NApp (NRef ref,args),_,_), args') -> + | NRef (ref,_) -> RefKey(canonical_gr ref), NotAppNotation + | NApp (NList (_,_,NApp (NRef (ref,_),args),_,_), args') -> RefKey (canonical_gr ref), AppBoundedNotation (List.length args + List.length args') | NApp (NList (_,_,NApp (_,args),_,_), args') -> Oth, AppBoundedNotation (List.length args + List.length args') @@ -640,7 +640,7 @@ let constr_of_globref allow_constant env sigma = function | GlobRef.IndRef c -> let sigma,c = Evd.fresh_inductive_instance env sigma c in sigma,mkIndU c - | GlobRef.ConstRef c when allow_constant -> + | GlobRef.ConstRef c when allow_constant || Environ.is_primitive_type env c -> let sigma,c = Evd.fresh_constant_instance env sigma c in sigma,mkConstU c | _ -> raise NotAValidPrimToken @@ -692,6 +692,13 @@ let rec constr_of_glob allow_constant to_post post env sigma g = match DAst.get sigma,mkApp (c, Array.of_list cl) end | Glob_term.GInt i -> sigma, mkInt i + | Glob_term.GFloat f -> sigma, mkFloat f + | Glob_term.GArray (_,t,def,ty) -> + let sigma, u' = Evd.fresh_array_instance env sigma in + let sigma, def' = constr_of_glob allow_constant to_post post env sigma def in + let sigma, t' = Array.fold_left_map (constr_of_glob allow_constant to_post post env) sigma t in + let sigma, ty' = constr_of_glob allow_constant to_post post env sigma ty in + sigma, mkArray (u',t',def',ty') | Glob_term.GSort gs -> let sigma,c = Evd.fresh_sort_in_family sigma (Glob_ops.glob_sort_family gs) in sigma,mkSort c @@ -712,6 +719,12 @@ let rec glob_of_constr token_kind ?loc env sigma c = match Constr.kind c with | Ind (ind, _) -> DAst.make ?loc (Glob_term.GRef (GlobRef.IndRef ind, None)) | Var id -> DAst.make ?loc (Glob_term.GRef (GlobRef.VarRef id, None)) | Int i -> DAst.make ?loc (Glob_term.GInt i) + | Float f -> DAst.make ?loc (Glob_term.GFloat f) + | Array (u,t,def,ty) -> + let def' = glob_of_constr token_kind ?loc env sigma def + and t' = Array.map (glob_of_constr token_kind ?loc env sigma) t + and ty' = glob_of_constr token_kind ?loc env sigma ty in + DAst.make ?loc (Glob_term.GArray (None,t',def',ty')) | Sort Sorts.SProp -> DAst.make ?loc (Glob_term.GSort (Glob_term.UNamed [Glob_term.GSProp, 0])) | Sort Sorts.Prop -> DAst.make ?loc (Glob_term.GSort (Glob_term.UNamed [Glob_term.GProp, 0])) | Sort Sorts.Set -> DAst.make ?loc (Glob_term.GSort (Glob_term.UNamed [Glob_term.GSet, 0])) @@ -782,13 +795,7 @@ end let z_two = Z.of_int 2 (** Conversion from bigint to int63 *) -let rec int63_of_pos_bigint i = - if Z.(equal i zero) then Uint63.of_int 0 - else - let quo, remi = Z.div_rem i z_two in - if Z.(equal remi one) then Uint63.add (Uint63.of_int 1) - (Uint63.mul (Uint63.of_int 2) (int63_of_pos_bigint quo)) - else Uint63.mul (Uint63.of_int 2) (int63_of_pos_bigint quo) +let int63_of_pos_bigint i = Uint63.of_int64 (Z.to_int64 i) module Numbers = struct (** * Number notation *) @@ -1041,7 +1048,7 @@ let interp_int63 ?loc n = let bigint_of_int63 c = match Constr.kind c with - | Int i -> Z.of_string (Uint63.to_string i) + | Int i -> Z.of_int64 (Uint63.to_int64 i) | _ -> raise NotAValidPrimToken let interp o ?loc n = @@ -1350,6 +1357,7 @@ let find_with_delimiters = function match (String.Map.find scope !scope_map).delimiters with | Some key -> Some (Some scope, Some key) | None -> None + | exception Not_found -> None let rec find_without_delimiters find (ntn_scope,ntn) = function | OpenScopeItem scope :: scopes -> @@ -2346,8 +2354,8 @@ let browse_notation strict ntn map = let global_reference_of_notation ~head test (ntn,sc,(on_parsing,on_printing,{not_interp = (_,c)})) = match c with - | NRef ref when test ref -> Some (on_parsing,on_printing,ntn,sc,ref) - | NApp (NRef ref, l) when head || List.for_all isNVar_or_NHole l && test ref -> + | NRef (ref,_) when test ref -> Some (on_parsing,on_printing,ntn,sc,ref) + | NApp (NRef (ref,_), l) when head || List.for_all isNVar_or_NHole l && test ref -> Some (on_parsing,on_printing,ntn,sc,ref) | _ -> None |