|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 49152 (0xc000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Abstract_Tree, seg_04931c, seg_049382
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Lexical, Bounded_String, Text_Io, Unchecked_Deallocation, Erreur;
with Models, Symbols, Comps_Dictionary,
Interprete, Set_Of_Connections, Set_Of_Links;
use Lexical, Bounded_String, Set_Of_Connections, Set_Of_Links;
package body Abstract_Tree is
procedure Free is new Unchecked_Deallocation (Cell, Object);
----------------------------------------------------------------------
-- Procedure: DESTROY
----------------------------------------------------------------------
-- Effet: Detruit tous les elements de l'arbre abstrait
--
-- Parametres: Node (in out) racine de l'arbre abstrait a detruire
----------------------------------------------------------------------
procedure Destroy (Node : in out Object) is
begin
case Node.Kind is
when Binary_Operator =>
Destroy (Node.Right_Node);
Destroy (Node.Left_Node);
Free (Node);
when Unary_Operator =>
Destroy (Node.Down_Node);
Free (Node);
when Integer_Data | Boolean_Data | State_Data |
Var_Data | Instruction | Player_Entry =>
Free (Node);
end case;
end Destroy;
----------------------------------------------------------------------
-- Fonction: MAKE_NODE
----------------------------------------------------------------------
-- Effet: Cree un noeud pour une operation binaire (comparaison,
-- mathematique et logique)
--
-- Parametres: Operation (in) token representant l'operation a memoriser
-- Left (in) expression gauche de l'operation
-- Right (in) expression droite de l'operation
--
-- Retourne: Un noeud contenant un operateur binaire avec comme partie
-- gauche le sous-arbre Left et comme partie gauche le sous-
-- arbre Right
----------------------------------------------------------------------
function Make_Node
(Operation : Token; Left, Right : Object) return Object is
The_Cell : Cell;
New_Node : Object;
begin
New_Node := new Cell (Kind => Binary_Operator);
case Operation is
when Plus | Moins | Mul | Div =>
New_Node.all := (Return_Type => Integer_Type,
Kind => Binary_Operator,
Binary_Kind => Operation,
Left_Node => Left,
Right_Node => Right);
if What_Type (Left) /= Integer_Type or
What_Type (Right) /= Integer_Type then
Erreur.Alerte ("Op Arithmetique: TYPES INCOMPATIBLES (" &
Token'Image (Operation) & ")");
end if;
when Equ | Diffr =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Binary_Operator,
Binary_Kind => Operation,
Left_Node => Left,
Right_Node => Right);
if What_Type (Left) /= What_Type (Right) then
Erreur.Alerte ("Op Test: TYPES INCOMPATIBLES (" &
Token'Image (Operation) & ")");
end if;
when Inf | Infequ | Sup | Supequ =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Binary_Operator,
Binary_Kind => Operation,
Left_Node => Left,
Right_Node => Right);
if What_Type (Left) /= Integer_Type or
What_Type (Right) /= Integer_Type then
Erreur.Alerte ("Op Test: TYPES INCOMPATIBLES (" &
Token'Image (Operation) & ")");
end if;
when Et | Ou =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Binary_Operator,
Binary_Kind => Operation,
Left_Node => Left,
Right_Node => Right);
if (What_Type (Left) /= Boolean_Type and
What_Type (Left) /= Entry_Type) or
(What_Type (Right) /= Boolean_Type and
What_Type (Right) /= Entry_Type) then
Erreur.Alerte ("Op Binaire: TYPES INCOMPATIBLES (" &
Token'Image (Operation) & ")");
end if;
when others =>
null;
end case;
return New_Node;
end Make_Node;
----------------------------------------------------------------------
-- Fonction: MAKE_NODE
----------------------------------------------------------------------
-- Effet: Cree un noeud pour une operation unaire binaire (NON)
--
-- Parametres: Operation (in) token representant l'operation a memoriser
-- Down (in) expression sur laquelle appliquer l'operation
--
-- Retourne: Un noeud contenant un operateur unaire.
----------------------------------------------------------------------
function Make_Node (Operation : Token; Down : Object) return Object is
New_Node : Object;
begin
New_Node := new Cell (Kind => Unary_Operator);
case Operation is
when Non =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Unary_Operator,
Unary_Kind => Operation,
Down_Node => Down);
if What_Type (Down) /= Boolean_Type then
Erreur.Alerte ("Op Unaire: TYPES INCOMPATIBLES");
end if;
when others =>
null;
end case;
return New_Node;
end Make_Node;
----------------------------------------------------------------------
-- Fonction: MAKE_NODE
----------------------------------------------------------------------
-- Effet: Cree une feuille contenant un entier
--
-- Parametres: Value (in) valeur a memoriser
--
-- Retourne: Une feuille contenant un entier
----------------------------------------------------------------------
function Make_Node (Value : Integer) return Object is
New_Node : Object;
begin
New_Node := new Cell (Kind => Integer_Data);
New_Node.all := (Return_Type => Integer_Type,
Kind => Integer_Data,
Integer_Value => Value);
return New_Node;
end Make_Node;
----------------------------------------------------------------------
-- Fonction: MAKE_NODE
----------------------------------------------------------------------
-- Effet: Cree une feuille contenant un booleen ou un etat de lien
--
-- Parametres: Value (in) token a memoriser
--
-- Retourne: Une feuille contenant un booleen ou un etat de lien
----------------------------------------------------------------------
function Make_Node (Value : Token) return Object is
New_Node : Object;
begin
case Value is
when Lie | Delie =>
New_Node := new Cell (State_Data);
New_Node.all := (Return_Type => State_Type,
Kind => State_Data,
State_Value => Value);
when Vrai =>
New_Node := new Cell (Boolean_Data);
New_Node.all := (Return_Type => Boolean_Type,
Kind => Boolean_Data,
Boolean_Value => True);
when Faux =>
New_Node := new Cell (Boolean_Data);
New_Node.all := (Return_Type => Boolean_Type,
Kind => Boolean_Data,
Boolean_Value => False);
when others =>
null;
end case;
return New_Node;
end Make_Node;
----------------------------------------------------------------------
-- Fonction: MAKE_NODE
----------------------------------------------------------------------
-- Effet: Cree une feuille contenant une variable ou un enumere
--
-- Parametres: Name (in) nom de la variable ou de l'enumere
-- Extension (in) nom de l'extension de la variable
-- Models_Table (in) tables des modeles (pour la table des symboles)
-- Symbols_Table (in) tables des symboles (pour retrouver
-- le type des differentes variables)
--
-- Retourne: Une feuille contenant une variable ou un enumere
----------------------------------------------------------------------
function Make_Node (Name, Extension : String;
Models_Table : Models.Object;
Symbols_Table : Symbols.Object) return Object is
New_Node : Object;
The_Name, The_Extension : Variable_String (32);
begin
Bounded_String.Free (The_Name);
Bounded_String.Copy (The_Name, Name);
Bounded_String.Free (The_Extension);
Bounded_String.Copy (The_Extension, Extension);
if Bounded_String.Length (The_Extension) = 0 then
if Symbols.Get_Symbol_Type (Symbols_Table, Models_Table, Name) =
"ENUMERE" then
New_Node := new Cell (Kind => Integer_Data);
New_Node.all :=
(Return_Type => Enumeration_Type,
Kind => Integer_Data,
Integer_Value =>
Symbols.Get_Symbol_Value
(Symbols_Table, Models_Table, Name, Name));
else
if Symbols.Get_Symbol_Type (Symbols_Table, Models_Table, Name) =
"STRUCTURE" then
New_Node := new Cell (Var_Data);
New_Node.all := (Return_Type => Struct_Type,
Kind => Var_Data,
Var_Name => The_Name,
Var_Extension => The_Extension);
else
Erreur.Alerte ("Manque Extension !!!");
end if;
end if;
else
New_Node := new Cell (Var_Data);
New_Node.all := (Return_Type => Other_Type,
Kind => Var_Data,
Var_Name => The_Name,
Var_Extension => The_Extension);
if Symbols.Get_Symbol_Type
(Symbols_Table, Models_Table, Name, Extension) = "ENTIER" then
New_Node.Return_Type := Integer_Type;
else
if Symbols.Get_Symbol_Type
(Symbols_Table, Models_Table, Name, Extension) =
"BOOLEEN" then
New_Node.Return_Type := Boolean_Type;
else
if Symbols.Get_Symbol_Type
(Symbols_Table, Models_Table, Name, Extension) =
"ENUMERE" then
New_Node.Return_Type := Enumeration_Type;
else
Erreur.Alerte
("Uniquement des Entiers/Booleens/Enumeres dans les expressions!!!");
end if;
end if;
end if;
end if;
return New_Node;
end Make_Node;
----------------------------------------------------------------------
-- Fonction: MAKE_NODE
----------------------------------------------------------------------
-- Effet: Cree une feuille contenant une fonction predefinie
--
-- Parametres: Name (in) token representant la foncion a memoriser
-- Param1 (in) chaine representant le premier parametre
-- Param2 (in) chaine representant le second parametre
--
-- Retourne: Une feuille contenant une fonction predefinie
----------------------------------------------------------------------
function Make_Node (Name : Token; Param1, Param2 : String) return Object is
New_Node : Object;
The_Param1, The_Param2 : Variable_String (32);
begin
New_Node := new Cell (Kind => Instruction);
Bounded_String.Free (The_Param1);
Bounded_String.Copy (The_Param1, Param1);
Bounded_String.Free (The_Param2);
Bounded_String.Copy (The_Param2, Param2);
case Name is
when Existe_Connexion | Existe_Lien =>
New_Node.all := (Return_Type => Boolean_Type,
Kind => Instruction,
Instruction_Name => Name,
Param1 => The_Param1,
Param2 => The_Param2);
when Etat_Connexion | Etat_Lien =>
New_Node.all := (Return_Type => State_Type,
Kind => Instruction,
Instruction_Name => Name,
Param1 => The_Param1,
Param2 => The_Param2);
when Destination_Connexion =>
New_Node.all := (Return_Type => Struct_Type,
Kind => Instruction,
Instruction_Name => Name,
Param1 => The_Param1,
Param2 => The_Param2);
when others =>
null;
end case;
return New_Node;
end Make_Node;
----------------------------------------------------------------------
-- Fonction: MAKE_NODE
----------------------------------------------------------------------
-- Effet: Cree une feuille contenant une entree clavier
--
-- Parametres: Entry1,Entry2,Entry3 (in) chaines representant les 3 mots
-- possibles constituant une entree utilisateur
--
-- Retourne: Une feuille contenant une entree clavier
----------------------------------------------------------------------
function Make_Node (Entry1, Entry2, Entry3 : String) return Object is
New_Node : Object;
Entry_Count : Integer;
The_Entry1, The_Entry2, The_Entry3 : Variable_String (32);
begin
New_Node := new Cell (Kind => Player_Entry);
Bounded_String.Free (The_Entry1);
Bounded_String.Copy (The_Entry1, Entry1);
Bounded_String.Free (The_Entry2);
Bounded_String.Copy (The_Entry2, Entry2);
Bounded_String.Free (The_Entry3);
Bounded_String.Copy (The_Entry3, Entry3);
Entry_Count := 0;
if Bounded_String.Length (The_Entry1) > 0 then
Entry_Count := 1;
if Bounded_String.Length (The_Entry2) > 0 then
Entry_Count := 2;
if Bounded_String.Length (The_Entry3) > 0 then
Entry_Count := 3;
end if;
end if;
end if;
New_Node.all := (Return_Type => Entry_Type,
Kind => Player_Entry,
Nb_Param => Entry_Count,
Entry1 => The_Entry1,
Entry2 => The_Entry2,
Entry3 => The_Entry3);
return New_Node;
end Make_Node;
----------------------------------------------------------------------
-- Fonction: EVALUATE_NODE
----------------------------------------------------------------------
-- Effet: Evalue un arbre retournant un entier
--
-- Parametres: Node (in) Racine de l'arbre a evaluer
-- Models_Table (in) Table des modeles
-- Symbols_Table (in) Table des symboles
-- Connect (in) Ensemble des connexions
-- Links (in) Ensemble des liens
-- Comp_Dict (in) Dictionaire des complements
--
-- Retourne: Un entier correspondant a la valeur de l'arbre
--
-- Exception: Bad_Type est leve si on appelle cette fonction avec un
-- arbre qui ne retourne pas d'entier
----------------------------------------------------------------------
function Evaluate_Node
(Node : Object;
Models_Table : Models.Object;
Symbols_Table : Symbols.Object;
Connect : Set_Of_Connections.Object;
Links : Set_Of_Links.Object;
Comp_Dict : Comps_Dictionary.Object) return Integer is
The_Integer : Integer;
begin
if Node.Return_Type /= Integer_Type and
Node.Return_Type /= Enumeration_Type then
raise Bad_Type;
end if;
case Node.Kind is
when Binary_Operator =>
case Node.Binary_Kind is
when Plus =>
return Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links, Comp_Dict) +
Evaluate_Node (Node.Right_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict);
when Moins =>
return Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links, Comp_Dict) -
Evaluate_Node (Node.Right_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict);
when Mul =>
return Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links, Comp_Dict) *
Evaluate_Node (Node.Right_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict);
when Div =>
return Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect, Links, Comp_Dict) /
Evaluate_Node (Node.Right_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict);
when others =>
null;
end case;
when Integer_Data =>
return Node.Integer_Value;
when Var_Data =>
The_Integer := Symbols.Get_Symbol_Value
(Symbols_Table, Models_Table,
Image (Node.Var_Name),
Image (Node.Var_Extension));
return The_Integer;
when others =>
null;
end case;
end Evaluate_Node;
----------------------------------------------------------------------
-- Fonction: COMPARE_STRINGS ----------------------------------------------------------------------
-- Effet: Evalue un arbre retournant un entier
--
-- Parametres: A , B (in) les 2 chaines a comparer
--
-- Retourne: Vrai si A=B
----------------------------------------------------------------------
function Compare_Strings (A, B : String) return Boolean is
begin
return A = B;
end Compare_Strings;
----------------------------------------------------------------------
-- Procedure: FIND_REAL_PARAMS
----------------------------------------------------------------------
-- Effet: Recherche a travers l'interpreteur du joueur et la table
-- des symboles la reelle valeur des parametres pour les
-- fonctions internes (cf COMP et pointeurs)
--
-- Parametres: A , B (in) parametres issus de la liste d'instructions
-- A , B (out) parametres reels pour l'evaluation des fonctions
----------------------------------------------------------------------
procedure Find_Real_Params (A, B : in out Variable_String;
Comp_Dict : Comps_Dictionary.Object;
Symbols_Table : Symbols.Object) is
begin
if Symbols.Has_Symbol (Symbols_Table, Image (A)) or
not Comps_Dictionary.Exist (Image (A), Comp_Dict) then
if Image (A) = "COMP" then
Bounded_String.Copy (A,
Interprete.First_Comp_Value (Comp_Dict));
end if;
if Symbols.Has_Symbol (Symbols_Table, Image (A)) or
not Comps_Dictionary.Exist (Image (A), Comp_Dict) then
if Symbols.Is_Pointer (Symbols_Table, Image (A)) then
Bounded_String.Copy (A, Symbols.Get_Pointer_Reference
(Symbols_Table, Image (A)));
end if;
end if;
end if;
if Symbols.Has_Symbol (Symbols_Table, Image (B)) or
not Comps_Dictionary.Exist (Image (B), Comp_Dict) then
if Image (B) = "COMP" then
Bounded_String.Copy (B,
Interprete.First_Comp_Value (Comp_Dict));
end if;
if Symbols.Has_Symbol (Symbols_Table, Image (B)) or
not Comps_Dictionary.Exist (Image (B), Comp_Dict) then
if Symbols.Is_Pointer (Symbols_Table, Image (B)) then
Bounded_String.Copy (B, Symbols.Get_Pointer_Reference
(Symbols_Table, Image (B)));
end if;
end if;
end if;
end Find_Real_Params;
----------------------------------------------------------------------
-- Fonction: EVALUATE_NODE
----------------------------------------------------------------------
-- Effet: Evalue un arbre retournant un booleen
--
-- Parametres: Node (in) Racine de l'arbre a evaluer
-- Models_Table (in) Table des modeles
-- Symbols_Table (in) Table des symboles
-- Connect (in) Ensemble des connexions
-- Links (in) Ensemble des liens
-- Comp_Dict (in) Dictionaire des complements
--
-- Retourne: Un booleen correspondant a la valeur de l'arbre
--
-- Exception: Bad_Type est leve si on appelle cette fonction avec un
-- arbre qui ne retourne pas un booleen
----------------------------------------------------------------------
function Evaluate_Node
(Node : Object;
Models_Table : Models.Object;
Symbols_Table : Symbols.Object;
Connect : Set_Of_Connections.Object;
Links : Set_Of_Links.Object;
Comp_Dict : Comps_Dictionary.Object) return Boolean is
The_Bool1, The_Bool2 : Boolean;
The_Integer1, The_Integer2 : Integer;
P1, P2 : Bounded_String.Variable_String (32);
begin
if Node.Return_Type /= Boolean_Type and
Node.Return_Type /= Entry_Type then
raise Bad_Type;
end if;
case Node.Kind is
when Binary_Operator =>
case Node.Left_Node.Return_Type is
when Boolean_Type | Entry_Type =>
The_Bool1 := Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict);
The_Bool2 := Evaluate_Node
(Node.Right_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict);
case Node.Binary_Kind is
when Equ =>
return The_Bool1 = The_Bool2;
when Diffr =>
return The_Bool1 /= The_Bool2;
when Et =>
return The_Bool1 and The_Bool2;
when Ou =>
return The_Bool1 or The_Bool2;
when others =>
null;
end case;
when Integer_Type =>
The_Integer1 := Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict);
The_Integer2 := Evaluate_Node
(Node.Right_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict);
case Node.Binary_Kind is
when Equ =>
return The_Integer1 = The_Integer2;
when Diffr =>
return The_Integer1 /= The_Integer2;
when Inf =>
return The_Integer1 < The_Integer2;
when Infequ =>
return The_Integer1 <= The_Integer2;
when Sup =>
return The_Integer1 > The_Integer2;
when Supequ =>
return The_Integer1 >= The_Integer2;
when others =>
null;
end case;
when Enumeration_Type =>
The_Integer1 := Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict);
The_Integer2 := Evaluate_Node
(Node.Right_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict);
case Node.Binary_Kind is
when Equ =>
return The_Integer1 = The_Integer2;
when Diffr =>
return The_Integer1 /= The_Integer2;
when others =>
null;
end case;
when State_Type | Struct_Type =>
case Node.Binary_Kind is
when Equ =>
return Compare_Strings
(Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict),
Evaluate_Node
(Node.Right_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict));
when Diffr =>
return not Compare_Strings
(Evaluate_Node
(Node.Left_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict),
Evaluate_Node
(Node.Right_Node,
Models_Table, Symbols_Table,
Connect, Links, Comp_Dict));
when others =>
null;
end case;
when others =>
null;
end case;
when Unary_Operator =>
case Node.Unary_Kind is
when Non =>
return not Evaluate_Node (Node.Down_Node, Models_Table,
Symbols_Table, Connect,
Links, Comp_Dict);
when others =>
null;
end case;
when Boolean_Data =>
return Node.Boolean_Value;
when Var_Data =>
The_Bool1 := Symbols.Get_Symbol_Value
(Symbols_Table, Models_Table,
Image (Node.Var_Name),
Image (Node.Var_Extension));
return The_Bool1;
when Instruction =>
P1 := Node.Param1;
P2 := Node.Param2;
Find_Real_Params (P1, P2, Comp_Dict, Symbols_Table);
case Node.Instruction_Name is
when Existe_Connexion =>
return Set_Of_Connections.Exist
(Image (P1), Image (P2), Connect);
when Existe_Lien =>
return Set_Of_Links.Exist
(Image (P1), Image (P2), Links);
when others =>
null;
end case;
when Player_Entry =>
if Interprete.Number_Of_Entries = Node.Nb_Param then
return Interprete.Is_Entry
(Image (Node.Entry1), Image (Node.Entry2),
Image (Node.Entry3), Comp_Dict);
else
return False;
end if;
when others =>
null;
end case;
end Evaluate_Node;
----------------------------------------------------------------------
-- Fonction: EVALUATE_NODE
----------------------------------------------------------------------
-- Effet: Evalue un arbre retournant un etat d'un lien/connexion
-- ou le nom d'une structure (sous forme de chaine)
--
-- Parametres: Node (in) Racine de l'arbre a evaluer
-- Models_Table (in) Table des modeles
-- Symbols_Table (in) Table des symboles
-- Connect (in) Ensemble des connexions
-- Links (in) Ensemble des liens
-- Comp_Dict (in) Dictionaire des complements
--
-- Retourne: Une chaine correspondant a la valeur de l'arbre
--
-- Exception: Bad_Type est leve si on appelle cette fonction avec un
-- arbre qui ne retourne pas un etat de lien/connexion ou
-- un nom de structure
----------------------------------------------------------------------
function Evaluate_Node
(Node : Object;
Models_Table : Models.Object;
Symbols_Table : Symbols.Object;
Connect : Set_Of_Connections.Object;
Links : Set_Of_Links.Object;
Comp_Dict : Comps_Dictionary.Object) return String is
P1, P2 : Bounded_String.Variable_String (32);
begin
if Node.Return_Type /= Struct_Type and
Node.Return_Type /= State_Type then
raise Bad_Type;
end if;
case Node.Return_Type is
when Struct_Type =>
case Node.Kind is
when Instruction =>
P1 := Node.Param1;
P2 := Node.Param2;
Find_Real_Params (P1, P2, Comp_Dict, Symbols_Table);
return Set_Of_Connections.What_Destination
(Image (P1), Image (P2), Connect);
when Var_Data =>
if Symbols.Is_Pointer (Symbols_Table,
Image (Node.Var_Name)) then
return Symbols.Get_Pointer_Reference
(Symbols_Table, Image (Node.Var_Name));
else
return Image (Node.Var_Name);
end if;
when others =>
null;
end case;
when State_Type =>
case Node.Kind is
when Instruction =>
P1 := Node.Param1;
P2 := Node.Param2;
Find_Real_Params (P1, P2, Comp_Dict, Symbols_Table);
case Node.Instruction_Name is
when Etat_Connexion =>
if Set_Of_Connections.What_State
(Image (P1), Image (P2), Connect) =
Linked then
return "LIE";
else
return "DELIE";
end if;
when Etat_Lien =>
if Set_Of_Links.What_State
(Image (P1), Image (P2), Links) =
Linked then
return "LIE";
else
return "DELIE";
end if;
when others =>
null;
end case;
when State_Data =>
return Token'Image (Node.State_Value);
when others =>
null;
end case;
when others =>
null;
end case;
end Evaluate_Node;
----------------------------------------------------------------------
-- Procedure: DUMP_SPACES
----------------------------------------------------------------------
-- Effet: Affiche une serie d'espce sur une ligne
--
-- Parametres: Nb (in) nombre d'espaces a afficher
----------------------------------------------------------------------
procedure Dump_Spaces (Nb : Integer) is
begin
for I in 1 .. Nb loop
Text_Io.Put (" ");
end loop;
end Dump_Spaces;
----------------------------------------------------------------------
-- Procedure: DUMP_STRUCT
----------------------------------------------------------------------
-- Effet: Affiche le contenu d'un arbre
--
-- Parametres: Nb (in) nombre d'espaces a afficher devant un ligne
-- Node (in) racine de l'arbre (sous arbre) a afficher
----------------------------------------------------------------------
procedure Dump_Struct (Nb : Integer; Node : Object) is
begin
case Node.Kind is
when Binary_Operator =>
Dump_Struct (Nb + 2, Node.Left_Node);
Dump_Spaces (Nb);
case Node.Binary_Kind is
when Plus =>
Text_Io.Put_Line ("+");
when Moins =>
Text_Io.Put_Line ("-");
when Mul =>
Text_Io.Put_Line ("*");
when Div =>
Text_Io.Put_Line ("/");
when Equ =>
Text_Io.Put_Line ("=");
when Diffr =>
Text_Io.Put_Line ("<>");
when Inf =>
Text_Io.Put_Line ("<");
when Sup =>
Text_Io.Put_Line (">");
when Infequ =>
Text_Io.Put_Line ("<=");
when Supequ =>
Text_Io.Put_Line (">=");
when Et =>
Text_Io.Put_Line ("ET");
when Ou =>
Text_Io.Put_Line ("OU");
when others =>
null;
end case;
Dump_Struct (Nb + 2, Node.Right_Node);
when Unary_Operator =>
Dump_Spaces (Nb);
Text_Io.Put_Line ("NON");
Dump_Struct (Nb + 2, Node.Down_Node);
when Integer_Data =>
Dump_Spaces (Nb);
Text_Io.Put_Line (Integer'Image (Node.Integer_Value) & " (" &
Node_Type'Image (Node.Return_Type) & ")");
when Boolean_Data =>
Dump_Spaces (Nb);
Text_Io.Put_Line (Boolean'Image (Node.Boolean_Value));
when Var_Data =>
Dump_Spaces (Nb);
if Bounded_String.Length (Node.Var_Extension) = 0 then
Text_Io.Put (Image (Node.Var_Name));
else
Text_Io.Put (Image (Node.Var_Name) & "." &
Image (Node.Var_Extension));
end if;
Text_Io.Put_Line (" (" &
Node_Type'Image (Node.Return_Type) & ")");
when State_Data =>
Dump_Spaces (Nb);
Text_Io.Put_Line (Token'Image (Node.State_Value));
when Instruction =>
Dump_Spaces (Nb);
Text_Io.Put (Token'Image (Node.Instruction_Name) & "(");
Text_Io.Put (Image (Node.Param1) & ",");
Text_Io.Put_Line (Image (Node.Param2) & ")");
when Player_Entry =>
Dump_Spaces (Nb);
Text_Io.Put ("[" & Image (Node.Entry1));
Text_Io.Put (" " & Image (Node.Entry2));
Text_Io.Put_Line (" " & Image (Node.Entry3) & "]");
end case;
end Dump_Struct;
----------------------------------------------------------------------
-- Procedure: DUMP
----------------------------------------------------------------------
-- Effet: Affiche le contenu d'un arbre
--
-- Parametres: Node (in) racine de l'arbre (sous arbre) a afficher
----------------------------------------------------------------------
procedure Dump (Node : Object) is
begin
Dump_Struct (0, Node);
end Dump;
----------------------------------------------------------------------
-- Fonction: WHAT_TYPE
----------------------------------------------------------------------
-- Effet: Renvoie le type d'un arbre (ou sous arbre)
--
-- Parametres: Node (in) racine de l'arbre (ou sous arbre) a tester
----------------------------------------------------------------------
function What_Type (Node : Object) return Node_Type is
begin
return Node.Return_Type;
end What_Type;
end Abstract_Tree;
nblk1=2f
nid=2f
hdr6=5c
[0x00] rec0=1e rec1=00 rec2=01 rec3=004
[0x01] rec0=18 rec1=00 rec2=23 rec3=00a
[0x02] rec0=08 rec1=00 rec2=12 rec3=022
[0x03] rec0=18 rec1=00 rec2=1a rec3=02c
[0x04] rec0=18 rec1=00 rec2=1b rec3=012
[0x05] rec0=18 rec1=00 rec2=1c rec3=08a
[0x06] rec0=1b rec1=00 rec2=27 rec3=02a
[0x07] rec0=1f rec1=00 rec2=1e rec3=02a
[0x08] rec0=1a rec1=00 rec2=1d rec3=000
[0x09] rec0=19 rec1=00 rec2=02 rec3=04c
[0x0a] rec0=18 rec1=00 rec2=05 rec3=018
[0x0b] rec0=07 rec1=00 rec2=17 rec3=080
[0x0c] rec0=1c rec1=00 rec2=15 rec3=012
[0x0d] rec0=17 rec1=00 rec2=03 rec3=070
[0x0e] rec0=19 rec1=00 rec2=06 rec3=048
[0x0f] rec0=1b rec1=00 rec2=29 rec3=024
[0x10] rec0=17 rec1=00 rec2=08 rec3=046
[0x11] rec0=1b rec1=00 rec2=0c rec3=05c
[0x12] rec0=15 rec1=00 rec2=16 rec3=034
[0x13] rec0=19 rec1=00 rec2=09 rec3=00e
[0x14] rec0=12 rec1=00 rec2=24 rec3=014
[0x15] rec0=1c rec1=00 rec2=14 rec3=002
[0x16] rec0=15 rec1=00 rec2=2b rec3=08e
[0x17] rec0=13 rec1=00 rec2=2a rec3=006
[0x18] rec0=16 rec1=00 rec2=28 rec3=01a
[0x19] rec0=10 rec1=00 rec2=21 rec3=01a
[0x1a] rec0=1b rec1=00 rec2=0a rec3=036
[0x1b] rec0=09 rec1=00 rec2=0e rec3=03a
[0x1c] rec0=19 rec1=00 rec2=22 rec3=00a
[0x1d] rec0=1d rec1=00 rec2=25 rec3=02c
[0x1e] rec0=18 rec1=00 rec2=26 rec3=03a
[0x1f] rec0=12 rec1=00 rec2=0d rec3=004
[0x20] rec0=1a rec1=00 rec2=0b rec3=03a
[0x21] rec0=20 rec1=00 rec2=10 rec3=002
[0x22] rec0=1b rec1=00 rec2=1f rec3=022
[0x23] rec0=14 rec1=00 rec2=07 rec3=034
[0x24] rec0=02 rec1=00 rec2=2d rec3=05a
[0x25] rec0=18 rec1=00 rec2=13 rec3=03c
[0x26] rec0=1b rec1=00 rec2=20 rec3=02a
[0x27] rec0=1a rec1=00 rec2=0f rec3=052
[0x28] rec0=1c rec1=00 rec2=19 rec3=04c
[0x29] rec0=12 rec1=00 rec2=2c rec3=022
[0x2a] rec0=1e rec1=00 rec2=18 rec3=04c
[0x2b] rec0=1c rec1=00 rec2=11 rec3=024
[0x2c] rec0=1a rec1=00 rec2=04 rec3=014
[0x2d] rec0=09 rec1=00 rec2=2e rec3=000
[0x2e] rec0=80 rec1=80 rec2=80 rec3=404
tail 0x2174d99b4865b6f450adb 0x42a00088462060003
Free Block Chain:
0x2f: 0000 00 00 02 e0 80 02 65 6e 02 00 06 20 20 20 20 2d ┆ en -┆