| 
									
										
										
										
											2014-01-10 14:54:46 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-03-26 14:28:41 +00:00
										 |  |  | with H2.Wide; | 
					
						
							|  |  |  | with H2.Slim; | 
					
						
							| 
									
										
										
										
											2013-12-28 16:52:31 +00:00
										 |  |  | with H2.Pool; | 
					
						
							| 
									
										
										
										
											2013-12-10 16:14:06 +00:00
										 |  |  | with Storage; | 
					
						
							| 
									
										
										
										
											2014-03-26 14:28:41 +00:00
										 |  |  | with Slim_Stream; | 
					
						
							|  |  |  | with Wide_Stream; | 
					
						
							| 
									
										
										
										
											2013-12-10 16:14:06 +00:00
										 |  |  | with Ada.Text_IO; | 
					
						
							| 
									
										
										
										
											2013-12-28 16:52:31 +00:00
										 |  |  | with Ada.Unchecked_Deallocation; | 
					
						
							| 
									
										
										
										
											2014-05-30 03:15:40 +00:00
										 |  |  | with H2.Sysapi; | 
					
						
							| 
									
										
										
										
											2013-12-10 16:14:06 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-05-30 03:15:40 +00:00
										 |  |  | with Interfaces.C; | 
					
						
							| 
									
										
										
										
											2013-12-10 16:14:06 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-05-30 03:15:40 +00:00
										 |  |  | procedure scheme is | 
					
						
							|  |  |  | 	package Stream renames Wide_Stream; | 
					
						
							|  |  |  | 	package Scheme renames H2.Wide.Scheme; | 
					
						
							|  |  |  | 	--package Stream renames Slim_Stream;
 | 
					
						
							|  |  |  | 	--package Scheme renames H2.Slim.Scheme;
 | 
					
						
							| 
									
										
										
										
											2014-06-02 15:25:42 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-12-10 16:14:06 +00:00
										 |  |  | 	Pool: aliased Storage.Global_Pool; | 
					
						
							| 
									
										
										
										
											2014-03-26 14:28:41 +00:00
										 |  |  | 	SI: Scheme.Interpreter_Record; | 
					
						
							| 
									
										
										
										
											2013-12-10 16:14:06 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-03-26 14:28:41 +00:00
										 |  |  | 	I: Scheme.Object_Pointer; | 
					
						
							|  |  |  | 	O: Scheme.Object_Pointer; | 
					
						
							| 
									
										
										
										
											2013-12-28 16:52:31 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  | 	--String: aliased S.Object_String := "(car '(1 2 3))";
 | 
					
						
							| 
									
										
										
										
											2014-03-26 14:28:41 +00:00
										 |  |  | 	String: aliased constant Scheme.Object_Character_Array := "((lambda (x y) (+ x y))  9  7)"; | 
					
						
							| 
									
										
										
										
											2013-12-28 16:52:31 +00:00
										 |  |  | 	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-16 16:52:18 +00:00
										 |  |  | 	--File_Name: aliased S.Object_Character_Array := "test.adb";
 | 
					
						
							| 
									
										
										
										
											2014-05-30 03:15:40 +00:00
										 |  |  | 	File_Name: aliased constant Scheme.Object_Character_Array := "시험.scm"; | 
					
						
							| 
									
										
										
										
											2013-12-28 16:52:31 +00:00
										 |  |  | 	--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; | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-03-09 18:01:38 +00:00
										 |  |  |    --procedure h2init;
 | 
					
						
							|  |  |  |    --pragma Import (C, h2init, "h2init");
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-12-10 16:14:06 +00:00
										 |  |  | begin | 
					
						
							| 
									
										
										
										
											2014-03-09 18:01:38 +00:00
										 |  |  | 	--h2init;
 | 
					
						
							| 
									
										
										
										
											2013-12-10 16:14:06 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-05-30 03:15:40 +00:00
										 |  |  | declare | 
					
						
							|  |  |  | 	package Sysapi is new H2.Sysapi ( | 
					
						
							|  |  |  | 		H2.Slim.Character, | 
					
						
							|  |  |  | 		H2.Wide.Character, | 
					
						
							|  |  |  | 		H2.Slim.String, | 
					
						
							|  |  |  | 		H2.Wide.String, | 
					
						
							|  |  |  | 		H2.Wide.Utf8.To_Unicode_String, | 
					
						
							|  |  |  | 		H2.Wide.Utf8.From_Unicode_String); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 	F: Sysapi.File_Pointer; | 
					
						
							| 
									
										
										
										
											2014-06-02 15:25:42 +00:00
										 |  |  | 	FL: Sysapi.File_Flag; | 
					
						
							| 
									
										
										
										
											2014-05-30 03:15:40 +00:00
										 |  |  | begin | 
					
						
							| 
									
										
										
										
											2014-06-02 15:25:42 +00:00
										 |  |  | 	Sysapi.Set_File_Flag_Bits (FL, Sysapi.FILE_FLAG_WRITE); | 
					
						
							|  |  |  | 	Sysapi.Set_File_Flag_Bits (FL, Sysapi.FILE_FLAG_READ); | 
					
						
							|  |  |  | 	Sysapi.File.Open (F, H2.Slim.String'("/etc/passwd"), FL); | 
					
						
							| 
									
										
										
										
											2014-05-30 03:15:40 +00:00
										 |  |  | 	Sysapi.File.Close (F); | 
					
						
							|  |  |  | end; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | declare | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 	LC_ALL : constant Interfaces.C.int := 0; | 
					
						
							|  |  |  | 	procedure setlocale ( | 
					
						
							|  |  |  | 		category : Interfaces.C.int; | 
					
						
							|  |  |  | 		locale : Interfaces.C.char_array); | 
					
						
							|  |  |  | 	pragma Import (C, setlocale); | 
					
						
							|  |  |  | 	Empty : aliased Interfaces.C.char_array := (0 => Interfaces.C.nul); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | begin | 
					
						
							|  |  |  | 	setlocale (LC_ALL, Empty); | 
					
						
							|  |  |  | end; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-03-26 14:28:41 +00:00
										 |  |  | 	Scheme.Open (SI, 2_000_000, Pool'Unchecked_Access); | 
					
						
							|  |  |  | 	--Scheme.Open (SI, null);
 | 
					
						
							| 
									
										
										
										
											2013-12-28 16:52:31 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-01 14:07:03 +00:00
										 |  |  | 	-- Specify the named stream handler
 | 
					
						
							| 
									
										
										
										
											2014-06-02 15:25:42 +00:00
										 |  |  | 	Scheme.Set_Option (SI, (Scheme.Stream_Option, | 
					
						
							|  |  |  | 	                   Stream.Allocate_Stream'Access, | 
					
						
							| 
									
										
										
										
											2014-01-01 14:07:03 +00:00
										 |  |  | 	                   Stream.Deallocate_Stream'Access) | 
					
						
							|  |  |  | 	); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-03-26 14:28:41 +00:00
										 |  |  | Scheme.Set_Option (SI, (Scheme.Trait_Option, Scheme.No_Optimization)); | 
					
						
							| 
									
										
										
										
											2014-01-28 15:42:28 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-01 14:07:03 +00:00
										 |  |  | 	File_Stream.Name := File_Name'Unchecked_Access; | 
					
						
							| 
									
										
										
										
											2014-01-14 14:22:06 +00:00
										 |  |  | 	begin | 
					
						
							| 
									
										
										
										
											2014-03-26 14:28:41 +00:00
										 |  |  | 		Scheme.Set_Input_Stream (SI, File_Stream); -- specify main input stream
 | 
					
						
							|  |  |  | 		--Schee.Set_Input_Stream (SI, String_Stream);
 | 
					
						
							| 
									
										
										
										
											2014-01-14 14:22:06 +00:00
										 |  |  | 	exception | 
					
						
							|  |  |  | 		when others => | 
					
						
							|  |  |  | 			Ada.Text_IO.Put_Line ("Cannot open Input Stream"); | 
					
						
							|  |  |  | 	end; | 
					
						
							| 
									
										
										
										
											2014-03-26 14:28:41 +00:00
										 |  |  | 	--Scheme.Set_Output_Stream (SI, Stream); -- specify main output stream.
 | 
					
						
							| 
									
										
										
										
											2014-01-01 14:07:03 +00:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-07 17:02:12 +00:00
										 |  |  | Ada.Text_IO.Put_Line ("-------------------------------------------"); | 
					
						
							| 
									
										
										
										
											2014-03-26 14:28:41 +00:00
										 |  |  | Scheme.Run_Loop (SI, I); | 
					
						
							|  |  |  | Scheme.Print (SI, I); | 
					
						
							|  |  |  | 	Scheme.Close (SI); | 
					
						
							| 
									
										
										
										
											2013-12-10 16:14:06 +00:00
										 |  |  | 
 | 
					
						
							|  |  |  | 	Ada.Text_IO.Put_Line ("BYE..."); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | end scheme; |