2015-03-15 22:56:09 +03:00
|
|
|
with Ada.Characters.Latin_1;
|
|
|
|
with Ada.Text_IO;
|
|
|
|
|
|
|
|
package body Types is
|
|
|
|
|
|
|
|
package ACL renames Ada.Characters.Latin_1;
|
|
|
|
|
2015-03-17 01:48:48 +03:00
|
|
|
|
|
|
|
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;
|
|
|
|
|
|
|
|
|
2015-03-15 22:56:09 +03:00
|
|
|
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
|
2015-03-17 01:48:48 +03:00
|
|
|
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;
|
2015-03-15 22:56:09 +03:00
|
|
|
end if;
|
|
|
|
end;
|
|
|
|
when List =>
|
|
|
|
|
|
|
|
declare
|
|
|
|
UBS : Unbounded_String := Null_Unbounded_String;
|
|
|
|
C : Lists.Cursor;
|
|
|
|
use type Lists.Cursor;
|
|
|
|
First_Pass : Boolean := True;
|
|
|
|
begin
|
2015-03-17 01:48:48 +03:00
|
|
|
|
2015-03-15 22:56:09 +03:00
|
|
|
if Lists.Is_Empty (T.The_List) then
|
2015-03-17 01:48:48 +03:00
|
|
|
return Opening (T.List_Type) & Closing (T.List_Type);
|
2015-03-15 22:56:09 +03:00
|
|
|
end if;
|
2015-03-17 01:48:48 +03:00
|
|
|
|
2015-03-15 22:56:09 +03:00
|
|
|
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;
|
2015-03-17 01:48:48 +03:00
|
|
|
return Opening (T.List_Type) &
|
|
|
|
To_String (UBS) &
|
|
|
|
Closing (T.List_Type);
|
2015-03-15 22:56:09 +03:00
|
|
|
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);
|
2015-03-16 01:00:31 +03:00
|
|
|
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;
|
2015-03-15 22:56:09 +03:00
|
|
|
end case;
|
|
|
|
end To_String;
|
|
|
|
|
|
|
|
end Types;
|