pure-lang-svn — SVN commits.

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

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

Revision: 111
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=111&view=rev
Author:   agraef
Date:     2008-05-22 22:23:01 -0700 (Thu, 22 May 2008)

Log Message:
-----------
Fix premature freeing of eval result. Add regression test.

Modified Paths:
--------------
    pure/trunk/test/test010.log
    pure/trunk/test/test010.pure

Modified: pure/trunk/test/test010.log
===================================================================
--- pure/trunk/test/test010.log	2008-05-23 05:18:37 UTC (rev 110)
+++ pure/trunk/test/test010.log	2008-05-23 05:23:01 UTC (rev 111)
@@ -1,3 +1,8 @@
 \x -> x!0==[0,1,0,0];
 eval "(\\x -> (x!0) == [0,1,0,0])" [[0,1,0,0],[1,1,2]];
 1
+1.2;
+-4;
+that;
+map eval ["1.2","-4","that"];
+[1.2,-4,that]

Modified: pure/trunk/test/test010.pure
===================================================================
--- pure/trunk/test/test010.pure	2008-05-23 05:18:37 UTC (rev 110)
+++ pure/trunk/test/test010.pure	2008-05-23 05:23:01 UTC (rev 111)
@@ -1,2 +1,3 @@
 
 eval "(\\x -> (x!0) == [0,1,0,0])" [[0,1,0,0],[1,1,2]];
+map (eval) ["1.2","-4","that"];


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

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

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

Revision: 110
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=110&view=rev
Author:   agraef
Date:     2008-05-22 22:18:37 -0700 (Thu, 22 May 2008)

Log Message:
-----------
Fix premature freeing of eval result.

Modified Paths:
--------------
    pure/trunk/ChangeLog
    pure/trunk/runtime.cc

Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog	2008-05-23 01:39:13 UTC (rev 109)
+++ pure/trunk/ChangeLog	2008-05-23 05:18:37 UTC (rev 110)
@@ -1,5 +1,8 @@
 2008-05-23  Albert Graef  <Dr....@t-...>
 
+	* runtime.cc (eval): Fix premature freeing of eval result.
+	Reported by Eddie Rucker.
+
 	* Makefile: Bump version number.
 
 	* interpreter.cc: If there are any child environments, doeval and

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-23 01:39:13 UTC (rev 109)
+++ pure/trunk/runtime.cc	2008-05-23 05:18:37 UTC (rev 110)
@@ -1503,6 +1503,7 @@
   assert(s);
   interpreter& interp = *interpreter::g_interp;
   pure_expr *res = interp.runstr(string(s)+";");
+  interp.result = 0;
   if (res) pure_unref_internal(res);
   return res;
 }


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

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

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

Revision: 109
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=109&view=rev
Author:   agraef
Date:     2008-05-22 18:39:13 -0700 (Thu, 22 May 2008)

Log Message:
-----------
Bump version number.

Modified Paths:
--------------
    pure/trunk/ChangeLog
    pure/trunk/Makefile

Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog	2008-05-23 01:24:21 UTC (rev 108)
+++ pure/trunk/ChangeLog	2008-05-23 01:39:13 UTC (rev 109)
@@ -1,5 +1,7 @@
 2008-05-23  Albert Graef  <Dr....@t-...>
 
+	* Makefile: Bump version number.
+
 	* interpreter.cc: If there are any child environments, doeval and
 	dodefn both create semi-permanent environments now, so that the
 	child environments and the corresponding LLVM IR survive for the

Modified: pure/trunk/Makefile
===================================================================
--- pure/trunk/Makefile	2008-05-23 01:24:21 UTC (rev 108)
+++ pure/trunk/Makefile	2008-05-23 01:39:13 UTC (rev 109)
@@ -9,7 +9,7 @@
 # installation time, you can also specify a DESTDIR path if you want to
 # install into a staging directory, e.g.: 'make install DESTDIR=$PWD/BUILD'.
 
-version = 0.2
+version = 0.3
 dist = pure-$(version)
 
 prefix = /usr/local


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

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

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

Revision: 108
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=108&view=rev
Author:   agraef
Date:     2008-05-22 18:24:21 -0700 (Thu, 22 May 2008)

Log Message:
-----------
Rename regression tests, so that they are executed in the right order.

Added Paths:
-----------
    pure/trunk/test/test001.log
    pure/trunk/test/test001.pure
    pure/trunk/test/test002.log
    pure/trunk/test/test002.pure
    pure/trunk/test/test003.log
    pure/trunk/test/test003.pure
    pure/trunk/test/test004.log
    pure/trunk/test/test004.pure
    pure/trunk/test/test005.log
    pure/trunk/test/test005.pure
    pure/trunk/test/test006.log
    pure/trunk/test/test006.pure
    pure/trunk/test/test007.log
    pure/trunk/test/test007.pure
    pure/trunk/test/test008.log
    pure/trunk/test/test008.pure
    pure/trunk/test/test009.log
    pure/trunk/test/test009.pure
    pure/trunk/test/test010.log
    pure/trunk/test/test010.pure

Removed Paths:
-------------
    pure/trunk/test/test1.log
    pure/trunk/test/test1.pure
    pure/trunk/test/test10.log
    pure/trunk/test/test10.pure
    pure/trunk/test/test2.log
    pure/trunk/test/test2.pure
    pure/trunk/test/test3.log
    pure/trunk/test/test3.pure
    pure/trunk/test/test4.log
    pure/trunk/test/test4.pure
    pure/trunk/test/test5.log
    pure/trunk/test/test5.pure
    pure/trunk/test/test6.log
    pure/trunk/test/test6.pure
    pure/trunk/test/test7.log
    pure/trunk/test/test7.pure
    pure/trunk/test/test8.log
    pure/trunk/test/test8.pure
    pure/trunk/test/test9.log
    pure/trunk/test/test9.pure

Copied: pure/trunk/test/test001.log (from rev 88, pure/trunk/test/test1.log)
===================================================================
--- pure/trunk/test/test001.log	                        (rev 0)
+++ pure/trunk/test/test001.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,194 @@
+square x/*0:1*/ = x/*0:1*/*x/*0:1*/;
+{
+  rule #0: square x = x*x
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+square 5;
+25
+fact1 n/*0:1*/ = n/*0:1*/*fact1 (n/*0:1*/-1) if n/*0:1*/>0;
+fact1 n/*0:1*/ = 1;
+{
+  rule #0: fact1 n = n*fact1 (n-1) if n>0
+  rule #1: fact1 n = 1
+  state 0: #0 #1
+	<var> state 1
+  state 1: #0 #1
+}
+{
+  rule #0: x = fact1 10
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+let x = fact1 10;
+x;
+3628800
+fact2 n/*0:1*/ = case n/*0:1*/ of n/*0:*/ = n/*0:*/*fact2 (n/*0:*/-1) if n/*0:*/>0; n/*0:*/ = 1 {
+  rule #0: n = n*fact2 (n-1) if n>0
+  rule #1: n = 1
+  state 0: #0 #1
+	<var> state 1
+  state 1: #0 #1
+} end;
+fact3 n/*0:1*/ = case n/*0:1*/ of 0 = 1; n/*0:*/ = n/*0:*/*fact3 (n/*0:*/-1) if n/*0:*/>0 {
+  rule #0: 0 = 1
+  rule #1: n = n*fact3 (n-1) if n>0
+  state 0: #0 #1
+	<var> state 1
+	0::int state 2
+  state 1: #1
+  state 2: #0 #1
+} end;
+fact4 n/*0:1*/ = if n/*0:1*/>0 then n/*0:1*/*fact4 (n/*0:1*/-1) else 1;
+fact5 = \n/*0:*/ -> if n/*0:*/>0 then n/*0:*/*fact5 (n/*0:*/-1) else 1 {
+  rule #0: n = if n>0 then n*fact5 (n-1) else 1
+  state 0: #0
+	<var> state 1
+  state 1: #0
+};
+{
+  rule #0: fact2 n = case n of n = n*fact2 (n-1) if n>0; n = 1 end
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+{
+  rule #0: fact3 n = case n of 0 = 1; n = n*fact3 (n-1) if n>0 end
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+{
+  rule #0: fact4 n = if n>0 then n*fact4 (n-1) else 1
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+{
+  rule #0: fact5 = \n -> if n>0 then n*fact5 (n-1) else 1
+  state 0: #0
+}
+fact2 10;
+3628800
+fact3 10;
+3628800
+fact4 10;
+3628800
+fact5 10;
+3628800
+fact n/*0:1*/::int = fact (bigint n/*0:1*/);
+fact n/*0:1*/::bigint = n/*0:1*/*fact (n/*0:1*/-1) if n/*0:1*/>0;
+fact n/*0:1*/::bigint = 1;
+{
+  rule #0: fact n::int = fact (bigint n)
+  rule #1: fact n::bigint = n*fact (n-1) if n>0
+  rule #2: fact n::bigint = 1
+  state 0: #0 #1 #2
+	<var>::int state 1
+	<var>::bigint state 2
+  state 1: #0
+  state 2: #1 #2
+}
+fact 50;
+30414093201713378043612608166064768844377641568960512000000000000L
+fib1 0 = 0;
+fib1 1 = 1;
+fib1 n/*0:1*/ = fib1 (n/*0:1*/-2)+fib1 (n/*0:1*/-1) if n/*0:1*/>1;
+fib2 n/*0:1*/ = case fibs/*0*/ n/*0:1*/ of a/*0:01*/,b/*0:1*/ = a/*0:01*/ {
+  rule #0: a,b = a
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = case fibs/*1*/ (n/*0:1*/-1) of a/*0:01*/,b/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ {
+  rule #0: a,b = b,a+b
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end {
+  rule #0: fibs n = 0,1 if n<=0
+  rule #1: fibs n = case fibs (n-1) of a,b = b,a+b end
+  state 0: #0 #1
+	<var> state 1
+  state 1: #0 #1
+} end;
+fib3 n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ n/*0:1*/ {
+  rule #0: a,b = fibs n
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when a/*0:01*/,b/*0:1*/ = fibs/*1*/ (n/*0:1*/-1) {
+  rule #0: a,b = fibs (n-1)
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end {
+  rule #0: fibs n = 0,1 if n<=0
+  rule #1: fibs n = b,a+b when a,b = fibs (n-1) end
+  state 0: #0 #1
+	<var> state 1
+  state 1: #0 #1
+} end;
+{
+  rule #0: fib1 0 = 0
+  rule #1: fib1 1 = 1
+  rule #2: fib1 n = fib1 (n-2)+fib1 (n-1) if n>1
+  state 0: #0 #1 #2
+	<var> state 1
+	0::int state 2
+	1::int state 3
+  state 1: #2
+  state 2: #0 #2
+  state 3: #1 #2
+}
+{
+  rule #0: fib2 n = case fibs n of a,b = a end with fibs n = 0,1 if n<=0; fibs n = case fibs (n-1) of a,b = b,a+b end end
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+{
+  rule #0: fib3 n = a when a,b = fibs n end with fibs n = 0,1 if n<=0; fibs n = b,a+b when a,b = fibs (n-1) end end
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+map fib1 (1..10);
+[1,1,2,3,5,8,13,21,34,55]
+map fib2 (1..10);
+[1,1,2,3,5,8,13,21,34,55]
+map fib3 (1..10);
+[1,1,2,3,5,8,13,21,34,55]

Copied: pure/trunk/test/test001.pure (from rev 88, pure/trunk/test/test1.pure)
===================================================================
--- pure/trunk/test/test001.pure	                        (rev 0)
+++ pure/trunk/test/test001.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,82 @@
+
+// A simple script with some function and variable definitions.
+// This is used to test the guts of the interpreter.
+
+square x = x*x;
+
+/* a multiline
+   comment */
+
+square 5;
+
+// Factorial, with guarded rules.
+
+fact1 n = n*fact1 (n-1) if n>0;
+        = 1 otherwise;
+
+let x = fact1 10; x;
+
+// Factorial, using case.
+
+fact2 n = case n of
+            n = n*fact2 (n-1) if n>0;
+              = 1 otherwise;
+          end;
+
+// Factorial, yet another one.
+
+fact3 n = case n of
+            0 = 1;
+            n = n*fact3 (n-1) if n>0;
+          end;
+
+// Factorial, with if-then-else.
+
+fact4 n = if n>0 then n*fact4 (n-1) else 1;
+
+// Factorial, with lambda ("pointless style").
+
+fact5 = \n -> if n>0 then n*fact5 (n-1) else 1;
+
+fact2 10;
+fact3 10;
+fact4 10;
+fact5 10;
+
+// Factorial, using bigints.
+
+fact n::int    = fact (bigint n);
+fact n::bigint = n*fact (n-1) if n>0;
+               = 1 otherwise;
+
+fact 50;
+
+// Fibonacci function, naive O(fib n) implementation.
+
+fib1 0 = 0;
+fib1 1 = 1;
+fib1 n = fib1 (n-2) + fib1 (n-1) if n>1;
+
+// Fibonacci function, O(n) implementation.
+
+fib2 n = case fibs n of
+	   a, b = a;
+         end
+         with
+           fibs n = 0, 1 if n<=0;
+                  = case fibs (n-1) of
+		      a, b = b, a+b;
+                    end otherwise;
+         end;
+
+// Fibonacci function, another O(N) implementation.
+
+fib3 n = a when a, b = fibs n end
+           with fibs n = 0, 1 if n<=0;
+                       = b, a+b when a, b = fibs (n-1) end
+                         otherwise;
+           end;
+
+map fib1 (1..10);
+map fib2 (1..10);
+map fib3 (1..10);

Copied: pure/trunk/test/test002.log (from rev 88, pure/trunk/test/test2.log)
===================================================================
--- pure/trunk/test/test002.log	                        (rev 0)
+++ pure/trunk/test/test002.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,63 @@
+fib n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ n/*0:1*/ {
+  rule #0: a,b = fibs n
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when a/*0:01*/,b/*0:1*/ = fibs/*1*/ (n/*0:1*/-1) {
+  rule #0: a,b = fibs (n-1)
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end {
+  rule #0: fibs n = 0,1 if n<=0
+  rule #1: fibs n = b,a+b when a,b = fibs (n-1) end
+  state 0: #0 #1
+	<var> state 1
+  state 1: #0 #1
+} end;
+fib2 n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ (0L,1L) n/*0:1*/ {
+  rule #0: a,b = fibs (0L,1L) n
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end with fibs (a/*0:0101*/,b/*0:011*/) n/*0:1*/ = a/*0:0101*/,b/*0:011*/ if n/*0:1*/<=0; fibs (a/*0:0101*/,b/*0:011*/) n/*0:1*/ = fibs/*1*/ (b/*0:011*/,a/*0:0101*/+b/*0:011*/) (n/*0:1*/-1) {
+  rule #0: fibs (a,b) n = a,b if n<=0
+  rule #1: fibs (a,b) n = fibs (b,a+b) (n-1)
+  state 0: #0 #1
+	<app> state 1
+  state 1: #0 #1
+	<app> state 2
+  state 2: #0 #1
+	, state 3
+  state 3: #0 #1
+	<var> state 4
+  state 4: #0 #1
+	<var> state 5
+  state 5: #0 #1
+	<var> state 6
+  state 6: #0 #1
+} end;

Copied: pure/trunk/test/test002.pure (from rev 88, pure/trunk/test/test2.pure)
===================================================================
--- pure/trunk/test/test002.pure	                        (rev 0)
+++ pure/trunk/test/test002.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,12 @@
+fib n = a when a, b = fibs n end
+          with fibs n = 0, 1 if n<=0;
+                      = b, a+b when a, b = fibs (n-1) end
+                        otherwise;
+          end;
+
+// tail-recursive version, using bigints
+
+fib2 n = a when a, b = fibs (0L, 1L) n end
+           with fibs (a, b) n = a, b if n<=0;
+                              = fibs (b, a+b) (n-1) otherwise;
+           end;

Copied: pure/trunk/test/test003.log (from rev 88, pure/trunk/test/test3.log)
===================================================================
--- pure/trunk/test/test003.log	                        (rev 0)
+++ pure/trunk/test/test003.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,20 @@
+fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0;
+fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when m/*0:*/ = n/*0:1*/-1; a/*0:01*/,b/*0:1*/ = fibs m/*0:*/ {
+  rule #0: a,b = fibs m
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} {
+  rule #0: m = n-1
+  state 0: #0
+	<var> state 1
+  state 1: #0
+} end;

Copied: pure/trunk/test/test003.pure (from rev 88, pure/trunk/test/test3.pure)
===================================================================
--- pure/trunk/test/test003.pure	                        (rev 0)
+++ pure/trunk/test/test003.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,3 @@
+fibs n = 0, 1 if n<=0;
+       = b, a+b when m = n-1; a, b = fibs m end
+         otherwise;

Copied: pure/trunk/test/test004.log (from rev 88, pure/trunk/test/test4.log)
===================================================================
--- pure/trunk/test/test004.log	                        (rev 0)
+++ pure/trunk/test/test004.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,99 @@
+foo x/*0:1*/ = bar/*0*/ with bar = x/*1:1*/ {
+  rule #0: bar = x
+  state 0: #0
+} end;
+foo2 x/*0:1*/ = bar/*0*/ x/*0:1*/ with bar 99 = bar/*1*/ (x/*1:1*/+1) {
+  rule #0: bar 99 = bar (x+1)
+  state 0: #0
+	99::int state 1
+  state 1: #0
+} end;
+foo3 x/*0:1*/ = bar/*0*/ with bar y/*0:1*/ = bar/*1*/ (y/*0:1*/+1) if y/*0:1*/==x/*1:1*/ {
+  rule #0: bar y = bar (y+1) if y==x
+  state 0: #0
+	<var> state 1
+  state 1: #0
+} end;
+{
+  rule #0: foo x = bar with bar = x end
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+{
+  rule #0: foo2 x = bar x with bar 99 = bar (x+1) end
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+{
+  rule #0: foo3 x = bar with bar y = bar (y+1) if y==x end
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+foo 99;
+99
+foo2 99;
+bar 100
+foo2 98;
+bar 98
+foo3 99;
+bar
+foo3 99 98;
+bar 98
+foo3 99 99;
+bar 100
+loop = loop;
+count n/*0:1*/ = ct/*0*/ n/*0:1*/ with ct n/*0:1*/::int = n/*0:1*/ if n/*0:1*/<=0; ct n/*0:1*/::int = ct/*1*/ (n/*0:1*/-1) {
+  rule #0: ct n::int = n if n<=0
+  rule #1: ct n::int = ct (n-1)
+  state 0: #0 #1
+	<var>::int state 1
+  state 1: #0 #1
+} end;
+{
+  rule #0: loop = loop
+  state 0: #0
+}
+{
+  rule #0: count n = ct n with ct n::int = n if n<=0; ct n::int = ct (n-1) end
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+count 100;
+0
+count2 n/*0:1*/::int = n/*0:1*/ if n/*0:1*/<=0;
+count2 n/*0:1*/::int = count2 (n/*0:1*/-1);
+{
+  rule #0: count2 n::int = n if n<=0
+  rule #1: count2 n::int = count2 (n-1)
+  state 0: #0 #1
+	<var>::int state 1
+  state 1: #0 #1
+}
+count2 100;
+0
+test x/*0:1*/::int = t/*0*/ x/*0:1*/ with t n/*0:1*/::int = t/*1*/ (-n/*0:1*/) if n/*0:1*/<0; t n/*0:1*/::int = u/*0*/ (n/*0:1*/+2) with u _/*0:1*/ = n/*1:1*/+1 {
+  rule #0: u _ = n+1
+  state 0: #0
+	<var> state 1
+  state 1: #0
+} end {
+  rule #0: t n::int = t (-n) if n<0
+  rule #1: t n::int = u (n+2) with u _ = n+1 end
+  state 0: #0 #1
+	<var>::int state 1
+  state 1: #0 #1
+} end;
+{
+  rule #0: test x::int = t x with t n::int = t (-n) if n<0; t n::int = u (n+2) with u _ = n+1 end end
+  state 0: #0
+	<var>::int state 1
+  state 1: #0
+}
+test 98;
+99
+test (-97);
+98

Copied: pure/trunk/test/test004.pure (from rev 88, pure/trunk/test/test4.pure)
===================================================================
--- pure/trunk/test/test004.pure	                        (rev 0)
+++ pure/trunk/test/test004.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,52 @@
+
+// Local function with environment test.
+
+foo x		= bar with bar = x end;
+foo2 x		= bar x with bar 99 = bar (x+1) end;
+foo3 x		= bar with bar y = bar (y+1) if y==x end;
+
+foo 99;
+foo2 99; foo2 98;
+foo3 99; foo3 99 98; foo3 99 99;
+
+// Tail recursion.
+
+loop = loop;
+
+// If LLVM supports proper tail calls on your platform, the following should
+// loop forever.
+//loop;
+
+// Tail recursion in a local function.
+
+count n		= ct n with
+		    ct n::int = n if n<=0;
+		              = ct (n-1) otherwise;
+		  end;
+
+// This should always work.
+count 100;
+// If proper tail calls are supported, this should work, too, no matter what
+// your stack size is.
+//count 10000000;
+
+// Tail recursion in a global function.
+
+count2 n::int	= n if n<=0;
+		= count2 (n-1) otherwise;
+
+// This should always work.
+count2 100;
+// Again, this should work if proper tail calls are supported, no matter what
+// your stack size is.
+//count2 10000000;
+
+// Trivial tail-recursive local function which passes an environment to
+// another local function. Note that the callee can never be tail-called in
+// such a situation because it needs the extra environment parameter which is
+// allocated on the caller's stack in the current implementation.
+
+test x::int	= t x
+with t n::int = t (-n) if n<0; = u (n+2) with u _ = n+1 end end;
+
+test 98; test (-97);

Copied: pure/trunk/test/test005.log (from rev 88, pure/trunk/test/test5.log)
===================================================================
--- pure/trunk/test/test005.log	                        (rev 0)
+++ pure/trunk/test/test005.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,13 @@
+fact 0 = 1;
+fact n/*0:1*/ = n/*0:1*/*fact (n/*0:1*/-1);
+{
+  rule #0: fact 0 = 1
+  rule #1: fact n = n*fact (n-1)
+  state 0: #0 #1
+	<var> state 1
+	0::int state 2
+  state 1: #1
+  state 2: #0 #1
+}
+fact 4;
+24

Copied: pure/trunk/test/test005.pure (from rev 88, pure/trunk/test/test5.pure)
===================================================================
--- pure/trunk/test/test005.pure	                        (rev 0)
+++ pure/trunk/test/test005.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,4 @@
+fact 0 = 1;
+fact n = n * fact (n-1);
+fact 4;
+

Copied: pure/trunk/test/test006.log (from rev 88, pure/trunk/test/test6.log)
===================================================================
--- pure/trunk/test/test006.log	                        (rev 0)
+++ pure/trunk/test/test006.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,11 @@
+fact n/*0:1*/ = 1 if n/*0:1*/==0;
+fact n/*0:1*/ = n/*0:1*/*fact (n/*0:1*/-1);
+{
+  rule #0: fact n = 1 if n==0
+  rule #1: fact n = n*fact (n-1)
+  state 0: #0 #1
+	<var> state 1
+  state 1: #0 #1
+}
+fact 4;
+24

Copied: pure/trunk/test/test006.pure (from rev 88, pure/trunk/test/test6.pure)
===================================================================
--- pure/trunk/test/test006.pure	                        (rev 0)
+++ pure/trunk/test/test006.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,3 @@
+fact n = 1 if n==0;
+       = n * fact (n-1) otherwise;
+fact 4;

Copied: pure/trunk/test/test007.log (from rev 88, pure/trunk/test/test7.log)
===================================================================
--- pure/trunk/test/test007.log	                        (rev 0)
+++ pure/trunk/test/test007.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,19 @@
+{
+  rule #0: y = \a -> \b -> a+b
+  state 0: #0
+	<var> state 1
+  state 1: #0
+}
+let y = \a/*0:*/ -> \b/*0:*/ -> a/*1:*/+b/*0:*/ {
+  rule #0: b = a+b
+  state 0: #0
+	<var> state 1
+  state 1: #0
+} {
+  rule #0: a = \b -> a+b
+  state 0: #0
+	<var> state 1
+  state 1: #0
+};
+y 1 5;
+6

Copied: pure/trunk/test/test007.pure (from rev 88, pure/trunk/test/test7.pure)
===================================================================
--- pure/trunk/test/test007.pure	                        (rev 0)
+++ pure/trunk/test/test007.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,2 @@
+let y = (\a b -> a+b);
+y 1 5;

Copied: pure/trunk/test/test008.log (from rev 88, pure/trunk/test/test8.log)
===================================================================
--- pure/trunk/test/test008.log	                        (rev 0)
+++ pure/trunk/test/test008.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,36 @@
+Binomial n/*0:01*/ k/*0:1*/ = Binomial n/*0:01*/ (n/*0:01*/-k/*0:1*/) if n/*0:01*/-k/*0:1*/<k/*0:1*/;
+Binomial n/*0:01*/ 0L = 1L;
+Binomial n/*0:01*/ 0 = 1;
+Binomial n/*0:01*/ 1L = n/*0:01*/;
+Binomial n/*0:01*/ 1 = n/*0:01*/;
+Binomial n/*0:01*/ k/*0:1*/ = Binomial nm2/*0:*/ (k/*1:1*/-2)+2*Binomial nm2/*0:*/ (k/*1:1*/-1)+Binomial nm2/*0:*/ k/*1:1*/ when nm2/*0:*/ = n/*0:01*/-2 {
+  rule #0: nm2 = n-2
+  state 0: #0
+	<var> state 1
+  state 1: #0
+} end;
+{
+  rule #0: Binomial n k = Binomial n (n-k) if n-k<k
+  rule #1: Binomial n 0L = 1L
+  rule #2: Binomial n 0 = 1
+  rule #3: Binomial n 1L = n
+  rule #4: Binomial n 1 = n
+  rule #5: Binomial n k = Binomial nm2 (k-2)+2*Binomial nm2 (k-1)+Binomial nm2 k when nm2 = n-2 end
+  state 0: #0 #1 #2 #3 #4 #5
+	<var> state 1
+  state 1: #0 #1 #2 #3 #4 #5
+	<var> state 2
+	0::int state 3
+	1::int state 4
+	0L::bigint state 5
+	1L::bigint state 6
+  state 2: #0 #5
+  state 3: #0 #2 #5
+  state 4: #0 #4 #5
+  state 5: #0 #1 #5
+  state 6: #0 #3 #5
+}
+Binomial 5 2;
+10
+Binomial 5L 2L;
+10L

Copied: pure/trunk/test/test008.pure (from rev 88, pure/trunk/test/test8.pure)
===================================================================
--- pure/trunk/test/test008.pure	                        (rev 0)
+++ pure/trunk/test/test008.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,13 @@
+Binomial n k = Binomial n (n-k) if n-k < k;
+Binomial n 0L = 1L;
+Binomial n 0 = 1;
+Binomial n 1L = n;
+Binomial n 1 = n;
+Binomial n k = 
+	Binomial nm2 (k-2) + 
+	2 * Binomial nm2 (k-1) +
+	Binomial nm2 k 
+	when nm2 = n-2 end;
+
+Binomial 5 2;
+Binomial 5L 2L;

Copied: pure/trunk/test/test009.log (from rev 88, pure/trunk/test/test9.log)
===================================================================
--- pure/trunk/test/test009.log	                        (rev 0)
+++ pure/trunk/test/test009.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,108 @@
+fib2 n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ n/*0:1*/ {
+  rule #0: a,b = fibs n
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when a/*0:01*/,b/*0:1*/ = fibs/*1*/ (n/*0:1*/-1) {
+  rule #0: a,b = fibs (n-1)
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end {
+  rule #0: fibs n = 0,1 if n<=0
+  rule #1: fibs n = b,a+b when a,b = fibs (n-1) end
+  state 0: #0 #1
+	<var> state 1
+  state 1: #0 #1
+} end;
+fib2 n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ n/*0:1*/ {
+  rule #0: a,b = fibs n
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when a/*0:01*/,b/*0:1*/ = fibs/*1*/ (n/*0:1*/-1) {
+  rule #0: a,b = fibs (n-1)
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end {
+  rule #0: fibs n = 0,1 if n<=0
+  rule #1: fibs n = b,a+b when a,b = fibs (n-1) end
+  state 0: #0 #1
+	<var> state 1
+  state 1: #0 #1
+} end;
+{
+  rule #0: fib2 n = a when a,b = fibs n end with fibs n = 0,1 if n<=0; fibs n = b,a+b when a,b = fibs (n-1) end end
+  rule #1: fib2 n = a when a,b = fibs n end with fibs n = 0,1 if n<=0; fibs n = b,a+b when a,b = fibs (n-1) end end
+  state 0: #0 #1
+	<var> state 1
+  state 1: #0 #1
+}
+warning: rule never reduced: fib2 n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ n/*0:1*/ {
+  rule #0: a,b = fibs n
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when a/*0:01*/,b/*0:1*/ = fibs/*1*/ (n/*0:1*/-1) {
+  rule #0: a,b = fibs (n-1)
+  state 0: #0
+	<app> state 1
+  state 1: #0
+	<app> state 2
+  state 2: #0
+	, state 3
+  state 3: #0
+	<var> state 4
+  state 4: #0
+	<var> state 5
+  state 5: #0
+} end {
+  rule #0: fibs n = 0,1 if n<=0
+  rule #1: fibs n = b,a+b when a,b = fibs (n-1) end
+  state 0: #0 #1
+	<var> state 1
+  state 1: #0 #1
+} end;
+map fib2 (1..10);
+[1,1,2,3,5,8,13,21,34,55]

Copied: pure/trunk/test/test009.pure (from rev 88, pure/trunk/test/test9.pure)
===================================================================
--- pure/trunk/test/test009.pure	                        (rev 0)
+++ pure/trunk/test/test009.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,11 @@
+fib2 n = a when a, b = fibs n end
+            with fibs n = 0, 1 if n<=0;
+                        = b, a+b when a, b = fibs (n-1) end
+                          otherwise;
+            end;
+fib2 n = a when a, b = fibs n end
+            with fibs n = 0, 1 if n<=0;
+                        = b, a+b when a, b = fibs (n-1) end
+                          otherwise;
+            end;
+map fib2 (1..10);

Copied: pure/trunk/test/test010.log (from rev 107, pure/trunk/test/test10.log)
===================================================================
--- pure/trunk/test/test010.log	                        (rev 0)
+++ pure/trunk/test/test010.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,3 @@
+\x -> x!0==[0,1,0,0];
+eval "(\\x -> (x!0) == [0,1,0,0])" [[0,1,0,0],[1,1,2]];
+1

Copied: pure/trunk/test/test010.pure (from rev 107, pure/trunk/test/test10.pure)
===================================================================
--- pure/trunk/test/test010.pure	                        (rev 0)
+++ pure/trunk/test/test010.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -0,0 +1,2 @@
+
+eval "(\\x -> (x!0) == [0,1,0,0])" [[0,1,0,0],[1,1,2]];

Deleted: pure/trunk/test/test1.log
===================================================================
--- pure/trunk/test/test1.log	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test1.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,194 +0,0 @@
-square x/*0:1*/ = x/*0:1*/*x/*0:1*/;
-{
-  rule #0: square x = x*x
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-square 5;
-25
-fact1 n/*0:1*/ = n/*0:1*/*fact1 (n/*0:1*/-1) if n/*0:1*/>0;
-fact1 n/*0:1*/ = 1;
-{
-  rule #0: fact1 n = n*fact1 (n-1) if n>0
-  rule #1: fact1 n = 1
-  state 0: #0 #1
-	<var> state 1
-  state 1: #0 #1
-}
-{
-  rule #0: x = fact1 10
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-let x = fact1 10;
-x;
-3628800
-fact2 n/*0:1*/ = case n/*0:1*/ of n/*0:*/ = n/*0:*/*fact2 (n/*0:*/-1) if n/*0:*/>0; n/*0:*/ = 1 {
-  rule #0: n = n*fact2 (n-1) if n>0
-  rule #1: n = 1
-  state 0: #0 #1
-	<var> state 1
-  state 1: #0 #1
-} end;
-fact3 n/*0:1*/ = case n/*0:1*/ of 0 = 1; n/*0:*/ = n/*0:*/*fact3 (n/*0:*/-1) if n/*0:*/>0 {
-  rule #0: 0 = 1
-  rule #1: n = n*fact3 (n-1) if n>0
-  state 0: #0 #1
-	<var> state 1
-	0::int state 2
-  state 1: #1
-  state 2: #0 #1
-} end;
-fact4 n/*0:1*/ = if n/*0:1*/>0 then n/*0:1*/*fact4 (n/*0:1*/-1) else 1;
-fact5 = \n/*0:*/ -> if n/*0:*/>0 then n/*0:*/*fact5 (n/*0:*/-1) else 1 {
-  rule #0: n = if n>0 then n*fact5 (n-1) else 1
-  state 0: #0
-	<var> state 1
-  state 1: #0
-};
-{
-  rule #0: fact2 n = case n of n = n*fact2 (n-1) if n>0; n = 1 end
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-{
-  rule #0: fact3 n = case n of 0 = 1; n = n*fact3 (n-1) if n>0 end
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-{
-  rule #0: fact4 n = if n>0 then n*fact4 (n-1) else 1
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-{
-  rule #0: fact5 = \n -> if n>0 then n*fact5 (n-1) else 1
-  state 0: #0
-}
-fact2 10;
-3628800
-fact3 10;
-3628800
-fact4 10;
-3628800
-fact5 10;
-3628800
-fact n/*0:1*/::int = fact (bigint n/*0:1*/);
-fact n/*0:1*/::bigint = n/*0:1*/*fact (n/*0:1*/-1) if n/*0:1*/>0;
-fact n/*0:1*/::bigint = 1;
-{
-  rule #0: fact n::int = fact (bigint n)
-  rule #1: fact n::bigint = n*fact (n-1) if n>0
-  rule #2: fact n::bigint = 1
-  state 0: #0 #1 #2
-	<var>::int state 1
-	<var>::bigint state 2
-  state 1: #0
-  state 2: #1 #2
-}
-fact 50;
-30414093201713378043612608166064768844377641568960512000000000000L
-fib1 0 = 0;
-fib1 1 = 1;
-fib1 n/*0:1*/ = fib1 (n/*0:1*/-2)+fib1 (n/*0:1*/-1) if n/*0:1*/>1;
-fib2 n/*0:1*/ = case fibs/*0*/ n/*0:1*/ of a/*0:01*/,b/*0:1*/ = a/*0:01*/ {
-  rule #0: a,b = a
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = case fibs/*1*/ (n/*0:1*/-1) of a/*0:01*/,b/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ {
-  rule #0: a,b = b,a+b
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end {
-  rule #0: fibs n = 0,1 if n<=0
-  rule #1: fibs n = case fibs (n-1) of a,b = b,a+b end
-  state 0: #0 #1
-	<var> state 1
-  state 1: #0 #1
-} end;
-fib3 n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ n/*0:1*/ {
-  rule #0: a,b = fibs n
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when a/*0:01*/,b/*0:1*/ = fibs/*1*/ (n/*0:1*/-1) {
-  rule #0: a,b = fibs (n-1)
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end {
-  rule #0: fibs n = 0,1 if n<=0
-  rule #1: fibs n = b,a+b when a,b = fibs (n-1) end
-  state 0: #0 #1
-	<var> state 1
-  state 1: #0 #1
-} end;
-{
-  rule #0: fib1 0 = 0
-  rule #1: fib1 1 = 1
-  rule #2: fib1 n = fib1 (n-2)+fib1 (n-1) if n>1
-  state 0: #0 #1 #2
-	<var> state 1
-	0::int state 2
-	1::int state 3
-  state 1: #2
-  state 2: #0 #2
-  state 3: #1 #2
-}
-{
-  rule #0: fib2 n = case fibs n of a,b = a end with fibs n = 0,1 if n<=0; fibs n = case fibs (n-1) of a,b = b,a+b end end
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-{
-  rule #0: fib3 n = a when a,b = fibs n end with fibs n = 0,1 if n<=0; fibs n = b,a+b when a,b = fibs (n-1) end end
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-map fib1 (1..10);
-[1,1,2,3,5,8,13,21,34,55]
-map fib2 (1..10);
-[1,1,2,3,5,8,13,21,34,55]
-map fib3 (1..10);
-[1,1,2,3,5,8,13,21,34,55]

Deleted: pure/trunk/test/test1.pure
===================================================================
--- pure/trunk/test/test1.pure	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test1.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,82 +0,0 @@
-
-// A simple script with some function and variable definitions.
-// This is used to test the guts of the interpreter.
-
-square x = x*x;
-
-/* a multiline
-   comment */
-
-square 5;
-
-// Factorial, with guarded rules.
-
-fact1 n = n*fact1 (n-1) if n>0;
-        = 1 otherwise;
-
-let x = fact1 10; x;
-
-// Factorial, using case.
-
-fact2 n = case n of
-            n = n*fact2 (n-1) if n>0;
-              = 1 otherwise;
-          end;
-
-// Factorial, yet another one.
-
-fact3 n = case n of
-            0 = 1;
-            n = n*fact3 (n-1) if n>0;
-          end;
-
-// Factorial, with if-then-else.
-
-fact4 n = if n>0 then n*fact4 (n-1) else 1;
-
-// Factorial, with lambda ("pointless style").
-
-fact5 = \n -> if n>0 then n*fact5 (n-1) else 1;
-
-fact2 10;
-fact3 10;
-fact4 10;
-fact5 10;
-
-// Factorial, using bigints.
-
-fact n::int    = fact (bigint n);
-fact n::bigint = n*fact (n-1) if n>0;
-               = 1 otherwise;
-
-fact 50;
-
-// Fibonacci function, naive O(fib n) implementation.
-
-fib1 0 = 0;
-fib1 1 = 1;
-fib1 n = fib1 (n-2) + fib1 (n-1) if n>1;
-
-// Fibonacci function, O(n) implementation.
-
-fib2 n = case fibs n of
-	   a, b = a;
-         end
-         with
-           fibs n = 0, 1 if n<=0;
-                  = case fibs (n-1) of
-		      a, b = b, a+b;
-                    end otherwise;
-         end;
-
-// Fibonacci function, another O(N) implementation.
-
-fib3 n = a when a, b = fibs n end
-           with fibs n = 0, 1 if n<=0;
-                       = b, a+b when a, b = fibs (n-1) end
-                         otherwise;
-           end;
-
-map fib1 (1..10);
-map fib2 (1..10);
-map fib3 (1..10);

Deleted: pure/trunk/test/test10.log
===================================================================
--- pure/trunk/test/test10.log	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test10.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,3 +0,0 @@
-\x -> x!0==[0,1,0,0];
-eval "(\\x -> (x!0) == [0,1,0,0])" [[0,1,0,0],[1,1,2]];
-1

Deleted: pure/trunk/test/test10.pure
===================================================================
--- pure/trunk/test/test10.pure	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test10.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,2 +0,0 @@
-
-eval "(\\x -> (x!0) == [0,1,0,0])" [[0,1,0,0],[1,1,2]];

Deleted: pure/trunk/test/test2.log
===================================================================
--- pure/trunk/test/test2.log	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test2.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,63 +0,0 @@
-fib n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ n/*0:1*/ {
-  rule #0: a,b = fibs n
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when a/*0:01*/,b/*0:1*/ = fibs/*1*/ (n/*0:1*/-1) {
-  rule #0: a,b = fibs (n-1)
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end {
-  rule #0: fibs n = 0,1 if n<=0
-  rule #1: fibs n = b,a+b when a,b = fibs (n-1) end
-  state 0: #0 #1
-	<var> state 1
-  state 1: #0 #1
-} end;
-fib2 n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ (0L,1L) n/*0:1*/ {
-  rule #0: a,b = fibs (0L,1L) n
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end with fibs (a/*0:0101*/,b/*0:011*/) n/*0:1*/ = a/*0:0101*/,b/*0:011*/ if n/*0:1*/<=0; fibs (a/*0:0101*/,b/*0:011*/) n/*0:1*/ = fibs/*1*/ (b/*0:011*/,a/*0:0101*/+b/*0:011*/) (n/*0:1*/-1) {
-  rule #0: fibs (a,b) n = a,b if n<=0
-  rule #1: fibs (a,b) n = fibs (b,a+b) (n-1)
-  state 0: #0 #1
-	<app> state 1
-  state 1: #0 #1
-	<app> state 2
-  state 2: #0 #1
-	, state 3
-  state 3: #0 #1
-	<var> state 4
-  state 4: #0 #1
-	<var> state 5
-  state 5: #0 #1
-	<var> state 6
-  state 6: #0 #1
-} end;

Deleted: pure/trunk/test/test2.pure
===================================================================
--- pure/trunk/test/test2.pure	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test2.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,12 +0,0 @@
-fib n = a when a, b = fibs n end
-          with fibs n = 0, 1 if n<=0;
-                      = b, a+b when a, b = fibs (n-1) end
-                        otherwise;
-          end;
-
-// tail-recursive version, using bigints
-
-fib2 n = a when a, b = fibs (0L, 1L) n end
-           with fibs (a, b) n = a, b if n<=0;
-                              = fibs (b, a+b) (n-1) otherwise;
-           end;

Deleted: pure/trunk/test/test3.log
===================================================================
--- pure/trunk/test/test3.log	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test3.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,20 +0,0 @@
-fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0;
-fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when m/*0:*/ = n/*0:1*/-1; a/*0:01*/,b/*0:1*/ = fibs m/*0:*/ {
-  rule #0: a,b = fibs m
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} {
-  rule #0: m = n-1
-  state 0: #0
-	<var> state 1
-  state 1: #0
-} end;

Deleted: pure/trunk/test/test3.pure
===================================================================
--- pure/trunk/test/test3.pure	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test3.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,3 +0,0 @@
-fibs n = 0, 1 if n<=0;
-       = b, a+b when m = n-1; a, b = fibs m end
-         otherwise;

Deleted: pure/trunk/test/test4.log
===================================================================
--- pure/trunk/test/test4.log	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test4.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,99 +0,0 @@
-foo x/*0:1*/ = bar/*0*/ with bar = x/*1:1*/ {
-  rule #0: bar = x
-  state 0: #0
-} end;
-foo2 x/*0:1*/ = bar/*0*/ x/*0:1*/ with bar 99 = bar/*1*/ (x/*1:1*/+1) {
-  rule #0: bar 99 = bar (x+1)
-  state 0: #0
-	99::int state 1
-  state 1: #0
-} end;
-foo3 x/*0:1*/ = bar/*0*/ with bar y/*0:1*/ = bar/*1*/ (y/*0:1*/+1) if y/*0:1*/==x/*1:1*/ {
-  rule #0: bar y = bar (y+1) if y==x
-  state 0: #0
-	<var> state 1
-  state 1: #0
-} end;
-{
-  rule #0: foo x = bar with bar = x end
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-{
-  rule #0: foo2 x = bar x with bar 99 = bar (x+1) end
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-{
-  rule #0: foo3 x = bar with bar y = bar (y+1) if y==x end
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-foo 99;
-99
-foo2 99;
-bar 100
-foo2 98;
-bar 98
-foo3 99;
-bar
-foo3 99 98;
-bar 98
-foo3 99 99;
-bar 100
-loop = loop;
-count n/*0:1*/ = ct/*0*/ n/*0:1*/ with ct n/*0:1*/::int = n/*0:1*/ if n/*0:1*/<=0; ct n/*0:1*/::int = ct/*1*/ (n/*0:1*/-1) {
-  rule #0: ct n::int = n if n<=0
-  rule #1: ct n::int = ct (n-1)
-  state 0: #0 #1
-	<var>::int state 1
-  state 1: #0 #1
-} end;
-{
-  rule #0: loop = loop
-  state 0: #0
-}
-{
-  rule #0: count n = ct n with ct n::int = n if n<=0; ct n::int = ct (n-1) end
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-count 100;
-0
-count2 n/*0:1*/::int = n/*0:1*/ if n/*0:1*/<=0;
-count2 n/*0:1*/::int = count2 (n/*0:1*/-1);
-{
-  rule #0: count2 n::int = n if n<=0
-  rule #1: count2 n::int = count2 (n-1)
-  state 0: #0 #1
-	<var>::int state 1
-  state 1: #0 #1
-}
-count2 100;
-0
-test x/*0:1*/::int = t/*0*/ x/*0:1*/ with t n/*0:1*/::int = t/*1*/ (-n/*0:1*/) if n/*0:1*/<0; t n/*0:1*/::int = u/*0*/ (n/*0:1*/+2) with u _/*0:1*/ = n/*1:1*/+1 {
-  rule #0: u _ = n+1
-  state 0: #0
-	<var> state 1
-  state 1: #0
-} end {
-  rule #0: t n::int = t (-n) if n<0
-  rule #1: t n::int = u (n+2) with u _ = n+1 end
-  state 0: #0 #1
-	<var>::int state 1
-  state 1: #0 #1
-} end;
-{
-  rule #0: test x::int = t x with t n::int = t (-n) if n<0; t n::int = u (n+2) with u _ = n+1 end end
-  state 0: #0
-	<var>::int state 1
-  state 1: #0
-}
-test 98;
-99
-test (-97);
-98

Deleted: pure/trunk/test/test4.pure
===================================================================
--- pure/trunk/test/test4.pure	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test4.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,52 +0,0 @@
-
-// Local function with environment test.
-
-foo x		= bar with bar = x end;
-foo2 x		= bar x with bar 99 = bar (x+1) end;
-foo3 x		= bar with bar y = bar (y+1) if y==x end;
-
-foo 99;
-foo2 99; foo2 98;
-foo3 99; foo3 99 98; foo3 99 99;
-
-// Tail recursion.
-
-loop = loop;
-
-// If LLVM supports proper tail calls on your platform, the following should
-// loop forever.
-//loop;
-
-// Tail recursion in a local function.
-
-count n		= ct n with
-		    ct n::int = n if n<=0;
-		              = ct (n-1) otherwise;
-		  end;
-
-// This should always work.
-count 100;
-// If proper tail calls are supported, this should work, too, no matter what
-// your stack size is.
-//count 10000000;
-
-// Tail recursion in a global function.
-
-count2 n::int	= n if n<=0;
-		= count2 (n-1) otherwise;
-
-// This should always work.
-count2 100;
-// Again, this should work if proper tail calls are supported, no matter what
-// your stack size is.
-//count2 10000000;
-
-// Trivial tail-recursive local function which passes an environment to
-// another local function. Note that the callee can never be tail-called in
-// such a situation because it needs the extra environment parameter which is
-// allocated on the caller's stack in the current implementation.
-
-test x::int	= t x
-with t n::int = t (-n) if n<0; = u (n+2) with u _ = n+1 end end;
-
-test 98; test (-97);

Deleted: pure/trunk/test/test5.log
===================================================================
--- pure/trunk/test/test5.log	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test5.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,13 +0,0 @@
-fact 0 = 1;
-fact n/*0:1*/ = n/*0:1*/*fact (n/*0:1*/-1);
-{
-  rule #0: fact 0 = 1
-  rule #1: fact n = n*fact (n-1)
-  state 0: #0 #1
-	<var> state 1
-	0::int state 2
-  state 1: #1
-  state 2: #0 #1
-}
-fact 4;
-24

Deleted: pure/trunk/test/test5.pure
===================================================================
--- pure/trunk/test/test5.pure	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test5.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,4 +0,0 @@
-fact 0 = 1;
-fact n = n * fact (n-1);
-fact 4;
-

Deleted: pure/trunk/test/test6.log
===================================================================
--- pure/trunk/test/test6.log	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test6.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,11 +0,0 @@
-fact n/*0:1*/ = 1 if n/*0:1*/==0;
-fact n/*0:1*/ = n/*0:1*/*fact (n/*0:1*/-1);
-{
-  rule #0: fact n = 1 if n==0
-  rule #1: fact n = n*fact (n-1)
-  state 0: #0 #1
-	<var> state 1
-  state 1: #0 #1
-}
-fact 4;
-24

Deleted: pure/trunk/test/test6.pure
===================================================================
--- pure/trunk/test/test6.pure	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test6.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,3 +0,0 @@
-fact n = 1 if n==0;
-       = n * fact (n-1) otherwise;
-fact 4;

Deleted: pure/trunk/test/test7.log
===================================================================
--- pure/trunk/test/test7.log	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test7.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,19 +0,0 @@
-{
-  rule #0: y = \a -> \b -> a+b
-  state 0: #0
-	<var> state 1
-  state 1: #0
-}
-let y = \a/*0:*/ -> \b/*0:*/ -> a/*1:*/+b/*0:*/ {
-  rule #0: b = a+b
-  state 0: #0
-	<var> state 1
-  state 1: #0
-} {
-  rule #0: a = \b -> a+b
-  state 0: #0
-	<var> state 1
-  state 1: #0
-};
-y 1 5;
-6

Deleted: pure/trunk/test/test7.pure
===================================================================
--- pure/trunk/test/test7.pure	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test7.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,2 +0,0 @@
-let y = (\a b -> a+b);
-y 1 5;

Deleted: pure/trunk/test/test8.log
===================================================================
--- pure/trunk/test/test8.log	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test8.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,36 +0,0 @@
-Binomial n/*0:01*/ k/*0:1*/ = Binomial n/*0:01*/ (n/*0:01*/-k/*0:1*/) if n/*0:01*/-k/*0:1*/<k/*0:1*/;
-Binomial n/*0:01*/ 0L = 1L;
-Binomial n/*0:01*/ 0 = 1;
-Binomial n/*0:01*/ 1L = n/*0:01*/;
-Binomial n/*0:01*/ 1 = n/*0:01*/;
-Binomial n/*0:01*/ k/*0:1*/ = Binomial nm2/*0:*/ (k/*1:1*/-2)+2*Binomial nm2/*0:*/ (k/*1:1*/-1)+Binomial nm2/*0:*/ k/*1:1*/ when nm2/*0:*/ = n/*0:01*/-2 {
-  rule #0: nm2 = n-2
-  state 0: #0
-	<var> state 1
-  state 1: #0
-} end;
-{
-  rule #0: Binomial n k = Binomial n (n-k) if n-k<k
-  rule #1: Binomial n 0L = 1L
-  rule #2: Binomial n 0 = 1
-  rule #3: Binomial n 1L = n
-  rule #4: Binomial n 1 = n
-  rule #5: Binomial n k = Binomial nm2 (k-2)+2*Binomial nm2 (k-1)+Binomial nm2 k when nm2 = n-2 end
-  state 0: #0 #1 #2 #3 #4 #5
-	<var> state 1
-  state 1: #0 #1 #2 #3 #4 #5
-	<var> state 2
-	0::int state 3
-	1::int state 4
-	0L::bigint state 5
-	1L::bigint state 6
-  state 2: #0 #5
-  state 3: #0 #2 #5
-  state 4: #0 #4 #5
-  state 5: #0 #1 #5
-  state 6: #0 #3 #5
-}
-Binomial 5 2;
-10
-Binomial 5L 2L;
-10L

Deleted: pure/trunk/test/test8.pure
===================================================================
--- pure/trunk/test/test8.pure	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test8.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,13 +0,0 @@
-Binomial n k = Binomial n (n-k) if n-k < k;
-Binomial n 0L = 1L;
-Binomial n 0 = 1;
-Binomial n 1L = n;
-Binomial n 1 = n;
-Binomial n k = 
-	Binomial nm2 (k-2) + 
-	2 * Binomial nm2 (k-1) +
-	Binomial nm2 k 
-	when nm2 = n-2 end;
-
-Binomial 5 2;
-Binomial 5L 2L;

Deleted: pure/trunk/test/test9.log
===================================================================
--- pure/trunk/test/test9.log	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test9.log	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,108 +0,0 @@
-fib2 n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ n/*0:1*/ {
-  rule #0: a,b = fibs n
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when a/*0:01*/,b/*0:1*/ = fibs/*1*/ (n/*0:1*/-1) {
-  rule #0: a,b = fibs (n-1)
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end {
-  rule #0: fibs n = 0,1 if n<=0
-  rule #1: fibs n = b,a+b when a,b = fibs (n-1) end
-  state 0: #0 #1
-	<var> state 1
-  state 1: #0 #1
-} end;
-fib2 n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ n/*0:1*/ {
-  rule #0: a,b = fibs n
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when a/*0:01*/,b/*0:1*/ = fibs/*1*/ (n/*0:1*/-1) {
-  rule #0: a,b = fibs (n-1)
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end {
-  rule #0: fibs n = 0,1 if n<=0
-  rule #1: fibs n = b,a+b when a,b = fibs (n-1) end
-  state 0: #0 #1
-	<var> state 1
-  state 1: #0 #1
-} end;
-{
-  rule #0: fib2 n = a when a,b = fibs n end with fibs n = 0,1 if n<=0; fibs n = b,a+b when a,b = fibs (n-1) end end
-  rule #1: fib2 n = a when a,b = fibs n end with fibs n = 0,1 if n<=0; fibs n = b,a+b when a,b = fibs (n-1) end end
-  state 0: #0 #1
-	<var> state 1
-  state 1: #0 #1
-}
-warning: rule never reduced: fib2 n/*0:1*/ = a/*0:01*/ when a/*0:01*/,b/*0:1*/ = fibs/*0*/ n/*0:1*/ {
-  rule #0: a,b = fibs n
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end with fibs n/*0:1*/ = 0,1 if n/*0:1*/<=0; fibs n/*0:1*/ = b/*0:1*/,a/*0:01*/+b/*0:1*/ when a/*0:01*/,b/*0:1*/ = fibs/*1*/ (n/*0:1*/-1) {
-  rule #0: a,b = fibs (n-1)
-  state 0: #0
-	<app> state 1
-  state 1: #0
-	<app> state 2
-  state 2: #0
-	, state 3
-  state 3: #0
-	<var> state 4
-  state 4: #0
-	<var> state 5
-  state 5: #0
-} end {
-  rule #0: fibs n = 0,1 if n<=0
-  rule #1: fibs n = b,a+b when a,b = fibs (n-1) end
-  state 0: #0 #1
-	<var> state 1
-  state 1: #0 #1
-} end;
-map fib2 (1..10);
-[1,1,2,3,5,8,13,21,34,55]

Deleted: pure/trunk/test/test9.pure
===================================================================
--- pure/trunk/test/test9.pure	2008-05-23 01:15:11 UTC (rev 107)
+++ pure/trunk/test/test9.pure	2008-05-23 01:24:21 UTC (rev 108)
@@ -1,11 +0,0 @@
-fib2 n = a when a, b = fibs n end
-            with fibs n = 0, 1 if n<=0;
-                        = b, a+b when a, b = fibs (n-1) end
-                          otherwise;
-            end;
-fib2 n = a when a, b = fibs n end
-            with fibs n = 0, 1 if n<=0;
-                        = b, a+b when a, b = fibs (n-1) end
-                          otherwise;
-            end;
-map fib2 (1..10);


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

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

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

Revision: 107
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=107&view=rev
Author:   agraef
Date:     2008-05-22 18:15:11 -0700 (Thu, 22 May 2008)

Log Message:
-----------
Fix segfaults caused by closures being called after their environments and LLVM IR was freed.

Modified Paths:
--------------
    pure/trunk/ChangeLog
    pure/trunk/interpreter.cc
    pure/trunk/interpreter.hh

Added Paths:
-----------
    pure/trunk/test/test10.log
    pure/trunk/test/test10.pure

Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog	2008-05-22 14:42:19 UTC (rev 106)
+++ pure/trunk/ChangeLog	2008-05-23 01:15:11 UTC (rev 107)
@@ -1,3 +1,21 @@
+2008-05-23  Albert Graef  <Dr....@t-...>
+
+	* interpreter.cc: If there are any child environments, doeval and
+	dodefn both create semi-permanent environments now, so that the
+	child environments and the corresponding LLVM IR survive for the
+	entire lifetime of any embedded closures, which might still be
+	called at a later time. This fixes the segfaults occurring when a
+	closure gets called after its associated environment was purged. A
+	partial fix for some situations (as reported earlier by Chris
+	Double) was already in the 0.2 release, but this didn't deal with
+	all cases, such as closures constructed in a call to the eval
+	function, as reported by Eddie Rucker.
+
+	TODO: The current solution leaks memory, as the doeval/dodefn
+	environments aren't reclaimed any more. This still needs to be
+	fixed, by counting references on the global ancestor environments
+	of each closure constructed in doeval and dodefn.
+
 2008-05-22  Albert Graef  <Dr....@t-...>
 
 	* interpreter.cc, runtime.cc: Major overhaul of expression memory

Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc	2008-05-22 14:42:19 UTC (rev 106)
+++ pure/trunk/interpreter.cc	2008-05-23 01:15:11 UTC (rev 107)
@@ -787,7 +787,6 @@
   // patch up the global variable table to replace it with a cbox.
   map<int32_t,GlobalVar>::iterator v = globalvars.find(f);
   if (v != globalvars.end()) {
-    v->second.clear();
     pure_expr *cv = pure_const(f);
     if (v->second.x) pure_free(v->second.x);
     v->second.x = pure_new(cv);
@@ -1554,8 +1553,7 @@
     v.v = new GlobalVariable
       (ExprPtrTy, false, GlobalVariable::ExternalLinkage, 0, sym.s, module);
     JIT->addGlobalMapping(v.v, &v.x);
-  } else
-    v.clear();
+  }
   if (v.x) pure_free(v.x); v.x = pure_new(x);
   environ[tag] = env_info(&v.x, temp);
   restore_globals(g);
@@ -1575,15 +1573,6 @@
   return os << ")";
 }
 
-void GlobalVar::clear()
-{
-  if (e) {
-    assert(e->refc > 0);
-    if (--e->refc == 0) delete e;
-    e = 0;
-  }
-}
-
 Env& Env::operator= (const Env& e)
 {
   if (f) {
@@ -2569,8 +2558,7 @@
       (ExprPtrTy, false, GlobalVariable::InternalLinkage, 0,
        mkvarlabel(sym.f), module);
     JIT->addGlobalMapping(v.v, &v.x);
-  } else
-    v.clear();
+  }
   if (v.x) pure_free(v.x); v.x = pure_new(cv);
   Value *defaultv = b.CreateLoad(v.v);
   vector<Value*> myargs(2);
@@ -2597,7 +2585,13 @@
   }
   // Create an anonymous function to call in order to evaluate the target
   // expression.
-  Env f(0, 0, x, false);
+  /* NOTE: The environment is allocated dynamically, so that its child
+     environments survive for the entire lifetime of any embedded closures,
+     which might still be called at a later time. XXXFIXME: This leaks memory
+     right now. How do we keep track of environments that might still be
+     needed? */
+  Env *fptr = new Env(0, 0, x, false);
+  Env &f = *fptr;
   push("doeval", &f);
   fun_prolog("");
 #if DEBUG>1
@@ -2618,6 +2612,8 @@
   // Get rid of our anonymous function.
   JIT->freeMachineCodeForFunction(f.f);
   f.f->eraseFromParent();
+  // If there are no child envs, we can get rid of the environment now.
+  if (f.fmap[0].empty()) delete fptr;
   // NOTE: Result (if any) is to be freed by the caller.
   return res;
 }
@@ -2631,10 +2627,6 @@
   }
   // Create an anonymous function to call in order to evaluate the rhs
   // expression, match against the lhs and bind variables in lhs accordingly.
-  /* NOTE: Unlike doeval(), we must create a semi-permanent environment here
-     whose child environments persist for the entire lifetime of the variables
-     bound in this definition, since some of those bindings may refer to
-     closures (executable code) that might still be called some time. */
   Env *fptr = new Env(0, 0, rhs, false);
   Env &f = *fptr;
   push("dodefn", &f);
@@ -2673,9 +2665,7 @@
       v.v = new GlobalVariable
 	(ExprPtrTy, false, GlobalVariable::ExternalLinkage, 0, sym.s, module);
       JIT->addGlobalMapping(v.v, &v.x);
-    } else
-      v.clear();
-    v.e = fptr; f.refc++;
+    }
     if (v.x) call("pure_free", f.builder.CreateLoad(v.v));
     call("pure_new", x);
 #if DEBUG>2
@@ -2703,13 +2693,14 @@
   // Get rid of our anonymous function.
   JIT->freeMachineCodeForFunction(f.f);
   f.f->eraseFromParent();
+  // If there are no child envs, we can get rid of the environment now.
+  if (f.fmap[0].empty()) delete fptr;
   if (!res) {
     // We caught an exception, clean up the mess.
     for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
       int32_t tag = it->first;
       GlobalVar& v = globalvars[tag];
       if (!v.x) {
-	v.clear();
 	JIT->updateGlobalMapping(v.v, 0);
 	v.v->eraseFromParent();
 	globalvars.erase(tag);
@@ -3407,8 +3398,7 @@
       (ExprPtrTy, false, GlobalVariable::InternalLinkage, 0,
        mkvarlabel(tag), module);
     JIT->addGlobalMapping(v.v, &v.x);
-  } else
-    v.clear();
+  }
   if (v.x) pure_free(v.x); v.x = pure_new(cv);
   return act_builder().CreateLoad(v.v);
 }

Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh	2008-05-22 14:42:19 UTC (rev 106)
+++ pure/trunk/interpreter.hh	2008-05-23 01:15:11 UTC (rev 107)
@@ -69,9 +69,7 @@
   // global variable
   llvm::GlobalVariable* v;
   pure_expr *x;
-  Env *e;
-  GlobalVar() { v = 0; x = 0; e = 0; }
-  void clear();
+  GlobalVar() { v = 0; x = 0; }
 };
 
 struct VarInfo {
@@ -133,7 +131,7 @@
   Builder builder;
   // parent environment (if any)
   Env *parent;
-  // reference counter (for dodefn)
+  // reference counter (currently unused)
   uint32_t refc;
   // convenience functions for invoking CreateGEP() and CreateLoad()
   llvm::Value *CreateGEP

Added: pure/trunk/test/test10.log
===================================================================
--- pure/trunk/test/test10.log	                        (rev 0)
+++ pure/trunk/test/test10.log	2008-05-23 01:15:11 UTC (rev 107)
@@ -0,0 +1,3 @@
+\x -> x!0==[0,1,0,0];
+eval "(\\x -> (x!0) == [0,1,0,0])" [[0,1,0,0],[1,1,2]];
+1

Added: pure/trunk/test/test10.pure
===================================================================
--- pure/trunk/test/test10.pure	                        (rev 0)
+++ pure/trunk/test/test10.pure	2008-05-23 01:15:11 UTC (rev 107)
@@ -0,0 +1,2 @@
+
+eval "(\\x -> (x!0) == [0,1,0,0])" [[0,1,0,0],[1,1,2]];


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

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

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

Revision: 106
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=106&view=rev
Author:   agraef
Date:     2008-05-22 07:42:19 -0700 (Thu, 22 May 2008)

Log Message:
-----------
Reenable some optimizations to speed up trivial cases of function calls and returns, which were previously removed (cf. rev. 97) to facilitate implementation of the shadow stack.

Modified Paths:
--------------
    pure/trunk/ChangeLog
    pure/trunk/interpreter.cc
    pure/trunk/runtime.cc
    pure/trunk/runtime.h

Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog	2008-05-22 07:14:45 UTC (rev 105)
+++ pure/trunk/ChangeLog	2008-05-22 14:42:19 UTC (rev 106)
@@ -4,8 +4,8 @@
 	handling. Fixed the shadow stack and memory debugging code. Both
 	function arguments and environment are now visible on the shadow
 	stack, and all remaining memory leaks have been fixed. Note that,
-	compared to previous revisions, the shadow stack slows down the
-	interpreter a little bit and it also needs some additional memory.
+	compared to previous revisions, the shadow stack slows down
+	compiled code by some 10% and it needs some additional memory.
 	OTOH, it also provides additional data that will be needed in the
 	planned symbolic debugger, and it seems to be the most efficient
 	way to handle dangling expression pointers after an exception

Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc	2008-05-22 07:14:45 UTC (rev 105)
+++ pure/trunk/interpreter.cc	2008-05-22 14:42:19 UTC (rev 106)
@@ -253,6 +253,13 @@
   declare_extern((void*)pure_pop_tail_args,
 		 "pure_pop_tail_args", "void", -2, "expr*", "int");
 
+  declare_extern((void*)pure_push_arg,
+		 "pure_push_arg",  "void",    1, "expr*");
+  declare_extern((void*)pure_pop_arg,
+		 "pure_pop_arg",   "void",    1, "expr*");
+  declare_extern((void*)pure_pop_tail_arg,
+		 "pure_pop_tail_arg", "void", 1, "expr*");
+
   declare_extern((void*)pure_debug,
 		 "pure_debug",      "void",  -2, "int", "char*");
 }
@@ -1678,6 +1685,7 @@
   ReturnInst *ret = builder.CreateRet(v);
   Instruction *pi = ret;
   Function *free_fun = interp.module->getFunction("pure_pop_args");
+  Function *free1_fun = interp.module->getFunction("pure_pop_arg");
   if (isa<CallInst>(v)) {
     CallInst* c = cast<CallInst>(v);
     // Check whether the call is actually subject to tail call elimination (as
@@ -1691,8 +1699,12 @@
       if (isa<CallInst>(it)) {
 	CallInst* c1 = cast<CallInst>(it);
 	if (c1->getCalledFunction() ==
-	    interp.module->getFunction("pure_push_args"))
+	    interp.module->getFunction("pure_push_args") ||
+	    c1->getCalledFunction() ==
+	    interp.module->getFunction("pure_push_arg")) {
 	  free_fun = interp.module->getFunction("pure_pop_tail_args");
+	  free1_fun = interp.module->getFunction("pure_pop_tail_arg");
+	}
       }
     }
     pi = c;
@@ -1700,7 +1712,12 @@
   // We must garbage-collect args and environment here, immediately before the
   // call (if any), or the return instruction otherwise.
   vector<Value*> myargs;
-  if (n+m != 0) {
+  if (pi != ret && n == 1 && m == 0)
+    new CallInst(free1_fun, args[0], "", pi);
+  else if (pi != ret && n == 0 && m == 1) {
+    Value *v = new GetElementPtrInst(envs, Zero, "", pi);
+    new CallInst(free1_fun, new LoadInst(v, "", pi), "", pi);
+  } else if (n+m != 0) {
     if (pi == ret)
       myargs.push_back(v);
     else
@@ -3075,10 +3092,14 @@
   if (n>0) {
     for (i = 0; i < n; i++)
       argv[i] = codegen(args[i]);
-    vector<Value*> argv1;
-    argv1.push_back(UInt(n));
-    argv1.insert(argv1.end(), argv.begin(), argv.end());
-    act_env().CreateCall(module->getFunction("pure_push_args"), argv1);
+    if (n == 1)
+      act_env().CreateCall(module->getFunction("pure_push_arg"), argv);
+    else {
+      vector<Value*> argv1;
+      argv1.push_back(UInt(n));
+      argv1.insert(argv1.end(), argv.begin(), argv.end());
+      act_env().CreateCall(module->getFunction("pure_push_args"), argv1);
+    }
   }
   return act_env().CreateCall(info.f, argv);
 }
@@ -3360,10 +3381,14 @@
     return fcall(f, x);
   else {
     // create a boxed closure
-    vector<Value*> newargs;
-    newargs.push_back(UInt(f.m));
-    newargs.insert(newargs.end(), x.begin(), x.end());
-    act_env().CreateCall(module->getFunction("pure_new_args"), newargs);
+    if (f.m == 1)
+      act_env().CreateCall(module->getFunction("pure_new"), x);
+    else {
+      vector<Value*> newargs;
+      newargs.push_back(UInt(f.m));
+      newargs.insert(newargs.end(), x.begin(), x.end());
+      act_env().CreateCall(module->getFunction("pure_new_args"), newargs);
+    }
     return call("pure_clos", f.local, thunked, f.tag, f.h, f.n, x);
   }
 }
@@ -3578,10 +3603,14 @@
     return fcall(f, x);
   else {
     // create a boxed closure
-    vector<Value*> newargs;
-    newargs.push_back(UInt(f.m));
-    newargs.insert(newargs.end(), x.begin(), x.end());
-    act_env().CreateCall(module->getFunction("pure_new_args"), newargs);
+    if (f.m == 1)
+      act_env().CreateCall(module->getFunction("pure_new"), x);
+    else {
+      vector<Value*> newargs;
+      newargs.push_back(UInt(f.m));
+      newargs.insert(newargs.end(), x.begin(), x.end());
+      act_env().CreateCall(module->getFunction("pure_new_args"), newargs);
+    }
     return call("pure_clos", f.local, thunked, f.tag, f.h, f.n, x);
   }
 }
@@ -3605,7 +3634,11 @@
     x.push_back(e.argv);
   }
   // count references to parameters
-  if (n+m > 0) {
+  if (n == 1 && m == 0)
+    e.CreateCall(module->getFunction("pure_push_arg"), args);
+  else if (n == 0 && m == 1)
+    e.CreateCall(module->getFunction("pure_push_arg"), env);
+  else if (n+m > 0) {
     vector<Value*> args1;
     args1.push_back(UInt(n+m));
     args1.insert(args1.end(), args.begin(), args.end());
@@ -4039,10 +4072,14 @@
       x[i] = f.CreateLoadGEP(f.envs, UInt(i));
       assert(x[i]->getType() == ExprPtrTy);
     }
-    vector<Value*> newargs;
-    newargs.push_back(UInt(f.m));
-    newargs.insert(newargs.end(), x.begin(), x.end());
-    act_env().CreateCall(module->getFunction("pure_new_args"), newargs);
+    if (f.m == 1)
+      act_env().CreateCall(module->getFunction("pure_new"), x);
+    else {
+      vector<Value*> newargs;
+      newargs.push_back(UInt(f.m));
+      newargs.insert(newargs.end(), x.begin(), x.end());
+      act_env().CreateCall(module->getFunction("pure_new_args"), newargs);
+    }
     Value *defaultv = call("pure_clos", f.local, true, f.tag, f.h, f.n, x);
     for (size_t i = 0; i < f.n; ++i) {
       Value *arg = f.args[i];

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-22 07:14:45 UTC (rev 105)
+++ pure/trunk/runtime.cc	2008-05-22 14:42:19 UTC (rev 106)
@@ -1027,6 +1027,66 @@
 }
 
 extern "C"
+void pure_push_arg(pure_expr *x)
+{
+  interpreter& interp = *interpreter::g_interp;
+  size_t sz = interp.sstk_sz;
+  resize_sstk(interp.sstk, interp.sstk_cap, sz, 2);
+  pure_expr** sstk = interp.sstk;
+  sstk[sz++] = 0; sstk[sz++] = x;
+  if (x->refc > 0)
+    x->refc++;
+  else
+    pure_new_internal(x);
+#if SSTK_DEBUG>1
+  cerr << "++ stack: (sz = " << sz << ")\n";
+  for (size_t i = 0; i < sz; i++) {
+    pure_expr *x = sstk[i];
+    if (i == interp.sstk_sz) cerr << "** pushed:\n";
+    if (x)
+      cerr << i << ": " << (void*)x << ": " << x << endl;
+    else
+      cerr << i << ": " << "** frame **\n";
+  }
+#endif
+  interp.sstk_sz = sz;
+}
+
+extern "C"
+void pure_pop_arg(pure_expr *x)
+{
+#if SSTK_DEBUG
+  pure_pop_args(0, 1, x);
+#else
+  interpreter& interp = *interpreter::g_interp;
+  interp.sstk_sz -= 2;
+  if (x->refc > 1)
+    x->refc--;
+  else
+    pure_free_internal(x);
+#endif
+}
+
+extern "C"
+void pure_pop_tail_arg(pure_expr *x)
+{
+#if SSTK_DEBUG
+  pure_pop_tail_args(0, 1, x);
+#else
+  interpreter& interp = *interpreter::g_interp;
+  pure_expr **sstk = interp.sstk;
+  size_t lastsz = interp.sstk_sz, oldsz = lastsz;
+  while (lastsz > 0 && sstk[--lastsz]) ;
+  memmove(sstk+lastsz-2, sstk+lastsz, (oldsz-lastsz)*sizeof(pure_expr*));
+  interp.sstk_sz -= 2;
+  if (x->refc > 1)
+    x->refc--;
+  else
+    pure_free_internal(x);
+#endif
+}
+
+extern "C"
 void pure_debug(int32_t tag, const char *format, ...)
 {
   cout << "break at ";

Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h	2008-05-22 07:14:45 UTC (rev 105)
+++ pure/trunk/runtime.h	2008-05-22 14:42:19 UTC (rev 106)
@@ -183,6 +183,12 @@
 void pure_pop_args(pure_expr *x, uint32_t n, ...);
 void pure_pop_tail_args(pure_expr *x, uint32_t n, ...);
 
+/* Optimize the special case of a single argument to be pushed/popped. */
+
+void pure_push_arg(pure_expr *x);
+void pure_pop_arg(pure_expr *x);
+void pure_pop_tail_arg(pure_expr *x);
+
 /* Debugging support. Preliminary. */
 
 void pure_debug(int32_t tag, const char *format, ...);


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

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

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

Revision: 105
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=105&view=rev
Author:   agraef
Date:     2008-05-22 00:14:45 -0700 (Thu, 22 May 2008)

Log Message:
-----------
Updated ChangeLog.

Modified Paths:
--------------
    pure/trunk/ChangeLog

Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog	2008-05-22 07:10:33 UTC (rev 104)
+++ pure/trunk/ChangeLog	2008-05-22 07:14:45 UTC (rev 105)
@@ -1,9 +1,9 @@
-2008-05-21  Albert Graef  <Dr....@t-...>
+2008-05-22  Albert Graef  <Dr....@t-...>
 
 	* interpreter.cc, runtime.cc: Major overhaul of expression memory
 	handling. Fixed the shadow stack and memory debugging code. Both
 	function arguments and environment are now visible on the shadow
-	stack, and most remaining memory leaks have been fixed. Note that,
+	stack, and all remaining memory leaks have been fixed. Note that,
 	compared to previous revisions, the shadow stack slows down the
 	interpreter a little bit and it also needs some additional memory.
 	OTOH, it also provides additional data that will be needed in the


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

[pure-lang-svn] SF.net SVN: pure-lang: [104] pure/trunk/runtime.cc

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

Revision: 104
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=104&view=rev
Author:   agraef
Date:     2008-05-22 00:10:33 -0700 (Thu, 22 May 2008)

Log Message:
-----------
Fix bug in memory debugging code.

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

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-22 07:03:58 UTC (rev 103)
+++ pure/trunk/runtime.cc	2008-05-22 07:10:33 UTC (rev 104)
@@ -52,6 +52,9 @@
   if (x->tag == EXPR::APP) {
     mem_mark(x->data.x[0]);
     mem_mark(x->data.x[1]);
+  } else if (x->tag >= 0 && x->data.clos) {
+    for (size_t i = 0; i < x->data.clos->m; i++)
+      mem_mark(x->data.clos->env[i]);
   }
 }
 #else


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

[pure-lang-svn] SF.net SVN: pure-lang: [103] pure/trunk/runtime.cc

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

Revision: 103
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=103&view=rev
Author:   agraef
Date:     2008-05-22 00:03:58 -0700 (Thu, 22 May 2008)

Log Message:
-----------
Fix memleak in catch function.

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

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-22 06:44:20 UTC (rev 102)
+++ pure/trunk/runtime.cc	2008-05-22 07:03:58 UTC (rev 103)
@@ -658,7 +658,6 @@
       pure_expr *e = interp.estk.front().e;
       interp.estk.pop_front();
       // collect garbage
-      pure_new_internal(x);
       pure_expr *tmps = interp.tmps;
       while (tmps) {
 	pure_expr *next = tmps->xp;


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

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

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

Revision: 102
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=102&view=rev
Author:   agraef
Date:     2008-05-21 23:44:20 -0700 (Wed, 21 May 2008)

Log Message:
-----------
Update system notes.

Modified Paths:
--------------
    pure/trunk/INSTALL

Modified: pure/trunk/INSTALL
===================================================================
--- pure/trunk/INSTALL	2008-05-21 21:09:55 UTC (rev 101)
+++ pure/trunk/INSTALL	2008-05-22 06:44:20 UTC (rev 102)
@@ -204,10 +204,10 @@
 SYSTEM NOTES
 ====== =====
 
-Pure is known to work on recent Linux and Mac OSX versions, but there are a
-few system-specific quirks which are discussed below. (Please also see the
-CAVEATS AND NOTES section of the manual page for information on other known
-limitations of the current implementation.)
+Pure is known to work on recent Linux and Mac OSX versions under x86, x86-64
+and ppc, but there are a few system-specific quirks which are discussed below.
+(Please also see the CAVEATS AND NOTES section of the manual page for
+information on other known limitations of the current implementation.)
 
 ALL PLATFORMS
 --- ---------
@@ -227,26 +227,22 @@
 64 BIT SYSTEMS
 -- --- -------
 
-64 bit systems are supported by Pure. Alas, for unknown reasons the 'debug'
-build currently does *not* work on (some?) 64 bit systems using gcc. This has
-been seen on various different 64 bit Linux versions, YMMV. You can tell that
-you're bitten by this bug if, after running 'make debug' (or using similar,
-custom compilation flags), 'make check' fails on most tests. Fortunately, it
-seems that you can easily work around this by making sure that you have at
-least -O enabled when compiling runtime.cc. Also please note that the
-'default' and 'release' builds should work fine. 32 bit builds also seem to be
-unaffected.
+64 bit systems are fully supported by Pure. Alas, for unknown reasons the
+'debug' build currently does *not* work on (some?) 64 bit systems using
+gcc. This has been seen on various different 64 bit Linux versions, YMMV. You
+can tell that you're bitten by this bug if, after running 'make debug' (or
+using similar, custom compilation flags), 'make check' fails on most tests.
+Fortunately, it seems that you can easily work around this by making sure that
+you have at least -O enabled when compiling runtime.cc. Also please note that
+the 'default' and 'release' builds should work fine. 32 bit builds also seem
+to be unaffected.
 
 LINUX
 -----
 
 Linux is the primary development platform for this software, and the sources
 should build out of the box on all recent Linux distributions. However, note
-the issues on 64 bit Linux systems described above. Also, it has been reported
-that the interpreter does *not* work under Ubuntu (32 bit) on PowerPC right
-now; I can't do much about this myself since I cannot reproduce this on my x86
-and i64 Linux systems. Any input which could help to resolve these issues is
-much appreciated.
+the issues on 64 bit Linux systems described above.
 
 MAC OSX
 --- ---


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

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

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

Revision: 100
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=100&view=rev
Author:   agraef
Date:     2008-05-18 03:44:48 -0700 (Sun, 18 May 2008)

Log Message:
-----------
STL containers are too darn slow, we do our own implementation of the shadow stack instead.

Modified Paths:
--------------
    pure/trunk/interpreter.cc
    pure/trunk/interpreter.hh
    pure/trunk/runtime.cc

Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc	2008-05-18 10:04:41 UTC (rev 99)
+++ pure/trunk/interpreter.cc	2008-05-18 10:44:48 UTC (rev 100)
@@ -62,6 +62,9 @@
     stackdir = c_stack_dir();
   }
 
+  sstk_sz = 0; sstk_cap = 0x10000; // 64K
+  sstk = (pure_expr**)malloc(sstk_cap*sizeof(pure_expr*));
+
   // Initialize the JIT.
 
   using namespace llvm;

Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh	2008-05-18 10:04:41 UTC (rev 99)
+++ pure/trunk/interpreter.hh	2008-05-18 10:44:48 UTC (rev 100)
@@ -12,7 +12,6 @@
 #include <llvm/Support/LLVMBuilder.h>
 
 #include <time.h>
-#include <stack>
 #include <set>
 #include <string>
 #include "expr.hh"
@@ -395,7 +394,7 @@
   map<int32_t,GlobalVar> globalvars;
   map<int32_t,Env> globalfuns;
   list<pure_exception> estk;
-  stack<pure_expr*> sstk;
+  pure_expr** sstk; size_t sstk_cap, sstk_sz;
 #if DEBUG
   set<pure_expr*> mem_allocations;
 #endif

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-18 10:04:41 UTC (rev 99)
+++ pure/trunk/runtime.cc	2008-05-18 10:44:48 UTC (rev 100)
@@ -683,9 +683,16 @@
 {
   va_list ap;
   interpreter& interp = *interpreter::g_interp;
+  pure_expr**& sstk = interp.sstk;
+  size_t cap = interp.sstk_cap, sz = interp.sstk_sz;
+  if (cap < sz+MAXARGS) {
+    cap = cap << 1;
+    sstk = (pure_expr**)realloc(sstk, cap*sizeof(pure_expr*));
+    interp.sstk_cap = cap;
+  }
   va_start(ap, x);
   while (x) {
-    interp.sstk.push(x);
+    sstk[sz++] = x;
     if (x->refc > 0)
       x->refc++;
     else
@@ -693,13 +700,14 @@
     x = va_arg(ap, pure_expr*);
   };
   va_end(ap);
+  interp.sstk_sz = sz;
 }
 
 extern "C"
 void pure_free_args(pure_expr *x, ...)
 {
   va_list ap;
-  interpreter& interp = *interpreter::g_interp;
+  size_t count = 0;
   va_start(ap, x);
   if (x) x->refc++;
   while (1) {
@@ -709,9 +717,11 @@
       x->refc--;
     else
       pure_free_internal(x);
-    interp.sstk.pop();
+    count++;
   };
   va_end(ap);
+  assert(interpreter::g_interp->sstk_sz >= count);
+  interpreter::g_interp->sstk_sz -= count;
 }
 
 extern "C"


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

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

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

Revision: 99
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=99&view=rev
Author:   agraef
Date:     2008-05-18 03:04:41 -0700 (Sun, 18 May 2008)

Log Message:
-----------
Vector implementation of shadow stack is too heavy, try STL stack instead.

Modified Paths:
--------------
    pure/trunk/interpreter.hh
    pure/trunk/runtime.cc

Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh	2008-05-18 09:51:44 UTC (rev 98)
+++ pure/trunk/interpreter.hh	2008-05-18 10:04:41 UTC (rev 99)
@@ -12,6 +12,7 @@
 #include <llvm/Support/LLVMBuilder.h>
 
 #include <time.h>
+#include <stack>
 #include <set>
 #include <string>
 #include "expr.hh"
@@ -394,7 +395,7 @@
   map<int32_t,GlobalVar> globalvars;
   map<int32_t,Env> globalfuns;
   list<pure_exception> estk;
-  vector<pure_expr*> sstk;
+  stack<pure_expr*> sstk;
 #if DEBUG
   set<pure_expr*> mem_allocations;
 #endif

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-18 09:51:44 UTC (rev 98)
+++ pure/trunk/runtime.cc	2008-05-18 10:04:41 UTC (rev 99)
@@ -683,17 +683,9 @@
 {
   va_list ap;
   interpreter& interp = *interpreter::g_interp;
-  size_t cap = interp.sstk.capacity(), sz = interp.sstk.size();
-  if (cap < sz+MAXARGS) {
-    if (sz == 0)
-      cap = 0x10000; // 64K
-    else
-      cap = cap << 1;
-    interp.sstk.reserve(cap);
-  }
   va_start(ap, x);
   while (x) {
-    interp.sstk.push_back(x);
+    interp.sstk.push(x);
     if (x->refc > 0)
       x->refc++;
     else
@@ -708,7 +700,6 @@
 {
   va_list ap;
   interpreter& interp = *interpreter::g_interp;
-  size_t count = 0;
   va_start(ap, x);
   if (x) x->refc++;
   while (1) {
@@ -718,12 +709,9 @@
       x->refc--;
     else
       pure_free_internal(x);
-    count++;
+    interp.sstk.pop();
   };
   va_end(ap);
-  size_t sz = interp.sstk.size();
-  assert(sz >= count);
-  interp.sstk.resize(sz-count);
 }
 
 extern "C"


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

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

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

Revision: 98
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=98&view=rev
Author:   agraef
Date:     2008-05-18 02:51:44 -0700 (Sun, 18 May 2008)

Log Message:
-----------
Add shadow stack to keep track of allocated function arguments.

Modified Paths:
--------------
    pure/trunk/interpreter.hh
    pure/trunk/runtime.cc

Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh	2008-05-18 09:28:00 UTC (rev 97)
+++ pure/trunk/interpreter.hh	2008-05-18 09:51:44 UTC (rev 98)
@@ -394,6 +394,7 @@
   map<int32_t,GlobalVar> globalvars;
   map<int32_t,Env> globalfuns;
   list<pure_exception> estk;
+  vector<pure_expr*> sstk;
 #if DEBUG
   set<pure_expr*> mem_allocations;
 #endif

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-18 09:28:00 UTC (rev 97)
+++ pure/trunk/runtime.cc	2008-05-18 09:51:44 UTC (rev 98)
@@ -682,8 +682,18 @@
 void pure_new_args(pure_expr *x, ...)
 {
   va_list ap;
+  interpreter& interp = *interpreter::g_interp;
+  size_t cap = interp.sstk.capacity(), sz = interp.sstk.size();
+  if (cap < sz+MAXARGS) {
+    if (sz == 0)
+      cap = 0x10000; // 64K
+    else
+      cap = cap << 1;
+    interp.sstk.reserve(cap);
+  }
   va_start(ap, x);
   while (x) {
+    interp.sstk.push_back(x);
     if (x->refc > 0)
       x->refc++;
     else
@@ -697,6 +707,8 @@
 void pure_free_args(pure_expr *x, ...)
 {
   va_list ap;
+  interpreter& interp = *interpreter::g_interp;
+  size_t count = 0;
   va_start(ap, x);
   if (x) x->refc++;
   while (1) {
@@ -706,8 +718,12 @@
       x->refc--;
     else
       pure_free_internal(x);
+    count++;
   };
   va_end(ap);
+  size_t sz = interp.sstk.size();
+  assert(sz >= count);
+  interp.sstk.resize(sz-count);
 }
 
 extern "C"


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

[pure-lang-svn] SF.net SVN: pure-lang: [97] pure/trunk/interpreter.cc

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

Revision: 97
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=97&view=rev
Author:   agraef
Date:     2008-05-18 02:28:00 -0700 (Sun, 18 May 2008)

Log Message:
-----------
Remove some optimizations so that all argument refcounting goes through pure_new_args/pure_free_args.

Modified Paths:
--------------
    pure/trunk/interpreter.cc

Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc	2008-05-18 09:07:35 UTC (rev 96)
+++ pure/trunk/interpreter.cc	2008-05-18 09:28:00 UTC (rev 97)
@@ -1677,14 +1677,7 @@
   // We must garbage-collect args and environment here, immediately before the
   // call (if any), or the return instruction otherwise.
   vector<Value*> myargs;
-  if (pi != ret && n == 1 && m == 0)
-    new CallInst(interp.module->getFunction("pure_free"),
-		 args[0], "", pi);
-  else if (pi != ret && n == 0 && m == 1) {
-    Value *v = new GetElementPtrInst(envs, Zero, "", pi);
-    new CallInst(interp.module->getFunction("pure_free"),
-		 new LoadInst(v, "", pi), "", pi);
-  } else if (n+m != 0) {
+  if (n+m != 0) {
     if (pi == ret)
       myargs.push_back(v);
     else
@@ -3060,13 +3053,9 @@
   if (n>0) {
     for (i = 0; i < n; i++)
       argv[i] = codegen(args[i]);
-    if (n == 1)
-      call("pure_new", argv[0]);
-    else {
-      vector<Value*> argv1 = argv;
-      argv1.push_back(NullExprPtr);
-      act_env().CreateCall(module->getFunction("pure_new_args"), argv1);
-    }
+    vector<Value*> argv1 = argv;
+    argv1.push_back(NullExprPtr);
+    act_env().CreateCall(module->getFunction("pure_new_args"), argv1);
   }
   return act_env().CreateCall(info.f, argv);
 }
@@ -3585,7 +3574,7 @@
   // direct call of a function, with parameters
   assert(f.f);
   // initialize the environment parameter
-  size_t n = args.size(), m = env.size();
+  size_t m = env.size();
   assert(f.local || m == 0);
   for (size_t i = 0; i < m; i++)
     e.builder.CreateStore(env[i], e.CreateGEP(e.argv, UInt(i)));
@@ -3596,13 +3585,9 @@
     x.push_back(e.argv);
   }
   // count references to parameters
-  if (n == 1)
-    call("pure_new", args[0]);
-  else if (n > 0) {
-    vector<Value*> args1 = args;
-    args1.push_back(NullExprPtr);
-    e.CreateCall(module->getFunction("pure_new_args"), args1);
-  }
+  vector<Value*> args1 = args;
+  args1.push_back(NullExprPtr);
+  e.CreateCall(module->getFunction("pure_new_args"), args1);
   // pass the function parameters
   x.insert(x.end(), args.begin(), args.end());
   // create the call


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

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

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

Revision: 96
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=96&view=rev
Author:   agraef
Date:     2008-05-18 02:07:35 -0700 (Sun, 18 May 2008)

Log Message:
-----------
Overhaul of memory debugging code.

Modified Paths:
--------------
    pure/trunk/interpreter.hh
    pure/trunk/runtime.cc

Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh	2008-05-17 20:06:47 UTC (rev 95)
+++ pure/trunk/interpreter.hh	2008-05-18 09:07:35 UTC (rev 96)
@@ -394,6 +394,9 @@
   map<int32_t,GlobalVar> globalvars;
   map<int32_t,Env> globalfuns;
   list<pure_exception> estk;
+#if DEBUG
+  set<pure_expr*> mem_allocations;
+#endif
   map<int32_t,ExternInfo> externals;
   llvm::Function *declare_extern(void *fp, string name, string restype,
 				 int n, ...);

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-17 20:06:47 UTC (rev 95)
+++ pure/trunk/runtime.cc	2008-05-18 09:07:35 UTC (rev 96)
@@ -19,31 +19,36 @@
       >= interpreter::stackmax)						\
     pure_throw(stack_exception())
 
-// Debug expression allocations.
+// Debug expression allocations. Warns about expression memory leaks.
+// NOTE: Bookkeeping starts and ends at each toplevel pure_invoke call.
+// Enabling this code will make the interpreter *much* slower.
 #if DEBUG>2
-int mem_level = 0;
-set<pure_expr*> mem_allocations;
-#if DEBUG>9
-#define MEMDEBUG_NEW(x)  mem_allocations.insert(x);	\
+#if DEBUG>9 // enable this to print each and every expression (de)allocation
+#define MEMDEBUG_NEW(x)  interpreter::g_interp->mem_allocations.insert(x); \
   cerr << "NEW:  " << (void*)x << ": " << x << endl;
-#define MEMDEBUG_FREE(x) mem_allocations.erase(x);	\
+#define MEMDEBUG_FREE(x) interpreter::g_interp->mem_allocations.erase(x); \
   cerr << "FREE: " << (void*)x << ": " << x << endl;
 #else
-#define MEMDEBUG_NEW(x)  mem_allocations.insert(x);
-#define MEMDEBUG_FREE(x) mem_allocations.erase(x);
+#define MEMDEBUG_NEW(x)  interpreter::g_interp->mem_allocations.insert(x);
+#define MEMDEBUG_FREE(x) interpreter::g_interp->mem_allocations.erase(x);
 #endif
-#define MEMDEBUG_INIT if (mem_level++==0) mem_allocations.clear();
-#define MEMDEBUG_SUMMARY(ret) if (--mem_level==0) { mem_mark(ret);	\
-  if (!mem_allocations.empty()) { cerr << "POSSIBLE LEAKS:\n";		\
-    for (set<pure_expr*>::iterator x = mem_allocations.begin();		\
-	 x != mem_allocations.end(); x++)				\
-      cerr << (void*)(*x) << " (refc = " << (*x)->refc << "): "		\
-	   << (*x) << endl;						\
-    mem_allocations.clear();						\
-  } }
+#define MEMDEBUG_INIT if (interpreter::g_interp->estk.empty())	\
+    interpreter::g_interp->mem_allocations.clear();
+#define MEMDEBUG_SUMMARY(ret) if (interpreter::g_interp->estk.empty()) {\
+    mem_mark(ret);							\
+    if (!interpreter::g_interp->mem_allocations.empty()) {		\
+      cerr << "** WARNING: leaked expressions:\n";			\
+      for (set<pure_expr*>::iterator x =				\
+	     interpreter::g_interp->mem_allocations.begin();		\
+	   x != interpreter::g_interp->mem_allocations.end(); x++)	\
+	cerr << (void*)(*x) << " (refc = " << (*x)->refc << "): "	\
+	     << (*x) << endl;						\
+      interpreter::g_interp->mem_allocations.clear();			\
+    }									\
+  }
 static void mem_mark(pure_expr *x)
 {
-  mem_allocations.erase(x);
+  interpreter::g_interp->mem_allocations.erase(x);
   if (x->tag == EXPR::APP) {
     mem_mark(x->data.x[0]);
     mem_mark(x->data.x[1]);


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

[pure-lang-svn] SF.net SVN: pure-lang: [95] pure/trunk/runtime.cc

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

Revision: 95
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=95&view=rev
Author:   agraef
Date:     2008-05-17 13:06:47 -0700 (Sat, 17 May 2008)

Log Message:
-----------
Bugfixes in memory debugging code.

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

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-17 19:45:28 UTC (rev 94)
+++ pure/trunk/runtime.cc	2008-05-17 20:06:47 UTC (rev 95)
@@ -21,6 +21,7 @@
 
 // Debug expression allocations.
 #if DEBUG>2
+int mem_level = 0;
 set<pure_expr*> mem_allocations;
 #if DEBUG>9
 #define MEMDEBUG_NEW(x)  mem_allocations.insert(x);	\
@@ -31,15 +32,15 @@
 #define MEMDEBUG_NEW(x)  mem_allocations.insert(x);
 #define MEMDEBUG_FREE(x) mem_allocations.erase(x);
 #endif
-#define MEMDEBUG_INIT mem_allocations.clear();
-#define MEMDEBUG_SUMMARY(ret) mem_mark(ret);				\
+#define MEMDEBUG_INIT if (mem_level++==0) mem_allocations.clear();
+#define MEMDEBUG_SUMMARY(ret) if (--mem_level==0) { mem_mark(ret);	\
   if (!mem_allocations.empty()) { cerr << "POSSIBLE LEAKS:\n";		\
     for (set<pure_expr*>::iterator x = mem_allocations.begin();		\
 	 x != mem_allocations.end(); x++)				\
       cerr << (void*)(*x) << " (refc = " << (*x)->refc << "): "		\
 	   << (*x) << endl;						\
     mem_allocations.clear();						\
-  }
+  } }
 static void mem_mark(pure_expr *x)
 {
   mem_allocations.erase(x);


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

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

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

Revision: 94
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=94&view=rev
Author:   agraef
Date:     2008-05-17 12:45:28 -0700 (Sat, 17 May 2008)

Log Message:
-----------
Fixed broken pure_free_internal routine.

Modified Paths:
--------------
    pure/trunk/ChangeLog
    pure/trunk/runtime.cc

Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog	2008-05-17 12:43:37 UTC (rev 93)
+++ pure/trunk/ChangeLog	2008-05-17 19:45:28 UTC (rev 94)
@@ -1,5 +1,8 @@
 2008-05-17  Albert Graef  <Dr....@t-...>
 
+	* runtime.cc (pure_free_internal): Fixed a glitch which was
+	causing big memleaks. Reported by Libor Spacek.
+
 	* interpreter.cc (define): Fixed error messages.
 	
 	* interpreter.cc, runtime.h: Reorganize pure_expr data structure
@@ -18,11 +21,10 @@
 	Please note that the typename 'long' *always* denotes signed 64
 	bit integers in Pure's extern declarations, even if the C 'long'
 	type is actually 32 bit (as it usually is even on most 64 bit
-	systems).
+	systems). Also note that at present 'long' is still converted
+	to/from Pure (32 bit) ints only, marshalling from/to Pure bigints
+	is not supported yet.
 
-	FIXME: At present 'long' is still converted to/from Pure (32 bit)
-	ints only, marshalling from/to Pure bigints is not supported yet.
-
 2008-05-16  Albert Graef  <Dr....@t-...>
 
 	* runtime.h: Fix compilation problems when header gets included

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-17 12:43:37 UTC (rev 93)
+++ pure/trunk/runtime.cc	2008-05-17 19:45:28 UTC (rev 94)
@@ -22,21 +22,37 @@
 // Debug expression allocations.
 #if DEBUG>2
 set<pure_expr*> mem_allocations;
-#define MEMDEBUG_NEW(x)  mem_allocations.insert(x);		\
+#if DEBUG>9
+#define MEMDEBUG_NEW(x)  mem_allocations.insert(x);	\
   cerr << "NEW:  " << (void*)x << ": " << x << endl;
-#define MEMDEBUG_FREE(x) mem_allocations.erase(x);		\
+#define MEMDEBUG_FREE(x) mem_allocations.erase(x);	\
   cerr << "FREE: " << (void*)x << ": " << x << endl;
+#else
+#define MEMDEBUG_NEW(x)  mem_allocations.insert(x);
+#define MEMDEBUG_FREE(x) mem_allocations.erase(x);
+#endif
 #define MEMDEBUG_INIT mem_allocations.clear();
-#define MEMDEBUG_SUMMARY cerr << "SUMMARY:\n";			\
-  for (set<pure_expr*>::iterator x = mem_allocations.begin();	\
-       x != mem_allocations.end(); x++)				\
-    cerr << (void*)(*x) << ": " << (*x) << endl;		\
-  mem_allocations.clear();
+#define MEMDEBUG_SUMMARY(ret) mem_mark(ret);				\
+  if (!mem_allocations.empty()) { cerr << "POSSIBLE LEAKS:\n";		\
+    for (set<pure_expr*>::iterator x = mem_allocations.begin();		\
+	 x != mem_allocations.end(); x++)				\
+      cerr << (void*)(*x) << " (refc = " << (*x)->refc << "): "		\
+	   << (*x) << endl;						\
+    mem_allocations.clear();						\
+  }
+static void mem_mark(pure_expr *x)
+{
+  mem_allocations.erase(x);
+  if (x->tag == EXPR::APP) {
+    mem_mark(x->data.x[0]);
+    mem_mark(x->data.x[1]);
+  }
+}
 #else
 #define MEMDEBUG_NEW(x)
 #define MEMDEBUG_FREE(x)
 #define MEMDEBUG_INIT
-#define MEMDEBUG_SUMMARY
+#define MEMDEBUG_SUMMARY(ret)
 #endif
 
 // Expression pointers are allocated in larger chunks for better performance.
@@ -115,30 +131,25 @@
   delete x->data.clos;
 }
 
+#if 1
+
+/* This is implemented (mostly) non-recursively to prevent stack overflows,
+   using the xp field to form a stack on the fly. */
+
 static inline
 void pure_free_internal(pure_expr *x)
 {
   assert(x && "pure_free: null expression");
   assert(x->refc > 0 && "pure_free: unreferenced expression");
   assert(!x->xp && "pure_free: corrupt expression data");
-  // Implemented (mostly) non-recursively to prevent stack overflows, using
-  // the xp field to form a stack on the fly.
-  pure_expr *xp;
+  pure_expr *xp = 0, *y;
  loop:
-#if DEBUG>2
-  if (x->tag >= 0 && x->data.clos)
-    cerr << "pure_free: " << (x->data.clos->local?"local":"global")
-	 << " closure " << x << " (" << (void*)x << "), refc = "
-	 << x->refc << endl;
-#endif
   if (--x->refc == 0) {
     switch (x->tag) {
     case EXPR::APP:
-      xp = x->data.x[0];
-      assert(!xp->xp);
-      xp->xp = x->data.x[1];
-      free_expr(x);
-      x = xp;
+      y = x->data.x[0];
+      assert(!x->xp);
+      x->xp = xp; xp = x; x = y;
       goto loop;
     case EXPR::INT:
     case EXPR::DBL:
@@ -158,17 +169,54 @@
       if (x->data.clos) pure_free_clos(x);
       break;
     }
-    xp = x->xp; x->xp = 0;
-    free_expr(x);
-  } else {
-    xp = x->xp; x->xp = 0;
   }
+  while (xp && x == xp->data.x[1]) {
+    if (x->refc == 0) free_expr(x);
+    x = xp; xp = x->xp;
+  }
+  if (x->refc == 0) free_expr(x);
   if (xp) {
-    x = xp;
+    x = xp->data.x[1];
     goto loop;
   }
 }
 
+#else
+
+/* This version is only included here for reference and debugging purposes,
+   normal builds should use the non-recursive version above. */
+
+static
+void pure_free_internal(pure_expr *x)
+{
+  if (--x->refc == 0) {
+    switch (x->tag) {
+    case EXPR::APP:
+      pure_free_internal(x->data.x[0]);
+      pure_free_internal(x->data.x[1]);
+      break;
+    case EXPR::INT:
+    case EXPR::DBL:
+      break;
+    case EXPR::BIGINT:
+      mpz_clear(x->data.z);
+      break;
+    case EXPR::STR:
+      free(x->data.s);
+      break;
+    case EXPR::PTR:
+      break;
+    default:
+      assert(x->tag >= 0);
+      if (x->data.clos) pure_free_clos(x);
+      break;
+    }
+    free_expr(x);
+  }
+}
+
+#endif
+
 static void inline
 pure_unref_internal(pure_expr *x)
 {
@@ -594,13 +642,13 @@
       if (tmps != e) pure_freenew(tmps);
       tmps = next;
     }
-    MEMDEBUG_SUMMARY
+    MEMDEBUG_SUMMARY(e)
     return 0;
   } else {
     pure_expr *res = fp();
     // normal return
     interp.estk.pop_front();
-    MEMDEBUG_SUMMARY
+    MEMDEBUG_SUMMARY(res)
 #if DEBUG>1
     pure_expr *tmps = interp.tmps;
     while (tmps) {


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

[pure-lang-svn] SF.net SVN: pure-lang: [93] pure/trunk/runtime.cc

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

Revision: 93
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=93&view=rev
Author:   agraef
Date:     2008-05-17 05:43:37 -0700 (Sat, 17 May 2008)

Log Message:
-----------
Optimize argument refcounting in pure_apply.

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

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-17 12:39:04 UTC (rev 92)
+++ pure/trunk/runtime.cc	2008-05-17 12:43:37 UTC (rev 93)
@@ -453,8 +453,10 @@
     }
     // collect arguments
     f = x;
-    for (size_t j = 1; f->tag == EXPR::APP; j++, f = f->data.x[0])
-      argv[i+n-j] = pure_new_internal(f->data.x[1]);
+    for (size_t j = 1; f->tag == EXPR::APP; j++, f = f->data.x[0]) {
+      assert(f->data.x[1]->refc > 0);
+      argv[i+n-j] = f->data.x[1]; f->data.x[1]->refc++;
+    }
     i += n; argv[i++] = y;
     assert(i == k);
     pure_free_internal(x);


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

[pure-lang-svn] SF.net SVN: pure-lang: [92] pure/trunk/runtime.cc

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

Revision: 92
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=92&view=rev
Author:   agraef
Date:     2008-05-17 05:39:04 -0700 (Sat, 17 May 2008)

Log Message:
-----------
Add code for debugging expression allocations.

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

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-05-17 06:39:30 UTC (rev 91)
+++ pure/trunk/runtime.cc	2008-05-17 12:39:04 UTC (rev 92)
@@ -19,6 +19,26 @@
       >= interpreter::stackmax)						\
     pure_throw(stack_exception())
 
+// Debug expression allocations.
+#if DEBUG>2
+set<pure_expr*> mem_allocations;
+#define MEMDEBUG_NEW(x)  mem_allocations.insert(x);		\
+  cerr << "NEW:  " << (void*)x << ": " << x << endl;
+#define MEMDEBUG_FREE(x) mem_allocations.erase(x);		\
+  cerr << "FREE: " << (void*)x << ": " << x << endl;
+#define MEMDEBUG_INIT mem_allocations.clear();
+#define MEMDEBUG_SUMMARY cerr << "SUMMARY:\n";			\
+  for (set<pure_expr*>::iterator x = mem_allocations.begin();	\
+       x != mem_allocations.end(); x++)				\
+    cerr << (void*)(*x) << ": " << (*x) << endl;		\
+  mem_allocations.clear();
+#else
+#define MEMDEBUG_NEW(x)
+#define MEMDEBUG_FREE(x)
+#define MEMDEBUG_INIT
+#define MEMDEBUG_SUMMARY
+#endif
+
 // Expression pointers are allocated in larger chunks for better performance.
 // NOTE: Only internal fields get initialized by new_expr(), the remaining
 // fields *must* be initialized as appropriate by the caller.
@@ -49,6 +69,7 @@
   interpreter& interp = *interpreter::g_interp;
   x->xp = interp.exps;
   interp.exps = x;
+  MEMDEBUG_FREE(x)
 }
 
 static inline
@@ -209,6 +230,7 @@
     }
     va_end(ap);
   }
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -220,6 +242,7 @@
   pure_expr *x = new_expr();
   x->tag = tag;
   x->data.clos = 0;
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -229,6 +252,7 @@
   pure_expr *x = new_expr();
   x->tag = EXPR::INT;
   x->data.i = i;
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -253,6 +277,7 @@
   pure_expr *x = new_expr();
   x->tag = EXPR::BIGINT;
   make_bigint(x->data.z, size, limbs);
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -262,6 +287,7 @@
   pure_expr *x = new_expr();
   x->tag = EXPR::BIGINT;
   mpz_init_set(x->data.z, z);
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -271,6 +297,7 @@
   pure_expr *x = new_expr();
   x->tag = EXPR::DBL;
   x->data.d = d;
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -280,6 +307,7 @@
   pure_expr *x = new_expr();
   x->tag = EXPR::PTR;
   x->data.p = p;
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -290,6 +318,7 @@
   pure_expr *x = new_expr();
   x->tag = EXPR::STR;
   x->data.s = strdup(s);
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -300,6 +329,7 @@
   pure_expr *x = new_expr();
   x->tag = EXPR::STR;
   x->data.s = toutf8(s, 0);
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -310,6 +340,7 @@
   pure_expr *x = new_expr();
   x->tag = EXPR::STR;
   x->data.s = s;
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -438,6 +469,7 @@
     f->tag = EXPR::APP;
     f->data.x[0] = x;
     f->data.x[1] = y;
+    MEMDEBUG_NEW(f)
     return f;
   }
 }
@@ -545,6 +577,7 @@
 #if DEBUG>1
   cerr << "pure_invoke: calling " << f << endl;
 #endif
+  MEMDEBUG_INIT
   // Push an exception.
   pure_exception ex; ex.e = 0; interp.estk.push_front(ex);
   // Call the function now. Catch exceptions generated by the runtime.
@@ -559,11 +592,13 @@
       if (tmps != e) pure_freenew(tmps);
       tmps = next;
     }
+    MEMDEBUG_SUMMARY
     return 0;
   } else {
     pure_expr *res = fp();
     // normal return
     interp.estk.pop_front();
+    MEMDEBUG_SUMMARY
 #if DEBUG>1
     pure_expr *tmps = interp.tmps;
     while (tmps) {
@@ -958,6 +993,7 @@
   pure_expr *x = new_expr();
   x->tag = EXPR::STR;
   x->data.s = buf;
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -1004,6 +1040,7 @@
   pure_expr *x = new_expr();
   x->tag = EXPR::STR;
   x->data.s = buf;
+  MEMDEBUG_NEW(x)
   return x;
 }
 
@@ -1018,6 +1055,7 @@
   pure_expr *x = new_expr();
   x->tag = EXPR::STR;
   x->data.s = buf;
+  MEMDEBUG_NEW(x)
   return x;
 }
 


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

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

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

Revision: 91
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=91&view=rev
Author:   agraef
Date:     2008-05-16 23:39:30 -0700 (Fri, 16 May 2008)

Log Message:
-----------
Fixed error messages for failed global variable bindings (let).

Modified Paths:
--------------
    pure/trunk/ChangeLog
    pure/trunk/interpreter.cc

Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog	2008-05-17 05:16:09 UTC (rev 90)
+++ pure/trunk/ChangeLog	2008-05-17 06:39:30 UTC (rev 91)
@@ -1,5 +1,7 @@
 2008-05-17  Albert Graef  <Dr....@t-...>
 
+	* interpreter.cc (define): Fixed error messages.
+	
 	* interpreter.cc, runtime.h: Reorganize pure_expr data structure
 	so that the data fields are *always* aligned on 8 byte boundaries.
 	This should now also work on 32 bit architectures where doubles

Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc	2008-05-17 05:16:09 UTC (rev 90)
+++ pure/trunk/interpreter.cc	2008-05-17 06:39:30 UTC (rev 91)
@@ -744,14 +744,20 @@
 void interpreter::define(rule *r)
 {
   last = expr();
-  pure_expr *res = defn(r->lhs, r->rhs);
+  pure_expr *e, *res = defn(r->lhs, r->rhs, e);
+  if ((verbose&verbosity::defs) != 0)
+    cout << "let " << r->lhs << " = " << r->rhs << ";\n";
   if (!res) {
     ostringstream msg;
-    msg << "failed match: " << r->lhs << " = " << r->rhs;
+    if (e) {
+      msg << "unhandled exception '" << e << "' while evaluating '"
+	  << "let " << r->lhs << " = " << r->rhs << "'";
+      pure_freenew(e);
+    } else
+      msg << "failed match while evaluating '"
+	  << "let " << r->lhs << " = " << r->rhs << "'";
     throw err(msg.str());
   }
-  if ((verbose&verbosity::defs) != 0)
-    cout << "let " << r->lhs << " = " << r->rhs << ";\n";
   delete r;
   pure_freenew(res);
   if (interactive && stats)


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

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

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

Revision: 90
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=90&view=rev
Author:   agraef
Date:     2008-05-16 22:16:09 -0700 (Fri, 16 May 2008)

Log Message:
-----------
Overhaul of internal type system, fix up pure_expr data structure so that data fields are always aligned on 8 byte boundaries.

Modified Paths:
--------------
    pure/trunk/ChangeLog
    pure/trunk/interpreter.cc
    pure/trunk/interpreter.hh
    pure/trunk/runtime.h

Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog	2008-05-16 16:37:31 UTC (rev 89)
+++ pure/trunk/ChangeLog	2008-05-17 05:16:09 UTC (rev 90)
@@ -1,3 +1,26 @@
+2008-05-17  Albert Graef  <Dr....@t-...>
+
+	* interpreter.cc, runtime.h: Reorganize pure_expr data structure
+	so that the data fields are *always* aligned on 8 byte boundaries.
+	This should now also work on 32 bit architectures where doubles
+	are aligned on 8 byte boundaries, such as Linux on 32 bit PPC.
+	Reported by Tim Haynes.
+
+	* interpreter.cc: Fixed some case labels in switch instructions
+	which should be signed rather than unsigned values. Also made
+	void* a pointer to a dummy struct in LLVM IR, so that it can be
+	distinguished from all other pointer types, and added support for
+	short (16 bit) and long (64 bit) integer types (as well as the
+	corresponding pointer types) in the C interface.
+
+	Please note that the typename 'long' *always* denotes signed 64
+	bit integers in Pure's extern declarations, even if the C 'long'
+	type is actually 32 bit (as it usually is even on most 64 bit
+	systems).
+
+	FIXME: At present 'long' is still converted to/from Pure (32 bit)
+	ints only, marshalling from/to Pure bigints is not supported yet.
+
 2008-05-16  Albert Graef  <Dr....@t-...>
 
 	* runtime.h: Fix compilation problems when header gets included

Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc	2008-05-16 16:37:31 UTC (rev 89)
+++ pure/trunk/interpreter.cc	2008-05-17 05:16:09 UTC (rev 90)
@@ -89,11 +89,17 @@
   // systems which do not allow the program to dlopen itself.
   JIT->InstallLazyFunctionCreator(resolve_external);
 
-  // Generic pointer type. LLVM doesn't like void*, so we use short* instead.
-  // (This is a bit of a kludge. We'd rather use char*, but we need to keep
-  // char* and void* apart, and short* isn't used for anything else here.)
+  // Generic pointer type. LLVM doesn't like void*, so we use a pointer to a
+  // dummy struct instead. (This is a bit of a kludge. We'd rather use char*,
+  // as suggested in the LLVM documentation, but we need to keep char* and
+  // void* apart.)
+  {
+    std::vector<const Type*> elts;
+    VoidPtrTy = PointerType::get(StructType::get(elts), 0);
+  }
 
-  VoidPtrTy = PointerType::get(Type::Int16Ty, 0);
+  // Char pointer type.
+  CharPtrTy = PointerType::get(Type::Int8Ty, 0);
 
   // Create the expr struct type.
 
@@ -101,11 +107,12 @@
      structure as defined by the runtime. In order to perform certain
      operations like built-in arithmetic, conditionals and expression matching
      in an efficient manner, we need to know about the layout of the relevant
-     fields in memory. The runtime will add additional variants and fields of
+     fields in memory. The runtime may add additional variants and fields of
      its own. The declarations below correspond to the following C struct:
 
      struct expr {
        int32_t tag; // see expr.hh, determines the variant
+       uint32_t refc; // reference counter
        union {
          struct { // application
 	   struct expr *x, *y;
@@ -127,6 +134,7 @@
     PATypeHolder StructTy = OpaqueType::get();
     std::vector<const Type*> elts;
     elts.push_back(Type::Int32Ty);
+    elts.push_back(Type::Int32Ty);
     elts.push_back(PointerType::get(StructTy, 0));
     elts.push_back(PointerType::get(StructTy, 0));
     ExprTy = StructType::get(elts);
@@ -134,20 +142,18 @@
     ExprTy = cast<StructType>(StructTy.get());
     module->addTypeName("struct.expr", ExprTy);
   }
-  // Other variants. Note that on 64 bit systems we have to add a dummy field
-  // so that the following value field is aligned properly.
   {
     std::vector<const Type*> elts;
     elts.push_back(Type::Int32Ty);
-    if (sizeof(void*)==8) elts.push_back(Type::Int32Ty); // dummy
     elts.push_back(Type::Int32Ty);
+    elts.push_back(Type::Int32Ty);
     IntExprTy = StructType::get(elts);
     module->addTypeName("struct.intexpr", IntExprTy);
   }
   {
     std::vector<const Type*> elts;
     elts.push_back(Type::Int32Ty);
-    if (sizeof(void*)==8) elts.push_back(Type::Int32Ty); // dummy
+    elts.push_back(Type::Int32Ty);
     elts.push_back(Type::DoubleTy);
     DblExprTy = StructType::get(elts);
     module->addTypeName("struct.dblexpr", DblExprTy);
@@ -155,15 +161,15 @@
   {
     std::vector<const Type*> elts;
     elts.push_back(Type::Int32Ty);
-    if (sizeof(void*)==8) elts.push_back(Type::Int32Ty); // dummy
-    elts.push_back(PointerType::get(Type::Int8Ty, 0));
+    elts.push_back(Type::Int32Ty);
+    elts.push_back(CharPtrTy);
     StrExprTy = StructType::get(elts);
     module->addTypeName("struct.strexpr", StrExprTy);
   }
   {
     std::vector<const Type*> elts;
     elts.push_back(Type::Int32Ty);
-    if (sizeof(void*)==8) elts.push_back(Type::Int32Ty); // dummy
+    elts.push_back(Type::Int32Ty);
     elts.push_back(VoidPtrTy);
     PtrExprTy = StructType::get(elts);
     module->addTypeName("struct.ptrexpr", PtrExprTy);
@@ -1456,7 +1462,11 @@
 #define Zero		UInt(0)
 #define One		UInt(1)
 #define Two		UInt(2)
-#define ValFldIndex	(sizeof(void*)==8?Two:One)
+#define Three		UInt(3)
+#define RefcFldIndex	One
+#define ValFldIndex	Two
+#define ValFld2Index	Three
+#define SubFldIndex(i)	UInt(i+2)
 #define NullExprPtr	ConstantPointerNull::get(ExprPtrTy)
 #define NullExprPtrPtr	ConstantPointerNull::get(ExprPtrPtrTy)
 
@@ -2066,6 +2076,8 @@
     return Type::Int1Ty;
   else if (name == "char")
     return Type::Int8Ty;
+  else if (name == "short")
+    return Type::Int16Ty;
   else if (name == "int")
     return Type::Int32Ty;
   else if (name == "long")
@@ -2073,7 +2085,9 @@
   else if (name == "double")
     return Type::DoubleTy;
   else if (name == "char*")
-    return PointerType::get(Type::Int8Ty, 0);
+    return CharPtrTy;
+  else if (name == "short*")
+    return PointerType::get(Type::Int16Ty, 0);
   else if (name == "int*")
     return PointerType::get(Type::Int32Ty, 0);
   else if (name == "long*")
@@ -2101,14 +2115,18 @@
     return "bool";
   else if (type == Type::Int8Ty)
     return "char";
+  else if (type == Type::Int16Ty)
+    return "short";
   else if (type == Type::Int32Ty)
     return "int";
   else if (type == Type::Int64Ty)
     return "long";
   else if (type == Type::DoubleTy)
     return "double";
-  else if (type == PointerType::get(Type::Int8Ty, 0))
+  else if (type == CharPtrTy)
     return "char*";
+  else if (type == PointerType::get(Type::Int16Ty, 0))
+    return "short*";
   else if (type == PointerType::get(Type::Int32Ty, 0))
     return "int*";
   else if (type == PointerType::get(Type::Int64Ty, 0))
@@ -2222,7 +2240,7 @@
 	// In Pure, we allow void* to be passed for a char*, to bypass the
 	// automatic marshalling from Pure to C strings. Oh well.
 	ok = gt->getParamType(i)==argt[i] ||
-	  gt->getParamType(i)==PointerType::get(Type::Int8Ty, 0) &&
+	  gt->getParamType(i)==CharPtrTy &&
 	  argt[i] == VoidPtrTy;
       }
       if (!ok) {
@@ -2317,6 +2335,18 @@
       idx[1] = ValFldIndex;
       Value *iv = b.CreateLoad(b.CreateGEP(pv, idx, idx+2), "intval");
       unboxed[i] = b.CreateTrunc(iv, Type::Int8Ty);
+    } else if (argt[i] == Type::Int16Ty) {
+      BasicBlock *okbb = new BasicBlock("ok");
+      Value *idx[2] = { Zero, Zero };
+      Value *tagv = b.CreateLoad(b.CreateGEP(x, idx, idx+2), "tag");
+      b.CreateCondBr
+	(b.CreateICmpEQ(tagv, SInt(EXPR::INT), "cmp"), okbb, failedbb);
+      f->getBasicBlockList().push_back(okbb);
+      b.SetInsertPoint(okbb);
+      Value *pv = b.CreateBitCast(x, IntExprPtrTy, "intexpr");
+      idx[1] = ValFldIndex;
+      Value *iv = b.CreateLoad(b.CreateGEP(pv, idx, idx+2), "intval");
+      unboxed[i] = b.CreateTrunc(iv, Type::Int16Ty);
     } else if (argt[i] == Type::Int32Ty) {
       BasicBlock *okbb = new BasicBlock("ok");
       Value *idx[2] = { Zero, Zero };
@@ -2353,7 +2383,7 @@
       idx[1] = ValFldIndex;
       Value *dv = b.CreateLoad(b.CreateGEP(pv, idx, idx+2), "dblval");
       unboxed[i] = dv;
-    } else if (argt[i] == PointerType::get(Type::Int8Ty, 0)) {
+    } else if (argt[i] == CharPtrTy) {
       BasicBlock *okbb = new BasicBlock("ok");
       Value *idx[2] = { Zero, Zero };
       Value *tagv = b.CreateLoad(b.CreateGEP(x, idx, idx+2), "tag");
@@ -2363,7 +2393,10 @@
       b.SetInsertPoint(okbb);
       Value *sv = b.CreateCall(module->getFunction("pure_get_cstring"), x);
       unboxed[i] = sv; temps = true;
-    } else if (argt[i] == PointerType::get(Type::Int32Ty, 0)) {
+    } else if (argt[i] == PointerType::get(Type::Int16Ty, 0) ||
+	       argt[i] == PointerType::get(Type::Int32Ty, 0) ||
+	       argt[i] == PointerType::get(Type::Int64Ty, 0) ||
+	       argt[i] == PointerType::get(Type::DoubleTy, 0)) {
       BasicBlock *okbb = new BasicBlock("ok");
       Value *idx[2] = { Zero, Zero };
       Value *tagv = b.CreateLoad(b.CreateGEP(x, idx, idx+2), "tag");
@@ -2375,18 +2408,6 @@
       idx[1] = ValFldIndex;
       Value *ptrv = b.CreateLoad(b.CreateGEP(pv, idx, idx+2), "ptrval");
       unboxed[i] = b.CreateBitCast(ptrv, argt[i]);
-    } else if (argt[i] == PointerType::get(Type::DoubleTy, 0)) {
-      BasicBlock *okbb = new BasicBlock("ok");
-      Value *idx[2] = { Zero, Zero };
-      Value *tagv = b.CreateLoad(b.CreateGEP(x, idx, idx+2), "tag");
-      b.CreateCondBr
-	(b.CreateICmpEQ(tagv, SInt(EXPR::PTR), "cmp"), okbb, failedbb);
-      f->getBasicBlockList().push_back(okbb);
-      b.SetInsertPoint(okbb);
-      Value *pv = b.CreateBitCast(x, PtrExprPtrTy, "ptrexpr");
-      idx[1] = ValFldIndex;
-      Value *ptrv = b.CreateLoad(b.CreateGEP(pv, idx, idx+2), "ptrval");
-      unboxed[i] = b.CreateBitCast(ptrv, argt[i]);
     } else if (argt[i] == ExprPtrTy) {
       // passed through
       unboxed[i] = x;
@@ -2425,12 +2446,12 @@
       phi->addIncoming(ptrv, ptrbb);
       phi->addIncoming(mpzv, mpzbb);
       unboxed[i] = phi;
-      if (gt->getParamType(i)==PointerType::get(Type::Int8Ty, 0))
+      if (gt->getParamType(i)==CharPtrTy)
 	// An external builtin already has this parameter declared as char*.
 	// We allow void* to be passed anyway, so just cast it to char* to
 	// make the LLVM typechecker happy.
 	unboxed[i] = b.CreateBitCast
-	  (unboxed[i], PointerType::get(Type::Int8Ty, 0));
+	  (unboxed[i], CharPtrTy);
     } else
       assert(0 && "invalid C type");
   }
@@ -2449,6 +2470,9 @@
     // char treated as an unsigned integer here
     u = b.CreateCall(module->getFunction("pure_int"),
 		     b.CreateZExt(u, Type::Int32Ty));
+  else if (type == Type::Int16Ty)
+    u = b.CreateCall(module->getFunction("pure_int"),
+		     b.CreateSExt(u, Type::Int32Ty));
   else if (type == Type::Int32Ty)
     u = b.CreateCall(module->getFunction("pure_int"), u);
   else if (type == Type::Int64Ty)
@@ -2456,14 +2480,14 @@
 		     b.CreateTrunc(u, Type::Int32Ty));
   else if (type == Type::DoubleTy)
     u = b.CreateCall(module->getFunction("pure_double"), u);
-  else if (type == PointerType::get(Type::Int8Ty, 0))
+  else if (type == CharPtrTy)
     u = b.CreateCall(module->getFunction("pure_cstring_dup"), u);
-  else if (type == PointerType::get(Type::Int32Ty, 0))
+  else if (type == PointerType::get(Type::Int16Ty, 0) ||
+	   type == PointerType::get(Type::Int32Ty, 0) ||
+	   type == PointerType::get(Type::Int64Ty, 0) ||
+	   type == PointerType::get(Type::DoubleTy, 0))
     u = b.CreateCall(module->getFunction("pure_pointer"),
 		     b.CreateBitCast(u, VoidPtrTy));
-  else if (type == PointerType::get(Type::DoubleTy, 0))
-    u = b.CreateCall(module->getFunction("pure_pointer"),
-		     b.CreateBitCast(u, VoidPtrTy));
   else if (type == ExprPtrTy) {
     // check that we actually got a valid pointer; otherwise the call failed
     BasicBlock *okbb = new BasicBlock("ok");
@@ -2603,7 +2627,7 @@
     path& p = *info.p;
     size_t n = p.len();
     for (size_t i = 0; i < n; i++)
-      x = f.CreateLoadGEP(x, Zero, UInt(p[i]+1), mklabel("x", i, p[i]+1));
+      x = f.CreateLoadGEP(x, Zero, SubFldIndex(p[i]), mklabel("x", i, p[i]+1));
     // store the value in a global variable of the same name
     const symbol& sym = symtab.sym(tag);
     GlobalVar& v = globalvars[tag];
@@ -3481,7 +3505,7 @@
   Value *v = e.args[k];
   size_t n = p.len();
   for (size_t i = 0; i < n; i++)
-    v = e.CreateLoadGEP(v, Zero, UInt(p[i]+1), mklabel("x", i, p[i]+1));
+    v = e.CreateLoadGEP(v, Zero, SubFldIndex(p[i]), mklabel("x", i, p[i]+1));
   return v;
 }
 
@@ -4180,12 +4204,12 @@
     // next match the first subterm...
     f.f->getBasicBlockList().push_back(ok1bb);
     f.builder.SetInsertPoint(ok1bb);
-    Value *x1 = f.CreateLoadGEP(x, Zero, One, "x1");
+    Value *x1 = f.CreateLoadGEP(x, Zero, ValFldIndex, "x1");
     simple_match(x1, s, ok2bb, failedbb);
     // and finally the second subterm...
     f.f->getBasicBlockList().push_back(ok2bb);
     f.builder.SetInsertPoint(ok2bb);
-    Value *x2 = f.CreateLoadGEP(x, Zero, Two, "x2");
+    Value *x2 = f.CreateLoadGEP(x, Zero, ValFld2Index, "x2");
     simple_match(x2, s, matchedbb, failedbb);
     break;
   }
@@ -4258,27 +4282,27 @@
 
 // helper macros to set up for the next state
 
-#define next_state(t)					\
-  do {							\
-    state *s = t->st;					\
-    list<Value*> ys = xs; ys.pop_front();		\
-    if (ys.empty())					\
-      try_rules(pm, s, failedbb, reduced);		\
-    else						\
-      complex_match(pm, ys, s, failedbb, reduced);	\
+#define next_state(t)						\
+  do {								\
+    state *s = t->st;						\
+    list<Value*> ys = xs; ys.pop_front();			\
+    if (ys.empty())						\
+      try_rules(pm, s, failedbb, reduced);			\
+    else							\
+      complex_match(pm, ys, s, failedbb, reduced);		\
   } while (0)
 
 // same as above, but handles the case of an application where we recurse into
 // subterms
 
-#define next_state2(t)					\
-  do {							\
-    state *s = t->st;					\
-    list<Value*> ys = xs; ys.pop_front();		\
-    Value *x1 = f.CreateLoadGEP(x, Zero, One, "x1");	\
-    Value *x2 = f.CreateLoadGEP(x, Zero, Two, "x2");	\
-    ys.push_front(x2); ys.push_front(x1);		\
-    complex_match(pm, ys, s, failedbb, reduced);	\
+#define next_state2(t)						\
+  do {								\
+    state *s = t->st;						\
+    list<Value*> ys = xs; ys.pop_front();			\
+    Value *x1 = f.CreateLoadGEP(x, Zero, ValFldIndex, "x1");	\
+    Value *x2 = f.CreateLoadGEP(x, Zero, ValFld2Index, "x2");	\
+    ys.push_front(x2); ys.push_front(x1);			\
+    complex_match(pm, ys, s, failedbb, reduced);		\
   } while (0)
 
 /* This is the core of the decision tree construction algorithm. It emits code
@@ -4352,7 +4376,7 @@
 	assert(!tmap[t->tag].bb);
 	tmap[t->tag].bb = bb;
 	tmap[t->tag].t = &*t;
-	sw->addCase(UInt(t->tag), bb);
+	sw->addCase(SInt(t->tag), bb);
       } else {
 	// transition on a constant, add it to the corresponding list
 	tmap[t->tag].tlist.push_back(trans_info(&*t, bb));
@@ -4361,7 +4385,7 @@
 	  // target to the outer switch
 	  tmap[t->tag].bb =
 	    new BasicBlock(mklabel("begin.state", s->s, -t->tag));
-	  sw->addCase(UInt(t->tag), tmap[t->tag].bb);
+	  sw->addCase(SInt(t->tag), tmap[t->tag].bb);
 	}
       }
     }
@@ -4458,7 +4482,7 @@
     for (t = t1, i = 0; t != s->tr.end() && t->tag == EXPR::VAR; t++, i++) {
       vtransbb.push_back
 	(new BasicBlock(mklabel("trans.state", s->s, t->st->s)));
-      sw->addCase(UInt(t->ttag), vtransbb[i]);
+      sw->addCase(SInt(t->ttag), vtransbb[i]);
     }
     // now handle the transitions on the different type tags
     for (t = t1, i = 0; t != s->tr.end() && t->tag == EXPR::VAR; t++, i++) {

Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh	2008-05-16 16:37:31 UTC (rev 89)
+++ pure/trunk/interpreter.hh	2008-05-17 05:16:09 UTC (rev 90)
@@ -388,7 +388,7 @@
   llvm::StructType  *ExprTy, *IntExprTy, *DblExprTy, *StrExprTy, *PtrExprTy;
   llvm::PointerType *ExprPtrTy, *ExprPtrPtrTy;
   llvm::PointerType *IntExprPtrTy, *DblExprPtrTy, *StrExprPtrTy, *PtrExprPtrTy;
-  llvm::PointerType *VoidPtrTy;
+  llvm::PointerType *VoidPtrTy, *CharPtrTy;
   const llvm::Type *named_type(string name);
   const char *type_name(const llvm::Type *type);
   map<int32_t,GlobalVar> globalvars;

Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h	2008-05-16 16:37:31 UTC (rev 89)
+++ pure/trunk/runtime.h	2008-05-17 05:16:09 UTC (rev 90)
@@ -32,6 +32,7 @@
   /* Public fields, these *must* be layed out exactly as indicated.
      The JIT depends on it! */
   int32_t tag; // type tag or symbol, see expr.hh for possible values
+  uint32_t refc;		// reference counter
   union {
     struct _pure_expr *x[2];	// application arguments (EXPR::APP)
     int32_t i;			// integer (EXPR::INT)
@@ -42,7 +43,6 @@
     pure_closure *clos;		// closure (0 if none)
   } data;
   /* Internal fields (DO NOT TOUCH). The JIT doesn't care about these. */
-  uint32_t refc;		// reference counter
   struct _pure_expr *xp;	// freelist pointer
 } pure_expr;
 


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

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

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

Revision: 89
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=89&view=rev
Author:   agraef
Date:     2008-05-16 09:37:31 -0700 (Fri, 16 May 2008)

Log Message:
-----------
Fixed C compilation problems with runtime.h.

Modified Paths:
--------------
    pure/trunk/ChangeLog
    pure/trunk/runtime.h

Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog	2008-05-16 08:46:10 UTC (rev 88)
+++ pure/trunk/ChangeLog	2008-05-16 16:37:31 UTC (rev 89)
@@ -1,3 +1,8 @@
+2008-05-16  Albert Graef  <Dr....@t-...>
+
+	* runtime.h: Fix compilation problems when header gets included
+	from C.
+
 2008-05-14  Albert Graef  <Dr....@t-...>
 
 	* funcall.h: Reduce maximum number of function parameters to

Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h	2008-05-16 08:46:10 UTC (rev 88)
+++ pure/trunk/runtime.h	2008-05-16 16:37:31 UTC (rev 89)
@@ -4,6 +4,7 @@
 /* The Pure runtime interface. */
 
 #include <stdint.h>
+#include <stdbool.h>
 #include <setjmp.h>
 #include <gmp.h>
 
@@ -124,9 +125,12 @@
 /* Run a Pure function and catch exceptions. If everything goes normal,
    pure_invoke returns the return value of the executed function. Otherwise it
    returns 0 and sets e to the exception value, as given by pure_throw().
-   XXXFIXME: Only supports parameterless functions right now. */
+   XXXFIXME: This only works with C++ and only supports parameterless
+   functions right now. */
 
+#ifdef __cplusplus
 pure_expr *pure_invoke(void *f, pure_expr*& e);
+#endif
 
 /* Count a new reference to an expression. This should be called whenever you
    want to store an expression somewhere, in order to prevent it from being


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

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

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

Revision: 88
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=88&view=rev
Author:   agraef
Date:     2008-05-16 01:46:10 -0700 (Fri, 16 May 2008)

Log Message:
-----------
Fix up message in ChangeLog.

Modified Paths:
--------------
    pure/trunk/ChangeLog

Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog	2008-05-14 20:36:31 UTC (rev 87)
+++ pure/trunk/ChangeLog	2008-05-16 08:46:10 UTC (rev 88)
@@ -23,7 +23,8 @@
 	separate environments for each rule of a function
 	definition. Reported by John Lunney.
 
-	* Makefile: Redirect warning and error messages to the logfile.
+	* Makefile: Redirect warning and error messages from regression
+	tests to the logfile.
 
 2008-05-10  Albert Graef  <Dr....@t-...>
 


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

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

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

Revision: 87
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=87&view=rev
Author:   agraef
Date:     2008-05-14 13:36:31 -0700 (Wed, 14 May 2008)

Log Message:
-----------
Comment changes.

Modified Paths:
--------------
    pure/trunk/INSTALL
    pure/trunk/Makefile

Modified: pure/trunk/INSTALL
===================================================================
--- pure/trunk/INSTALL	2008-05-14 20:13:10 UTC (rev 86)
+++ pure/trunk/INSTALL	2008-05-14 20:36:31 UTC (rev 87)
@@ -184,9 +184,9 @@
 This disables all runtime checks and debugging information in the interpreter
 and also uses a higher level of optimization. The 'release' build will usually
 give you faster execution times, but the differences aren't really that big
-anymore (5% compared to the default flags on my Linux system running gcc 4.1,
-YMMV), so you are encouraged to use the 'default' build unless performance is
-really critical.
+anymore (5-10% compared to the default flags on my Linux system running gcc
+4.1, YMMV), so you are encouraged to use the 'default' build unless
+performance is really critical.
 
 You can also do a 'debug' build as follows:
 

Modified: pure/trunk/Makefile
===================================================================
--- pure/trunk/Makefile	2008-05-14 20:13:10 UTC (rev 86)
+++ pure/trunk/Makefile	2008-05-14 20:36:31 UTC (rev 87)
@@ -48,8 +48,8 @@
 
 # The 'release' build disables all runtime checks and debugging information
 # and compiles with additional optimizations which makes programs go a little
-# faster (some 5% on a single-cpu AMD system running Linux and gcc 4.1, YMMV);
-# use this if performance is critical.
+# faster (some 5-10% on a single-cpu AMD system running Linux and gcc 4.1,
+# YMMV); use this if performance is critical.
 
 # The 'debug' build is like 'default' but without any optimizations; it builds
 # faster than 'default', but runs *much* slower, and isn't recommended for


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

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

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

Revision: 86
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=86&view=rev
Author:   agraef
Date:     2008-05-14 13:13:10 -0700 (Wed, 14 May 2008)

Log Message:
-----------
Update ChangeLog.

Modified Paths:
--------------
    pure/trunk/ChangeLog

Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog	2008-05-14 20:04:47 UTC (rev 85)
+++ pure/trunk/ChangeLog	2008-05-14 20:13:10 UTC (rev 86)
@@ -1,3 +1,19 @@
+2008-05-14  Albert Graef  <Dr....@t-...>
+
+	* funcall.h: Reduce maximum number of function parameters to
+	64. This seems to be large enough for most purposes, and speeds up
+	compilation with -Ox by a factor of around 10.
+
+	* Makefile: Overhaul of build options. In particular, the
+	'default' build now includes basic optimization (-O) which makes
+	the interpreter almost as fast as with the 'release' build, and
+	produces a working interpreter also on 64 bit systems. (The
+	'debug' build is still broken there, but see the SYSTEM NOTES
+	section in the INSTALL file for a workaround.)
+
+	* interpreter.cc, runtime.cc: 64 bit compatibility fixes in bigint
+	handling.
+
 2008-05-12  Albert Graef  <Dr....@t-...>
 
 	* interpreter.cc: Fix a severe bug in the environment handling


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