DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - download
Index: ┃ T ┃

⟦378404d7e⟧ TextFile

    Length: 32796 (0x801c)
    Types: TextFile
    Names: »TOUT_ADA«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧

TextFile

-- exemple de type derive\r
-- Auteur : Sebastien BROCHET\r
-- Date   : 7 Novembre 1993\r
\r
package money is\r
type object is private;\r
function "+"(left,right:object) return object;\r
function "-"(left,right:object) return object;\r
private\r
  type object is new integer range 1..500;\r
end money;\r
Package body Etape is\r
\r
-- testee\r
FUNCTION CreerUneEtape(UnTemps:temps;UneAction:Action;UneEtape:Etape) return Etape is\r
EtapeAux:Etape;\r
BEGIN\r
  EtapeAux:= NEW CelluleEtape;\r
    EtapeAux.LeTemps:=UnTemps;\r
    EtapeAux.Laction:=UneAction;\r
    EtapeAux.LaSuite:=UneEtape;\r
  return EtapeAux;\r
END;\r
\r
-- testee\r
FUNCTION LeTempsDeLetape(UneEtape:Etape) return Temps is\r
BEGIN\r
  return UneEtape.LeTemps;\r
END;\r
\r
-- Testee\r
FUNCTION LactionDeLetape(UneEtape:Etape) return Action is\r
BEGIN\r
  return UneEtape.Laction;\r
END;\r
\r
-- testee\r
FUNCTION LaSuiteDeLetape(UneEtape:Etape) return Etape is\r
BEGIN\r
  return UneEtape.LaSuite;\r
END;\r
\r
-- testee\r
PROCEDURE ChangerLeTempsDeLetape(UneEtape: IN OUT Etape;UnTemps:temps) is\r
BEGIN\r
  UneEtape.LeTemps:=UnTemps;\r
END;\r
\r
-- testee\r
PROCEDURE ChangerLactionDeLetape(UneEtape:IN OUT Etape;UneAction:Action) is\r
BEGIN\r
  UneEtape.Laction:=UneAction;\r
END;\r
\r
-- testee\r
-- rmq : L'etape E qui est retournee est la meme que celle transmise\r
-- elle n'est pas modifiee mais doit etre passee par adresse pour que\r
-- des affectations ( insertions) puissent se faire pdt la recursion arriere\r
PROCEDURE CaserUneActionDansLesEtapes(T:temps;A:Action;E:IN OUT Etape) is\r
BEGIN\r
  IF E = EtapeInexistante THEN  -- OK\r
     E:=CreerUneEtape(T,A,E);\r
  ELSE\r
     IF T = LeTempsDeLetape(E) THEN  -- OK\r
    ChangerLactionDeLetape(E,A);\r
     ELSE\r
    IF T > LeTempsDeLetape(E) THEN -- OK\r
       CaserUneActionDansLesEtapes(T,A,E.LaSuite);\r
    ELSE\r
       E:=CreerUneEtape(T,A,E);    -- OK\r
    END IF;\r
     END IF;\r
  END IF;\r
END;\r
\r
-- testee\r
PROCEDURE DetruireEtape(E:IN OUT Etape) is\r
BEGIN\r
  -- DISPOSE(E);  -- a modifier\r
  E:=EtapeInexistante;\r
END;\r
\r
-- testee\r
PROCEDURE ExclureUneActionDesEtapes(E:IN OUT Etape;T:temps) is\r
A_Jeter:Etape;\r
BEGIN\r
  IF E/= EtapeInexistante THEN  -- OK\r
    IF T = LeTempsDeLetape(E) THEN\r
    BEGIN\r
      A_Jeter:=E;\r
      E:=E.LaSuite;\r
      DetruireEtape(A_Jeter);   -- OK\r
    END;\r
    ELSE\r
       IF T > LeTempsDeLetape(E) THEN  -- OK\r
      ExclureUneActionDesEtapes(E.LaSuite,T);\r
       END IF;\r
    END IF;\r
  END IF;\r
END;\r
END Etape;\r
--  -------------- Etape ------------------------------\r
\r
Package Etape is     -- specifications\r
  TYPE Temps is New INTEGER;\r
  TYPE Action is New CHARACTER;\r
  TYPE CelluleEtape;\r
  TYPE Etape is access CelluleEtape;\r
  TYPE CelluleEtape is RECORD\r
             LeTemps:Temps;\r
             Laction:Action;\r
             LaSuite:Etape;\r
               END RECORD;\r
  EtapeInexistante: constant Etape:=null;\r
  FUNCTION CreerUneEtape(UnTemps:temps;UneAction:Action;UneEtape:Etape) return Etape;\r
  FUNCTION LeTempsDeLetape(UneEtape:Etape) return Temps;\r
  FUNCTION LactionDeLetape(UneEtape:Etape) return Action;\r
  FUNCTION LaSuiteDeLetape(UneEtape:Etape) return Etape;\r
  PROCEDURE ChangerLeTempsDeLetape(UneEtape: IN OUT Etape;UnTemps:temps);\r
  PROCEDURE ChangerLactionDeLetape(UneEtape:IN OUT Etape;UneAction:Action);\r
  PROCEDURE CaserUneActionDansLesEtapes(T:temps;A:Action;E:IN OUT Etape);\r
  PROCEDURE DetruireEtape(E:IN OUT Etape);\r
  PROCEDURE ExclureUneActionDesEtapes(E:IN OUT Etape;T:temps);\r
End Etape;\r
-- package generique FIFO
-- corps du package , genericite sur le type de l'element dans la FIFO
-- Auteur : Sebastien BROCHET
-- Date   : 3 Novembre 1993

With Text_IO;
package body FIFO is
  FreeCells:pCell;  -- lien avec les elts libres
  function NewCell(e:in Element) return pCell is
  result:pCell;
  begin
    if FreeCells /= Null then
       result:=FreeCells;
       FreeCells:=FreeCells.suc;
       result.all:=Cell'(e,Null);
       return result;
    else
       return New Cell'(e,Null);
    end if;
  end NewCell;
  procedure oldCell(o:pCell) is  -- pour restituer une Cell qui ne sert plus
  begin
    o.suc:=FreeCells;  -- insertion en tete
    FreeCells:=o;
  end oldCell;
  procedure DeQueue(F:in out Object;e:out Element) is  -- defiler
  pAux:pCell;     -- pointeur auxiliaire car simplement chainee
  begin
    if F=EmptyFifo then Text_IO.Put_Line("La file est vide !!!");
    else
       pAux:=F.Head;
       e:=F.Head.val;
       F.Head:=F.Head.suc;
       oldCell(pAux);
    end if;
--  exception
--    when empty => Text_IO.Put_Line("La file est vide !!!");
--  end;
  end DeQueue;
  procedure EnQueue(F:in out Object;e:in Element) is  -- enfiler
  begin
    F.Tail.suc:=NewCell(e);
    F.Tail:=F.Tail.suc;
  end EnQueue;
end FIFO;
-- package fifo specifications
-- genericite au niveau du type des elements contenus dans la fifo
-- auteur : Sebastien BROCHET
-- date   : 3 Novembre 1993

generic
   Type Element is private;
package FIFO is
  type Object is private;
  EmptyFifo:constant Object;  -- constante differee
  procedure EnQueue(F:in out Object;e:in Element);
  procedure DeQueue(F:in out Object;e:out Element);
  empty:exception;
  full:exception;
  Private
    type Cell;
    type pCell is access Cell;
    type Object is record
             head,tail:pCell;
           End record;
    EmptyFifo:constant object:=(Null,Null);
    type Cell is record
           val:Element;
           suc:pCell;
         End record;
end FIFO;
-- File body , package utilise par lex.ada\r
-- auteur : Sebastien BROCHET\r
-- date :   31 octobre 1993\r
\r
With Text_IO;\r
package body FILE is\r
  procedure FileOpen(aFile: in out INTEGER) is\r
  begin\r
    LookAhead:=False;\r
  end FileOpen;\r
  function FileAtEnd(aFile: in INTEGER) return boolean is\r
  begin\r
    return Text_IO.End_Of_File;   -- sur le fichier standart\r
  end FileAtEnd;\r
  procedure FileNext(aFile: in INTEGER) is\r
  begin\r
    if not LookAhead then\r
             Text_IO.Get(CurrentChar);\r
    else LookAhead:=False;\r
    end if;\r
  end FileNext;\r
  function FileValue(aFile: in INTEGER) return character is\r
  begin\r
    return CurrentChar;\r
  end FileValue;\r
  function FileGet(aFile: in INTEGER) return character is\r
  begin\r
    FileNext(aFile);\r
    return FileValue(aFile);\r
  end FileGet;\r
  procedure FileUnget(aFile: in out INTEGER) is\r
  begin\r
    LookAhead:=True;\r
  end FileUnget;\r
end FILE;\r
-- fichier : file_spe.ada\r
-- specification du package FILE utilise par lex.ada\r
-- auteur : Sebastien BROCHET\r
-- date   : 29 octobre 1993\r
\r
With Text_IO;\r
package FILE is\r
 CurrentChar : character;\r
 LookAhead : boolean;\r
 procedure FileOpen(aFile : in out INTEGER);  -- modifier avec type fichier\r
 function FileAtEnd(aFile : in INTEGER) return boolean;\r
 procedure FileNext(aFile:in INTEGER);\r
 function FileValue(aFile: in INTEGER) return character;\r
 function FileGet(aFile: in INTEGER) return character;\r
 procedure FileUnget(aFile: in out INTEGER);\r
end FILE;\r
With Text_IO;Use Text_IO;
procedure Hello is
Begin
  Put_Line("Hello World ");
End;
-- fichier : Lex_bod.ada\r
-- corps du package LEX utilise pour l'analyse lexicale\r
-- auteur : Sebastien BROCHET\r
-- date : 31 octobre 1993\r
\r
With FILE;\r
package body LEX is\r
  subtype alpha_L is character range 'a'..'z';\r
  subtype alpha_U is character range 'A'..'Z';\r
  subtype digit is character range '0'..'9';\r
  type class is (C_SPACE, C_POINT, C_DIGIT, C_ALPHA, C_OPER, C_UNK );\r
  Transition: array(L_OK..L_UNK,C_SPACE..C_UNK) of token:=\r
  -- C_*** ( SPACE  , POINT , DIGIT , ALPHA , OPER  , UNK )\r
       (\r
       ( L_OK   , L_OK  , L_OK  , L_OK  , L_UNK , L_OK ),  -- L_OK\r
       ( L_START, L_UNK , L_INT , L_ID  , L_OPER, L_UNK ), -- L_START\r
       ( L_OK   , L_REAL, L_INT , L_OK  , L_OK  , L_OK ),  -- L_INT\r
       ( L_OK   , L_OK  , L_REAL, L_OK  , L_OK  , L_OK ),  -- L_REAL\r
       ( L_OK   , L_OK  , L_OK  , L_OK  , L_OK  , L_OK ),  -- L_OPER\r
       ( L_OK   , L_OK  , L_ID  , L_ID  , L_OK  , L_OK ),  -- L_ID\r
       ( L_OK   , L_OK  , L_OK  , L_OK  , L_OK  , L_OK )  -- L_UNK\r
       );\r
  TheFile: INTEGER;\r
  function ClassTheChar(c:character) return class is\r
  begin\r
    if (c in alpha_L) or (c in alpha_U) then return C_ALPHA;end if;\r
    if c in digit then         return C_DIGIT;end if;\r
    if c=' ' then              return C_SPACE;end if;\r
    if (c='+') or (c='*') then return C_OPER;end if;\r
    if c='.' then              return C_POINT;end if;\r
    return C_UNK;\r
  end ClassTheChar;\r
  procedure LexOpen(aFile:in out Integer) is\r
  begin\r
    TheFile:=aFile;\r
    FILE.FileOpen(aFile);\r
    FILE.FileNext(TheFile);\r
  end LexOpen;\r
  procedure LexNext is\r
  index:positive range 1..256;\r
  NextState:Token;\r
  begin\r
    for i in CurrentValue'First..CurrentValue'Last loop\r
    CurrentValue(i):=' ';\r
    end loop;\r
    index:=1;\r
    if not FILE.FileAtEnd(TheFile) then\r
       CurrentToken:=L_START;\r
       NextState:=Transition(CurrentToken,ClassTheChar(FILE.FileValue(TheFile)));\r
       loop\r
     if NextState /= L_START then\r
        CurrentValue(index):=FILE.FileValue(TheFile);\r
        index:=index+1;\r
     end if;\r
     FILE.FileNext(TheFile);\r
     CurrentToken:=NextState;\r
     if not FILE.FileAtEnd(TheFile) then\r
        NextState:=transition(CurrentToken,ClassTheChar(FILE.FileValue(TheFile)));\r
     else\r
        NextState:=L_OK;\r
     end if;\r
       exit when NextState=L_Ok;\r
       end loop;\r
    else\r
       CurrentToken:=L_EOF;\r
    end if;\r
  end LexNext;\r
end LEX;\r
-- fichier : lex_spe.ada\r
-- specifications du package LEX\r
-- auteur : Sebastien BROCHET\r
-- date : 31 octobre 1993\r
\r
package LEX is\r
  type token is (L_OK,\r
         L_START, L_INT, L_REAL, L_OPER, L_ID,\r
         L_UNK, L_EOF);\r
  CurrentValue:STRING(1..256):=(1..256=>' ');\r
  CurrentToken:Token;\r
  procedure LexOpen(aFile: in out INTEGER);\r
  procedure LexNext;\r
end LEX;\r
-- Exemple de type mutable\r
-- Auteur : Sebastien BROCHET\r
-- Date   : 7 Novembre 93\r
-- remarque : il ne faut pas de type non contraint dans un record\r
--            il ne faut pas deux champ de meme nom fonction d'un discriminant\r
--            il ne faut pas de champ apres la partie variable du record\r
\r
-- function "*"(left:natural;right:character) return string is\r
-- begin\r
--  return string'(1..left=>right);\r
-- end "*";\r
\r
Procedure Test_Mutable is\r
NNS:constant:=10;\r
NNP:constant:=20;\r
subtype string_limiteP is string(1..NNP);\r
subtype string_limiteS is string(1..NNS);\r
type condition is (societe,personne);\r
condition_par_defaut:condition:=condition'(personne);\r
type Mon_type_Mutable(cond:condition:=condition_par_defaut) is\r
  record\r
    champ1:INTEGER:=0;\r
    case cond is\r
      when societe => nomS:string_limiteS:="Hello" & "               ";\r
      when personne => nomP:string_limiteP:="Bonjour" & "   ";\r
    end case;\r
  end record;\r
-- declaration de variables\r
Societe_non_mutable:Mon_type_Mutable(societe);\r
Personne_mutable:Mon_type_Mutable;\r
\r
begin\r
  Societe_non_Mutable.champ1:=10;\r
  Societe_non_Mutable.nomS:=string_limiteS'(1..NNS=>'S');\r
  Personne_mutable.champ1:=20;\r
  Personne_Mutable.nomP:=string_limiteP'(1..NNP=>'P');\r
--  Personne_Mutable.nomS(1..NNS):='S'; Le champ NomS n'existe pas\r
  Personne_Mutable:=Societe_non_Mutable;\r
  Personne_Mutable.nomS:=string_limiteS'(1..NNS=>'S');\r
--  Societe_non_Mutable:=Personne_Mutable; constraint_error\r
end Test_Mutable;\r
-- Test d'un type mutable\r
-- Auteur : Sebastien BROCHET\r
-- Date   : 7 Novembre 1993\r
\r
procedure test_Mutable1 is\r
type couleur is (rouge,vert,bleu);\r
type condition is (personne,societe);\r
type P(cond:condition:=personne) is\r
record\r
   champ1:INTEGER;\r
   champ3:character;\r
   case cond is\r
     when societe => i:integer;\r
     when personne => j:character;\r
   end case;\r
end record;\r
type S(coul:couleur:=bleu) is\r
record\r
  champ1:INTEGER:=10;\r
  case coul is\r
    when bleu => I:INTEGER;\r
    when rouge => null;\r
    when vert => j:character;\r
  end case;\r
end record;\r
begin\r
  null;\r
end test_mutable1;\r
With Text_IO;\r
\r
PROCEDURE Hello is\r
Begin\r
  for i in 1..10 loop\r
    Text_IO.Put_Line("Hello world ! ");\r
  end loop;\r
End Hello;\r
\r
-- pile generique ( corps )\r
-- Auteur : Sebastien BROCHET\r
-- Date   : 28 Octobre 1993\r
\r
With Text_IO;\r
package body pile is\r
i:integer:=1;\r
function Pile_Vide(Une_Pile: in Pile) return boolean is\r
begin\r
  return Une_Pile.i=Une_Pile.Contenu'first;\r
end;\r
function Pile_Pleine(Une_Pile: in Pile) return boolean is\r
begin\r
  return Une_Pile.i=Une_Pile.Contenu'last+1;\r
end;\r
procedure empiler(Une_Pile:in out Pile;Un_Element:in Element) is\r
begin\r
  if not Pile_Pleine(Une_Pile) then\r
     Une_Pile.Contenu(Une_Pile.i):=Un_Element;\r
     Une_Pile.i:=Une_Pile.i+1;\r
  else\r
     Text_IO.Put_Line("Pile pleine !!");\r
  end if;\r
end empiler;\r
procedure depiler(Une_Pile:in out Pile;Un_Element:out Element) is\r
begin\r
  if not Pile_Vide(Une_Pile) then\r
     Une_Pile.i:=Une_Pile.i-1;\r
     Un_Element:=Une_Pile.Contenu(Une_Pile.i);\r
  else\r
     Text_IO.Put_Line("Pile vide !! ");\r
  end if;\r
end depiler;\r
end pile;\r
-- Exemple de programme de gestion de pile\r
-- ou le type d'element contenu dans la pile est generique\r
-- Auteur : Sebastien BROCHET\r
-- Date   : 28 Octobre 1993\r
\r
generic\r
  type Element is private;\r
  Taille : positive;\r
package pile is\r
 type tContenu is array (integer range 1..Taille) of Element;\r
 type Pile is record\r
        i:integer;\r
        Contenu:tContenu;\r
          end record;\r
 procedure empiler(Une_Pile: in out Pile;Un_Element:in Element);\r
 procedure depiler(Une_Pile: in out Pile;Un_Element:out Element);\r
end pile;\r
--WITH Etape,Text_IO;
\r
--Package body Role is\r
\r
-- FUNCTION CreerUnRole(A:Acteur) return Role is\r
-- Resultat:Role;\r
-- BEGIN\r
--   Resultat:=NEW DescripteurDeRole;\r
--     Resultat.Lacteur:=A;\r
--     Resultat.LesEtapes:=Etape.EtapeInexistante;\r
--     Resultat.EnCours:=FALSE;\r
--     Resultat.LeDebut:=0;\r
--     Resultat.Lindex:=Etape.EtapeInexistante;\r
--     Resultat.LaDuree:=0;\r
--   return Resultat;\r
-- END;\r
-- \r
-- FUNCTION LeRoleEstVide(UnRole:Role) return BOOLEAN is\r
-- BEGIN\r
--   return BOOLEAN(UnRole.LesEtapes=Etape.EtapeInexistante);\r
-- END;\r
-- \r
-- FUNCTION LacteurDuRole(UnRole:Role)return Acteur is\r
-- BEGIN\r
--   return UnRole.Lacteur;\r
-- END;\r
-- \r
-- FUNCTION LaDureeDuRole(UnRole:Role) return Etape.Temps is\r
-- BEGIN\r
--   return UnRole.LaDuree;\r
-- END;\r
-- \r
-- FUNCTION LeRoleEstEnCours(UnRole:Role) return BOOLEAN is\r
-- BEGIN\r
--   return (UnRole.EnCours=TRUE);\r
-- END;\r
-- \r
-- FUNCTION LesEtapes(UnRole:Role) return Etape.Etape is\r
-- BEGIN\r
--   return UnRole.LesEtapes;\r
-- END;\r
-- \r
-- FUNCTION QuelleActionDuRole(UnRole:Role;UnTemps:Temps) return Etape.Action is\r
-- indexRole:Etape.Etape;\r
-- Trouve:BOOLEAN:=FALSE;\r
-- BEGIN\r
--   IndexRole:=LesEtapes(UnRole);\r
--   WHILE (IndexRole/=EtapeInexistante) AND (NOT TROUVE) DO\r
--   BEGIN\r
--     IF LeTempsDeLetape(IndexRole)=UnTemps THEN\r
--       Trouve:=TRUE;\r
--       QuelleActionDuRole:=LactionDeLetape(IndexRole);\r
--     END IF;\r
--     IndexRole:=LaSuiteDeLetape(IndexRole);\r
--   END;\r
-- END;\r
-- \r
-- PROCEDURE CaserUneActionDansUnRole(UnRole:Role;UnTemps:Etape.Temps;UneAction:Etape.Action) is\r
-- E:Etape.Etape;\r
-- BEGIN\r
--   E:=LesEtapes(UnRole);\r
--   CaserUneActionDansLesEtapes(UnTemps,UneAction,E);\r
-- END;\r
-- \r
-- PROCEDURE ExclureUneActionDansUnRole(UnRole:Role;UnTemps:Etape.Temps) is\r
-- E:Etape.Etape;\r
-- BEGIN\r
--   E:=LesEtapes(UnRole);\r
--   ExclureUneActionDesEtapes(E,UnTemps);\r
-- END;\r
-- \r
-- PROCEDURE DecalerUneActionDuRole(UnRole:Role;UnTemps:Etape.Temps;delai:INTEGER) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE DeplacerUneActionDuRole(UnRole:Role;UnTemps:Etape.Temps;delai:INTEGER) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE DecalerLeRole(UnRole:Role;UnTemps:Etape.Temps;delai:INTEGER) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE ViderLeRole(UnRole:IN OUT Role) is\r
-- BEGIN\r
--   UnRole.LesEtapes:=EtapeInexistante;\r
-- END;\r
-- \r
-- FUNCTION ChargerUnActeur(F:IN Text_IO.File_Type) return Etape.Acteur is\r
-- ActAux:Etape.Acteur;\r
-- BEGIN\r
--   READLN(F,ActAux);\r
--   return ActAux;\r
-- END;\r
-- \r
-- FUNCTION ChargerUneAction(F:IN Text_IO.File_Type) return Etape.Action is\r
-- ActionAux:Etape.Action;\r
-- BEGIN\r
--   READLN(F,ActionAux);\r
--   return ActionAux;\r
-- END;\r
-- \r
-- FUNCTION ChargerUnTemps(F:IN Text_IO.File_Type) return Etape.Temps is\r
-- TempsAux:Etape.Temps;\r
-- BEGIN\r
--   READLN(F,TempsAux);\r
--   return TempsAux;\r
-- END;\r
-- \r
-- FUNCTION ChargerUnRole(F:IN Text_IO.File_Type) return Role is\r
-- UnRole:Role;UnActeur:Etape.Acteur;\r
-- UneAction:Etape.Action;UnTemps:Etape.Temps;\r
-- Nombre:INTEGER;\r
-- BEGIN\r
--   UnActeur:=ChargerUnActeur(F);\r
--   UnRole:=CreerUnRole(UnActeur);\r
--   READLN(F,Nombre);\r
--   FOR i IN 1..Nombre LOOP\r
--     UneAction:=ChargerUneAction(F);\r
--     UnTemps:=ChargerUnTemps(F);\r
--     CaserUneActionDansUnRole(UnRole,UnTemps,UneAction);\r
--   END LOOP;\r
--   return UnRole;\r
-- END;\r
-- \r
-- PROCEDURE DemarrerLeRole(UnRole:IN OUT Role) is\r
-- IndiceRole:Role;\r
-- BEGIN\r
--   IndiceRole:=UnRole;\r
--   IndiceRole.EnCours:=TRUE;\r
--   IF IndiceRole.Etape!='' THEN\r
--     BEGIN\r
--       Text_IO.PutLine("Acteur = ",IndiceRole.Laction);\r
--       IndiceRole.Etape:=IndiceRole.Etape.LaSuite;\r
--     END;\r
-- END;\r
-- \r
-- PROCEDURE ArreterLeRole(UnRole:IN OUT Role) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE JouerLeRole(UnRole:Role) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE SolliciterLeRole(UnRole:Role) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE SauvegarderLeRole(UnRole:Role;Fichier:STRING) is\r
-- F:Text_IO.File_Type;\r
-- BEGIN\r
--   ASSIGN(F,Fichier);\r
--   APPEND(F);\r
--   SauverUnActeur(F,UnRole);\r
-- END;\r
-- END Role;\r
\r
-- ---------   Role -------------------------------------\r
WITH Etape,Text_IO;\r
Package Role is  -- specifications de l'objet role\r
SUBTYPE acteur is STRING(1..50);\r
TYPE DescripteurDeRole is RECORD\r
                Lacteur:Acteur;\r
                LesEtapes:Etape.Etape;\r
                EnCours:BOOLEAN;\r
                LeDebut:Etape.Temps;\r
                Lindex:Etape.Etape;\r
                LaDuree:Etape.Temps;\r
              END RECORD;\r
TYPE Role is access DescripteurDeRole;\r
\r
FUNCTION CreerUnRole(A:Acteur) return Role;\r
FUNCTION LeRoleEstVide(UnRole:Role) return BOOLEAN;\r
FUNCTION LacteurDuRole(UnRole:Role)return Acteur;\r
FUNCTION LaDureeDuRole(UnRole:Role) return Etape.Temps;\r
FUNCTION LeRoleEstEnCours(UnRole:Role) return BOOLEAN;\r
FUNCTION LesEtapes(UnRole:Role) return Etape.Etape;\r
FUNCTION QuelleActionDuRole(UnRole:Role;UnTemps:Etape.Temps) return Etape.Action;\r
PROCEDURE CaserUneActionDansUnRole(UnRole:Role;UnTemps:Etape.Temps;UneAction:Etape.Action);\r
PROCEDURE ExclureUneActionDansUnRole(UnRole:Role;UnTemps:Etape.Temps);\r
PROCEDURE DecalerUneActionDuRole(UnRole:Role;UnTemps:Etape.Temps;delai:INTEGER);\r
PROCEDURE DeplacerUneActionDuRole(UnRole:Role;UnTemps:Etape.Temps;delai:INTEGER);\r
PROCEDURE DecalerLeRole(UnRole:Role;UnTemps:Etape.Temps;delai:INTEGER);\r
PROCEDURE ViderLeRole(UnRole:IN OUT Role);\r
FUNCTION ChargerUnActeur(F:IN Text_IO.File_Type) return Acteur;\r
FUNCTION ChargerUneAction(F:IN Text_IO.File_Type) return Etape.Action;\r
FUNCTION ChargerUnTemps(F:IN Text_IO.File_Type) return Etape.Temps;\r
FUNCTION ChargerUnRole(F:IN Text_IO.File_Type) return Role;\r
PROCEDURE DemarrerLeRole(UnRole:IN OUT Role);\r
PROCEDURE ArreterLeRole(UnRole:IN OUT Role);\r
PROCEDURE JouerLeRole(UnRole:Role);\r
PROCEDURE SolliciterLeRole(UnRole:Role);\r
PROCEDURE SauvegarderLeRole(UnRole:Role;Fichier:STRING);\r
END Role;\r
--  Nom : TD.ADA\r
--  Auteur : Sebastien BROCHET\r
--  Date   : 9 Octobre 1993\r
--  But    : Ce programme illustre quelques TAD\r
--  conversion en Ada d'un TD ecrit en Pascal\r
--\r
\r
--  -------------- Etape ------------------------------\r
\r
-- Package Objet_Etape is     -- specifications\r
--   TYPE Temps is INTEGER;\r
--   TYPE Action is CHARacter;\r
--   TYPE Etape is access CelluleEtape;\r
--   TYPE CelluleEtape is RECORD\r
--                      LeTemps:Temps;\r
--                  Laction:Action;\r
--                  LaSuite:Etape;\r
--                END RECORD;\r
-- \r
--   FUNCTION CreerUneEtape(UnTemps:temps;UneAction:Action;UneEtape:Etape) return Etape;\r
--   FUNCTION LeTempsDeLetape(UneEtape:Etape) return Temps;\r
--   FUNCTION LactionDeLetape(UneEtape:Etape) return Action;\r
--   FUNCTION LaSuiteDeLetape(UneEtape:Etape) return Etape;\r
--   PROCEDURE ChangerLeTempsDeLetape(UneEtape: IN OUT Etape;UnTemps:temps);\r
--   PROCEDURE ChangerLactionDeLetape(UneEtape:IN OUT Etape;UneAction:Action);\r
--   PROCEDURE CaserUneActionDansLesEtapes(T:temps;A:Action;E:IN OUT Etape);\r
--   PROCEDURE DetruireEtape(E:IN OUT Etape);\r
--   PROCEDURE ExclureUneActionDesEtapes(E:IN OUT Etape;T:temps);\r
-- End Objet_Etape;\r
-- \r
-- Package body Objet_Etape is\r
--   EtapeInexistante: constant:= null;\r
-- \r
-- -- testee\r
-- FUNCTION CreerUneEtape(UnTemps:temps;UneAction:Action;UneEtape:Etape) return Etape is\r
-- EtapeAux:Etape;\r
-- BEGIN\r
--   EtapeAux:= NEW CelluleEtape;\r
--     EtapeAux.LeTemps:=UnTemps;\r
--     EtapeAux.Laction:=UneAction;\r
--     EtapeAux.LaSuite:=UneEtape;\r
--   return EtapeAux;\r
-- END;\r
-- \r
-- -- testee\r
-- FUNCTION LeTempsDeLetape(UneEtape:Etape) return Temps is\r
-- BEGIN\r
--   return UneEtape.LeTemps;\r
-- END;\r
-- \r
-- -- Testee\r
-- FUNCTION LactionDeLetape(UneEtape:Etape) return Action is\r
-- BEGIN\r
--   return UneEtape.Laction;\r
-- END;\r
-- \r
-- -- testee\r
-- FUNCTION LaSuiteDeLetape(UneEtape:Etape) return Etape is\r
-- BEGIN\r
--   return UneEtape.LaSuite;\r
-- END;\r
-- \r
-- -- testee\r
-- PROCEDURE ChangerLeTempsDeLetape(UneEtape: IN OUT Etape;UnTemps:temps) is\r
-- BEGIN\r
--   UneEtape.LeTemps:=UnTemps;\r
-- END;\r
-- \r
-- -- testee\r
-- PROCEDURE ChangerLactionDeLetape(UneEtape:IN OUT Etape;UneAction:Action) is\r
-- BEGIN\r
--   UneEtape.Laction:=UneAction;\r
-- END;\r
-- \r
-- -- testee\r
-- -- rmq : L'etape E qui est retournee est la meme que celle transmise\r
-- -- elle n'est pas modifiee mais doit etre passee par adresse pour que\r
-- -- des affectations ( insertions) puissent se faire pdt la recursion arriere\r
-- PROCEDURE CaserUneActionDansLesEtapes(T:temps;A:Action;E:IN OUT Etape) is\r
-- BEGIN\r
--   IF E = EtapeInexistante THEN  -- OK\r
--      E:=CreerUneEtape(T,A,E)\r
--   ELSE\r
--      IF T = LeTempsDeLetape(E) THEN  -- OK\r
--         ChangerLactionDeLetape(E,A)\r
--      ELSE\r
--     IF T > LeTempsDeLetape(E) THEN -- OK\r
--            CaserUneActionDansLesEtapes(T,A,E^.LaSuite)\r
--         ELSE\r
--        E:=CreerUneEtape(T,A,E);    -- OK\r
-- END;\r
-- \r
-- -- testee\r
-- PROCEDURE DetruireEtape(E:IN OUT Etape) is\r
-- BEGIN\r
--   DISPOSE(E);\r
--   E:=EtapeInexistante;\r
-- END;\r
-- \r
-- -- testee\r
-- PROCEDURE ExclureUneActionDesEtapes(E:IN OUT Etape;T:temps) is\r
-- A_Jeter:Etape;\r
-- BEGIN\r
--   IF E != EtapeInexistante THEN  -- OK\r
--   BEGIN\r
--     IF T = LeTempsDeLetape(E) THEN\r
--     BEGIN\r
--       A_Jeter:=E;\r
--       E:=E.LaSuite;\r
--       DetruireEtape(A_Jeter);   -- OK\r
--     END\r
--     ELSE\r
--        IF T > LeTempsDeLetape(E) THEN  -- OK\r
--       ExclureUneActionDesEtapes(E.LaSuite,T);\r
--   END;\r
-- END;\r
-- END Objet_Etape;\r
-- \r
-- -- ---------   Role -------------------------------------\r
-- \r
-- Package Objet_Role is  -- specifications de l'objet role\r
-- FUNCTION CreerUnRole(A:Acteur) retunr Role is\r
-- FUNCTION LeRoleEstVide(UnRole:Role) return BOOLEAN is\r
-- FUNCTION LacteurDuRole(UnRole:Role)return Acteur is\r
-- FUNCTION LaDureeDuRole(UnRole:Role) return Temps is\r
-- FUNCTION LeRoleEstEnCours(UnRole:Role) return BOOLEAN is\r
-- FUNCTION LesEtapes(UnRole:Role) return Etape is\r
-- FUNCTION QuelleActionDuRole(UnRole:Role;UnTemps:Temps) return Action is\r
-- PROCEDURE CaserUneActionDansUnRole(UnRole:Role;UnTemps:Temps;UneAction:Action) is\r
-- PROCEDURE ExclureUneActionDansUnRole(UnRole:Role;UnTemps:Temps) is\r
-- PROCEDURE DecalerUneActionDuRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is\r
-- PROCEDURE DeplacerUneActionDuRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is\r
-- PROCEDURE DecalerLeRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is\r
-- PROCEDURE ViderLeRole(UnRole:IN OUT Role) is\r
-- FUNCTION ChargerUnActeur(F:IN OUT TEXT) return Acteur is\r
-- FUNCTION ChargerUneAction(F:IN OUT TEXT) return Action is\r
-- FUNCTION ChargerUnTemps(F:IN OUT TEXT) return Temps is\r
-- FUNCTION ChargerUnRole(F:IN OUT TEXT) return Role is\r
-- PROCEDURE DemarrerLeRole(UnRole:IN OUT Role) is\r
-- PROCEDURE ArreterLeRole(UnRole:IN OUT Role) is\r
-- PROCEDURE JouerLeRole(UnRole:Role) is\r
-- PROCEDURE SolliciterLeRole(UnRole:Role) is\r
-- PROCEDURE SauvegarderLeRole(UnRole:Role;Fichier:STRING) is\r
-- END Objet_Role;\r
-- \r
-- \r
-- Package body Objet_Role is\r
-- \r
-- TYPE Acteur is STRING;\r
-- TYPE DescripteurDeRole is RECORD\r
--                            Lacteur:Acteur;\r
--                            LesEtapes:Etape;\r
--                            EnCours:BOOLEAN;\r
--                            LeDebut:Temps;\r
--                            Lindex:Etape;\r
--                            LaDuree:Temps;\r
--              END RECORD;\r
-- TYPE Role is access DescripteurDeRole;\r
-- \r
-- FUNCTION CreerUnRole(A:Acteur) retunr Role is\r
-- Resultat:Role;\r
-- BEGIN\r
--   Resultat:=NEW Role;\r
--     Resultat.Lacteur:=A;\r
--     Resultat.LesEtapes:=EtapeInexistante;\r
--     Resultat.EnCours:=FALSE;\r
--     Resultat.LeDebut:=0;\r
--     Resultat.Lindex:=EtapeInexistante;\r
--     Resultat.LaDuree:=0;\r
--   return Resultat;\r
-- END;\r
-- \r
-- FUNCTION LeRoleEstVide(UnRole:Role) return BOOLEAN is\r
-- BEGIN\r
--   return (UnRole.LesEtapes=EtapeInexistante);\r
-- END;\r
-- \r
-- FUNCTION LacteurDuRole(UnRole:Role)return Acteur is\r
-- BEGIN\r
--   return UnRole.Lacteur;\r
-- END;\r
-- \r
-- FUNCTION LaDureeDuRole(UnRole:Role) return Temps is\r
-- BEGIN\r
--   return UnRole.LaDuree;\r
-- END;\r
-- \r
-- FUNCTION LeRoleEstEnCours(UnRole:Role) return BOOLEAN is\r
-- BEGIN\r
--   return (UnRole.EnCours=TRUE);\r
-- END;\r
-- \r
-- FUNCTION LesEtapes(UnRole:Role) return Etape is\r
-- BEGIN\r
--   return UnRole.LesEtapes;\r
-- END;\r
-- \r
-- FUNCTION QuelleActionDuRole(UnRole:Role;UnTemps:Temps) return Action is\r
-- indexRole:Etape;\r
-- Trouve:BOOLEAN:=FALSE;\r
-- BEGIN\r
--   IndexRole:=LesEtapes(UnRole);\r
--   WHILE (IndexRole<>EtapeInexistante) AND (NOT TROUVE) DO\r
--   BEGIN\r
--     IF LeTempsDeLetape(IndexRole)=UnTemps THEN\r
--     BEGIN\r
--       Trouve:=TRUE;\r
--       QuelleActionDuRole:=LactionDeLetape(IndexRole);\r
--     END;\r
--     IndexRole:=LaSuiteDeLetape(IndexRole);\r
--   END;\r
-- END;\r
-- \r
-- PROCEDURE CaserUneActionDansUnRole(UnRole:Role;UnTemps:Temps;UneAction:Action) is\r
-- E:Etape;\r
-- BEGIN\r
--   E:=LesEtapes(UnRole);\r
--   CaserUneActionDansLesEtapes(UnTemps,UneAction,E);\r
-- END;\r
-- \r
-- PROCEDURE ExclureUneActionDansUnRole(UnRole:Role;UnTemps:Temps) is\r
-- E:Etape;\r
-- BEGIN\r
--   E:=LesEtapes(UnRole);\r
--   ExclureUneActionDesEtapes(E,UnTemps);\r
-- END;\r
-- \r
-- PROCEDURE DecalerUneActionDuRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE DeplacerUneActionDuRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE DecalerLeRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE ViderLeRole(UnRole:IN OUT Role) is\r
-- BEGIN\r
--   UnRole.LesEtapes:=EtapeInexistante;\r
-- END;\r
-- \r
-- FUNCTION ChargerUnActeur(F:IN OUT TEXT) return Acteur is\r
-- ActAux:Acteur;\r
-- BEGIN\r
--   READLN(F,ActAux);\r
--   return ActAux;\r
-- END;\r
-- \r
-- FUNCTION ChargerUneAction(F:IN OUT TEXT) return Action is\r
-- ActionAux:Action;\r
-- BEGIN\r
--   READLN(F,ActionAux);\r
--   return ActionAux;\r
-- END;\r
-- \r
-- FUNCTION ChargerUnTemps(F:IN OUT TEXT) return Temps is\r
-- TempsAux:Temps;\r
-- BEGIN\r
--   READLN(F,TempsAux);\r
--   return TempsAux;\r
-- END;\r
-- \r
-- FUNCTION ChargerUnRole(F:IN OUT TEXT) return Role is\r
-- UnRole:Role;UnActeur:Acteur;\r
-- UneAction:Action;UnTemps:Temps;\r
-- Nombre:INTEGER;\r
-- BEGIN\r
--   UnActeur:=ChargerUnActeur(F);\r
--   UnRole:=CreerUnRole(UnActeur);\r
--   READLN(F,Nombre);\r
--   FOR i IN 1..Nombre LOOP\r
--     UneAction:=ChargerUneAction(F);\r
--     UnTemps:=ChargerUnTemps(F);\r
--     CaserUneActionDansUnRole(UnRole,UnTemps,UneAction);\r
--   END LOOP;\r
--   return UnRole;\r
-- END;\r
-- \r
-- PROCEDURE DemarrerLeRole(UnRole:IN OUT Role) is\r
-- IndiceRole:Role;\r
-- BEGIN\r
--   IndiceRole:=UnRole;\r
--   IndiceRole.EnCours:=TRUE;\r
--   IF IndiceRole.Etape!='' THEN\r
--     BEGIN\r
--       Text_IO.PutLine("Acteur = ",IndiceRole.Laction);\r
--       IndiceRole.Etape:=IndiceRole.Etape.LaSuite;\r
--     END;\r
-- END;\r
-- \r
-- PROCEDURE ArreterLeRole(UnRole:IN OUT Role) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE JouerLeRole(UnRole:Role) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE SolliciterLeRole(UnRole:Role) is\r
-- BEGIN\r
--   null;\r
-- END;\r
-- \r
-- PROCEDURE SauvegarderLeRole(UnRole:Role;Fichier:STRING) is\r
-- F:TEXT;\r
-- BEGIN\r
--   ASSIGN(F,Fichier);\r
--   APPEND(F);\r
--   SauverUnActeur(F,UnRole);\r
-- END;\r
-- END Objet_Role;\r
-- \r
-- \r
-- -- Programme principal\r
-- \r
-- deb,E,debut:Etape;\r
-- R:Role;\r
-- \r
-- PROCEDURE Affiche(E:Etape) is\r
-- UnTemps:Temps;\r
-- UneAction:Action;\r
-- BEGIN\r
--   IF E!=EtapeInexistante THEN\r
--   BEGIN\r
--     UnTemps:=LeTempsDeLetape(E);\r
--     UneAction:=LactionDeLetape(E);\r
--     WRITELN('Temps : ',UnTemps,' Action : ',UneAction);\r
--   END\r
--   ELSE\r
--   Text_IO.PutLine("Pointeur NIL , erreur");\r
-- END;\r
-- \r
-- BEGIN\r
-- -- TEST des methodes liees a l'objet Etape\r
--   WRITELN;\r
--   deb:=CreerUneEtape(1,'S',EtapeInexistante);\r
--   Affiche(deb);\r
--   ChangerLeTempsDeLetape(deb,4);\r
--   ChangerLactionDeLetape(deb,'T');\r
--   Affiche(deb);\r
--   deb:=CreerUneEtape(3,'U',deb);\r
--   Affiche(deb);\r
--   debut:=deb;\r
--   deb:=LaSuiteDeLetape(deb);\r
--   Affiche(deb);\r
--   E:=EtapeInexistante;\r
--   CaserUneActionDansLesEtapes(9,'d',E);  -- Inexistante OK\r
--   Affiche(E);\r
--   CaserUneActionDansLesEtapes(2,'h',deb);  -- avant , OK\r
--   Affiche(deb);\r
--   CaserUneActionDansLesEtapes(2,'k',deb);  -- temps = , OK\r
--   Affiche(deb);\r
--   CaserUneActionDansLesEtapes(3,'z',deb);  -- apres\r
--   Affiche(deb);\r
--   deb:=LaSuiteDeLetape(deb);\r
--   Affiche(deb);\r
--   DetruireEtape(deb);\r
--   Affiche(deb);\r
--   E:=EtapeInexistante;\r
--   ExclureUneActionDesEtapes(E,15);   --  Inexistante\r
--   Affiche(E);\r
--   ExclureUneActionDesEtapes(debut,15);   --  T > , OK\r
--   Affiche(debut);\r
--   ExclureUneActionDesEtapes(debut,1);   --  T < , OK\r
--   Affiche(debut);\r
--   ExclureUneActionDesEtapes(debut,3);   --  T = , OK\r
--   Affiche(debut);\r
-- \r
--   -- TEST des methodes liees a l'objet Role\r
--   -- R:=CreerUnRole('b');\r
-- END;\r
-- -- test du package generique Pile\r
-- -- Auteur : Sebastien BROCHET\r
-- -- Date   : 28 Octobre 1993\r
-- \r
-- With Pile;\r
-- procedure test is\r
-- \r
-- package Pile_Int is new Pile(Element => integer;Taille => 20);\r
-- package Pile_Char is new Pile(Element => character;Taille => 20);\r
-- begin\r
--   null;\r
-- end test;\r
-- -- Test du package generique fifo
-- -- auteur : Sebastien BROCHET
-- -- date   : 3 Novembre 1993
-- 
-- With Fifo,Text_IO;
-- procedure TestFifo is
-- caractere:character:='s';
-- package FifoChar is new Fifo(Element=> character);
-- Ma_Fifo:FifoChar.Object;
-- begin
--   Ma_Fifo:=FifoChar.EmptyFifo;
--   loop
--     Text_IO.Put_Line("<1> Enfiler un caractere");
--     Text_IO.Put_Line("<2> Defiler un caractere");
--     Text_IO.Put_Line("<9> Quitter");
--     Text_IO.Put("Votre choix : ");
--     Text_IO.Get(caractere);
--     case caractere is
--       when '1'=> Text_IO.Put("Entrer un caractere : ");
--          Text_IO.Get(caractere);
--          FifoChar.EnQueue(Ma_Fifo,caractere);
--          Text_IO.New_Line;
--       when '2'=> FifoChar.DeQueue(Ma_Fifo,caractere);
--          Text_IO.Put_Line("Caractere extrait : " & caractere);
--       when others => null;
--     end case;
--   exit when caractere='9';
--   end loop;
-- end TestFifo;
-- -- fichier : TestLex.ada\r
-- -- Test du package LEX pour l'analyse lexicale\r
-- -- auteur : Sebastien BROCHET\r
-- -- date   : 31 octobre 1993\r
-- \r
-- With LEX,TEXT_IO;\r
-- procedure TestLex is\r
-- aFile:INTEGER:=1;   -- a modifer avec TEXT_IO.File_Type\r
-- begin\r
--   TEXT_IO.Put_Line("Entrer une chaine de caracteres : ");\r
--   LEX.LexOpen(aFile);\r
--   loop\r
--     LEX.LexNext;\r
--     Text_IO.Put_Line(LEX.CurrentValue);\r
--     Text_IO.Put_Line(LEX.Token'image(LEX.CurrentToken));\r
--     exit when TEXT_IO.End_Of_File;\r
--   end loop;\r
-- end TestLex;\r
-- With Text_IO;Use Text_IO;\r
-- procedure exemple is\r
-- begin\r
--   Put_Line("Table de multiplication : ");\r
--   for i in 1..10 loop\r
--     Put_Line\r
--   end loop;\r
-- end;\r