klisp

commit e96dd8cfc9ca55ff98d050ddef9b08432e37f2d1
parent 43f04b6fed44c6bd24db6337830ced33a2165e91
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Tue, 15 Mar 2011 01:00:18 -0300

Added guard-dynamic-extent to the ground environment. Still no interception algorithm.

Diffstat:
M
src/kgcontinuations.c
 | 
31
++++++++++++++++++++++++++++++-
M
src/kgcontinuations.h
 | 
3
++-
M
src/kground.c
 | 
3
++-

3 files changed, 34 insertions(+), 3 deletions(-)
diff --git a/src/kgcontinuations.c b/src/kgcontinuations.c
@@ -262,7 +262,36 @@ void Slet_cc(klisp_State *K, TValue *xparams, TValue ptree,
 }
 
 /* 7.3.3 guard-dynamic-extent */
-/* TODO */
+void guard_dynamic_extent(klisp_State *K, TValue *xparams, TValue ptree, 
+			  TValue denv)
+{
+    UNUSED(xparams);
+
+    bind_3tp(K, "guard-dynamic-extent", ptree, "any", anytype, entry_guards,
+	     "combiner", ttiscombiner, comb,
+	     "any", anytype, exit_guards);
+
+    entry_guards = check_copy_guards(K, "guard-dynamic-extent: entry guards", 
+				     entry_guards);
+    exit_guards = check_copy_guards(K, "guard-dynamic-extent: exit guards", 
+				     exit_guards);
+    /* GC: root continuations */
+    /* The current continuation is guarded */
+    TValue outer_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL, pass_value, 
+					   1, entry_guards);
+    /* mark it as an outer continuation */
+    kset_outer_cont(outer_cont);
+    TValue inner_cont = kmake_continuation(K, outer_cont, KNIL, KNIL, 
+					   pass_value, 1, exit_guards);
+    /* mark it as an outer continuation */
+    kset_inner_cont(inner_cont);
+
+    /* call combiner with no operands in the dynamic extent of inner,
+     with the dynamic env of this call */
+    kset_cc(K, inner_cont);
+    TValue expr = kcons(K, comb, KNIL);
+    ktail_eval(K, expr, denv);
+}
 
 /* 7.3.4 exit */    
 void kgexit(klisp_State *K, TValue *xparams, TValue ptree, 
diff --git a/src/kgcontinuations.h b/src/kgcontinuations.h
@@ -51,7 +51,8 @@ void Slet_cc(klisp_State *K, TValue *xparams, TValue ptree,
 	     TValue denv);
 
 /* 7.3.3 guard-dynamic-extent */
-/* TODO */
+void guard_dynamic_extent(klisp_State *K, TValue *xparams, TValue ptree, 
+			  TValue denv);
 
 /* 7.3.4 exit */    
 void kgexit(klisp_State *K, TValue *xparams, TValue ptree, 
diff --git a/src/kground.c b/src/kground.c
@@ -389,7 +389,8 @@ void kinit_ground_env(klisp_State *K)
 		    0);
 
     /* 7.3.3 guard-dynamic-extent */
-    /* TODO */
+    add_applicative(K, ground_env, "guard-dynamic-extent", 
+		    guard_dynamic_extent, 0);
 
     /* 7.3.4 exit */    
     add_applicative(K, ground_env, "exit", kgexit,