-- file : tri_fusion_liste.adb

with Ada.Text_Io, Ada.Integer_Text_Io;
use Ada.Text_Io, Ada.Integer_Text_Io;

-- on utilise explicitement la longueur de la liste
-- et on fait en sorte de ne pas avoir à la calculer
-- quand on la connaît sans calcul !!!


procedure Tri_Fusion_Liste is 
  type Cell; 
  type Pt_Cell is access Cell; 
  type Cell is 
     record 
        D : Integer;  
        S : Pt_Cell := null;  
     end record; 

  type List is 
     record 
        Deb : Pt_Cell;  
        Lon : Natural;  
     end record;
     
  function Cons (N : Integer; L : Pt_Cell  ) return Pt_Cell is 
  begin
    return new Cell'(N,L);
  end Cons;

  procedure Ecrire (L : in Pt_Cell ) is 
    K : Pt_Cell := L;  
  begin
    Put("[");
    if K/= null then
      Put(K.D,Width => 3); K:=K.S;
    end if;

    while K/= null loop
      Put(";"); Put(K.D,Width => 3); K:= K.S;
    end loop;
    Put("]");
  end Ecrire;

  procedure Tf (Li : in out List ) is 
    -- ** idee de tri fusion: une liste de 0 ou 1 elts est deja triée
    L1, L2 : List;  

    procedure Div ( Li : in List; L1, L2 : out List ) is 

      Pt : Pt_Cell := Li.Deb;  
    begin
      L1.Deb := Li.Deb; 
      L1.Lon:= Li.Lon / 2; L2.Lon:= Li.Lon-L1.Lon; 

      for I in 1..(L1.Lon - 1) loop

        Pt:=Pt.S;

      end loop; --en sortant pt pointe sur le dernier de L1

      L2.Deb := Pt.S;-- on est passe a la cellule suivante du bon nbre de fois
      Pt.S:= null;
      Put("divide "); Ecrire(L1.Deb); Ecrire(L2.Deb); New_Line;
    end Div;


    procedure Conquer (L1, L2 : in List; Li : out List  ) is 
      --On utilise conquer sur des listes L1, L2 qui sont deja triées pour faire
      -- 1 liste triée plus gde;             
      --dans cette procédure, L1 et L2 contiennent au moins un élément
      --Qd on sort de conquer, L1 et L2 sont périmées

      I1 : Pt_Cell := L1.Deb;   I2 : Pt_Cell := L2.Deb;  
      J  : Pt_Cell; --qu'on va initialiser
      
    begin
			-- traitement spécial pour la première cellule du résultat
      if I1.D <  I2.D then --I1 non nul car lg  >= 1 donc I1.d existe
        Li.Deb := I1; I1:= I1.S;  
      else
        Li.Deb := I2; I2:= I2.S;
      end if;

      J:=Li.Deb;

      while I1 /= null and I2 /= null loop
        if I1.D < I2.D then
          J.S := I1; I1 := I1.S;
        else
          J.S := I2; I2 := I2.S;
        end if;
        J:= J.S; -- *** avancer en écriture
      end loop;

      if I1 = null then
        J.S := I2 ;
      else
        J.S := I1;
      end if;

      Li.Lon := L1.Lon + L2.Lon;
      Put("conquer"); Ecrire(Li.Deb); New_Line;
    end Conquer;

  begin

    if Li.Lon <= 1 then return; end if; 

    Div (Li, L1, L2); 
    Tf(L1); Tf(L2);
    Conquer (L1, L2, Li); --met a jour Li 
    -- L1 et L2 sont périmées, mais vont être détruites
  end Tf;


  P1    : Pt_Cell;  
  Chain : List;  

begin

  --  P1:=Cons(24, (Cons (12, null)));
  P1:=Cons(24, (Cons (5, Cons(9, Cons(10, Cons(12, null))))));
  P1:=Cons(34, (Cons (3, Cons(9, Cons(11, Cons(2, P1))))));

  Chain:=(Deb => P1, Lon => 10);
  Ecrire(Chain.Deb); New_Line;  New_Line;
  Tf(Chain);   New_Line;
  Ecrire(Chain.Deb);

end Tri_Fusion_Liste;