[pure-lang-svn] SF.net SVN: pure-lang:[677] pure/trunk

[<ag...@us...>]

Revision: 677
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=677&view=rev
Author:   agraef
Date:     2008-09-01 13:31:10 +0000 (Mon, 01 Sep 2008)

Log Message:
-----------
Bugfixes.

Modified Paths:
--------------
    pure/trunk/printer.cc
    pure/trunk/runtime.cc
    pure/trunk/runtime.h

Modified: pure/trunk/printer.cc
===================================================================
--- pure/trunk/printer.cc	2008-09-01 07:00:29 UTC (rev 676)
+++ pure/trunk/printer.cc	2008-09-01 13:31:10 UTC (rev 677)
@@ -758,8 +758,6 @@
       return os << pure_paren(95, u) << " " << pure_paren(100, v);
   }
   default: {
-    if (x->data.clos && x->data.clos->xp)
-      return os << x->data.clos->xp;
     if (x->tag == 0) {
       const char *s = (x->data.clos && x->data.clos->n==0)?"thunk":"closure";
       return os << "<<" << s << " " << (void*)x << ">>";

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-09-01 07:00:29 UTC (rev 676)
+++ pure/trunk/runtime.cc	2008-09-01 13:31:10 UTC (rev 677)
@@ -235,6 +235,27 @@
   delete x->data.clos;
 }
 
+static pure_closure *pure_copy_clos(pure_closure *clos)
+{
+  assert(clos);
+  pure_closure *ret = new pure_closure;
+  ret->local = clos->local;
+  ret->thunked = clos->thunked;
+  ret->n = clos->n;
+  ret->m = clos->m;
+  ret->fp = clos->fp;
+  ret->ep = clos->ep;
+  if (clos->ep) ((Env*)clos->ep)->refc++;
+  if (clos->m == 0)
+    ret->env = 0;
+  else {
+    ret->env = new pure_expr*[clos->m];
+    for (size_t i = 0; i < clos->m; i++)
+      ret->env[i] = pure_new_internal(clos->env[i]);
+  }
+  return ret;
+}
+
 #if 1
 
 /* This is implemented (mostly) non-recursively to prevent stack overflows,
@@ -1196,7 +1217,6 @@
   x->data.clos->m = m;
   x->data.clos->fp = f;
   x->data.clos->ep = e;
-  x->data.clos->xp = 0;
   if (e) ((Env*)e)->refc++;
   if (m == 0)
     x->data.clos->env = 0;
@@ -1365,7 +1385,6 @@
   assert(x);
   if (x->tag == 0 && x->data.clos && x->data.clos->n == 0) {
     // parameterless anonymous closure (thunk)
-    if (x->data.clos->xp) return x->data.clos->xp; // memoized value
     pure_expr *ret;
     interpreter& interp = *interpreter::g_interp;
     void *fp = x->data.clos->fp;
@@ -1417,9 +1436,32 @@
 #endif
     // pop the function object from the shadow stack
     --interp.sstk_sz;
+    // check whether the result is again a thunk, then we have to evaluate
+    // that recursively
+    if (ret->tag == 0 && ret->data.clos && ret->data.clos->n == 0)
+      ret = pure_force(pure_new_internal(ret));
     // memoize the result
-    x->data.clos->xp = pure_new_internal(ret);
-    return ret;
+    assert(x!=ret);
+    pure_free_clos(x);
+    x->tag = ret->tag;
+    x->data = ret->data;
+    switch (x->tag) {
+    case EXPR::APP:
+      pure_new_internal(x->data.x[0]);
+      pure_new_internal(x->data.x[1]);
+    case EXPR::PTR:
+      if (x->data.x[2]) pure_new_internal(x->data.x[2]);
+      break;
+    case EXPR::STR:
+      x->data.s = strdup(x->data.s);
+      break;
+    default:
+      if (x->tag >= 0 && x->data.clos)
+	x->data.clos = pure_copy_clos(x->data.clos);
+      break;
+    }
+    pure_freenew(ret);
+    return x;
   } else {
 #if DEBUG>2
     if (x->tag >= 0 && x->data.clos)

Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h	2008-09-01 07:00:29 UTC (rev 676)
+++ pure/trunk/runtime.h	2008-09-01 13:31:10 UTC (rev 677)
@@ -26,7 +26,6 @@
   void *ep;			// pointer to compile time environment (Env*)
   uint32_t n, m;		// number of arguments and environment size
   struct _pure_expr **env;	// captured environment (if m>0, 0 otherwise)
-  struct _pure_expr *xp;	// pointer to memoized result
   bool local;			// local function?
   bool thunked;			// thunked closure? (kept unevaluated)
 } pure_closure;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.