mal/ada/types.adb

with Ada.Characters.Latin_1;
with Ada.Text_IO;

package body Types is

   package ACL renames Ada.Characters.Latin_1;


   function Opening (LT : List_Types) return Character is
      Res : Character;
   begin
      case LT is
         when List_List =>
            Res := '(';
         when Vector_List =>
            Res := '[';
         when Hashed_List =>
            Res := '{';
      end case;
      return Res;
   end Opening;


   function Closing (LT : List_Types) return Character is
      Res : Character;
   begin
      case LT is
         when List_List =>
            Res := ')';
         when Vector_List =>
            Res := ']';
         when Hashed_List =>
            Res := '}';
      end case;
      return Res;
   end Closing;


   function To_String (T : Mal_Type) return String is
      use Ada.Strings.Unbounded;
   begin
      case T.Sym_Type is
         when Int =>
            declare
               Res : String := Integer'Image (T.Int_Val);
            begin
               if Res (1) = ' ' then
                 return Res (2..Res'Last);
               else
                 return Res;
               end if;
            end;
         when Floating =>
            declare
               Res : String := Float'Image (T.Float_Val);
            begin
               if Res (1) = ' ' then
                 return Res (2..Res'Last);
               else
                 return Res;
               end if;
            end;
         when List =>

            declare
               UBS : Unbounded_String := Null_Unbounded_String;
               C : Lists.Cursor;
               use type Lists.Cursor;
               First_Pass : Boolean := True;
            begin

               if Lists.Is_Empty (T.The_List) then
                  return Opening (T.List_Type) & Closing (T.List_Type);
               end if;

               C := Lists.First (T.The_List);
               loop
                  if First_Pass then
                     First_Pass := False;
                  else
                     Append (UBS, " ");
                  end if;
                  UBStrings.Append (UBS, To_String (Lists.Element (C).all));
               exit when C = Lists.Last (T.The_List);
                  C := Lists.Next (C);
               end loop;
               return Opening (T.List_Type) &
                      To_String (UBS) &
                      Closing (T.List_Type);
            end;
         when Sym =>
            return "" & T.Symbol;
         when Str =>
            -- The_String includes the quotation marks.
            return To_String (T.The_String);
         when Atom =>
            return To_String (T.The_Atom);
         when Unitary =>
            case T.The_Function is
               when Quote =>
                  return "(quote " & To_String (T.The_Operand.all) & ")";
               when Unquote =>
                  return "(unquote " & To_String (T.The_Operand.all) & ")";
               when Quasiquote =>
                  return "(quasiquote " & To_String (T.The_Operand.all) & ")";
               when Splice_Unquote =>
                  return
                    "(splice-unquote " & To_String (T.The_Operand.all) & ")";
            end case;
      end case;
   end To_String;

end Types;