From 29b7183205aba5882672d3aef15dfddc8271b743 Mon Sep 17 00:00:00 2001
From: hyung-hwan <hyunghwan.chung@gmail.com>
Date: Thu, 19 Dec 2013 14:36:14 +0000
Subject: [PATCH] added experimental c-wrapper code

---
 include/h2scm.h   | 22 ++++++++++++++
 lib/h2-scheme.adb | 76 +++++++++++++++++++++++++++++++++++++++--------
 2 files changed, 86 insertions(+), 12 deletions(-)
 create mode 100644 include/h2scm.h

diff --git a/include/h2scm.h b/include/h2scm.h
new file mode 100644
index 0000000..c4ecd21
--- /dev/null
+++ b/include/h2scm.h
@@ -0,0 +1,22 @@
+#ifndef _H2SCM_H_
+#define _H2SCM_H_
+
+typedef struct h2scm_t h2scm_t;
+typedef struct h2scm_obj_t h2scm_obj_t;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+h2scm_t* h2scm_open (void);
+
+void h2scm_close (h2scm_t* scm);
+
+int h2scm_evaluate (h2scm_t* scm, h2scm_obj_t* src);
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif
diff --git a/lib/h2-scheme.adb b/lib/h2-scheme.adb
index 7cd45b5..f293925 100644
--- a/lib/h2-scheme.adb
+++ b/lib/h2-scheme.adb
@@ -1,6 +1,10 @@
 with H2.Pool;
 with System.Address_To_Access_Conversions;
 
+
+with Ada.Unchecked_Deallocation; -- for h2scm c interface. TOOD: move it to a separate file
+with Interfaces.C;
+
 package body H2.Scheme is
 
 	----------------------------------------------------------------------------------
@@ -1757,17 +1761,17 @@ begin
 			)
 		);
 
-	--	Z := Make_Cons (
-	--		Interp.Self,
-	--		Make_Symbol (Interp.Self, "begin"),
-	--		Y
-	--	);
+		Z := Make_Cons (
+			Interp.Self,
+			Make_Symbol (Interp.Self, "begin"),
+			Y
+		);
 
-	--	Result := Make_Cons (
-	--		Interp.Self,
-	--		Make_Symbol (Interp.Self, "begin"),
-	--		Make_Cons (Interp.Self, Z, Nil_Pointer)
-	--	);
+		Result := Make_Cons (
+			Interp.Self,
+			Make_Symbol (Interp.Self, "begin"),
+			Make_Cons (Interp.Self, Z, Nil_Pointer)
+		);
 
 
 Text_IO.PUt ("TEST OBJECT: ");
@@ -1900,8 +1904,7 @@ end Make_Test_Object;
 						case Car.Scode is
 							when Begin_Syntax =>
 
-								-- Skip begin
-								Operand := Cdr;
+								Operand := Cdr; -- Skip begin
 
 								if Operand = Nil_Pointer then
 									-- 'begin' is followed by nothing. i.e. (begin)
@@ -2268,6 +2271,55 @@ Print (Interp, Operand);
 		pragma Assert (Interp.Stack = Nil_Pointer);
 	end Evaluate;
 
+	----------------------------------------------------------------------------------
+
+	function h2scm_open return Interpreter_Pointer;
+	pragma Export (C, h2scm_open, "h2scm_open");
+
+	procedure h2scm_close (Interp: in out Interpreter_Pointer);
+	pragma Export (C, h2scm_close, "h2scm_close");
+
+	function h2scm_evaluate (Interp: access Interpreter_Record;
+	                         Source: in     Object_Pointer) return Interfaces.C.int;
+	pragma Export (C, h2scm_evaluate, "h2scm_evaluate");
+
+	procedure h2scm_dealloc is new 
+		Ada.Unchecked_Deallocation (Interpreter_Record, Interpreter_Pointer);
+
+	function h2scm_open return Interpreter_Pointer is
+		Interp: Interpreter_Pointer;	
+	begin
+		begin
+			Interp := new Interpreter_Record;
+		exception
+			when others =>
+				return null;
+		end;
+
+		begin
+			Open (Interp.all, 1_000_000, null);
+		exception
+			when others =>
+				h2scm_dealloc (Interp);
+				return null;
+		end;
+
+		return Interp;
+	end h2scm_open;
+
+	procedure h2scm_close (Interp: in out Interpreter_Pointer) is
+	begin
+Text_IO.Put_Line ("h2scm_close");
+		Close (Interp.all);	
+		h2scm_dealloc (Interp);
+	end h2scm_close;
+
+	function h2scm_evaluate (Interp: access Interpreter_Record;
+	                         Source: in     Object_Pointer) return Interfaces.C.int is
+	begin
+		return Interfaces.C.int(Interp.Heap(Interp.Current_Heap).Size);
+	end h2scm_evaluate;
+	
 end H2.Scheme;