Re: S-expression I/O in Ada

[Natasha Kerensikova <lithiumcat@gmail.com>]

Hello,

Here is my second try at a in-memory S-expression package. I used
Doubly_Linked_Lists, but I did my best to make it as easy as possible to
switch to Vectors.

I managed to remove all explicit access, except for callbacks.

I face the difficulty of trying to make as few list assignments as
possible, because they trigger deep-copy. The problem is that the
package is supposed to be fed directly from external data, which might
be unsafe. So I don't want deep copyings all over the place, because it
might become very expensive on specially-crafted deep input.

Inspired from Ada containers interface (i.e. Cursors), I think the
interface here is usable for read a S-expression object.

However I couldn't imagine a way to design S-expression construction
interface without triggering a deep copy. Ada containers use
Update_Element, which requires passing a read-write container. So in
order to Append a node to a List (let's call it L), I need to pass L's
parent in read-write mode. However in order to get a read-write access
to L's parent, I need to pass L's grandparent to something, which
requires L's grand-grandparent, and so on until the unknown root list.
Obviously this doesn't work.

Using the Append procedure implemented here, I can insert a List as a
node at the end of an existing List, but that makes a deep copy of the
inserted List. So using this interface, if we imagine more and more
complex objects containing less complex object, it means making a simple
list, deep-copying into a large list, itself deep-copied into a larger
list, itself deep-copied into an even larger list, and so-on. While it's
bounded by the application rather than as user input, which is less bad,
it seems sounds horribly inefficient.

Does anybody have an idea about how to solve this issue?


Another point I discovered while writing this implementation, is that I
end up writing a lot of wrappers over the container's functions. Would
it be possible to somehow define List and Cursors directly as instances
of the container respective types, and to expose directly container's
functions? All this while maintaining the type hiding, I don't want to
expose the container, and just want to specify "I expose this and that
functions" and tell in the body "oh by the way, this and that functions
are just public names of this and that container functions". This way
the code would be lighter but still as flexible (whenever I'm not
satisfied with container functions, or whenever I want to change the
container, I just have to (re)write the publicly exposed functions
without changing the specification).

Or is it just completely insane?


Also, I find this implementation much more complex than I expected
for a conceptually simple object. I'm afraid I got caught up into some
design hell and came up with something much more complex than needed.
However I can't see how I can make it simpler without giving up to the
deep-copy issue. Is it because I'm a noob or because it really has to be
that complex?


I believe I would be much more at ease with a custom access-based
singly-linked list implementation, but I'm afraid this is due to my
excessive use of C pointers. I still can't estimate how bad or inelegant
or ugly are explicit access. I guess even in Ada they have some niche
use, and avoiding expensive copy can be one them, right?


Another thing I noticed with this relatively large package is Ada
verbosity. Now I see the difference between using words versus {}. The
problem I see with words for everything is that identifiers don't come
out as well (even with syntax highlighting, differently-colored words
have less contrast than words and punctuation). I hope it's only because
I'm still misusing whitespace.

I'm used to 8-column tab for indentation in C, is it completely
unrealistic in Ada? I followed the recommendation of 3-space
indentation, and that's very flat. Again, do I need only time to get
used to it, or are there other lighter whitespace styles that I haven't
encountered yet?


Last point, I had trouble finding names. I read the Ada 95 Quality and
Style Guide, and I find it difficult to follow. For example, I was
tempted to call "Atom" the public array representation, the internal
node type, and the function taking a Cursor and returning the public
array representation. I was tempted to call "Node_Type" the public
enumeration type, the function taking a Cursor and returning the type of
the pointed node, and (not in this implementation but in some other
attempts) the internal object discriminant name.

Does it become easier with practice? Would you mind reviewing my name
choices to progress faster?


As usual, all comments on my code are welcome, especially those that can
make me progress.
Thanks in advance for your help,
Natasha





with Ada.Containers;
use  Ada.Containers;

private with Ada.Containers.Indefinite_Doubly_Linked_Lists;


package S_Expressions is

   -----------
   -- Types --
   -----------

   type Octet is range 0 .. 255;
   type Atom_Data is array (Integer range <>) of Octet;
      -- Atom_Data is public to allow Object <--> Atom conversion anywhere

   type List is tagged private;
      -- a S-experssion is actually a List object
      -- theoretically any List tail should be a valid S-expression,
      --    but it seems to difficult and not useful enough
      -- each element is either an Atom or a List

   type Cursor is private;
      -- designates an element in a List

   type Node_Kind is (Node_Atom, Node_List);



   ---------------
   -- Constants --
   ---------------

   Empty_List : constant List;
   No_Element : constant Cursor;


   ------------------------------------
   -- String vs Atom_Data converters --
   ------------------------------------

   procedure String_To_Atom(S : in String; A : out Atom_Data);
   procedure Atom_To_String(A : in Atom_Data; S : out String);
   function To_Atom(S : in String) return Atom_Data;
   function To_String(A : in Atom_Data) return String;


   ---------------------
   -- List inspection --
   ---------------------

   procedure Counts(sexp : in List; Atom_Count, List_Count : out Count_Type);
   function Atom_Count(sexp : in List) return Count_Type;
   function List_Count(sexp : in List) return Count_Type;
   function Node_Count(sexp : in List) return Count_Type;


   ---------------
   -- Iterators --
   ---------------

   procedure Iterate(sexp         : in List;
                     Process_Atom : access procedure(Atom : in Atom_Data);
                     Process_List : access procedure(Sublist : in List));
   procedure Iterate_Over_Atoms(sexp    : in List;
                                Process : not null access procedure
                                             (Atom : in Atom_Data));
   procedure Iterate_Over_Lists(sexp    : in List;
                                Process : not null access procedure
                                             (Sublist : in List));


   -----------------------
   -- Cursor management --
   -----------------------

   function First(sexp : in List) return Cursor;
   function Last(sexp : in List) return Cursor;

   procedure Next(Position : in out Cursor);
   procedure Previous(Position : in out Cursor);
   function Next(Position : in Cursor) return Cursor;
   function Previous(Position : in Cursor) return Cursor;

   function Is_Atom(Element : in Cursor) return Boolean;
   function Is_List(Element : in Cursor) return Boolean;
   function Kind_Of(Element : in Cursor) return Node_Kind;


   --------------------
   -- Atom accessors --
   --------------------

   procedure Query_Atom(Element : in Cursor;
                        Process : not null access procedure
                                       (Atom : in Atom_Data));
   function Atom_Size(Element : in Cursor) return Natural;
   function Atom_Contents(Element : in Cursor) return Atom_Data;
   function Atom_To_String(Element : in Cursor) return String;


   --------------------
   -- List accessors --
   --------------------

   procedure Query_List(Element : in Cursor;
                        Process : not null access procedure
                                       (Sub_Sexp : in List));
   function Sublist_First(Element : in Cursor) return Cursor;
   function Sublist_Last(Element : in Cursor) return Cursor;


   -----------------------
   -- Node constructors --
   -----------------------


   procedure Append(Target : in out List; Data : in Atom_Data);
      -- Append a new atom to the target list
   procedure Append(Target : in out List; Data : in String);
      -- Append a new atom built from a String to the target list
   procedure Append(Target : in out List; Data : in List);
      -- Append a copy of the given list to the target list



private

   ----------------------
   -- Type definitions --
   ----------------------

   type Node is tagged null record;

   package Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists
                        (Element_Type => Node'Class);

   type Atom (Size : Natural) is new Node with
      record
         Internal : Atom_Data (1 .. Size);
      end record;

   type List is new Node with
      record
         Internal : Lists.List;
      end record;

   type Cursor is
      record
         Internal : Lists.Cursor;
      end record;


   ---------------
   -- Constants --
   ---------------

   Empty_List : constant List := List'(Internal => Lists.Empty_List);
   No_Element : constant Cursor := Cursor'(Internal => Lists.No_Element);

end S_Expressions;




with Ada.Tags;

package body S_Expressions is

   -----------------------------------
   -- Tag related private functions --
   -----------------------------------


   function Is_Atom(N : in Node'Class) return Boolean is
   begin
      return Ada.Tags."="(N'Tag, Atom'Tag);
   end;

   function Is_List(N : in Node'Class) return Boolean is
   begin
      return Ada.Tags."="(N'Tag, List'Tag);
   end;

   function Kind_Of(N : in Node'Class) return Node_Kind is
      ret : Node_Kind;
   begin
      if Is_Atom(N) then
         ret := Node_Atom;
      elsif Is_List(N) then
         ret := Node_List;
      else
         raise Program_Error;
      end if;
      return ret;
   end Kind_Of;

   pragma Inline(Is_Atom, Is_List, Kind_Of);



   ------------------------------------
   -- String vs Atom_Data converters --
   ------------------------------------

   procedure String_To_Atom(S : in String; A : out Atom_Data) is
   begin
      for i in S'Range loop
         A(i - S'First + A'First) := Character'Pos(S(i)) - 1;
      end loop;
   end String_To_Atom;



   procedure Atom_To_String(A : in Atom_Data; S : out String) is
   begin
      for i in A'Range loop
         S(i - A'First + S'First) := Character'Val(A(i) + 1);
      end loop;
   end Atom_To_String;



   function To_Atom(S : in String) return Atom_Data is
      ret : Atom_Data(1 .. S'Length);
   begin
      String_To_Atom(S, ret);
      return ret;
   end To_Atom;



   function To_String(A : in Atom_Data) return String is
      ret : String(A'Range);
   begin
      Atom_To_String(A, ret);
      return ret;
   end To_String;


   ---------------------
   -- List inspection --
   ---------------------


   procedure Counts(sexp : in List; Atom_Count, List_Count : out Count_Type) is

      procedure Process(Element : in Node'Class) is
      begin
         case Kind_Of(Element) is
            when Node_Atom =>
               Atom_Count := Atom_Count + 1;
            when Node_List =>
               List_Count := List_Count + 1;
         end case;
      end;

      procedure Process(Position : in Lists.Cursor) is
      begin
         Lists.Query_Element(Position, Process'Access);
      end Process;

   begin
      Atom_Count := 0;
      List_Count := 0;
      Lists.Iterate(sexp.Internal, Process'Access);
   end Counts;



   function Atom_Count(sexp : in List) return Count_Type is
      ret, discard : Count_Type;
   begin
      Counts(sexp, ret, discard);
      return ret;
   end;



   function List_Count(sexp : in List) return Count_Type is
      ret, discard : Count_Type;
   begin
      Counts(sexp, discard, ret);
      return ret;
   end;



   function Node_Count(sexp : in List) return Count_Type is
   begin
      return Lists.Length(sexp.Internal);
   end;



   ---------------
   -- Iterators --
   ---------------

   procedure Iterate(sexp         : in List;
                     Process_Atom : access procedure(Atom : in Atom_Data);
                     Process_List : access procedure(Sublist : in List)) is
      procedure Process(N : in Node'Class) is
      begin
         case Kind_Of(N) is
            when Node_Atom => Process_Atom(Atom(N).Internal);
            when Node_List => Process_List(List(N));
         end case;
      end Process;

      procedure Read_Element(C : in Lists.Cursor) is
      begin
         Lists.Query_Element(C, Process'Access);
      end;

   begin
      if Process_Atom = null then
         if Process_List /= null then
            Iterate_Over_Lists(sexp, Process_List);
         end if;
      else
         if Process_List = null then
            Iterate_Over_Atoms(sexp, Process_Atom);
         else
            Lists.Iterate(sexp.Internal, Read_Element'Access);
         end if;
      end if;
   end Iterate;



   procedure Iterate_Over_Atoms(sexp    : in List;
                                Process : not null access procedure
                                             (Atom : in Atom_Data)) is
      procedure Internal_Process(N : Node'Class) is
      begin
         if Is_Atom(N) then
            Process(Atom(N).Internal);
         end if;
      end Internal_Process;

      procedure Read_Element(C : in Lists.Cursor) is
      begin
         Lists.Query_Element(C, Internal_Process'Access);
      end;

   begin
      Lists.Iterate(sexp.Internal, Read_Element'Access);
   end Iterate_Over_Atoms;



   procedure Iterate_Over_Lists(sexp    : in List;
                                Process : not null access procedure
                                             (Sublist : in List)) is
      procedure Internal_Process(N : Node'Class) is
      begin
         if Is_List(N) then
            Process(List(N));
         end if;
      end Internal_Process;

      procedure Read_Element(C : in Lists.Cursor) is
      begin
         Lists.Query_Element(C, Internal_Process'Access);
      end;

   begin
      Lists.Iterate(sexp.Internal, Read_Element'Access);
   end Iterate_Over_Lists;



   -----------------------
   -- Cursor management --
   -----------------------


   function First(sexp : in List) return Cursor is
      ret : Cursor := (Internal => Lists.First(sexp.Internal));
   begin
      return ret;
   end First;



   function Last(sexp : in List) return Cursor is
      ret : Cursor := (Internal => Lists.Last(sexp.Internal));
   begin
      return ret;
   end Last;



   procedure Next(Position : in out Cursor) is
   begin
      Lists.Next(Position.Internal);
   end Next;



   procedure Previous(Position : in out Cursor) is
   begin
      Lists.Previous(Position.Internal);
   end Previous;



   function Next(Position : in Cursor) return Cursor is
      ret : Cursor := (Internal => Lists.Next(Position.Internal));
   begin
      return ret;
   end Next;



   function Previous(Position : in Cursor) return Cursor is
      ret : Cursor := (Internal => Lists.Previous(Position.Internal));
   begin
      return ret;
   end Previous;



   function Is_Atom(Element : in Cursor) return Boolean is
   begiN
      return Element /= No_Element
         and then Lists.Has_Element(Element.Internal)
         and then Kind_Of(Element) = Node_Atom;
   end Is_Atom;



   function Is_List(Element : in Cursor) return Boolean is
   begiN
      return Element /= No_Element
         and then Lists.Has_Element(Element.Internal)
         and then Kind_Of(Element) = Node_List;
   end Is_List;



   function Kind_Of(Element : in Cursor) return Node_Kind is
      ret : Node_Kind;
      procedure Process(Element : in Node'Class) is
      begin
         ret := Kind_Of(Element);
      end;
   begin
      Lists.Query_Element(Element.Internal, Process'Access);
      return ret;
   end Kind_Of;



   --------------------
   -- Atom accessors --
   --------------------


   procedure Query_Atom(Element : in Cursor;
                        Process : not null access procedure
                                       (Atom : in Atom_Data)) is
      procedure Internal_Process(Element : in Node'Class) is
      begin
         Process(Atom(Element).Internal);
      end Internal_Process;
   begin
      Lists.Query_Element(Element.Internal, Internal_Process'Access);
   end Query_Atom;



   function Atom_Size(Element : in Cursor) return Natural is
      ret : Natural;
      procedure Record_Size(Element : in Node'Class) is
      begin
         ret := Atom(Element).Size;
      end Record_Size;
   begin
      Lists.Query_Element(Element.Internal, Record_Size'Access);
      return ret;
   end Atom_Size;



   function Atom_Contents(Element : in Cursor) return Atom_Data is
      ret : Atom_Data(1 .. Atom_Size(Element));
      procedure Copy_Atom_Data(Element : in Node'Class) is
      begin
         ret := Atom(Element).Internal;
      end;
   begin
      Lists.Query_Element(Element.Internal, Copy_Atom_Data'Access);
      return ret;
   end Atom_Contents;



   function Atom_To_String(Element : in Cursor) return String is
      ret : String(1 .. Atom_Size(Element));
      procedure To_String(Element : in Node'Class) is
         input : Atom_Data renames Atom(Element).Internal;
      begin
         Atom_To_String(Atom(Element).Internal, ret);
      end;
   begin
      Lists.Query_Element(Element.Internal, To_String'Access);
      return ret;
   end Atom_To_String;



   --------------------
   -- List accessors --
   --------------------


   procedure Query_List(Element : in Cursor;
                        Process : not null access procedure
                                       (Sub_Sexp : in List)) is
      procedure Internal_Process(Element : in Node'Class) is
      begin
         Process(List(Element));
      end Internal_Process;
   begin
      Lists.Query_Element(Element.Internal, Internal_Process'Access);
   end Query_List;



   function Sublist_First(Element : in Cursor) return Cursor is
      ret : Cursor;
      procedure Make_First(Element : in Node'Class) is
      begin
         ret.Internal := Lists.First(List(Element).Internal);
      end Make_First;
   begin
      Lists.Query_Element(Element.Internal, Make_First'Access);
      return ret;
   end Sublist_First;



   function Sublist_Last(Element : in Cursor) return Cursor is
      ret : Cursor;
      procedure Make_Last(Element : in Node'Class) is
      begin
         ret.Internal := Lists.Last(List(Element).Internal);
      end Make_Last;
   begin
      Lists.Query_Element(Element.Internal, Make_Last'Access);
      return ret;
   end Sublist_Last;


   -----------------------
   -- Node constructors --
   -----------------------


   procedure Append(Target : in out List; Data : in Atom_Data) is
      Neo_Node : Atom(Data'Length);
   begin
      Neo_Node.Internal(1 .. Data'Length) := Data(Data'Range);
      Lists.Append(Target.Internal, Neo_Node);
   end Append;



   procedure Append(Target : in out List; Data : in String) is
      Neo_Node : Atom(Data'Length);
   begin
      String_To_Atom(Data, Neo_Node.Internal);
      Lists.Append(Target.Internal, Neo_Node);
   end Append;



   procedure Append(Target : in out List; Data : in List) is
   begin
      Lists.Append(Target.Internal, Data);
   end Append;



end S_Expressions;