added experimental stream handling code
This commit is contained in:
@ -1,6 +1,9 @@
|
||||
with H2.Scheme;
|
||||
with H2.Pool;
|
||||
with Storage;
|
||||
with Stream;
|
||||
with Ada.Text_IO;
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
procedure scheme is
|
||||
package S renames H2.Scheme;
|
||||
@ -10,12 +13,62 @@ procedure scheme is
|
||||
|
||||
I: S.Object_Pointer;
|
||||
O: S.Object_Pointer;
|
||||
|
||||
--String: aliased S.Object_String := "(car '(1 2 3))";
|
||||
String: aliased 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);
|
||||
|
||||
|
||||
File_Name: aliased S.Object_String := "test.adb";
|
||||
--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;
|
||||
|
||||
procedure Allocate_Stream (Interp: in out S.Interpreter_Record;
|
||||
Name: access S.Object_String;
|
||||
Result: in out S.Stream_Pointer) is
|
||||
subtype FSR is Stream.File_Stream_Record;
|
||||
type FSP is access all FSR;
|
||||
package P is new H2.Pool (FSR, FSP);
|
||||
|
||||
X: FSP;
|
||||
for X'Address use Result'Address;
|
||||
pragma Import (Ada, X);
|
||||
begin
|
||||
X := P.Allocate (S.Get_Storage_Pool(Interp));
|
||||
X.Name := Stream.Object_String_Pointer(Name);
|
||||
end Allocate_Stream;
|
||||
|
||||
procedure Deallocate_Stream (Interp: in out S.Interpreter_Record;
|
||||
Source: in out S.Stream_Pointer) is
|
||||
subtype FSR is Stream.File_Stream_Record;
|
||||
type FSP is access all FSR;
|
||||
package P is new H2.Pool (FSR, FSP);
|
||||
|
||||
X: FSP;
|
||||
for X'Address use Source'Address;
|
||||
pragma Import (Ada, X);
|
||||
begin
|
||||
P.Deallocate (X, S.Get_Storage_Pool(Interp));
|
||||
end Deallocate_Stream;
|
||||
|
||||
-- --procedure Dealloc_Stream is new Ada.Unchecked_Deallocation (Stream_Record'Class, Stream_Pointer);
|
||||
-- --procedure Destroy_Stream (Stream: in out Stream_Pointer) renames Dealloc_Stream;
|
||||
|
||||
|
||||
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);
|
||||
|
||||
File_Stream.Name := File_Name'Unchecked_Access;
|
||||
S.Set_Input_Stream (SI, File_Stream); -- specify main input stream
|
||||
--S.Set_Output_Stream (SI, Stream); -- specify main output stream.
|
||||
S.Read (SI, I);
|
||||
S.Make_Test_Object (SI, I);
|
||||
|
||||
S.Evaluate (SI, I, O);
|
||||
S.Print (SI, I);
|
||||
Ada.Text_IO.Put_Line ("-------------------------------------------");
|
||||
|
Reference in New Issue
Block a user