hcl/cmd/scheme.adb

88 lines
3.0 KiB
Ada
Raw Normal View History

2013-12-10 16:14:06 +00:00
with H2.Scheme;
with H2.Pool;
2013-12-10 16:14:06 +00:00
with Storage;
with Stream;
2013-12-10 16:14:06 +00:00
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;
2013-12-10 16:14:06 +00:00
2013-12-10 16:14:06 +00:00
procedure scheme is
--package S renames H2.Scheme;
--package S is new H2.Scheme (Wide_Character, Wide_String);
package S renames Stream.S;
2013-12-10 16:14:06 +00:00
Pool: aliased Storage.Global_Pool;
SI: S.Interpreter_Record;
2013-12-17 16:04:55 +00:00
I: S.Object_Pointer;
O: S.Object_Pointer;
--String: aliased S.Object_String := "(car '(1 2 3))";
2014-01-01 14:07:03 +00:00
String: aliased constant S.Object_String := "((lambda (x y) (+ x y)) 9 7)";
String_Stream: Stream.String_Input_Stream_Record (String'Unchecked_Access);
--String_Stream: Stream.String_Input_Stream_Record := (Len => String'Length, Str => String, Pos => 0);
2014-01-01 14:07:03 +00:00
--File_Name: aliased S.Object_String := "test.adb";
File_Name: aliased constant S.Object_String := "test.scm";
--File_Stream: Stream.File_Stream_Record (File_Name'Unchecked_Access);
--File_Stream: Stream.File_Stream_Record := (Name => File_Name'Unchecked_Access);
File_Stream: Stream.File_Stream_Record;
2013-12-10 16:14:06 +00:00
begin
Ada.Text_Io.Put_Line (S.Object_Word'Image(S.Object_Pointer_Bytes));
S.Open (SI, 2_000_000, Pool'Unchecked_Access);
--S.Open (SI, null);
2014-01-01 14:07:03 +00:00
-- Specify the named stream handler
S.Set_Option (SI, (S.Stream_Option,
Stream.Allocate_Stream'Access,
Stream.Deallocate_Stream'Access)
);
File_Stream.Name := File_Name'Unchecked_Access;
S.Set_Input_Stream (SI, File_Stream); -- specify main input stream
--S.Set_Input_Stream (SI, String_Stream);
--S.Set_Output_Stream (SI, Stream); -- specify main output stream.
Ada.Text_IO.Put_Line ("-------------------------------------------");
S.Run_Loop (SI, I);
S.Print (SI, I);
2013-12-10 16:14:06 +00:00
S.Close (SI);
declare
subtype x is S.Object_Record (S.Moved_Object, 0);
subtype y is S.Object_Record (S.Pointer_Object, 1);
subtype z is S.Object_Record (S.Character_Object, 1);
subtype q is S.Object_Record (S.Byte_Object, 1);
a: x;
b: y;
c: z;
d: q;
w: S.Object_Word;
begin
Ada.Text_Io.Put_Line (S.Object_Word'Image(w'Size));
Ada.Text_Io.Put_Line (S.Object_Word'Image(S.Object_Word'Size));
Ada.Text_IO.Put_Line ("------");
Ada.Text_Io.Put_Line (S.Object_Word'Image(x'Size));
Ada.Text_Io.Put_Line (S.Object_Word'Image(y'Size));
Ada.Text_Io.Put_Line (S.Object_Word'Image(z'Size));
Ada.Text_Io.Put_Line (S.Object_Word'Image(q'Size));
Ada.Text_Io.Put_Line (S.Object_Word'Image(x'Max_Size_In_Storage_Elements));
Ada.Text_Io.Put_Line (S.Object_Word'Image(y'Max_Size_In_Storage_Elements));
Ada.Text_Io.Put_Line (S.Object_Word'Image(z'Max_Size_In_Storage_Elements));
Ada.Text_Io.Put_Line (S.Object_Word'Image(q'Max_Size_In_Storage_Elements));
Ada.Text_Io.Put_Line (S.Object_Word'Image(a'Size));
Ada.Text_Io.Put_Line (S.Object_Word'Image(b'Size));
Ada.Text_Io.Put_Line (S.Object_Word'Image(c'Size));
Ada.Text_Io.Put_Line (S.Object_Word'Image(c'Size));
Ada.Text_Io.Put_Line (S.Object_Integer'Image(S.Object_Integer'First));
Ada.Text_Io.Put_Line (S.Object_Integer'Image(S.Object_Integer'Last));
end;
Ada.Text_IO.Put_Line ("BYE...");
end scheme;