diff --git a/src/proto_alpha/lib_protocol/storage_functors.ml b/src/proto_alpha/lib_protocol/storage_functors.ml
index bde65c9d02730f70566b494cb9abae42981913e0..25c5c333bf4f7a32d236c15224912cb4d743395e 100644
--- a/src/proto_alpha/lib_protocol/storage_functors.ml
+++ b/src/proto_alpha/lib_protocol/storage_functors.ml
@@ -275,6 +275,10 @@ module Make_data_set_storage (C : Raw_context.T) (I : INDEX) :
       Data_encoding.bool
 end
 
+module type DATA_NAME = sig
+  val data_name : string list
+end
+
 module Make_indexed_data_storage (C : Raw_context.T) (I : INDEX) (V : VALUE) :
   Indexed_data_storage with type t = C.t and type key = I.t and type value = V.t =
 struct
@@ -911,12 +915,8 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :
         Data_encoding.bool
   end
 
-  module Make_map (R : REGISTER) (N : NAME) (V : VALUE) :
-    Indexed_data_storage_with_local_context
-      with type t = t
-       and type key = key
-       and type value = V.t
-       and type local_context = local_context = struct
+  module Make_map_param (D : DATA_NAME) (R : REGISTER) (N : NAME) (V : VALUE) =
+  struct
     type t = C.t
 
     type context = t
@@ -927,56 +927,58 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :
 
     type nonrec local_context = local_context
 
+    let data_name = D.data_name @ N.name
+
     include Make_encoder (V)
 
-    let mem s i = Raw_context.mem (pack s i) N.name
+    let mem s i = Raw_context.mem (pack s i) data_name
 
     let get s i =
-      Raw_context.get (pack s i) N.name >>=? fun b ->
-      let key () = Raw_context.absolute_key (pack s i) N.name in
+      Raw_context.get (pack s i) data_name >>=? fun b ->
+      let key () = Raw_context.absolute_key (pack s i) data_name in
       Lwt.return (of_bytes ~key b)
 
     let find s i =
-      Raw_context.find (pack s i) N.name >|= function
+      Raw_context.find (pack s i) data_name >|= function
       | None -> Result.return_none
       | Some b ->
-          let key () = Raw_context.absolute_key (pack s i) N.name in
+          let key () = Raw_context.absolute_key (pack s i) data_name in
           of_bytes ~key b >|? fun v -> Some v
 
     let update s i v =
-      Raw_context.update (pack s i) N.name (to_bytes v) >|=? fun c ->
+      Raw_context.update (pack s i) data_name (to_bytes v) >|=? fun c ->
       let s, _ = unpack c in
       C.project s
 
     let init s i v =
-      Raw_context.init (pack s i) N.name (to_bytes v) >|=? fun c ->
+      Raw_context.init (pack s i) data_name (to_bytes v) >|=? fun c ->
       let s, _ = unpack c in
       C.project s
 
     let add s i v =
-      Raw_context.add (pack s i) N.name (to_bytes v) >|= fun c ->
+      Raw_context.add (pack s i) data_name (to_bytes v) >|= fun c ->
       let s, _ = unpack c in
       C.project s
 
     let add_or_remove s i v =
-      Raw_context.add_or_remove (pack s i) N.name (Option.map to_bytes v)
+      Raw_context.add_or_remove (pack s i) data_name (Option.map to_bytes v)
       >|= fun c ->
       let s, _ = unpack c in
       C.project s
 
     let remove s i =
-      Raw_context.remove (pack s i) N.name >|= fun c ->
+      Raw_context.remove (pack s i) data_name >|= fun c ->
       let s, _ = unpack c in
       C.project s
 
     let remove_existing s i =
-      Raw_context.remove_existing (pack s i) N.name >|=? fun c ->
+      Raw_context.remove_existing (pack s i) data_name >|=? fun c ->
       let s, _ = unpack c in
       C.project s
 
     let clear s =
       fold_keys s ~order:`Sorted ~init:s ~f:(fun i s ->
-          Raw_context.remove (pack s i) N.name >|= fun c ->
+          Raw_context.remove (pack s i) data_name >|= fun c ->
           let s, _ = unpack c in
           s)
       >|= fun t -> C.project t
@@ -1014,46 +1016,64 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :
     module Local = struct
       type context = Raw_context.Local_context.t
 
-      let mem local = Raw_context.Local_context.mem local N.name
+      let mem local = Raw_context.Local_context.mem local data_name
 
       let get local =
-        Raw_context.Local_context.get local N.name >|= fun r ->
-        let key () = Raw_context.Local_context.absolute_key local N.name in
+        Raw_context.Local_context.get local data_name >|= fun r ->
+        let key () = Raw_context.Local_context.absolute_key local data_name in
         r >>? of_bytes ~key
 
       let find local =
-        Raw_context.Local_context.find local N.name >|= function
+        Raw_context.Local_context.find local data_name >|= function
         | None -> Result.return_none
         | Some b ->
-            let key () = Raw_context.Local_context.absolute_key local N.name in
+            let key () =
+              Raw_context.Local_context.absolute_key local data_name
+            in
             of_bytes ~key b >|? fun v -> Some v
 
       let init local v =
-        Raw_context.Local_context.init local N.name (to_bytes v)
+        Raw_context.Local_context.init local data_name (to_bytes v)
 
       let update local v =
-        Raw_context.Local_context.update local N.name (to_bytes v)
+        Raw_context.Local_context.update local data_name (to_bytes v)
 
-      let add local v = Raw_context.Local_context.add local N.name (to_bytes v)
+      let add local v =
+        Raw_context.Local_context.add local data_name (to_bytes v)
 
       let add_or_remove local vo =
         Raw_context.Local_context.add_or_remove
           local
-          N.name
+          data_name
           (Option.map to_bytes vo)
 
       let remove_existing local =
-        Raw_context.Local_context.remove_existing local N.name
+        Raw_context.Local_context.remove_existing local data_name
 
-      let remove local = Raw_context.Local_context.remove local N.name
+      let remove local = Raw_context.Local_context.remove local data_name
     end
   end
 
-  module Make_carbonated_map (R : REGISTER) (N : NAME) (V : VALUE) :
-    Non_iterable_indexed_carbonated_data_storage
+  module Make_map (R : REGISTER) (N : NAME) (V : VALUE) :
+    Indexed_data_storage_with_local_context
       with type t = t
        and type key = key
-       and type value = V.t = struct
+       and type value = V.t
+       and type local_context = local_context =
+    Make_map_param
+      (struct
+        let data_name = []
+      end)
+      (R)
+      (N)
+      (V)
+
+  module Make_carbonated_map_param
+      (D : DATA_NAME)
+      (R : REGISTER)
+      (N : NAME)
+      (V : VALUE) =
+  struct
     type t = C.t
 
     type context = t
@@ -1066,7 +1086,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :
 
     let len_name = len_name :: N.name
 
-    let data_name = data_name :: N.name
+    let data_name = D.data_name @ N.name
 
     let consume_mem_gas c =
       let path_length = List.length (Raw_context.absolute_key c N.name) + 1 in
@@ -1152,33 +1172,57 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :
 
     let add_or_remove s i v =
       match v with None -> remove s i | Some v -> add s i v
+  end
 
-    let mem_unaccounted s i = Raw_context.mem (pack s i) data_name
+  module Make_carbonated_map_with_uncarbonated_accesses_INTERNAL
+      (R : REGISTER)
+      (N : NAME)
+      (V : VALUE) =
+  struct
+    module D = struct
+      let data_name = [data_name]
+    end
 
-    let fold_keys_unaccounted s ~order ~init ~f =
-      fold_keys s ~order ~init ~f:(fun i acc ->
-          mem_unaccounted s i >>= function
-          | false -> Lwt.return acc
-          | true -> f i acc)
+    include Make_map_param (D) (R) (N) (V)
 
-    let keys_unaccounted s =
-      fold_keys_unaccounted s ~order:`Sorted ~init:[] ~f:(fun p acc ->
-          Lwt.return (p :: acc))
+    module Carbonated = struct
+      include Make_carbonated_map_param (D) (R) (N) (V)
 
-    let () =
-      let open Storage_description in
-      let unpack = unpack I.args in
-      let description =
-        if R.ghost then Storage_description.create ()
-        else Raw_context.description
-      in
-      register_value
-        ~get:(fun c ->
-          let c, k = unpack c in
-          find c k >|=? fun (_, v) -> v)
-        (register_named_subcontext description N.name)
-        V.encoding
+      let keys_unaccounted = keys
+    end
   end
+
+  module Make_carbonated_map (R : REGISTER) (N : NAME) (V : VALUE) :
+    Non_iterable_indexed_carbonated_data_storage
+      with type t = t
+       and type key = key
+       and type value = V.t = struct
+    module M =
+      Make_carbonated_map_with_uncarbonated_accesses_INTERNAL (R) (N) (V)
+
+    include M.Carbonated
+  end
+
+  module Make_carbonated_map_with_uncarbonated_accesses
+      (R : REGISTER)
+      (N : NAME)
+      (V : VALUE) :
+    Carbonated_data_storage_with_uncarbonated_accesses
+      with type t = t
+       and type key = key
+       and type value = V.t =
+    Make_carbonated_map_with_uncarbonated_accesses_INTERNAL (R) (N) (V)
+
+  module Make_carbonated_map_with_uncarbonated_accesses_and_local_context
+      (R : REGISTER)
+      (N : NAME)
+      (V : VALUE) :
+    Carbonated_data_storage_with_uncarbonated_accesses_and_local_context
+      with type t = t
+       and type key = key
+       and type value = V.t
+       and type local_context = local_context =
+    Make_carbonated_map_with_uncarbonated_accesses_INTERNAL (R) (N) (V)
 end
 
 module type WRAPPER = sig
diff --git a/src/proto_alpha/lib_protocol/storage_sigs.ml b/src/proto_alpha/lib_protocol/storage_sigs.ml
index 7654bc4f1d8107bfd19e786145eae57feb78a2e7..83d3bd48a9c6b0e652a983b7294c6b91de5bd9a6 100644
--- a/src/proto_alpha/lib_protocol/storage_sigs.ml
+++ b/src/proto_alpha/lib_protocol/storage_sigs.ml
@@ -325,6 +325,26 @@ module type Indexed_data_storage_with_local_context = sig
   end
 end
 
+module type Carbonated_data_storage_with_uncarbonated_accesses = sig
+  include Indexed_data_storage
+
+  module Carbonated :
+    Non_iterable_indexed_carbonated_data_storage
+      with type key := key
+       and type value := value
+       and type t := t
+end
+
+module type Carbonated_data_storage_with_uncarbonated_accesses_and_local_context = sig
+  include Indexed_data_storage_with_local_context
+
+  module Carbonated :
+    Non_iterable_indexed_carbonated_data_storage
+      with type key := key
+       and type value := value
+       and type t := t
+end
+
 module type Indexed_data_snapshotable_storage = sig
   type snapshot
 
@@ -488,5 +508,24 @@ module type Indexed_raw_context = sig
        and type key = key
        and type value = V.t
 
+  module Make_carbonated_map_with_uncarbonated_accesses
+      (_ : REGISTER)
+      (_ : NAME)
+      (V : VALUE) :
+    Carbonated_data_storage_with_uncarbonated_accesses
+      with type t = t
+       and type key = key
+       and type value = V.t
+
+  module Make_carbonated_map_with_uncarbonated_accesses_and_local_context
+      (_ : REGISTER)
+      (_ : NAME)
+      (V : VALUE) :
+    Carbonated_data_storage_with_uncarbonated_accesses_and_local_context
+      with type t = t
+       and type key = key
+       and type value = V.t
+       and type local_context = local_context
+
   module Raw_context : Raw_context.T with type t = t ipath
 end