diff --git a/gcc/ada/libgnat/a-cofuba.adb b/gcc/ada/libgnat/a-cofuba.adb
--- a/gcc/ada/libgnat/a-cofuba.adb
+++ b/gcc/ada/libgnat/a-cofuba.adb
@@ -52,6 +52,24 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
    --  Resize the underlying array if needed so that it can contain one more
    --  element.
 
+   function Elements (C : Container) return Element_Array_Access is
+     (C.Controlled_Base.Base.Elements)
+   with
+     Global => null,
+     Pre    =>
+       C.Controlled_Base.Base /= null
+       and then C.Controlled_Base.Base.Elements /= null;
+
+   function Get
+     (C_E : Element_Array_Access;
+      I   : Count_Type)
+      return Element_Access
+   is
+     (C_E (I).Ref.E_Access)
+   with
+     Global => null,
+     Pre    => C_E /= null and then C_E (I).Ref /= null;
+
    ---------
    -- "=" --
    ---------
@@ -61,9 +79,8 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
       if C1.Length /= C2.Length then
          return False;
       end if;
-
       for I in 1 .. C1.Length loop
-         if C1.Base.Elements (I).all /= C2.Base.Elements (I).all then
+         if Get (Elements (C1), I).all /= Get (Elements (C2), I).all then
             return False;
          end if;
       end loop;
@@ -78,7 +95,7 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
    function "<=" (C1 : Container; C2 : Container) return Boolean is
    begin
       for I in 1 .. C1.Length loop
-         if Find (C2, C1.Base.Elements (I)) = 0 then
+         if Find (C2, Get (Elements (C1), I)) = 0 then
             return False;
          end if;
       end loop;
@@ -95,50 +112,138 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
       I : Index_Type;
       E : Element_Type) return Container
    is
+      C_B : Array_Base_Access renames C.Controlled_Base.Base;
    begin
-      if To_Count (I) = C.Length + 1 and then C.Length = C.Base.Max_Length then
-         Resize (C.Base);
-         C.Base.Max_Length := C.Base.Max_Length + 1;
-         C.Base.Elements (C.Base.Max_Length) := new Element_Type'(E);
+      if To_Count (I) = C.Length + 1 and then C.Length = C_B.Max_Length then
+         Resize (C_B);
+         C_B.Max_Length := C_B.Max_Length + 1;
+         C_B.Elements (C_B.Max_Length) := Element_Init (E);
 
-         return Container'(Length => C.Base.Max_Length, Base => C.Base);
+         return Container'(Length          => C_B.Max_Length,
+                           Controlled_Base => C.Controlled_Base);
       else
          declare
-            A : constant Array_Base_Access := Content_Init (C.Length);
+            A : constant Array_Base_Controlled_Access :=
+              Content_Init (C.Length);
             P : Count_Type := 0;
          begin
-            A.Max_Length := C.Length + 1;
+            A.Base.Max_Length := C.Length + 1;
             for J in 1 .. C.Length + 1 loop
                if J /= To_Count (I) then
                   P := P + 1;
-                  A.Elements (J) := C.Base.Elements (P);
+                  A.Base.Elements (J) := C_B.Elements (P);
                else
-                  A.Elements (J) := new Element_Type'(E);
+                  A.Base.Elements (J) := Element_Init (E);
                end if;
             end loop;
 
-            return Container'(Length => A.Max_Length,
-                              Base   => A);
+            return Container'(Length           => A.Base.Max_Length,
+                              Controlled_Base  => A);
          end;
       end if;
    end Add;
 
+   ------------
+   -- Adjust --
+   ------------
+
+   procedure Adjust (Controlled_Base : in out Array_Base_Controlled_Access) is
+      C_B : Array_Base_Access renames Controlled_Base.Base;
+   begin
+      if C_B /= null then
+         C_B.Reference_Count := C_B.Reference_Count + 1;
+      end if;
+   end Adjust;
+
+   procedure Adjust (Ctrl_E : in out Controlled_Element_Access) is
+   begin
+      if Ctrl_E.Ref /= null then
+         Ctrl_E.Ref.Reference_Count := Ctrl_E.Ref.Reference_Count + 1;
+      end if;
+   end Adjust;
+
    ------------------
    -- Content_Init --
    ------------------
 
-   function Content_Init (L : Count_Type := 0) return Array_Base_Access
+   function Content_Init
+     (L : Count_Type := 0) return Array_Base_Controlled_Access
    is
       Max_Init : constant Count_Type := 100;
       Size     : constant Count_Type :=
         (if L < Count_Type'Last - Max_Init then L + Max_Init
          else Count_Type'Last);
+
+      --  The Access in the array will be initialized to null
+
       Elements : constant Element_Array_Access :=
         new Element_Array'(1 .. Size => <>);
+      B        : constant Array_Base_Access :=
+        new Array_Base'(Reference_Count => 1,
+                        Max_Length      => 0,
+                        Elements        => Elements);
    begin
-      return new Array_Base'(Max_Length => 0, Elements => Elements);
+      return (Ada.Finalization.Controlled with Base => B);
    end Content_Init;
 
+   ------------------
+   -- Element_Init --
+   ------------------
+
+   function Element_Init (E : Element_Type) return Controlled_Element_Access
+   is
+      Refcounted_E : constant Refcounted_Element_Access :=
+        new Refcounted_Element'(Reference_Count => 1,
+                                E_Access        => new Element_Type'(E));
+   begin
+      return (Ada.Finalization.Controlled with Ref => Refcounted_E);
+   end Element_Init;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   procedure Finalize (Controlled_Base : in out Array_Base_Controlled_Access)
+   is
+      procedure Unchecked_Free_Base is new Ada.Unchecked_Deallocation
+        (Object => Array_Base,
+         Name   => Array_Base_Access);
+      procedure Unchecked_Free_Array is new Ada.Unchecked_Deallocation
+        (Object => Element_Array,
+         Name   => Element_Array_Access);
+
+      C_B : Array_Base_Access renames Controlled_Base.Base;
+   begin
+      if C_B /= null then
+         C_B.Reference_Count := C_B.Reference_Count - 1;
+         if C_B.Reference_Count = 0 then
+            Unchecked_Free_Array (Controlled_Base.Base.Elements);
+            Unchecked_Free_Base (Controlled_Base.Base);
+         end if;
+         C_B := null;
+      end if;
+   end Finalize;
+
+   procedure Finalize (Ctrl_E : in out Controlled_Element_Access) is
+      procedure Unchecked_Free_Ref is new Ada.Unchecked_Deallocation
+        (Object => Refcounted_Element,
+         Name   => Refcounted_Element_Access);
+
+      procedure Unchecked_Free_Element is new Ada.Unchecked_Deallocation
+        (Object => Element_Type,
+         Name   => Element_Access);
+
+   begin
+      if Ctrl_E.Ref /= null then
+         Ctrl_E.Ref.Reference_Count := Ctrl_E.Ref.Reference_Count - 1;
+         if Ctrl_E.Ref.Reference_Count = 0 then
+            Unchecked_Free_Element (Ctrl_E.Ref.E_Access);
+            Unchecked_Free_Ref (Ctrl_E.Ref);
+         end if;
+         Ctrl_E.Ref := null;
+      end if;
+   end Finalize;
+
    ----------
    -- Find --
    ----------
@@ -146,7 +251,7 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
    function Find (C : Container; E : access Element_Type) return Count_Type is
    begin
       for I in 1 .. C.Length loop
-         if C.Base.Elements (I).all = E.all then
+         if Get (Elements (C), I).all = E.all then
             return I;
          end if;
       end loop;
@@ -162,7 +267,7 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
    ---------
 
    function Get (C : Container; I : Index_Type) return Element_Type is
-     (C.Base.Elements (To_Count (I)).all);
+      (Get (Elements (C), To_Count (I)).all);
 
    ------------------
    -- Intersection --
@@ -170,19 +275,19 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
 
    function Intersection (C1 : Container; C2 : Container) return Container is
       L : constant Count_Type := Num_Overlaps (C1, C2);
-      A : constant Array_Base_Access := Content_Init (L);
+      A : constant Array_Base_Controlled_Access := Content_Init (L);
       P : Count_Type := 0;
 
    begin
-      A.Max_Length := L;
+      A.Base.Max_Length := L;
       for I in 1 .. C1.Length loop
-         if Find (C2, C1.Base.Elements (I)) > 0 then
+         if Find (C2, Get (Elements (C1), I)) > 0 then
             P := P + 1;
-            A.Elements (P) := C1.Base.Elements (I);
+            A.Base.Elements (P) := Elements (C1) (I);
          end if;
       end loop;
 
-      return Container'(Length => P, Base => A);
+      return Container'(Length => P, Controlled_Base => A);
    end Intersection;
 
    ------------
@@ -199,7 +304,7 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
 
    begin
       for I in 1 .. C1.Length loop
-         if Find (C2, C1.Base.Elements (I)) > 0 then
+         if Find (C2, Get (Elements (C1), I)) > 0 then
             P := P + 1;
          end if;
       end loop;
@@ -214,21 +319,23 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
    function Remove (C : Container; I : Index_Type) return Container is
    begin
       if To_Count (I) = C.Length then
-         return Container'(Length => C.Length - 1, Base => C.Base);
+         return Container'(Length          => C.Length - 1,
+                           Controlled_Base => C.Controlled_Base);
       else
          declare
-            A : constant Array_Base_Access := Content_Init (C.Length - 1);
+            A : constant Array_Base_Controlled_Access
+              := Content_Init (C.Length - 1);
             P : Count_Type := 0;
          begin
-            A.Max_Length := C.Length - 1;
+            A.Base.Max_Length := C.Length - 1;
             for J in 1 .. C.Length loop
                if J /= To_Count (I) then
                   P := P + 1;
-                  A.Elements (P) := C.Base.Elements (J);
+                  A.Base.Elements (P) := Elements (C) (J);
                end if;
             end loop;
 
-            return Container'(Length => C.Length - 1, Base => A);
+            return Container'(Length => C.Length - 1, Controlled_Base => A);
          end;
       end if;
    end Remove;
@@ -277,13 +384,14 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
       E : Element_Type) return Container
    is
       Result : constant Container :=
-                 Container'(Length => C.Length,
-                            Base => Content_Init (C.Length));
+                 Container'(Length          => C.Length,
+                            Controlled_Base => Content_Init (C.Length));
+      R_Base : Array_Base_Access renames Result.Controlled_Base.Base;
 
    begin
-      Result.Base.Max_Length := C.Length;
-      Result.Base.Elements (1 .. C.Length) := C.Base.Elements (1 .. C.Length);
-      Result.Base.Elements (To_Count (I)) := new Element_Type'(E);
+      R_Base.Max_Length := C.Length;
+      R_Base.Elements (1 .. C.Length) := Elements (C) (1 .. C.Length);
+      R_Base.Elements (To_Count (I)) := Element_Init (E);
       return Result;
    end Set;
 
@@ -305,20 +413,19 @@ package body Ada.Containers.Functional_Base with SPARK_Mode => Off is
 
       declare
          L : constant Count_Type := Length (C1) - N + Length (C2);
-         A : constant Array_Base_Access := Content_Init (L);
+         A : constant Array_Base_Controlled_Access := Content_Init (L);
          P : Count_Type := Length (C1);
-
       begin
-         A.Max_Length := L;
-         A.Elements (1 .. C1.Length) := C1.Base.Elements (1 .. C1.Length);
+         A.Base.Max_Length := L;
+         A.Base.Elements (1 .. C1.Length) := Elements (C1) (1 .. C1.Length);
          for I in 1 .. C2.Length loop
-            if Find (C1, C2.Base.Elements (I)) = 0 then
+            if Find (C1, Get (Elements (C2), I)) = 0 then
                P := P + 1;
-               A.Elements (P) := C2.Base.Elements (I);
+               A.Base.Elements (P) := Elements (C2) (I);
             end if;
          end loop;
 
-         return Container'(Length => L, Base => A);
+         return Container'(Length => L, Controlled_Base => A);
       end;
    end Union;
 


diff --git a/gcc/ada/libgnat/a-cofuba.ads b/gcc/ada/libgnat/a-cofuba.ads
--- a/gcc/ada/libgnat/a-cofuba.ads
+++ b/gcc/ada/libgnat/a-cofuba.ads
@@ -34,6 +34,10 @@
 
 pragma Ada_2012;
 
+--  To allow reference counting on the base container
+
+private with Ada.Finalization;
+
 private generic
    type Index_Type is (<>);
    --  To avoid Constraint_Error being raised at run time, Index_Type'Base
@@ -98,33 +102,97 @@ package Ada.Containers.Functional_Base with SPARK_Mode => Off is
 
 private
 
+   --  Theoretically, each operation on a functional container implies the
+   --  creation of a new container i.e. the copy of the array itself and all
+   --  the elements in it. In the implementation, most of these copies are
+   --  avoided by sharing between the containers.
+   --
+   --  A container stores its last used index. So, when adding an
+   --  element at the end of the container, the exact same array can be reused.
+   --  As a functionnal container cannot be modifed once created, there is no
+   --  risk of unwanted modifications.
+   --
+   --                 _1_2_3_
+   --  S             :    end       => [1, 2, 3]
+   --                      |
+   --                 |1|2|3|4|.|.|
+   --                        |
+   --  Add (S, 4, 4) :      end     => [1, 2, 3, 4]
+   --
+   --  The elements are also shared between containers as much as possible. For
+   --  example, when something is added in the middle, the array is changed but
+   --  the elementes are reused.
+   --
+   --                  _1_2_3_4_
+   --  S             : |1|2|3|4|    => [1, 2, 3, 4]
+   --                   |  \ \ \
+   --  Add (S, 2, 5) : |1|5|2|3|4|  => [1, 5, 2, 3, 4]
+   --
+   --  To make this sharing possible, both the elements and the arrays are
+   --  stored inside dynamically allocated access types which shall be
+   --  deallocated when they are no longer used. The memory is managed using
+   --  reference counting both at the array and at the element level.
+
    subtype Positive_Count_Type is Count_Type range 1 .. Count_Type'Last;
 
+   type Reference_Count_Type is new Natural;
+
    type Element_Access is access all Element_Type;
 
+   type Refcounted_Element is record
+      Reference_Count : Reference_Count_Type;
+      E_Access        : Element_Access;
+   end record;
+
+   type Refcounted_Element_Access is access Refcounted_Element;
+
+   type Controlled_Element_Access is new Ada.Finalization.Controlled
+   with record
+      Ref : Refcounted_Element_Access := null;
+   end record;
+
+   function Element_Init (E : Element_Type) return Controlled_Element_Access;
+   --  Use to initialize a refcounted element
+
    type Element_Array is
-     array (Positive_Count_Type range <>) of Element_Access;
+     array (Positive_Count_Type range <>) of Controlled_Element_Access;
 
    type Element_Array_Access_Base is access Element_Array;
 
-   subtype Element_Array_Access is not null Element_Array_Access_Base;
-
-   Empty_Element_Array_Access : constant Element_Array_Access :=
-     new Element_Array'(1 .. 0 => null);
+   subtype Element_Array_Access is Element_Array_Access_Base;
 
    type Array_Base is record
-     Max_Length : Count_Type;
-     Elements   : Element_Array_Access;
+     Reference_Count : Reference_Count_Type;
+     Max_Length      : Count_Type;
+     Elements        : Element_Array_Access;
+   end record;
+
+   type Array_Base_Access is access Array_Base;
+
+   type Array_Base_Controlled_Access is new Ada.Finalization.Controlled
+   with record
+      Base : Array_Base_Access;
    end record;
 
-   type Array_Base_Access is not null access Array_Base;
+   overriding procedure Adjust
+     (Controlled_Base : in out Array_Base_Controlled_Access);
+
+   overriding procedure Finalize
+     (Controlled_Base : in out Array_Base_Controlled_Access);
+
+   overriding procedure Adjust
+     (Ctrl_E : in out Controlled_Element_Access);
+
+   overriding procedure Finalize
+     (Ctrl_E : in out Controlled_Element_Access);
 
-   function Content_Init (L : Count_Type := 0) return Array_Base_Access;
+   function Content_Init (L : Count_Type := 0)
+                          return Array_Base_Controlled_Access;
    --  Used to initialize the content of an array base with length L
 
    type Container is record
-      Length : Count_Type := 0;
-      Base   : Array_Base_Access := Content_Init;
+      Length          : Count_Type := 0;
+      Controlled_Base : Array_Base_Controlled_Access := Content_Init;
    end record;
 
 end Ada.Containers.Functional_Base;


