diff options
| author |  Maxime Dénès <mail@maximedenes.fr> | 2017-08-01 13:01:53 +0200 |
|---|---|---|
| committer | Maxime Dénès <mail@maximedenes.fr> | 2017-08-01 13:01:53 +0200 |
| commit | 89fa6804337ca0ca091b32261d0b4684ba30432d (patch) | |
| tree | d3171707fc94d4851e0498ea58a051528e294d57 /pretyping/detyping.ml | |
| parent | 72c69399c0d4b37174f9d91ac79fc359619eb63c (diff) | |
| parent | d5ee6e2d24d0f9b42499b507fe9d03555c9ddf45 (diff) | |
Merge PR #913: Less allocations in Detyping
Diffstat (limited to 'pretyping/detyping.ml')
| -rw-r--r-- | pretyping/detyping.ml | 13 |
1 files changed, 11 insertions, 2 deletions
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml index cac411183..a27debe73 100644 --- a/pretyping/detyping.ml +++ b/pretyping/detyping.ml @@ -475,8 +475,8 @@ let rec detype flags avoid env sigma t = CAst.make @@ GApp (f',args''@args') | _ -> GApp (f',args') in - mkapp (detype flags avoid env sigma f) - (Array.map_to_list (detype flags avoid env sigma) args) + mkapp (detype flags avoid env sigma f) + (detype_array flags avoid env sigma args) | Const (sp,u) -> GRef (ConstRef sp, detype_instance sigma u) | Proj (p,c) -> let noparams () = @@ -694,6 +694,15 @@ and detype_binder (lax,isgoal as flags) bk avoid env sigma na body ty c = let t = if s != InProp && not !Flags.raw_print then None else Some (detype (lax,false) avoid env sigma ty) in GLetIn (na', c, t, r) +(** We use a dedicated function here to prevent overallocation from + Array.map_to_list. *) +and detype_array flags avoid env sigma args = + let ans = ref [] in + for i = Array.length args - 1 downto 0 do + ans := detype flags avoid env sigma args.(i) :: !ans; + done; + !ans + let detype_rel_context ?(lax=false) where avoid env sigma sign = let where = Option.map (fun c -> EConstr.it_mkLambda_or_LetIn c sign) where in let rec aux avoid env = function |