Re: S-expression I/O in Ada

[Natasha Kerensikova <lithiumcat@gmail.com>]

Hello,

here is my first try at a S_Expressions package, which is supposed to
handle the in-memory representations. I first planned to begin with the
Sexp_Stream I imagined, but it proved much more difficult than I
thought, so I went for the easier package first.

Even though I'm much more used to C than to Ada, I have the feeling it's
horribly ugly and that using access types all over the place like I did
is extremely poor. Yet I just can't find out exactly how it's wrong, nor
how to get it right.

Would any other you be kind enough to have a look at it, and point me
where I did wrong and explain me how wrong it is, be it on high-level
package design to low-level implementation choice and anything in
between including code style.


Thanks in advance for your help,
Natacha




with Ada.Finalization;

package S_Expressions is

   -- atom related types
   -- they are public to allow atom <--> object converters anywhere
   type Octet is range 0 .. 255;
   type Atom_Data is array (Integer range <>) of Octet;

   function To_String (From: in Atom_Data) return String;

   -- S-expression private types
   type Node_Content is (Atom, List);
   type Node (Content: Node_Content) is
      new Ada.Finalization.Controlled with private;
   type Access_Node is access Node;

   -- Node accessors
   function Get_Atom(node: not null Access_Node) return Atom_Data;
   function Get_Child(node: not null Access_Node) return Access_Node;
   function Get_Next(node: not null Access_Node) return Access_Node;
   function Get_Node_Type(node: not null Access_Node) return Node_Content;

   -- Node constructors
   function New_Atom_Node(contents: Atom_Data; next: Access_Node)
     return Access_Node;
   function New_List_Node(child, next: Access_Node)
     return Access_Node;

private

   type Access_Atom_Data is access Atom_Data;

   type Node (Content: Node_Content) is
      new Ada.Finalization.Controlled with record
         Next: Access_Node;
         case Content is
            when Atom =>
               Atom: Access_Atom_Data;
            when List =>
               Child: Access_Node;
         end case;
      end record;

   overriding procedure Adjust(object: in out Node);
   overriding procedure Finalize(object: in out Node);

end S_Expressions;




with Ada.Unchecked_Deallocation;

package body S_Expressions is

   procedure Free is
      new Ada.Unchecked_Deallocation (Node, Access_Node);
   procedure Free is
      new Ada.Unchecked_Deallocation (Atom_Data, Access_Atom_Data);

   -- Atom data duplication
   function Duplicate(object: in Access_Atom_Data) return Access_Atom_Data is
      new_object: Access_Atom_Data;
   begin
      if object /= Null then
         new_object := new Atom_Data(object'Range);
         new_object.All := object.All;
      end if;
      return new_object;
   end Duplicate;


   -- Deep node duplication
   function Duplicate(object: in Access_Node) return Access_Node is
      new_object: Access_Node;
   begin
      if object /= Null then
         case object.Content is
            when Atom =>
               new_object := new Node (Atom);
               new_object.Atom := Duplicate(object.Atom);
            when List =>
               new_object := new Node (List);
               new_object.Child := Duplicate(object.Child);
         end case;
         new_object.Next := Duplicate(object.Next);
      end if;
      return new_object;
   end Duplicate;


   -- atom to string converter
   function To_String(from: Atom_Data) return String is
      to: String(from'Range);
   begin
      for i in from'Range loop
         to(i) := Character'Val(from(i) + 1);
      end loop;
      return to;
   end To_String;


   -- deep copy of node objects
   overriding procedure Adjust(object: in out Node) is
   begin
      case object.Content is
         when Atom =>
            object.Atom := Duplicate(object.Atom);
         when List =>
            object.Child := Duplicate(object.Child);
      end case;
      object.Next := Duplicate(object.Next);
   end Adjust;


   -- deep release of node objects
   overriding procedure Finalize(object: in out Node) is
   begin
      case object.Content is
         when Atom => Free(object.Atom);
         when List => Free(object.Child);
      end case;
      Free(object.Next);
   end;


   -- Node acessors
   function Get_Node_Type(node: not null Access_Node) return Node_Content is
   begin
      return node.Content;
   end;

   function Get_Atom(node: not null Access_Node) return Atom_Data is
   begin
      return node.Atom.All;
   end;

   function Get_Child(node: not null Access_Node) return Access_Node is
   begin
      return node.Child;
   end;

   function Get_Next(node: not null Access_Node) return Access_Node is
   begin
      return node.Next;
   end;


   -- Node constructors
   function New_Atom_Node(contents: Atom_Data; next: Access_Node)
     return Access_Node is
      new_node: Access_Node;
   begin
      new_node := new Node (Atom);
      new_node.Atom := Duplicate (contents'Access);
      new_node.Next := next;
      return new_node;
   end;

   function New_List_Node(child, next: Access_Node)
     return Access_Node is
      new_node: Access_Node;
   begin
      new_node := new Node (List);
      new_node.Child := Duplicate (child);
      new_node.Next := next;
      return new_node;
   end;

end S_Expressions;