-----------------------------------------------------------
--
-- S Y M B O L T A B L E S (SPEC)
--
-- AUTHOR: Michael Vorburger
-- DATE  : 7-9/5/96
--
-----------------------------------------------------------

with 
  Ada.Strings, 
  Ada.Strings.Fixed; 

use   
  Ada.Strings, 
  Ada.Strings.Fixed; 

with EltLists;

with Symbols; use Symbols;

package SymbolTables is

   SymbolTableLength :      constant := 20;  -- NOT 1024 (!)
   SymbolDefinitionLength : constant := 2048;

   subtype SymbolDefinition is String(1..SymbolDefinitionLength);

-----------------------------------------------------------------
-- I'd prefer making the following private, but it's impossible.
-- ("Expected private type eltlist, found private type symtbl")
-----------------------------------------------------------------

  type SYMBOLTABLEENTRY is
  record
    SYM : SYMBOL;            -- The Symbol to be defined
    DEF : SYMBOLDEFINITION;  -- The Definition of this Symbol
  end record;

  package A_SymbolTable is new EltLists(Element => SYMBOLTABLEENTRY,
                                        MaxListLength => SymbolTableLength);

  subtype SYMBOLTABLE is A_SYMBOLTABLE.ELTLIST;

  -- type SymbolTable is private; --- MySymbolTable.Eltlist;

----------------------------------------------------------------

   procedure CLEARSYMBOLTABLE(T: in out SYMBOLTABLE);
   -- WAS: function  EmptySymbolTable return SymbolTable;

   function  GetDefinition(T : SymbolTable; S : Symbol)
		return SymbolDefinition;
   procedure SetDefinition(T : in out SymbolTable; S : Symbol;
				D : SymbolDefinition);
   procedure RemoveEntry  (T : in out SymbolTable; S : Symbol);

   function  IsInTable    (T : SymbolTable; S : Symbol) return Boolean;
   function  NextSymbol   (T : SymbolTable; S : Symbol) return Symbol;

   procedure WRITETABLE   (T :SymbolTable);

   procedure ReadTable(T: out SymbolTable);
   -- WAS: function  ReadTable return SymbolTable;

   procedure ReadTable(Filename: String; T: out SymbolTable);
   -- WAS: function  ReadTable(Filename : String) return SymbolTable;

-- Exceptions

   SYMBOL_NOT_FOUND: exception; 
   -- can be raised by GetDefinition, RemoveEntry, NextSymbol
   -- exeption EMPTYSYMBOLTABLE;

private

  -- type SYMBOLTABLEENTRY is
  -- record
  --   SYM : SYMBOL;            -- The Symbol to be defined
  --   DEF : SYMBOLDEFINITION;  -- The Definition of this Symbol
  -- end record;

  -- package A_SymbolTable is new EltLists
  --				(Element       => SYMBOLTABLEENTRY,
  --                             MaxListLength => SymbolTableLength);

  -- SUBTYPE CANNOT BE PRIVAT (?? - Why?)
  -- subtype SYMBOLTABLE is new A_SYMBOLTABLE.ELTLIST;

  procedure  DICHTOSEARCH(T: in SYMBOLTABLE; S: SYMBOL; 
			Found: out BOOLEAN; P: out NATURAL);

end SymbolTables;   

-----------------------------------------------------------
--
-- S Y M B O L T A B L E S (BODY)
--
-- AUTHOR: Michael Vorburger
-- DATE  : 7-9/5/96
--
-----------------------------------------------------------

with ELTLISTS;
with TEXT_IO;

package body SYMBOLTABLES is

   package IIO is new TEXT_IO.INTEGER_IO(INTEGER);

   package LISTS renames A_SYMBOLTABLE;

   -- This function returns the index where S is or should be in T. If S really
   -- is there, Found is TRUE, otherwise it is FALSE and S can be inserted at
   -- this position.
 
   procedure DICHTOSEARCH(T: in SYMBOLTABLE; S: SYMBOL; Found: out BOOLEAN;
                                                        P:     out NATURAL) is
     L: POSITIVE := 1;               -- Begin of section looked at
     R: NATURAL  := LISTS.LENGTH(T); -- End of section looked at; ALWAYS: L<R
     M: NATURAL;
   begin
     if R=0 then begin -- Special case if table is empty
       FOUND:=FALSE;   -- has to be caught because L>R
       P:=1;
       return;
     end;
     end if;
     
     while R>=L loop
       M:=(L+R)/2;
       if S>LISTS.GETELEMENT(T,M).SYM then
         L:=M+1;        -- R unchanged
       elsif S<LISTS.GETELEMENT(T,M).SYM then
         R:=M-1;        -- L unchanged
       else             
         FOUND:=TRUE;   -- means: S found!
         P:=M;
         return;
       end if;
     end loop;

     -- If we arrive here, S is not in the list but can be inserted at
     -- either M or M+1:

     if S<LISTS.GETELEMENT(T,M).SYM then P:=M; else P:=M+1; end if;
     FOUND:=FALSE;
     return;

   end DICHTOSEARCH;

   procedure  CLEARSYMBOLTABLE(T: in out SYMBOLTABLE) is
   begin
     LISTS.CLEARLIST(T);
   end CLEARSYMBOLTABLE;

   function  GetDefinition(T : SymbolTable; S : Symbol) return SYMBOLDEFINITION
   is
     F:BOOLEAN; -- return value of dichtosearch's FOUND
     N:NATURAL; -- return value of dichtosearch
   begin
     DICHTOSEARCH(T,S,F,N);
     if F then
       return LISTS.GETELEMENT(T,N).DEF;
     else
       raise SYMBOL_NOT_FOUND;
     end if;
   end;

   function  NextSymbol   (T : SymbolTable; S : Symbol) return SYMBOL is
     F:BOOLEAN; -- return value of dichtosearch's FOUND
     N:NATURAL; -- return value of dichtosearch
   begin
     DICHTOSEARCH(T,S,F,N);
     if F then
       return LISTS.GETELEMENT(T,N+1).SYM;
     else
       raise SYMBOL_NOT_FOUND;
     end if;
   end NEXTSYMBOL;

   procedure SetDefinition(T : in out SymbolTable; S : Symbol;
                           D : SymbolDefinition) is
     F:BOOLEAN;     -- return value of dichtosearch's FOUND
     N:NATURAL;     -- return value of dichtosearch
     E:SYMBOLTABLEENTRY := (SYM => S, DEF => D); -- the record to be inserted
                                                 -- in the dictionary
   begin
     DICHTOSEARCH(T,S,F,N);

     if F then
       LISTS.SETELEMENT(T,N,E);
     else
       LISTS.INSERTELEMENT(T,N,E);
     end if;
   end;

   procedure RemoveEntry  (T : in out SymbolTable; S : Symbol) is
     F:BOOLEAN; -- return value of dichtosearch's FOUND
     N:NATURAL; -- return value of dichtosearch
   begin
     DICHTOSEARCH(T,S,F,N);
     if F then
       LISTS.DELETEELEMENT(T,N);
     else
       raise SYMBOL_NOT_FOUND;
     end if;
   end;

   function  IsInTable    (T : SymbolTable; S : Symbol) return BOOLEAN is
     F:BOOLEAN; -- return value of dichtosearch's FOUND
     N:NATURAL; -- return value of dichtosearch
   begin
     DICHTOSEARCH(T,S,F,N);
     return F;
   end ISINTABLE;

   procedure WRITETABLE   (T :SymbolTable) is
     use TEXT_IO;
     E: SYMBOLTABLEENTRY;
   begin
     for I in 1..LISTS.LENGTH(T) loop
       E:=LISTS.GETELEMENT(T,I);
       PUT(SYMBOLS.TO_STRING(E.SYM));
       NEW_LINE;                       -- PUT(" : ");
       PUT(TRIM(E.DEF,RIGHT));
       NEW_LINE(2);
     end loop;
   end WRITETABLE;

   -- This is a private function which will be invoked by ReadTable
   -- (Keyboard=STDIN) and ReadTable(FileName).
   procedure READTABLE_FILE_TYPE(F: TEXT_IO.FILE_TYPE; T: out SYMBOLTABLE) is
     use TEXT_IO;
     
     KEYSTR : STRING(1..SYMBOLDEFINITIONLENGTH);  -- The read key as string
     KEYLEN : INTEGER;               -- Length of the read string
     KEY    : SYMBOLS.SYMBOL;        -- This key as SYMBOL type
     
     DEFSTR : SYMBOLDEFINITION;      -- The read definition as string
     DEFLEN : INTEGER;               -- Length of the definition string
     DEF    : SYMBOLDEFINITION;      -- The definintion (padded with spaces)

   begin
     LISTS.CLEARLIST(T);

     KEY:=EMPTYSYMBOL;
     loop
         -- see below; the next line is already read!
         if KEY = EMPTYSYMBOL then
           GET_LINE(F,KEYSTR,KEYLEN);
           KEY := FirstSymbol( TRIM(KEYSTR(1..KEYLEN), Both) );
           -- was: TO_SYMBOL(TRIM(KEYSTR(1..KEYLEN),Both), DROP => RIGHT);
         end if;
         exit when KEY = EMPTYSYMBOL;
       
         GET_LINE(F, DEFSTR, DEFLEN);
         MOVE(DEFSTR(1..DEFLEN), DEF, DROP => RIGHT);
         SETDEFINITION(T,KEY,DEF);
       
         GET_LINE(F,KEYSTR,KEYLEN);  -- This is to skip a line!
         KEY := TO_SYMBOL(TRIM(KEYSTR(1..KEYLEN),Both), DROP => RIGHT);
     end loop;
   exception
     when others => null;
       -- Just catch _all_ exceptions! (If we continue reading at EOF,
       -- an ADA.IO_EXCEPTIONS.END_ERROR will be raised.)
   end READTABLE_FILE_TYPE;

   procedure ReadTable(T: out SYMBOLTABLE) is
     use TEXT_IO;
   begin
     PUT("ReadTable from Keyboard; enter Symbol & Definition, line by");
     PUT("line. Stop with Ctrl-Z."); NEW_LINE;
 
     READTABLE_FILE_TYPE(CURRENT_INPUT,T);
   end READTABLE;

   procedure ReadTable(Filename : String; T: out SYMBOLTABLE) is
     use TEXT_IO;
     FILEID : FILE_TYPE;
   begin
     CLEARSYMBOLTABLE(T);

     OPEN(FILE=> FILEID, MODE=> IN_FILE, NAME=> FILENAME);
     
     READTABLE_FILE_TYPE(FILEID,T);

     CLOSE(FILEID);
  end READTABLE;

end SYMBOLTABLES;     

-----------------------------------------------------------
--
-- S T A C K S E T (SPEC)
--
-- A simple Stack which also allows to check whether an
-- element is somewhere in the Stack.
--
-- AUTHOR: Michael Vorburger
-- DATE  : 9/5/96
--
-----------------------------------------------------------

-- The solution shown here does not publish a special type
-- Stack which then had to be passed as first parameter to
-- the functions in here. Instead, each instance of this
-- generic package IS a stack. Note that this does not
-- cause any problem for more than one stack, because
-- one can simply declare a new one saying:
-- package StackSet2 is new StackSet_Integer;
-- if StackSet_Integer was defined as:
-- package StackSet_Integer is new StackSet(Integer);

generic
   type Element is private;
   Size         :  Positive := 50;

package StackSet is

   -- Before using StackSet or to Reset, call Init.
   procedure Init;
   
   function Length return Natural;
   function Get(i:Natural) return Element;

   -- Push should be self-explanatory.
   procedure Push(E: Element); 
   
   -- Pop should be self-explanatory.
   function  Pop return Element;

   -- This version of Pop simply removes the topmost element.
   procedure Pop;

   -- This function returns TRUE if E is somewhere in the Stack.
   function  IsInStack(E: Element) return boolean;

   StackEmpty, StackFull : exception;

end StackSet;     

-----------------------------------------------------------
--
-- S T A C K S E T (BODY)
--
-- A simple Stack which also allows to check whether an
-- element is somewhere in the Stack.
--
-- AUTHOR: Michael Vorburger
-- DATE  : 9/5/96
--
-----------------------------------------------------------

with EltLists;

package body StackSet is

   package List_Package is new EltLists(Element, Size);
   use List_Package;

   List : EltList;
   Next : Natural;

   procedure Init is
   begin
     ClearList(List);
     Next := 1;
   end;

   procedure Push(E: Element) is
   begin
     if Next > Size then raise StackFull; end if;
     InsertElement(List, Next, E);
     Next:=Next+1;
   end Push;
   
   function Length return Natural is
   begin
     return Next-1;
   end;

   function Get(i:Natural) return Element is
   begin
     return GetElement(List,i);
   end;

   function  Pop return Element is
     R: Element;
   begin
     if Next = 1 then raise StackEmpty; end if;
     R:=GetElement(List, Next-1);
     DeleteElement(List, Next-1);
     Next:=Next-1;
     return R;
   end Pop;

   -- This version of Pop simply removes the topmost element.
   procedure  Pop is
   begin
     if Next = 1 then raise StackEmpty; end if;
     DeleteElement(List, Next-1);
     Next:=Next-1;
   end Pop;

   -- This function returns TRUE if E is somewhere in the Stack.
   function  IsInStack(E: Element) return boolean is
     F:element;
   begin
     for I in 1..Next-1 loop
       if GetElement(List, I) = E then return True; end if;
     end loop;
     return False;
   end;

end StackSet;     

with StackSet;
with SYMBOLS, SYMBOLTABLES; use Symbols, Symboltables;

with ADA.STRINGS.FIXED; use ADA.STRINGS; use ADA.STRINGS.FIXED;
with TEXT_IO; use TEXT_IO;

procedure EX4 is
 
  package StackSet_Symbol is new StackSet(Symbol);
  use StackSet_Symbol;

  T: SYMBOLTABLE;
  
  Inp: String(1..240);  -- The user's input
  L  : Natural;         -- Length of that line

  Procedure RecursiveOutput(S: in out String) is
    Sym, f: Symbol;
    str: STring(1..80);
    Def: SymbolDefinition;

    -- STRANGE STRANGE STRANGE STRANGE STRANGE STRANGE STRANGE STRANGE
    -- This function is identical with StackSet.IsInStack, isn't it?
    -- Nevertheless, they behave differently; IsInStack always returns
    -- False; IsSymOnStack behaves correctly. Is this some problem with
    -- the generic stuff??
    
    function IsSymOnStack return boolean is
    begin
      for i in 1..StackSet_Symbol.Length loop
        if StackSet_Symbol.Get(i) = sym then return True; end if;
      end loop;
      return False;
    end IsSymOnStack;

  begin
   loop
     Sym:=FirstSymbol(S); 
     exit when Sym = EmptySymbol;

     put(To_String(Sym));

     -- (see above)
     -- IsInTable(T,Sym) and not IsInStack(Sym) does not work here!!!

     if IsInTable(T,Sym) and not IsSymOnStack then
       Def:=GetDefinition(T,Sym);
       Put(" (Definition of '"); Put(To_String(Sym)); Put("' = '");
       Push(Sym);
       RecursiveOutput( Def ); 
       Pop;
       Put("')");
     end if;
     Put(" ");

     Move(TailSymbols(S), S, Drop => Right);
     -- NOT: S:=TailSymbols(S);  -> Constrained Error!
   end loop;
  end;

begin
   READTABLE("dictionary.txt",T);
   PUT_LINE("Dictionary contents:"); Writetable(T);
   
   PUT_LINE("Type in some text, words defined in dictionary.txt will be replaced.");
   GET_LINE(Inp, L);

   NEW_LINE;
   PUT_LINE("Here is the expanded version of the text you entered:");
   
   StackSet_Symbol.Init;
   RecursiveOutput( Inp(1..L) );
end EX4; 

more ADA: [ Plot ] [ Sorting ] [ OOP-Matrices ] [ Symbol Table ] [ Sym. Derivation ]