From c31bab2fd445dba83004ce9457eb41b6a98846b7 Mon Sep 17 00:00:00 2001 From: Sylvain Dailler <dailler@adacore.com> Date: Mon, 15 Apr 2019 10:12:20 +0200 Subject: [PATCH] Fix memoization of checksums --- src/session/termcode.ml | 35 ++++++++++++++++++++++++++++++++--- 1 file changed, 32 insertions(+), 3 deletions(-) diff --git a/src/session/termcode.ml b/src/session/termcode.ml index 00915c0f07..10244457c3 100644 --- a/src/session/termcode.ml +++ b/src/session/termcode.ml @@ -698,14 +698,14 @@ module Checksum = struct Buffer.clear b; Digest.to_hex dnew - let task_v2 version = + let task_v2 = let c = ref 0 in let m = ref Ident.Mid.empty in let b = Buffer.create 8192 in let task_hd t (cold,mold,dold) = c := cold; m := mold; - tdecl (version,c,m,b) t.Task.task_decl; + tdecl (CV2,c,m,b) t.Task.task_decl; Buffer.add_string b (Digest.to_hex dold); let dnew = Digest.string (Buffer.contents b) in Buffer.clear b; @@ -721,10 +721,39 @@ module Checksum = struct let _,_,dnew = Trans.apply tr t in Digest.to_hex dnew + (* WARNING: The occurence of [Trans.fold] in [task_v3] needs to be executed + once at initialization in order for all the applications of this + transformation to share the same Wtask ([h] created on first line of + [Trans.fold]). In short, the closure is here just so that Trans.fold is + executed once and shared for all functions. + So, in particular, don't add arguments to task_v3 here. *) + let task_v3 = + let c = ref 0 in + let m = ref Ident.Mid.empty in + let b = Buffer.create 8192 in + let task_hd t (cold,mold,dold) = + c := cold; + m := mold; + tdecl (CV3,c,m,b) t.Task.task_decl; + Buffer.add_string b (Digest.to_hex dold); + let dnew = Digest.string (Buffer.contents b) in + Buffer.clear b; + let mnew = match t.Task.task_decl.Theory.td_node with + | Theory.Decl { Decl.d_news = s } -> + Ident.Sid.fold (fun id a -> + Ident.Mid.add id (Ident.Mid.find id !m) a) s mold + | _ -> !m in + !c, mnew, dnew + in + let tr = Trans.fold task_hd (0, Ident.Mid.empty, Digest.string "") in + fun t -> + let _,_,dnew = Trans.apply tr t in + Digest.to_hex dnew let task ~version t = match version with | CV1 -> task_v1 t - | CV2 | CV3 -> task_v2 version t + | CV2 -> task_v2 t + | CV3 -> task_v3 t end -- GitLab