pure-lang-svn Mailing List for Pure (Page 30)
Status: Beta
Brought to you by:
agraef
Menu
▾
▴
pure-lang-svn — SVN commits.
You can subscribe to this list here.
| 2008 |
Jan
|
Feb
|
Mar
|
Apr
(5) |
May
(141) |
Jun
(184) |
Jul
(97) |
Aug
(232) |
Sep
(196) |
Oct
|
Nov
|
Dec
|
|---|
|
From: <ag...@us...> - 2008-05-27 08:38:29
|
Revision: 141
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=141&view=rev
Author: agraef
Date: 2008-05-27 01:38:37 -0700 (Tue, 27 May 2008)
Log Message:
-----------
Make body of 'when' clause tail-recursive.
Modified Paths:
--------------
pure/trunk/interpreter.cc
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-05-27 04:46:07 UTC (rev 140)
+++ pure/trunk/interpreter.cc 2008-05-27 08:38:37 UTC (rev 141)
@@ -2765,8 +2765,8 @@
// end = end of rule list
{
if (r == end) {
- Value *v = codegen(x);
- return v;
+ toplevel_codegen(x);
+ return 0;
} else {
Env& act = act_env();
rulel::const_iterator s = r;
@@ -2788,7 +2788,8 @@
// matched => emit code for the reduct
e.f->getBasicBlockList().push_back(matchedbb);
e.builder.SetInsertPoint(matchedbb);
- e.CreateRet(when_codegen(x, m+1, s, end));
+ Value *v = when_codegen(x, m+1, s, end);
+ if (v) e.CreateRet(v);
// failed => throw an exception
e.f->getBasicBlockList().push_back(failedbb);
e.builder.SetInsertPoint(failedbb);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-27 04:45:59
|
Revision: 140
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=140&view=rev
Author: agraef
Date: 2008-05-26 21:46:07 -0700 (Mon, 26 May 2008)
Log Message:
-----------
Revert previous changes which are not needed any more because && and || are now tail-recursive.
Modified Paths:
--------------
pure/trunk/lib/prelude.pure
pure/trunk/test/prelude.log
Modified: pure/trunk/lib/prelude.pure
===================================================================
--- pure/trunk/lib/prelude.pure 2008-05-27 04:32:49 UTC (rev 139)
+++ pure/trunk/lib/prelude.pure 2008-05-27 04:46:07 UTC (rev 140)
@@ -92,12 +92,12 @@
()==() = 1;
(x,xs)==() = 0;
()==(x,xs) = 0;
-(x,xs)==(y,ys) = if x==y then xs==ys else 0;
+(x,xs)==(y,ys) = x==y && xs==ys;
()!=() = 0;
(x,xs)!=() = 1;
()!=(x,xs) = 1;
-(x,xs)!=(y,ys) = if x!=y then 1 else xs!=ys;
+(x,xs)!=(y,ys) = x!=y || xs!=ys;
null () = 1;
null (x,xs) = 0;
@@ -133,12 +133,12 @@
[]==[] = 1;
(x:xs)==[] = 0;
[]==(x:xs) = 0;
-(x:xs)==(y:ys) = if x==y then xs==ys else 1;
+(x:xs)==(y:ys) = x==y && xs==ys;
[]!=[] = 0;
(x:xs)!=[] = 1;
[]!=(x:xs) = 1;
-(x:xs)!=(y:ys) = if x!=y then 1 else xs!=ys;
+(x:xs)!=(y:ys) = x!=y || xs!=ys;
null [] = 1;
null (x:xs) = 0;
@@ -207,10 +207,10 @@
functions have slightly different names). */
all p [] = 1;
-all p (x:xs) = if p x then all p xs else 0;
+all p (x:xs) = p x && all p xs;
any p [] = 0;
-any p (x:xs) = if p x then 1 else any p xs;
+any p (x:xs) = p x || any p xs;
do f [] = ();
do f (x:xs) = do f xs when _ = f x end;
Modified: pure/trunk/test/prelude.log
===================================================================
--- pure/trunk/test/prelude.log 2008-05-27 04:32:49 UTC (rev 139)
+++ pure/trunk/test/prelude.log 2008-05-27 04:46:07 UTC (rev 140)
@@ -334,11 +334,11 @@
()==() = 1;
(x/*0:0101*/,xs/*0:011*/)==() = 0;
()==(x/*0:101*/,xs/*0:11*/) = 0;
-(x/*0:0101*/,xs/*0:011*/)==(y/*0:101*/,ys/*0:11*/) = if x/*0:0101*/==y/*0:101*/ then xs/*0:011*/==ys/*0:11*/ else 0;
+(x/*0:0101*/,xs/*0:011*/)==(y/*0:101*/,ys/*0:11*/) = x/*0:0101*/==y/*0:101*/&&xs/*0:011*/==ys/*0:11*/;
()!=() = 0;
(x/*0:0101*/,xs/*0:011*/)!=() = 1;
()!=(x/*0:101*/,xs/*0:11*/) = 1;
-(x/*0:0101*/,xs/*0:011*/)!=(y/*0:101*/,ys/*0:11*/) = if x/*0:0101*/!=y/*0:101*/ then 1 else xs/*0:011*/!=ys/*0:11*/;
+(x/*0:0101*/,xs/*0:011*/)!=(y/*0:101*/,ys/*0:11*/) = x/*0:0101*/!=y/*0:101*/||xs/*0:011*/!=ys/*0:11*/;
null () = 1;
null (x/*0:101*/,xs/*0:11*/) = 0;
#() = 0;
@@ -407,11 +407,11 @@
[]==[] = 1;
x/*0:0101*/:xs/*0:011*/==[] = 0;
[]==x/*0:101*/:xs/*0:11*/ = 0;
-x/*0:0101*/:xs/*0:011*/==y/*0:101*/:ys/*0:11*/ = if x/*0:0101*/==y/*0:101*/ then xs/*0:011*/==ys/*0:11*/ else 1;
+x/*0:0101*/:xs/*0:011*/==y/*0:101*/:ys/*0:11*/ = x/*0:0101*/==y/*0:101*/&&xs/*0:011*/==ys/*0:11*/;
[]!=[] = 0;
x/*0:0101*/:xs/*0:011*/!=[] = 1;
[]!=x/*0:101*/:xs/*0:11*/ = 1;
-x/*0:0101*/:xs/*0:011*/!=y/*0:101*/:ys/*0:11*/ = if x/*0:0101*/!=y/*0:101*/ then 1 else xs/*0:011*/!=ys/*0:11*/;
+x/*0:0101*/:xs/*0:011*/!=y/*0:101*/:ys/*0:11*/ = x/*0:0101*/!=y/*0:101*/||xs/*0:011*/!=ys/*0:11*/;
null [] = 1;
null (x/*0:101*/:xs/*0:11*/) = 0;
#[] = 0;
@@ -629,9 +629,9 @@
state 1: #0
}) n/*0:01*/;
all p/*0:01*/ [] = 1;
-all p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = if p/*0:01*/ x/*0:101*/ then all p/*0:01*/ xs/*0:11*/ else 0;
+all p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = p/*0:01*/ x/*0:101*/&&all p/*0:01*/ xs/*0:11*/;
any p/*0:01*/ [] = 0;
-any p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = if p/*0:01*/ x/*0:101*/ then 1 else any p/*0:01*/ xs/*0:11*/;
+any p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = p/*0:01*/ x/*0:101*/||any p/*0:01*/ xs/*0:11*/;
do f/*0:01*/ [] = ();
do f/*0:01*/ (x/*0:101*/:xs/*0:11*/) = do f/*1:01*/ xs/*1:11*/ when _/*0:*/ = f/*0:01*/ x/*0:101*/ {
rule #0: _ = f x
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-27 04:32:42
|
Revision: 139
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=139&view=rev
Author: agraef
Date: 2008-05-26 21:32:49 -0700 (Mon, 26 May 2008)
Log Message:
-----------
Remove bogus tail call flag on calls to pure_throw.
Modified Paths:
--------------
pure/trunk/interpreter.cc
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-05-27 04:28:33 UTC (rev 138)
+++ pure/trunk/interpreter.cc 2008-05-27 04:32:49 UTC (rev 139)
@@ -4010,8 +4010,7 @@
else
args.push_back(NullExprPtr);
Env& e = act_env();
- CallInst *v = e.CreateCall(f, args);
- v->setTailCall();
+ e.CreateCall(f, args);
// add a ret instruction to terminate the current block
e.builder.CreateRet(NullExprPtr);
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-27 04:28:34
|
Revision: 138
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=138&view=rev
Author: agraef
Date: 2008-05-26 21:28:33 -0700 (Mon, 26 May 2008)
Log Message:
-----------
Experimental support for tail-recursive short-circuit logical operators (&& and ||).
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-05-26 20:25:34 UTC (rev 137)
+++ pure/trunk/ChangeLog 2008-05-27 04:28:33 UTC (rev 138)
@@ -1,3 +1,11 @@
+2008-05-27 Albert Graef <Dr....@t-...>
+
+ * interpreter.cc (toplevel_codegen): Experimental support for
+ tail-recursive short-circuit logical operators (&& and ||). Note
+ that this makes these operations behave slightly differently (more
+ like if-then-else) if they form the right-hand side of an
+ equation. But the advantages seem to outweigh the semantic quirks.
+
2008-05-26 Albert Graef <Dr....@t-...>
* interpreter.cc, runtime.cc: Overhaul of the shadow stack
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-05-26 20:25:34 UTC (rev 137)
+++ pure/trunk/interpreter.cc 2008-05-27 04:28:33 UTC (rev 138)
@@ -3225,11 +3225,51 @@
void interpreter::toplevel_codegen(expr x)
{
+#if USE_FASTCC
assert(!x.is_null());
- if (x.tag() == EXPR::COND)
+ if (x.tag() == EXPR::COND) {
toplevel_cond(x.xval1(), x.xval2(), x.xval3());
- else
- act_env().CreateRet(codegen(x));
+ return;
+ }
+ Env& e = act_env();
+#if TAILOPS
+ Builder& b = act_builder();
+ expr f; uint32_t n = count_args(x, f);
+ if (n == 2 && x.ttag() == EXPR::INT &&
+ x.xval1().xval2().ttag() != EXPR::DBL &&
+ x.xval2().ttag() != EXPR::DBL) {
+ if (f.ftag() == symtab.or_sym().f) {
+ Value *u = get_int(x.xval1().xval2());
+ Value *condv = b.CreateICmpNE(u, Zero, "cond");
+ BasicBlock *iftruebb = new BasicBlock("iftrue");
+ BasicBlock *iffalsebb = new BasicBlock("iffalse");
+ b.CreateCondBr(condv, iftruebb, iffalsebb);
+ e.f->getBasicBlockList().push_back(iftruebb);
+ b.SetInsertPoint(iftruebb);
+ e.CreateRet(ibox(One));
+ e.f->getBasicBlockList().push_back(iffalsebb);
+ b.SetInsertPoint(iffalsebb);
+ toplevel_codegen(x.xval2());
+ } else if (f.ftag() == symtab.and_sym().f) {
+ Value *u = get_int(x.xval1().xval2());
+ Value *condv = b.CreateICmpNE(u, Zero, "cond");
+ BasicBlock *iftruebb = new BasicBlock("iftrue");
+ BasicBlock *iffalsebb = new BasicBlock("iffalse");
+ b.CreateCondBr(condv, iftruebb, iffalsebb);
+ e.f->getBasicBlockList().push_back(iffalsebb);
+ b.SetInsertPoint(iffalsebb);
+ e.CreateRet(ibox(Zero));
+ e.f->getBasicBlockList().push_back(iftruebb);
+ b.SetInsertPoint(iftruebb);
+ toplevel_codegen(x.xval2());
+ } else
+ e.CreateRet(codegen(x));
+ } else
+#endif
+ e.CreateRet(codegen(x));
+#else
+ act_env().CreateRet(codegen(x));
+#endif
}
Value *interpreter::codegen(expr x)
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-05-26 20:25:34 UTC (rev 137)
+++ pure/trunk/interpreter.hh 2008-05-27 04:28:33 UTC (rev 138)
@@ -28,6 +28,11 @@
/* Experimental support for the "fast" calling convention which is needed to
get tail call elimination. */
#define USE_FASTCC 1
+/* Experimental support for tail-recursive short-circuit logical operators (&&
+ and ||). This will only have an effect if USE_FASTCC is enabled. Note that
+ if you disable this option, && and || will still be short-curcuit, they
+ just won't be tail-recursive in their second operand any more. */
+#define TAILOPS 1
using namespace std;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-26 20:25:27
|
Revision: 137
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=137&view=rev
Author: agraef
Date: 2008-05-26 13:25:34 -0700 (Mon, 26 May 2008)
Log Message:
-----------
Environment vectors are now maintained on the shadow stack, so that all local functions and anonymous closures are now eligible for tail call optimization.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/TODO
pure/trunk/funcall.h
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
pure/trunk/pure.1
pure/trunk/runtime.cc
pure/trunk/runtime.h
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-05-25 21:14:08 UTC (rev 136)
+++ pure/trunk/ChangeLog 2008-05-26 20:25:34 UTC (rev 137)
@@ -1,3 +1,11 @@
+2008-05-26 Albert Graef <Dr....@t-...>
+
+ * interpreter.cc, runtime.cc: Overhaul of the shadow stack
+ machinery. Environment vectors are now maintained on the shadow
+ stack, so that all local functions and anonymous closures are
+ eligible for tail call optimization, even if they need access to
+ their environment.
+
2008-05-25 Albert Graef <Dr....@t-...>
* lib/prelude.pure: Rewrite prelude operations to make them
Modified: pure/trunk/TODO
===================================================================
--- pure/trunk/TODO 2008-05-25 21:14:08 UTC (rev 136)
+++ pure/trunk/TODO 2008-05-26 20:25:34 UTC (rev 137)
@@ -36,8 +36,7 @@
functions to the runtime.
- Better support for proper tail calls. Currently this only works for direct
- calls and if the callee doesn't need an environment (i.e., all data is
- passed as parameters). See the manpage for details.
+ calls. See the manpage for details.
- More aggressive optimizations (common subexpression elimination for "pure"
a.k.a. side-effect-free function calls, etc.).
Modified: pure/trunk/funcall.h
===================================================================
--- pure/trunk/funcall.h 2008-05-25 21:14:08 UTC (rev 136)
+++ pure/trunk/funcall.h 2008-05-26 20:25:34 UTC (rev 137)
@@ -81,3 +81,77 @@
assert(n <= MAXARGS && "funcall: function call exceeds maximum #args"); \
ret = 0; break; \
}
+
+/* Same as above, but with an extra environment parameter. */
+
+#define xfuncall(ret,fp,n,e,x) \
+ switch (n) { \
+ case 0: ret = ((pure_expr*(*)(uint32_t))fp)(e); break; \
+ case 1: ret = ((pure_expr*(*)(uint32_t,void*))fp)(e,x[0]); break; \
+ case 2: ret = ((pure_expr*(*)(uint32_t,void*,void*))fp)(e,x[0],x[1]); break; \
+ case 3: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*))fp)(e,x[0],x[1],x[2]); break; \
+ case 4: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3]); break; \
+ case 5: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4]); break; \
+ case 6: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5]); break; \
+ case 7: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6]); break; \
+ case 8: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7]); break; \
+ case 9: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8]); break; \
+ case 10: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9]); break; \
+ case 11: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10]); break; \
+ case 12: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11]); break; \
+ case 13: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12]); break; \
+ case 14: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13]); break; \
+ case 15: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14]); break; \
+ case 16: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15]); break; \
+ case 17: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16]); break; \
+ case 18: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17]); break; \
+ case 19: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18]); break; \
+ case 20: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19]); break; \
+ case 21: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20]); break; \
+ case 22: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21]); break; \
+ case 23: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22]); break; \
+ case 24: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23]); break; \
+ case 25: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24]); break; \
+ case 26: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25]); break; \
+ case 27: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26]); break; \
+ case 28: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27]); break; \
+ case 29: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28]); break; \
+ case 30: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29]); break; \
+ case 31: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30]); break; \
+ case 32: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31]); break; \
+ case 33: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32]); break; \
+ case 34: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33]); break; \
+ case 35: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34]); break; \
+ case 36: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35]); break; \
+ case 37: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36]); break; \
+ case 38: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37]); break; \
+ case 39: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38]); break; \
+ case 40: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39]); break; \
+ case 41: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40]); break; \
+ case 42: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41]); break; \
+ case 43: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42]); break; \
+ case 44: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43]); break; \
+ case 45: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44]); break; \
+ case 46: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45]); break; \
+ case 47: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46]); break; \
+ case 48: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47]); break; \
+ case 49: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48]); break; \
+ case 50: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49]); break; \
+ case 51: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50]); break; \
+ case 52: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51]); break; \
+ case 53: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52]); break; \
+ case 54: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53]); break; \
+ case 55: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54]); break; \
+ case 56: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55]); break; \
+ case 57: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56]); break; \
+ case 58: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57]); break; \
+ case 59: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58]); break; \
+ case 60: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59]); break; \
+ case 61: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60]); break; \
+ case 62: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60],x[61]); break; \
+ case 63: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60],x[61],x[62]); break; \
+ case 64: ret = ((pure_expr*(*)(uint32_t,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(e,x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60],x[61],x[62],x[63]); break; \
+ default: \
+ assert(n <= MAXARGS && "funcall: function call exceeds maximum #args"); \
+ ret = 0; break; \
+}
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-05-25 21:14:08 UTC (rev 136)
+++ pure/trunk/interpreter.cc 2008-05-26 20:25:34 UTC (rev 137)
@@ -55,7 +55,7 @@
stats(false), temp(0),
ps("> "), lib(""), histfile("/.pure_history"), modname("pure"),
nerrs(0), source_s(0), result(0), mem(0), exps(0), tmps(0),
- module(0), JIT(0), FPM(0), fptr(0), vptr(0)
+ module(0), JIT(0), FPM(0), fptr(0)
{
if (!g_interp) {
g_interp = this;
@@ -64,6 +64,7 @@
sstk_sz = 0; sstk_cap = 0x10000; // 64K
sstk = (pure_expr**)malloc(sstk_cap*sizeof(pure_expr*));
+ assert(sstk);
// Initialize the JIT.
@@ -187,6 +188,14 @@
StrExprPtrTy = PointerType::get(StrExprTy, 0);
PtrExprPtrTy = PointerType::get(PtrExprTy, 0);
+ sstkvar = new GlobalVariable
+ (ExprPtrPtrTy, false, GlobalVariable::InternalLinkage, 0, "$$sstk$$",
+ module);
+ JIT->addGlobalMapping(sstkvar, &sstk);
+ fptrvar = new GlobalVariable
+ (VoidPtrTy, false, GlobalVariable::InternalLinkage, 0, "$$fptr$$", module);
+ JIT->addGlobalMapping(fptrvar, &fptr);
+
// Add prototypes for the runtime interface and enter the corresponding
// function pointers into the runtime map.
@@ -207,9 +216,9 @@
declare_extern((void*)pure_double,
"pure_double", "expr*", 1, "double");
declare_extern((void*)pure_string_dup,
- "pure_string_dup", "expr*", 1, "char*");
+ "pure_string_dup", "expr*", 1, "char*");
declare_extern((void*)pure_cstring_dup,
- "pure_cstring_dup", "expr*", 1, "char*");
+ "pure_cstring_dup","expr*", 1, "char*");
declare_extern((void*)pure_pointer,
"pure_pointer", "expr*", 1, "void*");
declare_extern((void*)pure_apply,
@@ -221,13 +230,13 @@
"pure_cmp_string", "int", 2, "expr*", "char*");
declare_extern((void*)pure_get_cstring,
- "pure_get_cstring", "char*", 1, "expr*");
+ "pure_get_cstring", "char*", 1, "expr*");
declare_extern((void*)pure_free_cstrings,
- "pure_free_cstrings", "void", 0);
+ "pure_free_cstrings","void", 0);
declare_extern((void*)pure_get_bigint,
- "pure_get_bigint", "void*", 1, "expr*");
+ "pure_get_bigint", "void*", 1, "expr*");
declare_extern((void*)pure_get_long,
- "pure_get_long", "long", 1, "expr*");
+ "pure_get_long", "long", 1, "expr*");
declare_extern((void*)pure_catch,
"pure_catch", "expr*", 2, "expr*", "expr*");
@@ -251,18 +260,18 @@
"pure_free_args", "void", -2, "expr*", "int");
declare_extern((void*)pure_push_args,
- "pure_push_args", "void", -1, "int");
+ "pure_push_args", "int", -2, "int", "int");
declare_extern((void*)pure_pop_args,
- "pure_pop_args", "void", -2, "expr*", "int");
+ "pure_pop_args", "void", 3, "expr*", "int", "int");
declare_extern((void*)pure_pop_tail_args,
- "pure_pop_tail_args", "void", -2, "expr*", "int");
+ "pure_pop_tail_args","void", 3, "expr*", "int", "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*");
+ "pure_pop_arg", "void", 0);
declare_extern((void*)pure_pop_tail_arg,
- "pure_pop_tail_arg", "void", 1, "expr*");
+ "pure_pop_tail_arg", "void", 0);
declare_extern((void*)pure_debug,
"pure_debug", "void", -2, "int", "char*");
@@ -1588,7 +1597,7 @@
} else {
// uninitialized environment; simply copy everything
tag = e.tag; name = e.name; n = e.n; f = e.f; h = e.h; fp = e.fp;
- args = e.args; envs = e.envs; argv = e.argv;
+ args = e.args; envs = e.envs;
b = e.b; local = e.local; parent = e.parent;
}
fmap = e.fmap; fmap_idx = e.fmap_idx;
@@ -1628,7 +1637,7 @@
fp = 0;
// delete all nested environments and reinitialize other body-related data
fmap.clear(); fmap_idx = 0;
- xmap.clear(); xtab.clear(); prop.clear(); m = 0; argv = 0;
+ xmap.clear(); xtab.clear(); prop.clear(); m = 0;
// now that all references have been removed, delete the function pointers
for (list<Function*>::iterator fi = to_be_deleted.begin();
fi != to_be_deleted.end(); fi++) {
@@ -1693,11 +1702,19 @@
if (isa<CallInst>(it)) {
CallInst* c1 = cast<CallInst>(it);
if (c1->getCalledFunction() ==
- 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");
+ } else if (c1->getCalledFunction() ==
+ interp.module->getFunction("pure_push_args")) {
+ free_fun = interp.module->getFunction("pure_pop_tail_args");
+ free1_fun = interp.module->getFunction("pure_pop_tail_arg");
+ /* Patch up this call to correct the offset of the environment. */
+ CallInst *c2 = c1->clone();
+ c1->getParent()->getInstList().insert(c1, c2);
+ Value *v = BinaryOperator::createSub(c2, UInt(n+m+1), "", c1);
+ BasicBlock::iterator ii(c1);
+ ReplaceInstWithValue(c1->getParent()->getInstList(), ii, v);
}
}
}
@@ -1705,24 +1722,16 @@
}
// 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(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) {
+ new CallInst(free1_fun, "", pi);
+ else if (n+m != 0) {
+ vector<Value*> myargs;
if (pi == ret)
myargs.push_back(v);
else
myargs.push_back(ConstantPointerNull::get(interp.ExprPtrTy));
- myargs.push_back(UInt(n+m));
- for (size_t i = 0; i < n; i++)
- myargs.push_back(args[i]);
- for (size_t i = 0; i < m; i++) {
- Value *v = new GetElementPtrInst(envs, UInt(i), "", pi);
- myargs.push_back(new LoadInst(v, "", pi));
- }
+ myargs.push_back(UInt(n));
+ myargs.push_back(UInt(m));
new CallInst(free_fun, myargs.begin(), myargs.end(), "", pi);
if (pi == ret) {
Value *x[1] = { v };
@@ -2549,11 +2558,10 @@
// free arguments (we do that here so that the arguments don't get freed
// before we know that we don't need them anymore)
if (n > 0) {
- vector<Value*> freeargs(n+2);
+ vector<Value*> freeargs(3);
freeargs[0] = u;
freeargs[1] = UInt(n);
- for (size_t i = 0; i < n; i++)
- freeargs[i+2] = args[i];
+ freeargs[2] = Zero;
b.CreateCall(module->getFunction("pure_pop_args"),
freeargs.begin(), freeargs.end());
b.CreateCall(module->getFunction("pure_unref"), u);
@@ -2597,11 +2605,10 @@
Value *interpreter::envptr(Env *f)
{
- if (!fptr) return NullPtr;
- if (!vptr) vptr = new GlobalVariable
- (VoidPtrTy, false, GlobalVariable::InternalLinkage, 0, "$$fptr$$", module);
- JIT->updateGlobalMapping(vptr, &fptr);
- return act_builder().CreateLoad(vptr);
+ if (!fptr)
+ return NullPtr;
+ else
+ return act_builder().CreateLoad(fptrvar);
}
pure_expr *interpreter::doeval(expr x, pure_expr*& e)
@@ -3126,6 +3133,7 @@
else {
vector<Value*> argv1;
argv1.push_back(UInt(n));
+ argv1.push_back(Zero);
argv1.insert(argv1.end(), argv.begin(), argv.end());
act_env().CreateCall(module->getFunction("pure_push_args"), argv1);
}
@@ -3624,7 +3632,8 @@
{
// environment proxy
Env &e = act_env();
- return e.CreateLoadGEP(e.envs, UInt(v));
+ Value *sstkptr = e.builder.CreateLoad(sstkvar);
+ return e.CreateLoadGEP(sstkptr, e.builder.CreateAdd(e.envs, UInt(v)));
}
Value *interpreter::vref(int32_t tag, uint8_t idx, path p)
@@ -3694,28 +3703,22 @@
// direct call of a function, with parameters
assert(f.f);
size_t n = args.size(), m = env.size();
- // initialize the environment parameter
+ // count references to parameters and create the environment parameter
assert(f.local || m == 0);
- for (size_t i = 0; i < m; i++)
- e.builder.CreateStore(env[i], e.CreateGEP(e.argv, UInt(i)));
- // pass the environment as the first parameter, if applicable
- vector<Value*> x;
- if (f.local && m > 0) {
- if (m > e.l) e.l = m;
- x.push_back(e.argv);
- }
- // count references to parameters
+ Value *argv = 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.push_back(UInt(n));
+ args1.push_back(UInt(m));
args1.insert(args1.end(), args.begin(), args.end());
args1.insert(args1.end(), env.begin(), env.end());
- e.CreateCall(module->getFunction("pure_push_args"), args1);
+ argv = e.CreateCall(module->getFunction("pure_push_args"), args1);
}
+ // pass the environment as the first parameter, if applicable
+ vector<Value*> x;
+ if (m>0) x.push_back(argv);
// pass the function parameters
x.insert(x.end(), args.begin(), args.end());
// create the call
@@ -3989,7 +3992,7 @@
// argument types
vector<const Type*> argt(f.n, ExprPtrTy);
assert(f.m == 0 || f.local);
- if (f.m > 0) argt.insert(argt.begin(), ExprPtrPtrTy);
+ if (f.m > 0) argt.insert(argt.begin(), Type::Int32Ty);
// function type
FunctionType *ft = FunctionType::get(ExprPtrTy, argt, false);
/* Mangle local function names so that they're easier to identify; as a
@@ -4025,14 +4028,7 @@
f.tag == 0 || symtab.sym(f.tag).prec < 10)
scope = Function::InternalLinkage;
#if USE_FASTCC
- /* Currently we only allow fastcc (and thus tail call elimination) if the
- function takes no environment. This is because the passed environment
- is allocated on the caller's stack, so we can't do a tail call in this
- case. It would be possible to also optimize the case of a local
- function with environment which just calls itself directly (passing
- through the environment), but currently we don't keep track of such
- situations and thus this optimization isn't implemented yet. */
- if (!name.empty() && f.m == 0) cc = CallingConv::Fast;
+ if (!name.empty()) cc = CallingConv::Fast;
#endif
/* Mangle the name of the C-callable wrapper if it would shadow another C
function. */
@@ -4094,10 +4090,6 @@
msg << "entry " << f.name;
debug(msg.str().c_str()); }
#endif
- // Allocate an array to be filled with environment values passed in
- // parameterless function calls. NOTE: This needs to be patched up when
- // finalizing the function body, as we don't know the needed size yet.
- f.argv = f.builder.CreateAlloca(ExprPtrTy, /*UInt(f.l)*/0, "argv");
// return the function just created
return f.f;
}
@@ -4141,8 +4133,9 @@
// failed match is non-fatal, instead we return a "thunk" (literal fbox)
// of ourself applied to our arguments as the result
vector<Value*> x(f.m);
+ Value *sstkptr = f.builder.CreateLoad(sstkvar);
for (size_t i = 0; i < f.m; i++) {
- x[i] = f.CreateLoadGEP(f.envs, UInt(i));
+ x[i] = f.CreateLoadGEP(sstkptr, f.builder.CreateAdd(f.envs, UInt(i)));
assert(x[i]->getType() == ExprPtrTy);
}
if (f.m == 1)
@@ -4169,16 +4162,6 @@
{
Env& f = act_env();
assert(f.f!=0);
- // Now that all locals have been processed, we need to patch up the alloca
- // for the environment vector used as temporary storage in parameterless
- // function calls.
- BasicBlock::iterator ii(f.argv);
- if (f.l == 0)
- ReplaceInstWithValue(f.argv->getParent()->getInstList(), ii,
- NullExprPtrPtr);
- else
- ReplaceInstWithInst(f.argv->getParent()->getInstList(), ii,
- new AllocaInst(ExprPtrTy, UInt(f.l), "argv"));
// validate the generated code, checking for consistency
verifyFunction(*f.f);
// optimize
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-05-25 21:14:08 UTC (rev 136)
+++ pure/trunk/interpreter.hh 2008-05-26 20:25:34 UTC (rev 137)
@@ -92,9 +92,8 @@
// function environment
int32_t tag; // function id, zero for anonymous functions
string name; // LLVM assembly function name
- // n = #function args, m = #extra args (captured environment), l = max
- // environment size in fbox call
- uint32_t n, m, l;
+ // n = #function args, m = #extra args (captured environment)
+ uint32_t n, m;
// f = the (internal) LLVM function, h = the C-callable stub (if needed)
llvm::Function *f, *h;
// fp = pointer to the JITed function (executable code)
@@ -103,8 +102,6 @@
vector<llvm::Value*> args;
// environment pointer (expr**)
llvm::Value *envs;
- // storage for passed environment vectors
- llvm::AllocaInst* argv;
// mapping of captured variables to the corresponding locals
map<xmap_key,uint32_t > xmap;
// info about captured variables
@@ -164,12 +161,12 @@
llvm::ReturnInst *CreateRet(llvm::Value *v);
// default constructor
Env()
- : tag(0), n(0), m(0), l(0), f(0), h(0), fp(0), args(0), envs(0), argv(0),
+ : tag(0), n(0), m(0), f(0), h(0), fp(0), args(0), envs(0),
fmap(1), fmap_idx(0), b(false), local(false), parent(0), refc(0) {}
// environment for an anonymous closure with given body x
Env(int32_t _tag, uint32_t _n, expr x, bool _b, bool _local = false)
- : tag(_tag), n(_n), m(0), l(0), f(0), h(0), fp(0), args(n), envs(0),
- argv(0), fmap(1), fmap_idx(0), b(_b), local(_local), parent(0), refc(0)
+ : tag(_tag), n(_n), m(0), f(0), h(0), fp(0), args(n), envs(0),
+ fmap(1), fmap_idx(0), b(_b), local(_local), parent(0), refc(0)
{
if (envstk.empty()) {
assert(!local);
@@ -182,8 +179,8 @@
}
// environment for a named closure with given definition info
Env(int32_t _tag, const env_info& info, bool _b, bool _local = false)
- : tag(_tag), n(info.argc), m(0), l(0), f(0), h(0), fp(0), args(n), envs(0),
- argv(0), fmap(1), fmap_idx(0), b(_b), local(_local), parent(0), refc(0)
+ : tag(_tag), n(info.argc), m(0), f(0), h(0), fp(0), args(n), envs(0),
+ fmap(1), fmap_idx(0), b(_b), local(_local), parent(0), refc(0)
{
if (envstk.empty()) {
assert(!local);
@@ -393,6 +390,7 @@
map<int32_t,Env> globalfuns;
list<pure_exception> estk;
pure_expr** sstk; size_t sstk_cap, sstk_sz;
+ llvm::GlobalVariable *sstkvar;
#if DEBUG
set<pure_expr*> mem_allocations;
#endif
@@ -405,7 +403,7 @@
string asname = "");
private:
Env *fptr;
- llvm::GlobalVariable *vptr;
+ llvm::GlobalVariable *fptrvar;
llvm::Value *envptr(Env *f);
EnvStack envstk;
void push(const char *msg, Env *e);
Modified: pure/trunk/pure.1
===================================================================
--- pure/trunk/pure.1 2008-05-25 21:14:08 UTC (rev 136)
+++ pure/trunk/pure.1 2008-05-26 20:25:34 UTC (rev 137)
@@ -1092,33 +1092,23 @@
Fortunately, Pure normally does proper tail calls (if LLVM provides that
feature on the platform at hand), so most tail-recursive definitions should
work fine in limited stack space. For instance, the following little program
-should loop forever if your platform supports the required optimizations:
+will loop forever if your platform supports the required optimizations:
.sp
.nf
loop = loop;
.fi
.PP
-The current tail call implementation appears to work fairly well in practice,
-but it has a few quirks which are discussed in the following. Most notably, a
-tail call will be eliminated \fIonly\fP if the call is done \fIdirectly\fP,
-i.e., through an explicit call, not through a (global or local) function
-variable. Otherwise the call will be handled by the runtime system which is
-written in C and can't do proper tail calls because C can't (at least not in a
-portable way).
-.PP
-This also affects mutually recursive global function calls, since there the
-calls are handled in an indirect way, too, through an anonymous global
-variable. (This is done so that a global function definition can be changed at
-any time during an interactive session, without having to recompile the entire
-program.) However, mutual tail recursion does work with \fIlocal\fP functions,
-so it's easy to work around this limitation.
-.PP
-Alas, with local functions there's another restriction, namely that a local
-function can be tail-called \fIonly\fP if it does \fInot\fP use its
-environment. That's because in the current implementation the implicit
-environment parameter is created on the caller's stack. Hence, to get proper
-tail recursion with local functions, you \fImust\fP pass all data needed by
-the function as parameters (which can usually be achieved quite easily).
+In the current implementation, a tail call will be eliminated \fIonly\fP if
+the call is done \fIdirectly\fP, i.e., through an explicit call, not through a
+(global or local) function variable. Otherwise the call will be handled by the
+runtime system which is written in C and can't do proper tail calls because C
+can't (at least not in a portable way). This also affects mutually recursive
+global function calls, since there the calls are handled in an indirect way,
+too, through an anonymous global variable. (This is done so that a global
+function definition can be changed at any time during an interactive session,
+without having to recompile the entire program.) However, mutual tail
+recursion does work with \fIlocal\fP functions, so it's easy to work around
+this limitation.
.SH FILES
.TP
.B ~/.pure_history
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-05-25 21:14:08 UTC (rev 136)
+++ pure/trunk/runtime.cc 2008-05-26 20:25:34 UTC (rev 137)
@@ -65,19 +65,13 @@
#define MEMDEBUG_SUMMARY(ret)
#endif
-// Debug shadow stack manipulations. SSTK_DEBUG=1 adds special code to verify
-// the integrity of the shadow stack, any level >1 also prints pushes and pops
-// of stack frames. NOTE: Enabling this code slows down the interpreter, and
-// generates *lots* of debugging output for level >1.
+// Debug shadow stack manipulations. Prints pushes and pops of stack frames.
+// NOTE: Enabling this code generates *lots* of debugging output.
#if DEBUG>2
-#define SSTK_DEBUG 2
-#else
-#if DEBUG>1
#define SSTK_DEBUG 1
#else
#define SSTK_DEBUG 0
#endif
-#endif
// Expression pointers are allocated in larger chunks for better performance.
// NOTE: Only internal fields get initialized by new_expr(), the remaining
@@ -555,51 +549,43 @@
assert(x && y && x->refc > 0 && y->refc > 0);
// travel down the spine, count arguments
pure_expr *f = x, *f0, *ret;
- uint32_t n = 0;
+ uint32_t n = 1;
while (f->tag == EXPR::APP) { f = f->data.x[0]; n++; }
f0 = f;
if (f->tag >= 0 && f->data.clos && !f->data.clos->thunked &&
- f->data.clos->n == n+1) {
+ f->data.clos->n == n) {
// saturated call; execute it now
interpreter& interp = *interpreter::g_interp;
void *fp = f->data.clos->fp;
- size_t i = 0, m = f->data.clos->m, k = n+1+(m>0?1:0);
- assert(k <= MAXARGS && "pure_apply: function call exceeds maximum #args");
- void **argv = (void**)alloca(k*sizeof(void*));
+ size_t m = f->data.clos->m;
+ uint32_t env = 0;
+ void **argv = (void**)alloca(n*sizeof(void*));
assert(argv && "pure_apply: stack overflow");
+ assert(n <= MAXARGS && "pure_apply: function call exceeds maximum #args");
assert(f->data.clos->local || m == 0);
- pure_expr **env = 0;
- if (f->data.clos->local && m>0) {
- // add implicit environment parameter
- env = (pure_expr**)alloca(m*sizeof(pure_expr*));
- assert(env && "pure_apply: stack overflow");
- argv[i++] = env;
- for (size_t j = 0; j < m; j++) {
- assert(f->data.clos->env[j]->refc > 0);
- env[j] = f->data.clos->env[j]; env[j]->refc++;
- }
- }
// collect arguments
f = x;
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++;
+ argv[n-1-j] = f->data.x[1]; f->data.x[1]->refc++;
}
- i += n; argv[i++] = y;
- assert(i == k);
+ argv[n-1] = y;
// make sure that we do not gc the function before calling it
f0->refc++; pure_free_internal(x);
// construct a stack frame
{
size_t sz = interp.sstk_sz;
- assert(k == n+1+(env?1:0));
- resize_sstk(interp.sstk, interp.sstk_cap, sz, n+m+2);
- pure_expr** sstk = interp.sstk;
+ resize_sstk(interp.sstk, interp.sstk_cap, sz, n+m+1);
+ pure_expr **sstk = interp.sstk;
+ if (m>0) env = sz+n+1;
sstk[sz++] = 0;
- for (size_t j = env?1:0; j < k; j++)
+ for (size_t j = 0; j < n; j++)
sstk[sz++] = (pure_expr*)argv[j];
- if (env) for (size_t j = 0; j < m; j++)
- sstk[sz++] = env[j];
+ for (size_t j = 0; j < m; j++) {
+ sstk[sz++] = f0->data.clos->env[j];
+ assert(f0->data.clos->env[j]->refc > 0);
+ f0->data.clos->env[j]->refc++;
+ }
#if SSTK_DEBUG>1
cerr << "++ stack: (sz = " << sz << ")\n";
for (size_t i = 0; i < sz; i++) {
@@ -617,7 +603,10 @@
cerr << "pure_apply: calling " << x << " (" << y << ") -> " << fp << endl;
#endif
checkstk(test);
- funcall(ret, fp, k, argv);
+ if (m>0)
+ xfuncall(ret, fp, n, env, argv)
+ else
+ funcall(ret, fp, n, argv)
pure_free_internal(f0);
return ret;
} else {
@@ -657,22 +646,18 @@
#endif
assert(h->refc > 0 && x->refc > 0);
size_t m = x->data.clos->m;
+ assert(x->data.clos->local || m == 0);
pure_expr **env = 0;
- if (x->data.clos->local && m>0) {
- // add implicit environment parameter
- env = (pure_expr**)alloca(m*sizeof(pure_expr*));
- assert(env && "pure_catch: stack overflow");
- for (size_t i = 0; i < m; i++) {
- assert(x->data.clos->env[i]->refc > 0);
- env[i] = x->data.clos->env[i]; env[i]->refc++;
- }
+ if (m>0) {
// construct a stack frame
size_t sz = interp.sstk_sz;;
resize_sstk(interp.sstk, interp.sstk_cap, sz, m+1);
- pure_expr** sstk = interp.sstk;
+ pure_expr **sstk = interp.sstk; env = sstk+sz+1;
sstk[sz++] = 0;
- for (size_t i = 0; i < m; i++)
- sstk[sz++] = env[i];
+ for (size_t j = 0; j < m; j++) {
+ sstk[sz++] = x->data.clos->env[j];
+ assert(env[j]->refc > 0); env[j]->refc++;
+ }
#if SSTK_DEBUG>1
cerr << "++ stack: (sz = " << sz << ")\n";
for (size_t i = 0; i < sz; i++) {
@@ -725,7 +710,7 @@
pure_expr *res;
if (env)
// pass environment
- res = ((pure_expr*(*)(void*))fp)(env);
+ res = ((pure_expr*(*)(uint32_t))fp)(env-interp.sstk);
else
// parameterless call
res = ((pure_expr*(*)())fp)();
@@ -868,17 +853,17 @@
}
extern "C"
-void pure_push_args(uint32_t n, ...)
+uint32_t pure_push_args(uint32_t n, uint32_t m, ...)
{
va_list ap;
interpreter& interp = *interpreter::g_interp;
size_t sz = interp.sstk_sz;
- resize_sstk(interp.sstk, interp.sstk_cap, sz, n+1);
- pure_expr** sstk = interp.sstk;
+ resize_sstk(interp.sstk, interp.sstk_cap, sz, n+m+1);
+ pure_expr **sstk = interp.sstk; uint32_t env = (m>0)?sz+n+1:0;
// mark the beginning of this frame
sstk[sz++] = 0;
- va_start(ap, n);
- while (n-- > 0) {
+ va_start(ap, m);
+ for (size_t i = 0; i < n+m; i++) {
pure_expr *x = va_arg(ap, pure_expr*);
sstk[sz++] = x;
if (x->refc > 0)
@@ -887,7 +872,7 @@
pure_new_internal(x);
};
va_end(ap);
-#if SSTK_DEBUG>1
+#if SSTK_DEBUG
cerr << "++ stack: (sz = " << sz << ")\n";
for (size_t i = 0; i < sz; i++) {
pure_expr *x = sstk[i];
@@ -899,33 +884,22 @@
}
#endif
interp.sstk_sz = sz;
+ // return a pointer to the environment:
+ return env;
}
extern "C"
-void pure_pop_args(pure_expr *x, uint32_t n, ...)
+void pure_pop_args(pure_expr *x, uint32_t n, uint32_t m)
{
- va_list ap;
interpreter& interp = *interpreter::g_interp;
-#if SSTK_DEBUG
pure_expr **sstk = interp.sstk;
- pure_expr **y = (pure_expr**)alloca(n*sizeof(pure_expr*));
- size_t i, sz = interp.sstk_sz, oldsz = sz;
- while (sz > 0 && sstk[--sz]) ;
+ size_t sz = interp.sstk_sz;
+#if !defined(NDEBUG) || SSTK_DEBUG
+ size_t oldsz = sz;
+#endif
+ sz -= n+m+1;
assert(sz < oldsz && !sstk[sz]);
- if (x) x->refc++;
- va_start(ap, n);
- for (i = 0; i < n; i++) {
- pure_expr *x = va_arg(ap, pure_expr*);
- y[i] = x;
- };
- va_end(ap);
- if (oldsz-sz-1 != n) goto error;
- for (i = 0; i < n; i++) {
- pure_expr *x = y[i];
- if (sstk[sz+i+1] != x) goto error;
- }
- interp.sstk_sz = sz;
-#if SSTK_DEBUG>1
+#if SSTK_DEBUG
cerr << "++ stack: (oldsz = " << oldsz << ")\n";
for (size_t i = 0; i < oldsz; i++) {
pure_expr *x = sstk[i];
@@ -936,74 +910,29 @@
cerr << i << ": " << "** frame **\n";
}
#endif
- for (size_t i = 0; i < n; i++) {
- pure_expr *x = y[i];
- if (x->refc > 1)
- x->refc--;
- else
- pure_free_internal(x);
- }
- return;
- error:
- cerr << "ERROR: can't find stack frame to be popped.\n";
- cerr << "++ stack: (oldsz = " << oldsz << ")\n";
- for (size_t i = 0; i < oldsz; i++) {
- pure_expr *x = sstk[i];
- if (x)
- cerr << i << ": " << (void*)x << ": " << x << endl;
- else
- cerr << i << ": " << "** frame **\n";
- }
- cerr << "++ pop:\n";
- for (size_t i = 0; i < n; i++) {
- pure_expr *x = y[i];
- cerr << i << ": " << (void*)x << ": " << x << endl;
- }
- abort();
-#else
- // This doesn't verify the integrity of the shadow stack and is *much*
- // faster.
- interp.sstk_sz -= n+1;
if (x) x->refc++;
- va_start(ap, n);
- while (n-- > 0) {
- pure_expr *x = va_arg(ap, pure_expr*);
+ for (size_t i = 0; i < n+m; i++) {
+ pure_expr *x = sstk[sz+1+i];
+ assert(x);
if (x->refc > 1)
x->refc--;
else
pure_free_internal(x);
};
- va_end(ap);
-#endif
+ interp.sstk_sz = sz;
}
extern "C"
-void pure_pop_tail_args(pure_expr *x, uint32_t n, ...)
+void pure_pop_tail_args(pure_expr *x, uint32_t n, uint32_t m)
{
- va_list ap;
interpreter& interp = *interpreter::g_interp;
-#if SSTK_DEBUG
pure_expr **sstk = interp.sstk;
- pure_expr **y = (pure_expr**)alloca(n*sizeof(pure_expr*));
- size_t i, sz = interp.sstk_sz, lastsz, oldsz = sz;
- while (sz > 0 && sstk[--sz]) ;
- assert(sz < oldsz && !sstk[sz]);
- lastsz = sz;
- while (sz > 0 && sstk[--sz]) ;
+ size_t sz, lastsz = interp.sstk_sz, oldsz = lastsz;
+ while (lastsz > 0 && sstk[--lastsz]) ;
+ assert(lastsz < oldsz && !sstk[lastsz]);
+ sz = lastsz-(n+m+1);
assert(sz < lastsz && !sstk[sz]);
- if (x) x->refc++;
- va_start(ap, n);
- for (i = 0; i < n; i++) {
- pure_expr *x = va_arg(ap, pure_expr*);
- y[i] = x;
- };
- va_end(ap);
- if (lastsz-sz-1 != n) goto error;
- for (i = 0; i < n; i++) {
- pure_expr *x = y[i];
- if (sstk[sz+i+1] != x) goto error;
- }
-#if SSTK_DEBUG>1
+#if SSTK_DEBUG
cerr << "++ stack: (oldsz = " << oldsz << ", lastsz = " << lastsz << ")\n";
for (size_t i = 0; i < oldsz; i++) {
pure_expr *x = sstk[i];
@@ -1015,62 +944,17 @@
cerr << i << ": " << "** frame **\n";
}
#endif
- memmove(sstk+sz, sstk+lastsz, (oldsz-lastsz)*sizeof(pure_expr*));
- oldsz -= n+1;
- interp.sstk_sz = oldsz;
-#if SSTK_DEBUG>1
- cerr << "++ new stack: (newsz = " << oldsz << ")\n";
- for (size_t i = 0; i < oldsz; i++) {
- pure_expr *x = sstk[i];
- if (x)
- cerr << i << ": " << (void*)x << ": " << x << endl;
- else
- cerr << i << ": " << "** frame **\n";
- }
-#endif
- for (size_t i = 0; i < n; i++) {
- pure_expr *x = y[i];
- if (x->refc > 1)
- x->refc--;
- else
- pure_free_internal(x);
- }
- return;
- error:
- cerr << "ERROR: can't find stack frame to be popped.\n";
- cerr << "++ stack: (oldsz = " << oldsz << ", lastsz = " << lastsz << ")\n";
- for (size_t i = 0; i < oldsz; i++) {
- pure_expr *x = sstk[i];
- if (x)
- cerr << i << ": " << (void*)x << ": " << x << endl;
- else
- cerr << i << ": " << "** frame **\n";
- }
- cerr << "++ pop:\n";
- for (size_t i = 0; i < n; i++) {
- pure_expr *x = y[i];
- cerr << i << ": " << (void*)x << ": " << x << endl;
- }
- abort();
-#else
- // This doesn't verify the integrity of the shadow stack and is *much*
- // faster.
- pure_expr **sstk = interp.sstk;
- size_t lastsz = interp.sstk_sz, oldsz = lastsz;
- while (lastsz > 0 && sstk[--lastsz]) ;
- memmove(sstk+lastsz-n-1, sstk+lastsz, (oldsz-lastsz)*sizeof(pure_expr*));
- interp.sstk_sz -= n+1;
if (x) x->refc++;
- va_start(ap, n);
- while (n-- > 0) {
- pure_expr *x = va_arg(ap, pure_expr*);
+ for (size_t i = 0; i < n+m; i++) {
+ pure_expr *x = sstk[sz+1+i];
+ assert(x);
if (x->refc > 1)
x->refc--;
else
pure_free_internal(x);
};
- va_end(ap);
-#endif
+ memmove(sstk+sz, sstk+lastsz, (oldsz-lastsz)*sizeof(pure_expr*));
+ interp.sstk_sz -= n+m+1;
}
extern "C"
@@ -1100,36 +984,38 @@
}
extern "C"
-void pure_pop_arg(pure_expr *x)
+void pure_pop_arg()
{
#if SSTK_DEBUG
- pure_pop_args(0, 1, x);
+ pure_pop_args(0, 1, 0);
#else
interpreter& interp = *interpreter::g_interp;
- interp.sstk_sz -= 2;
+ pure_expr *x = interp.sstk[interp.sstk_sz-1];
if (x->refc > 1)
x->refc--;
else
pure_free_internal(x);
+ interp.sstk_sz -= 2;
#endif
}
extern "C"
-void pure_pop_tail_arg(pure_expr *x)
+void pure_pop_tail_arg()
{
#if SSTK_DEBUG
- pure_pop_tail_args(0, 1, x);
+ pure_pop_tail_args(0, 1, 0);...
[truncated message content] |
|
From: <ag...@us...> - 2008-05-25 21:14:04
|
Revision: 136
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=136&view=rev
Author: agraef
Date: 2008-05-25 14:14:08 -0700 (Sun, 25 May 2008)
Log Message:
-----------
Rewrite prelude operations to make them tail-recursive.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/prelude.pure
pure/trunk/test/prelude.log
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-05-25 16:01:10 UTC (rev 135)
+++ pure/trunk/ChangeLog 2008-05-25 21:14:08 UTC (rev 136)
@@ -1,5 +1,8 @@
2008-05-25 Albert Graef <Dr....@t-...>
+ * lib/prelude.pure: Rewrite prelude operations to make them
+ tail-recursive.
+
* interpreter.cc, runtime.cc: Add marshalling between long (64
bit) ints and Pure bigints in the C interface. This means that
both Pure ints and bigints can now be passed for 'long' arguments
@@ -9,8 +12,6 @@
as results can now be called from Pure without loosing bits due to
truncation.
- * lib/prelude.pure: Make 'all' and 'any' tail-recursive.
-
* interpreter.cc: Make toplevel if-then-else properly
tail-recursive. Thus, e.g., the following function will now run in
constant stack space: count x = if x<=0 then x else count (x-1);
Modified: pure/trunk/lib/prelude.pure
===================================================================
--- pure/trunk/lib/prelude.pure 2008-05-25 16:01:10 UTC (rev 135)
+++ pure/trunk/lib/prelude.pure 2008-05-25 21:14:08 UTC (rev 136)
@@ -77,9 +77,14 @@
/* Poor man's tuples(TM). These are constructed with the pairing operator ',',
are always flat and associate to the right. The empty tuple, denoted (), is
neutral with respect to ','. Operations are provided to test for equality/
- inequality and emptiness, to determine the size of a tuple, and for
- zero-based indexing. */
+ inequality and emptiness, to determine the size of a tuple, for zero-based
+ indexing, and to reverse a tuple. */
+/* Note: Some of these definitions aren't exactly pretty. They are what they
+ are because they are the most efficient (at least asymptotically). In
+ particular, we strive for tail-recursive and constant or linear-time
+ implementations where this is feasible. */
+
x,() = x;
(),y = y;
(x,y),z = x,(y,z);
@@ -87,64 +92,94 @@
()==() = 1;
(x,xs)==() = 0;
()==(x,xs) = 0;
-(x,xs)==(y,ys) = x==y && xs==ys;
+(x,xs)==(y,ys) = if x==y then xs==ys else 0;
()!=() = 0;
(x,xs)!=() = 1;
()!=(x,xs) = 1;
-(x,xs)!=(y,ys) = x!=y || xs!=ys;
+(x,xs)!=(y,ys) = if x!=y then 1 else xs!=ys;
null () = 1;
null (x,xs) = 0;
#() = 0;
-#(x,y,xs) = 1+#(y,xs);
-#(x,y) = 2 otherwise;
+#(x,xs) = accum 1 xs with
+ accum n::int (x,xs) = accum (n+1) xs;
+ accum n::int x = n+1;
+end;
(x,xs)!0 = x;
(x,y,xs)!n::int = (y,xs)!(n-1) if n>0;
(x,y)!1 = y;
+reverse () = ();
+reverse (x,xs) = accum x xs with
+ accum ys (x,xs) = accum (x,ys) xs;
+ accum ys x = x,ys;
+end;
+
/* Lists are the usual "conses" written using the infix ':' operator. '[]'
denotes the empty list. Moreover, the parser provides the customary sugar
for proper list values [x] where x is any singleton or tuple (in the latter
case you'll get a list made from all the elements of x). The usual basic
operations are provided to test for equality/inequality and emptiness, to
- compute the size of a list, and for indexing and concatenation. We also
- provide two frequently used operations to reverse a list and to concatenate
- a list of lists. */
+ compute the size of a list, for indexing and concatenation, and for
+ reversing a list. */
+/* Note: Some list operations throw a 'bad_list_value xs' exception if their
+ argument is not a "proper" list (i.e., ending in []). In this case xs
+ denotes the offending tail of the list. */
+
[]==[] = 1;
(x:xs)==[] = 0;
[]==(x:xs) = 0;
-(x:xs)==(y:ys) = x==y && xs==ys;
+(x:xs)==(y:ys) = if x==y then xs==ys else 1;
[]!=[] = 0;
(x:xs)!=[] = 1;
[]!=(x:xs) = 1;
-(x:xs)!=(y:ys) = x!=y || xs!=ys;
+(x:xs)!=(y:ys) = if x!=y then 1 else xs!=ys;
null [] = 1;
null (x:xs) = 0;
#[] = 0;
-#(x:xs) = 1+#xs;
+#(x:xs) = accum 1 xs with
+ accum n::int (x:xs) = accum (n+1) xs;
+ accum n::int [] = n;
+ accum _ xs = throw (bad_list_value xs);
+end;
(x:xs)!0 = x;
(x:xs)!n::int = xs!(n-1) if n>0;
[]+ys = ys;
-(x:xs)+ys = x:xs+ys;
+(x:xs)+ys = x : accum ys (reverse xs) with
+ accum ys (x:xs) = accum (x:ys) xs;
+ accum ys [] = ys;
+end;
+reverse [] = [];
+reverse (x:xs) = accum [x] xs with
+ accum ys (x:xs) = accum (x:ys) xs;
+ accum ys [] = ys;
+ accum _ xs = throw (bad_list_value xs);
+end;
+
/* Convert between lists and tuples. */
list () = [];
-list (x,y,xs) = x:list (y,xs);
-list (x,y) = [x,y];
+list (x,xs) = accum [x] xs with
+ accum ys (x,xs) = accum (x:ys) xs;
+ accum ys x = reverse (x:ys);
+end;
tuple [] = ();
-tuple [x] = x;
-tuple (x:y:xs) = x,tuple (y:xs);
+tuple (x:xs) = accum x xs with
+ accum ys (x:xs) = accum (x,ys) xs;
+ accum ys [] = if tuplep ys then reverse ys else ys;
+ accum _ xs = throw (bad_list_value xs);
+end;
/* Slicing. xs!ns returns the list of xs!n for all members n of the index list
ns which are in the range 0..#xs-1. This works on any data structure with
@@ -152,12 +187,11 @@
structures defined above. */
xs![] = [];
-xs!(n::int:ns) = slice xs (n:ns) with
- slice xs [] = [];
- slice xs (n::int:ns)
- = xs!n:slice xs ns if n>=0 && n<m;
- = xs!ns otherwise;
- end when m::int = #xs end;
+xs!(n:ns) = accum [] xs (reverse (n:ns)) (#xs) with
+ accum ys xs [] m = ys;
+ accum ys xs (n::int:ns) m = accum (xs!n:ys) xs ns m if n>=0 && n<m;
+ = accum ys xs ns m otherwise;
+end;
/* Arithmetic sequences. */
@@ -245,41 +279,46 @@
= x:takewhile p xs if p x;
= [] otherwise;
-/* Concatenate a list of lists in both linear time and constant space. */
+/* Concatenate a list of lists. */
cat [] = [];
cat (xs:xss) = accum (reverse xs) xss with
accum xs [] = reverse xs;
accum xs ([]:yss) = accum xs yss;
accum xs ((y:ys):yss) = accum (y:xs) (ys:yss);
- accum xs yss = reverse xs+cat yss otherwise;
-end if listp xs;
+ accum _ (ys:_) = throw (bad_list_value ys);
+ accum _ yss = throw (bad_list_value yss);
+end;
/* Combine cat and map. This is used by list comprehensions. */
catmap f xs = cat (map f xs);
-/* Reverse a list (must be a proper list). */
-
-reverse xs = foldl (flip (:)) [] xs if listp xs;
-
/* Some useful list generators. */
-repeat n x = [] if n<=0;
- = x:repeat (n-1) x otherwise;
+repeat n::int x = accum [] n x with
+ accum xs n::int x = xs if n<=0;
+ = accum (x:xs) (n-1) x;
+end;
-cycle n [] = [];
-cycle n (x:xs) = [] if n<=0;
- = mkcycle n xs with
- mkcycle n xs = take n xs if n<=m;
- = xs+mkcycle (n-m) xs otherwise;
- end when xs = x:xs; m = #xs end;
+cycle n::int [] = [];
+cycle n::int (x:xs)
+ = [] if n<=0;
+ = accum [] (#xs) n xs with
+ accum ys m::int n::int xs
+ = cat ys+take n xs if n<=m;
+ = accum (xs:ys) m (n-m) xs otherwise;
+ end when xs = x:xs end;
-while p f a = a:while p f (f a) if p a;
- = [] otherwise;
+while p f a = accum [] p f a with
+ accum as p f a = accum (a:as) p f (f a) if p a;
+ = reverse as otherwise;
+ end;
-until p f a = [] if p a;
- = a:until p f (f a) otherwise;
+until p f a = accum [] p f a with
+ accum as p f a = reverse as if p a;
+ = accum (a:as) p f (f a) otherwise;
+ end;
/* zip, unzip and friends. */
Modified: pure/trunk/test/prelude.log
===================================================================
--- pure/trunk/test/prelude.log 2008-05-25 16:01:10 UTC (rev 135)
+++ pure/trunk/test/prelude.log 2008-05-25 21:14:08 UTC (rev 136)
@@ -334,66 +334,267 @@
()==() = 1;
(x/*0:0101*/,xs/*0:011*/)==() = 0;
()==(x/*0:101*/,xs/*0:11*/) = 0;
-(x/*0:0101*/,xs/*0:011*/)==(y/*0:101*/,ys/*0:11*/) = x/*0:0101*/==y/*0:101*/&&xs/*0:011*/==ys/*0:11*/;
+(x/*0:0101*/,xs/*0:011*/)==(y/*0:101*/,ys/*0:11*/) = if x/*0:0101*/==y/*0:101*/ then xs/*0:011*/==ys/*0:11*/ else 0;
()!=() = 0;
(x/*0:0101*/,xs/*0:011*/)!=() = 1;
()!=(x/*0:101*/,xs/*0:11*/) = 1;
-(x/*0:0101*/,xs/*0:011*/)!=(y/*0:101*/,ys/*0:11*/) = x/*0:0101*/!=y/*0:101*/||xs/*0:011*/!=ys/*0:11*/;
+(x/*0:0101*/,xs/*0:011*/)!=(y/*0:101*/,ys/*0:11*/) = if x/*0:0101*/!=y/*0:101*/ then 1 else xs/*0:011*/!=ys/*0:11*/;
null () = 1;
null (x/*0:101*/,xs/*0:11*/) = 0;
#() = 0;
-#(x/*0:101*/,y/*0:1101*/,xs/*0:111*/) = 1+#(y/*0:1101*/,xs/*0:111*/);
-#(x/*0:101*/,y/*0:11*/) = 2;
+#(x/*0:101*/,xs/*0:11*/) = accum/*0*/ 1 xs/*0:11*/ with accum n/*0:01*/::int (x/*0:101*/,xs/*0:11*/) = accum/*1*/ (n/*0:01*/+1) xs/*0:11*/; accum n/*0:01*/::int x/*0:1*/ = n/*0:01*/+1 {
+ rule #0: accum n::int (x,xs) = accum (n+1) xs
+ rule #1: accum n::int x = n+1
+ state 0: #0 #1
+ <var>::int state 1
+ state 1: #0 #1
+ <var> state 2
+ <app> state 3
+ state 2: #1
+ state 3: #0 #1
+ <var> state 4
+ <app> state 6
+ state 4: #1
+ <var> state 5
+ state 5: #1
+ state 6: #0 #1
+ <var> state 7
+ , state 10
+ state 7: #1
+ <var> state 8
+ state 8: #1
+ <var> state 9
+ state 9: #1
+ state 10: #0 #1
+ <var> state 11
+ state 11: #0 #1
+ <var> state 12
+ state 12: #0 #1
+} end;
(x/*0:0101*/,xs/*0:011*/)!0 = x/*0:0101*/;
(x/*0:0101*/,y/*0:01101*/,xs/*0:0111*/)!n/*0:1*/::int = (y/*0:01101*/,xs/*0:0111*/)!(n/*0:1*/-1) if n/*0:1*/>0;
(x/*0:0101*/,y/*0:011*/)!1 = y/*0:011*/;
+reverse () = ();
+reverse (x/*0:101*/,xs/*0:11*/) = accum/*0*/ x/*0:101*/ xs/*0:11*/ with accum ys/*0:01*/ (x/*0:101*/,xs/*0:11*/) = accum/*1*/ (x/*0:101*/,ys/*0:01*/) xs/*0:11*/; accum ys/*0:01*/ x/*0:1*/ = x/*0:1*/,ys/*0:01*/ {
+ rule #0: accum ys (x,xs) = accum (x,ys) xs
+ rule #1: accum ys x = x,ys
+ state 0: #0 #1
+ <var> state 1
+ state 1: #0 #1
+ <var> state 2
+ <app> state 3
+ state 2: #1
+ state 3: #0 #1
+ <var> state 4
+ <app> state 6
+ state 4: #1
+ <var> state 5
+ state 5: #1
+ state 6: #0 #1
+ <var> state 7
+ , state 10
+ state 7: #1
+ <var> state 8
+ state 8: #1
+ <var> state 9
+ state 9: #1
+ state 10: #0 #1
+ <var> state 11
+ state 11: #0 #1
+ <var> state 12
+ state 12: #0 #1
+} end;
[]==[] = 1;
x/*0:0101*/:xs/*0:011*/==[] = 0;
[]==x/*0:101*/:xs/*0:11*/ = 0;
-x/*0:0101*/:xs/*0:011*/==y/*0:101*/:ys/*0:11*/ = x/*0:0101*/==y/*0:101*/&&xs/*0:011*/==ys/*0:11*/;
+x/*0:0101*/:xs/*0:011*/==y/*0:101*/:ys/*0:11*/ = if x/*0:0101*/==y/*0:101*/ then xs/*0:011*/==ys/*0:11*/ else 1;
[]!=[] = 0;
x/*0:0101*/:xs/*0:011*/!=[] = 1;
[]!=x/*0:101*/:xs/*0:11*/ = 1;
-x/*0:0101*/:xs/*0:011*/!=y/*0:101*/:ys/*0:11*/ = x/*0:0101*/!=y/*0:101*/||xs/*0:011*/!=ys/*0:11*/;
+x/*0:0101*/:xs/*0:011*/!=y/*0:101*/:ys/*0:11*/ = if x/*0:0101*/!=y/*0:101*/ then 1 else xs/*0:011*/!=ys/*0:11*/;
null [] = 1;
null (x/*0:101*/:xs/*0:11*/) = 0;
#[] = 0;
-#(x/*0:101*/:xs/*0:11*/) = 1+#xs/*0:11*/;
+#(x/*0:101*/:xs/*0:11*/) = accum/*0*/ 1 xs/*0:11*/ with accum n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (n/*0:01*/+1) xs/*0:11*/; accum n/*0:01*/::int [] = n/*0:01*/; accum _/*0:01*/ xs/*0:1*/ = throw (bad_list_value xs/*0:1*/) {
+ rule #0: accum n::int (x:xs) = accum (n+1) xs
+ rule #1: accum n::int [] = n
+ rule #2: accum _ xs = throw (bad_list_value xs)
+ state 0: #0 #1 #2
+ <var> state 1
+ <var>::int state 3
+ state 1: #2
+ <var> state 2
+ state 2: #2
+ state 3: #0 #1 #2
+ <var> state 4
+ <app> state 5
+ [] state 15
+ state 4: #2
+ state 5: #0 #2
+ <var> state 6
+ <app> state 8
+ state 6: #2
+ <var> state 7
+ state 7: #2
+ state 8: #0 #2
+ <var> state 9
+ : state 12
+ state 9: #2
+ <var> state 10
+ state 10: #2
+ <var> state 11
+ state 11: #2
+ state 12: #0 #2
+ <var> state 13
+ state 13: #0 #2
+ <var> state 14
+ state 14: #0 #2
+ state 15: #1 #2
+} end;
(x/*0:0101*/:xs/*0:011*/)!0 = x/*0:0101*/;
(x/*0:0101*/:xs/*0:011*/)!n/*0:1*/::int = xs/*0:011*/!(n/*0:1*/-1) if n/*0:1*/>0;
[]+ys/*0:1*/ = ys/*0:1*/;
-(x/*0:0101*/:xs/*0:011*/)+ys/*0:1*/ = x/*0:0101*/:xs/*0:011*/+ys/*0:1*/;
+(x/*0:0101*/:xs/*0:011*/)+ys/*0:1*/ = x/*0:0101*/:accum/*0*/ ys/*0:1*/ (reverse xs/*0:011*/) with accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (x/*0:101*/:ys/*0:01*/) xs/*0:11*/; accum ys/*0:01*/ [] = ys/*0:01*/ {
+ rule #0: accum ys (x:xs) = accum (x:ys) xs
+ rule #1: accum ys [] = ys
+ state 0: #0 #1
+ <var> state 1
+ state 1: #0 #1
+ <app> state 2
+ [] state 7
+ state 2: #0
+ <app> state 3
+ state 3: #0
+ : state 4
+ state 4: #0
+ <var> state 5
+ state 5: #0
+ <var> state 6
+ state 6: #0
+ state 7: #1
+} end;
+reverse [] = [];
+reverse (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [x/*0:101*/] xs/*0:11*/ with accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (x/*0:101*/:ys/*0:01*/) xs/*0:11*/; accum ys/*0:01*/ [] = ys/*0:01*/; accum _/*0:01*/ xs/*0:1*/ = throw (bad_list_value xs/*0:1*/) {
+ rule #0: accum ys (x:xs) = accum (x:ys) xs
+ rule #1: accum ys [] = ys
+ rule #2: accum _ xs = throw (bad_list_value xs)
+ state 0: #0 #1 #2
+ <var> state 1
+ state 1: #0 #1 #2
+ <var> state 2
+ <app> state 3
+ [] state 13
+ state 2: #2
+ state 3: #0 #2
+ <var> state 4
+ <app> state 6
+ state 4: #2
+ <var> state 5
+ state 5: #2
+ state 6: #0 #2
+ <var> state 7
+ : state 10
+ state 7: #2
+ <var> state 8
+ state 8: #2
+ <var> state 9
+ state 9: #2
+ state 10: #0 #2
+ <var> state 11
+ state 11: #0 #2
+ <var> state 12
+ state 12: #0 #2
+ state 13: #1 #2
+} end;
list () = [];
-list (x/*0:101*/,y/*0:1101*/,xs/*0:111*/) = x/*0:101*/:list (y/*0:1101*/,xs/*0:111*/);
-list (x/*0:101*/,y/*0:11*/) = [x/*0:101*/,y/*0:11*/];
+list (x/*0:101*/,xs/*0:11*/) = accum/*0*/ [x/*0:101*/] xs/*0:11*/ with accum ys/*0:01*/ (x/*0:101*/,xs/*0:11*/) = accum/*1*/ (x/*0:101*/:ys/*0:01*/) xs/*0:11*/; accum ys/*0:01*/ x/*0:1*/ = reverse (x/*0:1*/:ys/*0:01*/) {
+ rule #0: accum ys (x,xs) = accum (x:ys) xs
+ rule #1: accum ys x = reverse (x:ys)
+ state 0: #0 #1
+ <var> state 1
+ state 1: #0 #1
+ <var> state 2
+ <app> state 3
+ state 2: #1
+ state 3: #0 #1
+ <var> state 4
+ <app> state 6
+ state 4: #1
+ <var> state 5
+ state 5: #1
+ state 6: #0 #1
+ <var> state 7
+ , state 10
+ state 7: #1
+ <var> state 8
+ state 8: #1
+ <var> state 9
+ state 9: #1
+ state 10: #0 #1
+ <var> state 11
+ state 11: #0 #1
+ <var> state 12
+ state 12: #0 #1
+} end;
tuple [] = ();
-tuple [x/*0:101*/] = x/*0:101*/;
-tuple (x/*0:101*/:y/*0:1101*/:xs/*0:111*/) = x/*0:101*/,tuple (y/*0:1101*/:xs/*0:111*/);
+tuple (x/*0:101*/:xs/*0:11*/) = accum/*0*/ x/*0:101*/ xs/*0:11*/ with accum ys/*0:01*/ (x/*0:101*/:xs/*0:11*/) = accum/*1*/ (x/*0:101*/,ys/*0:01*/) xs/*0:11*/; accum ys/*0:01*/ [] = if tuplep ys/*0:01*/ then reverse ys/*0:01*/ else ys/*0:01*/; accum _/*0:01*/ xs/*0:1*/ = throw (bad_list_value xs/*0:1*/) {
+ rule #0: accum ys (x:xs) = accum (x,ys) xs
+ rule #1: accum ys [] = if tuplep ys then reverse ys else ys
+ rule #2: accum _ xs = throw (bad_list_value xs)
+ state 0: #0 #1 #2
+ <var> state 1
+ state 1: #0 #1 #2
+ <var> state 2
+ <app> state 3
+ [] state 13
+ state 2: #2
+ state 3: #0 #2
+ <var> state 4
+ <app> state 6
+ state 4: #2
+ <var> state 5
+ state 5: #2
+ state 6: #0 #2
+ <var> state 7
+ : state 10
+ state 7: #2
+ <var> state 8
+ state 8: #2
+ <var> state 9
+ state 9: #2
+ state 10: #0 #2
+ <var> state 11
+ state 11: #0 #2
+ <var> state 12
+ state 12: #0 #2
+ state 13: #1 #2
+} end;
xs/*0:01*/![] = [];
-xs/*0:01*/!(n/*0:101*/::int:ns/*0:11*/) = slice/*0*/ xs/*1:01*/ (n/*1:101*/:ns/*1:11*/) with slice xs/*0:01*/ [] = []; slice xs/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = xs/*0:01*/!n/*0:101*/:slice/*1*/ xs/*0:01*/ ns/*0:11*/ if n/*0:101*/>=0&&n/*0:101*/<m/*1:*/; slice xs/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = xs/*0:01*/!ns/*0:11*/ {
- rule #0: slice xs [] = []
- rule #1: slice xs (n::int:ns) = xs!n:slice xs ns if n>=0&&n<m
- rule #2: slice xs (n::int:ns) = xs!ns
+xs/*0:01*/!(n/*0:101*/:ns/*0:11*/) = accum/*0*/ [] xs/*0:01*/ (reverse (n/*0:101*/:ns/*0:11*/)) (#xs/*0:01*/) with accum ys/*0:0001*/ xs/*0:001*/ [] m/*0:1*/ = ys/*0:0001*/; accum ys/*0:0001*/ xs/*0:001*/ (n/*0:0101*/::int:ns/*0:011*/) m/*0:1*/ = accum/*1*/ (xs/*0:001*/!n/*0:0101*/:ys/*0:0001*/) xs/*0:001*/ ns/*0:011*/ m/*0:1*/ if n/*0:0101*/>=0&&n/*0:0101*/<m/*0:1*/; accum ys/*0:0001*/ xs/*0:001*/ (n/*0:0101*/::int:ns/*0:011*/) m/*0:1*/ = accum/*1*/ ys/*0:0001*/ xs/*0:001*/ ns/*0:011*/ m/*0:1*/ {
+ rule #0: accum ys xs [] m = ys
+ rule #1: accum ys xs (n::int:ns) m = accum (xs!n:ys) xs ns m if n>=0&&n<m
+ rule #2: accum ys xs (n::int:ns) m = accum ys xs ns m
state 0: #0 #1 #2
<var> state 1
state 1: #0 #1 #2
- [] state 2
- <app> state 3
- state 2: #0
- state 3: #1 #2
- <app> state 4
- state 4: #1 #2
- : state 5
+ <var> state 2
+ state 2: #0 #1 #2
+ [] state 3
+ <app> state 5
+ state 3: #0
+ <var> state 4
+ state 4: #0
state 5: #1 #2
- <var>::int state 6
+ <app> state 6
state 6: #1 #2
- <var> state 7
+ : state 7
state 7: #1 #2
-} end when m/*0:*/::int = #xs/*0:01*/ {
- rule #0: m::int = #xs
- state 0: #0
- <var>::int state 1
- state 1: #0
+ <var>::int state 8
+ state 8: #1 #2
+ <var> state 9
+ state 9: #1 #2
+ <var> state 10
+ state 10: #1 #2
} end;
n1/*0:0101*/,n2/*0:011*/..m/*0:1*/ = while (\i/*0:*/ -> s/*1:*/*i/*0:*/<=s/*1:*/*m/*3:1*/ {
rule #0: i = s*i<=s*m
@@ -514,98 +715,128 @@
takewhile p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = x/*0:101*/:takewhile p/*0:01*/ xs/*0:11*/ if p/*0:01*/ x/*0:101*/;
takewhile p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = [];
cat [] = [];
-cat (xs/*0:101*/:xss/*0:11*/) = accum/*0*/ (reverse xs/*0:101*/) xss/*0:11*/ with accum xs/*0:01*/ [] = reverse xs/*0:01*/; accum xs/*0:01*/ ([]:yss/*0:11*/) = accum/*1*/ xs/*0:01*/ yss/*0:11*/; accum xs/*0:01*/ ((y/*0:10101*/:ys/*0:1011*/):yss/*0:11*/) = accum/*1*/ (y/*0:10101*/:xs/*0:01*/) (ys/*0:1011*/:yss/*0:11*/); accum xs/*0:01*/ yss/*0:1*/ = reverse xs/*0:01*/+cat yss/*0:1*/ {
+cat (xs/*0:101*/:xss/*0:11*/) = accum/*0*/ (reverse xs/*0:101*/) xss/*0:11*/ with accum xs/*0:01*/ [] = reverse xs/*0:01*/; accum xs/*0:01*/ ([]:yss/*0:11*/) = accum/*1*/ xs/*0:01*/ yss/*0:11*/; accum xs/*0:01*/ ((y/*0:10101*/:ys/*0:1011*/):yss/*0:11*/) = accum/*1*/ (y/*0:10101*/:xs/*0:01*/) (ys/*0:1011*/:yss/*0:11*/); accum _/*0:01*/ (ys/*0:101*/:_/*0:11*/) = throw (bad_list_value ys/*0:101*/); accum _/*0:01*/ yss/*0:1*/ = throw (bad_list_value yss/*0:1*/) {
rule #0: accum xs [] = reverse xs
rule #1: accum xs ([]:yss) = accum xs yss
rule #2: accum xs ((y:ys):yss) = accum (y:xs) (ys:yss)
- rule #3: accum xs yss = reverse xs+cat yss
- state 0: #0 #1 #2 #3
+ rule #3: accum _ (ys:_) = throw (bad_list_value ys)
+ rule #4: accum _ yss = throw (bad_list_value yss)
+ state 0: #0 #1 #2 #3 #4
<var> state 1
- state 1: #0 #1 #2 #3
+ state 1: #0 #1 #2 #3 #4
<var> state 2
[] state 3
<app> state 4
- state 2: #3
- state 3: #0 #3
- state 4: #1 #2 #3
+ state 2: #4
+ state 3: #0 #4
+ state 4: #1 #2 #3 #4
<var> state 5
<app> state 7
- state 5: #3
+ state 5: #4
<var> state 6
- state 6: #3
- state 7: #1 #2 #3
+ state 6: #4
+ state 7: #1 #2 #3 #4
<var> state 8
: state 11
- state 8: #3
+ state 8: #4
<var> state 9
- state 9: #3
+ state 9: #4
<var> state 10
- state 10: #3
- state 11: #1 #2 #3
+ state 10: #4
+ state 11: #1 #2 #3 #4
<var> state 12
[] state 14
<app> state 16
- state 12: #3
+ state 12: #3 #4
<var> state 13
- state 13: #3
- state 14: #1 #3
+ state 13: #3 #4
+ state 14: #1 #3 #4
<var> state 15
- state 15: #1 #3
- state 16: #2 #3
+ state 15: #1 #3 #4
+ state 16: #2 #3 #4
<var> state 17
<app> state 20
- state 17: #3
+ state 17: #3 #4
<var> state 18
- state 18: #3
+ state 18: #3 #4
<var> state 19
- state 19: #3
- state 20: #2 #3
+ state 19: #3 #4
+ state 20: #2 #3 #4
<var> state 21
: state 25
- state 21: #3
+ state 21: #3 #4
<var> state 22
- state 22: #3
+ state 22: #3 #4
<var> state 23
- state 23: #3
+ state 23: #3 #4
<var> state 24
- state 24: #3
- state 25: #2 #3
+ state 24: #3 #4
+ state 25: #2 #3 #4
<var> state 26
- state 26: #2 #3
+ state 26: #2 #3 #4
<var> state 27
- state 27: #2 #3
+ state 27: #2 #3 #4
<var> state 28
- state 28: #2 #3
-} end if listp xs/*0:101*/;
+ state 28: #2 #3 #4
+} end;
catmap f/*0:01*/ xs/*0:1*/ = cat (map f/*0:01*/ xs/*0:1*/);
-reverse xs/*0:1*/ = foldl (flip (:)) [] xs/*0:1*/ if listp xs/*0:1*/;
-repeat n/*0:01*/ x/*0:1*/ = [] if n/*0:01*/<=0;
-repeat n/*0:01*/ x/*0:1*/ = x/*0:1*/:repeat (n/*0:01*/-1) x/*0:1*/;
-cycle n/*0:01*/ [] = [];
-cycle n/*0:01*/ (x/*0:101*/:xs/*0:11*/) = [] if n/*0:01*/<=0;
-cycle n/*0:01*/ (x/*0:101*/:xs/*0:11*/) = mkcycle/*0*/ n/*2:01*/ xs/*1:*/ with mkcycle n/*0:01*/ xs/*0:1*/ = take n/*0:01*/ xs/*0:1*/ if n/*0:01*/<=m/*1:*/; mkcycle n/*0:01*/ xs/*0:1*/ = xs/*0:1*/+mkcycle/*1*/ (n/*0:01*/-m/*1:*/) xs/*0:1*/ {
- rule #0: mkcycle n xs = take n xs if n<=m
- rule #1: mkcycle n xs = xs+mkcycle (n-m) xs
+repeat n/*0:01*/::int x/*0:1*/ = accum/*0*/ [] n/*0:01*/ x/*0:1*/ with accum xs/*0:001*/ n/*0:01*/::int x/*0:1*/ = xs/*0:001*/ if n/*0:01*/<=0; accum xs/*0:001*/ n/*0:01*/::int x/*0:1*/ = accum/*1*/ (x/*0:1*/:xs/*0:001*/) (n/*0:01*/-1) x/*0:1*/ {
+ rule #0: accum xs n::int x = xs if n<=0
+ rule #1: accum xs n::int x = accum (x:xs) (n-1) x
state 0: #0 #1
<var> state 1
state 1: #0 #1
- <var> state 2
+ <var>::int state 2
state 2: #0 #1
-} end when xs/*0:*/ = x/*0:101*/:xs/*0:11*/; m/*0:*/ = #xs/*0:*/ {
- rule #0: m = #xs
- state 0: #0
+ <var> state 3
+ state 3: #0 #1
+} end;
+cycle n/*0:01*/::int [] = [];
+cycle n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = [] if n/*0:01*/<=0;
+cycle n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = accum/*0*/ [] (#xs/*0:*/) n/*1:01*/ xs/*0:*/ with accum ys/*0:0001*/ m/*0:001*/::int n/*0:01*/::int xs/*0:1*/ = cat ys/*0:0001*/+take n/*0:01*/ xs/*0:1*/ if n/*0:01*/<=m/*0:001*/; accum ys/*0:0001*/ m/*0:001*/::int n/*0:01*/::int xs/*0:1*/ = accum/*1*/ (xs/*0:1*/:ys/*0:0001*/) m/*0:001*/ (n/*0:01*/-m/*0:001*/) xs/*0:1*/ {
+ rule #0: accum ys m::int n::int xs = cat ys+take n xs if n<=m
+ rule #1: accum ys m::int n::int xs = accum (xs:ys) m (n-m) xs
+ state 0: #0 #1
<var> state 1
- state 1: #0
-} {
+ state 1: #0 #1
+ <var>::int state 2
+ state 2: #0 #1
+ <var>::int state 3
+ state 3: #0 #1
+ <var> state 4
+ state 4: #0 #1
+} end when xs/*0:*/ = x/*0:101*/:xs/*0:11*/ {
rule #0: xs = x:xs
state 0: #0
<var> state 1
state 1: #0
} end;
-while p/*0:001*/ f/*0:01*/ a/*0:1*/ = a/*0:1*/:while p/*0:001*/ f/*0:01*/ (f/*0:01*/ a/*0:1*/) if p/*0:001*/ a/*0:1*/;
-while p/*0:001*/ f/*0:01*/ a/*0:1*/ = [];
-until p/*0:001*/ f/*0:01*/ a/*0:1*/ = [] if p/*0:001*/ a/*0:1*/;
-until p/*0:001*/ f/*0:01*/ a/*0:1*/ = a/*0:1*/:until p/*0:001*/ f/*0:01*/ (f/*0:01*/ a/*0:1*/);
+while p/*0:001*/ f/*0:01*/ a/*0:1*/ = accum/*0*/ [] p/*0:001*/ f/*0:01*/ a/*0:1*/ with accum as/*0:0001*/ p/*0:001*/ f/*0:01*/ a/*0:1*/ = accum/*1*/ (a/*0:1*/:as/*0:0001*/) p/*0:001*/ f/*0:01*/ (f/*0:01*/ a/*0:1*/) if p/*0:001*/ a/*0:1*/; accum as/*0:0001*/ p/*0:001*/ f/*0:01*/ a/*0:1*/ = reverse as/*0:0001*/ {
+ rule #0: accum as p f a = accum (a:as) p f (f a) if p a
+ rule #1: accum as p f a = reverse as
+ state 0: #0 #1
+ <var> state 1
+ state 1: #0 #1
+ <var> state 2
+ state 2: #0 #1
+ <var> state 3
+ state 3: #0 #1
+ <var> state 4
+ state 4: #0 #1
+} end;
+until p/*0:001*/ f/*0:01*/ a/*0:1*/ = accum/*0*/ [] p/*0:001*/ f/*0:01*/ a/*0:1*/ with accum as/*0:0001*/ p/*0:001*/ f/*0:01*/ a/*0:1*/ = reverse as/*0:0001*/ if p/*0:001*/ a/*0:1*/; accum as/*0:0001*/ p/*0:001*/ f/*0:01*/ a/*0:1*/ = accum/*1*/ (a/*0:1*/:as/*0:0001*/) p/*0:001*/ f/*0:01*/ (f/*0:01*/ a/*0:1*/) {
+ rule #0: accum as p f a = reverse as if p a
+ rule #1: accum as p f a = accum (a:as) p f (f a)
+ state 0: #0 #1
+ <var> state 1
+ state 1: #0 #1
+ <var> state 2
+ state 2: #0 #1
+ <var> state 3
+ state 3: #0 #1
+ <var> state 4
+ state 4: #0 #1
+} end;
zip (x/*0:0101*/:xs/*0:011*/) (y/*0:101*/:ys/*0:11*/) = (x/*0:0101*/,y/*0:101*/):zip xs/*0:011*/ ys/*0:11*/;
zip _/*0:01*/ _/*0:1*/ = [];
zip3 (x/*0:00101*/:xs/*0:0011*/) (y/*0:0101*/:ys/*0:011*/) (z/*0:101*/:zs/*0:11*/) = (x/*0:00101*/,y/*0:0101*/,z/*0:101*/):zip3 xs/*0:0011*/ ys/*0:011*/ zs/*0:11*/;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-25 16:01:06
|
Revision: 135
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=135&view=rev
Author: agraef
Date: 2008-05-25 09:01:10 -0700 (Sun, 25 May 2008)
Log Message:
-----------
Bugfix in pointer -> bigint conversion.
Modified Paths:
--------------
pure/trunk/runtime.cc
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-05-25 15:56:23 UTC (rev 134)
+++ pure/trunk/runtime.cc 2008-05-25 16:01:10 UTC (rev 135)
@@ -1211,11 +1211,12 @@
case EXPR::INT: return pure_pointer((void*)x->data.i);
case EXPR::BIGINT:
if (sizeof(mp_limb_t) == 8)
- return pure_pointer((void*)x->data.z->_mp_d[0]);
+ return pure_pointer((void*)mpz_getlimbn(x->data.z, 0));
else if (sizeof(void*) == 4)
return pure_pointer((void*)mpz_get_ui(x->data.z));
else {
- uint64_t u = x->data.z->_mp_d[0]+(((uint64_t)x->data.z->_mp_d[1])<<32);
+ uint64_t u = mpz_getlimbn(x->data.z, 0) +
+ (((uint64_t)mpz_getlimbn(x->data.z, 1))<<32);
return pure_pointer((void*)u);
}
default: return 0;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-25 15:56:18
|
Revision: 134
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=134&view=rev
Author: agraef
Date: 2008-05-25 08:56:23 -0700 (Sun, 25 May 2008)
Log Message:
-----------
Add marshalling between 64 bit ints and Pure bigints to the C interface.
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-25 09:14:26 UTC (rev 133)
+++ pure/trunk/ChangeLog 2008-05-25 15:56:23 UTC (rev 134)
@@ -1,5 +1,14 @@
2008-05-25 Albert Graef <Dr....@t-...>
+ * interpreter.cc, runtime.cc: Add marshalling between long (64
+ bit) ints and Pure bigints in the C interface. This means that
+ both Pure ints and bigints can now be passed for 'long' arguments
+ of externals (with sign extension/truncation as necessary), and
+ 'long' values are promoted to Pure bigints on return. Hence C
+ functions taking 64 bit integers as arguments and returning them
+ as results can now be called from Pure without loosing bits due to
+ truncation.
+
* lib/prelude.pure: Make 'all' and 'any' tail-recursive.
* interpreter.cc: Make toplevel if-then-else properly
@@ -74,9 +83,7 @@
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). 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.
+ systems).
2008-05-16 Albert Graef <Dr....@t-...>
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-05-25 09:14:26 UTC (rev 133)
+++ pure/trunk/interpreter.cc 2008-05-25 15:56:23 UTC (rev 134)
@@ -199,6 +199,8 @@
"pure_const", "expr*", 1, "int");
declare_extern((void*)pure_int,
"pure_int", "expr*", 1, "int");
+ declare_extern((void*)pure_long,
+ "pure_long", "expr*", 1, "long");
declare_extern((void*)pure_bigint,
"pure_bigint", "expr*", 2, "int",
sizeof(mp_limb_t)==8?"long*":"int*");
@@ -224,6 +226,8 @@
"pure_free_cstrings", "void", 0);
declare_extern((void*)pure_get_bigint,
"pure_get_bigint", "void*", 1, "expr*");
+ declare_extern((void*)pure_get_long,
+ "pure_get_long", "long", 1, "expr*");
declare_extern((void*)pure_catch,
"pure_catch", "expr*", 2, "expr*", "expr*");
@@ -2224,8 +2228,8 @@
}
// External C function visible in the Pure program. No varargs are allowed
// here for now. Also, we have to translate some of the parameter types
- // (expr** becomes void*, int32_t gets promoted in64_t if the default int
- // type of the target platform has 64 bit).
+ // (expr** becomes void*, int32_t gets promoted to int64_t if the default
+ // int type of the target platform has 64 bit).
assert(!varargs);
if (type == ExprPtrPtrTy)
type = VoidPtrTy;
@@ -2388,17 +2392,33 @@
Value *iv = b.CreateLoad(b.CreateGEP(pv, idx, idx+2), "intval");
unboxed[i] = iv;
} else if (argt[i] == Type::Int64Ty) {
+ BasicBlock *intbb = new BasicBlock("int");
+ BasicBlock *mpzbb = new BasicBlock("mpz");
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);
+ SwitchInst *sw = b.CreateSwitch(tagv, failedbb, 2);
+ /* We allow either ints or bigints to be passed for a long value. */
+ sw->addCase(SInt(EXPR::INT), intbb);
+ sw->addCase(SInt(EXPR::BIGINT), mpzbb);
+ f->getBasicBlockList().push_back(intbb);
+ b.SetInsertPoint(intbb);
Value *pv = b.CreateBitCast(x, IntExprPtrTy, "intexpr");
idx[1] = ValFldIndex;
Value *iv = b.CreateLoad(b.CreateGEP(pv, idx, idx+2), "intval");
- unboxed[i] = b.CreateSExt(iv, Type::Int64Ty);
+ Value *intv = b.CreateSExt(iv, Type::Int64Ty);
+ b.CreateBr(okbb);
+ f->getBasicBlockList().push_back(mpzbb);
+ b.SetInsertPoint(mpzbb);
+ // Handle the case of a bigint (mpz_t -> long).
+ Value *mpzv = b.CreateCall(module->getFunction("pure_get_long"), x);
+ b.CreateBr(okbb);
+ f->getBasicBlockList().push_back(okbb);
+ b.SetInsertPoint(okbb);
+ PHINode *phi = b.CreatePHI(Type::Int64Ty);
+ phi->addIncoming(intv, intbb);
+ phi->addIncoming(mpzv, mpzbb);
+ unboxed[i] = phi;
} else if (argt[i] == Type::DoubleTy) {
BasicBlock *okbb = new BasicBlock("ok");
Value *idx[2] = { Zero, Zero };
@@ -2478,8 +2498,7 @@
// 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], CharPtrTy);
+ unboxed[i] = b.CreateBitCast(unboxed[i], CharPtrTy);
} else
assert(0 && "invalid C type");
}
@@ -2504,8 +2523,7 @@
else if (type == Type::Int32Ty)
u = b.CreateCall(module->getFunction("pure_int"), u);
else if (type == Type::Int64Ty)
- u = b.CreateCall(module->getFunction("pure_int"),
- b.CreateTrunc(u, Type::Int32Ty));
+ u = b.CreateCall(module->getFunction("pure_long"), u);
else if (type == Type::DoubleTy)
u = b.CreateCall(module->getFunction("pure_double"), u);
else if (type == CharPtrTy)
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-05-25 09:14:26 UTC (rev 133)
+++ pure/trunk/runtime.cc 2008-05-25 15:56:23 UTC (rev 134)
@@ -340,6 +340,22 @@
return x;
}
+extern "C"
+pure_expr *pure_long(int64_t l)
+{
+ int sgn = (l>0)?1:(l<0)?-1:0;
+ uint64_t v = (uint64_t)(l>=0?l:-l);
+ if (sizeof(mp_limb_t) == 8) {
+ // 8 byte limbs, value fits in a single limb.
+ limb_t u[1] = { v };
+ return pure_bigint(sgn, u);
+ } else {
+ // 4 byte limbs, put least significant word in the first limb.
+ limb_t u[2] = { (uint32_t)v, (uint32_t)(v>>32) };
+ return pure_bigint(sgn+sgn, u);
+ }
+}
+
static void make_bigint(mpz_t z, int32_t size, limb_t *limbs)
{
// FIXME: For efficiency, we poke directly into the mpz struct here, this
@@ -466,6 +482,7 @@
return s;
}
+extern "C"
void pure_free_cstrings()
{
for (list<char*>::iterator t = temps.begin(); t != temps.end(); t++)
@@ -473,6 +490,18 @@
temps.clear();
}
+extern "C"
+int64_t pure_get_long(pure_expr *x)
+{
+ uint64_t v =
+ (sizeof(mp_limb_t) == 8) ? (uint64_t)mpz_getlimbn(x->data.z, 0) :
+ (mpz_getlimbn(x->data.z, 0) +
+ (((uint64_t)mpz_getlimbn(x->data.z, 1))<<32));
+ cerr << "v = " << v << endl;
+ return (mpz_sgn(x->data.z) < 0) ? -(int64_t)v : (int64_t)v;
+}
+
+extern "C"
void *pure_get_bigint(pure_expr *x)
{
assert(x && x->tag == EXPR::BIGINT);
Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h 2008-05-25 09:14:26 UTC (rev 133)
+++ pure/trunk/runtime.h 2008-05-25 15:56:23 UTC (rev 134)
@@ -63,6 +63,7 @@
void *f, void *e, uint32_t m, /* m x pure_expr* */ ...);
pure_expr *pure_const(int32_t tag);
pure_expr *pure_int(int32_t i);
+pure_expr *pure_long(int64_t l);
pure_expr *pure_bigint(int32_t size, limb_t *limbs);
pure_expr *pure_mpz(mpz_t z);
pure_expr *pure_double(double d);
@@ -95,11 +96,11 @@
char *pure_get_cstring(pure_expr *x);
void pure_free_cstrings();
-/* Get a pointer to the mpz_t value of a bigint expression which can be passed
- to the GMP routines. This is used to unbox bigint arguments and map them to
- void* in the C interface. */
+/* Convert a bigint expression to a pointer (mpz_t) or a long (64 bit)
+ integer. This is used to marshall bigint arguments in the C interface. */
void *pure_get_bigint(pure_expr *x);
+int64_t pure_get_long(pure_expr *x);
/* Execute a closure. If the given expression x (or x y in the case of
pure_apply) is a parameterless closure (or a saturated application of a
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-25 09:14:19
|
Revision: 133
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=133&view=rev
Author: agraef
Date: 2008-05-25 02:14:26 -0700 (Sun, 25 May 2008)
Log Message:
-----------
Completely disable all DEBUG sections for release build.
Modified Paths:
--------------
pure/trunk/Makefile
Modified: pure/trunk/Makefile
===================================================================
--- pure/trunk/Makefile 2008-05-25 07:02:37 UTC (rev 132)
+++ pure/trunk/Makefile 2008-05-25 09:14:26 UTC (rev 133)
@@ -78,8 +78,8 @@
CFLAGS = -g -O -Wall
else
ifeq ($(build),release)
-CXXFLAGS = -O3 -DNDEBUG -Wall $(LLVM_FLAGS)
-CFLAGS = -O3 -DNDEBUG -Wall
+CXXFLAGS = -O3 -DNDEBUG -DDEBUG=0 -Wall $(LLVM_FLAGS)
+CFLAGS = -O3 -DNDEBUG -DDEBUG=0 -Wall
else
ifeq ($(build),debug)
CXXFLAGS = -g -Wall $(LLVM_FLAGS)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-25 07:02:32
|
Revision: 132
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=132&view=rev
Author: agraef
Date: 2008-05-25 00:02:37 -0700 (Sun, 25 May 2008)
Log Message:
-----------
Update test logs.
Modified Paths:
--------------
pure/trunk/test/prelude.log
Modified: pure/trunk/test/prelude.log
===================================================================
--- pure/trunk/test/prelude.log 2008-05-25 07:00:36 UTC (rev 131)
+++ pure/trunk/test/prelude.log 2008-05-25 07:02:37 UTC (rev 132)
@@ -428,9 +428,9 @@
state 1: #0
}) n/*0:01*/;
all p/*0:01*/ [] = 1;
-all p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = p/*0:01*/ x/*0:101*/&&all p/*0:01*/ xs/*0:11*/;
+all p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = if p/*0:01*/ x/*0:101*/ then all p/*0:01*/ xs/*0:11*/ else 0;
any p/*0:01*/ [] = 0;
-any p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = p/*0:01*/ x/*0:101*/||any p/*0:01*/ xs/*0:11*/;
+any p/*0:01*/ (x/*0:101*/:xs/*0:11*/) = if p/*0:01*/ x/*0:101*/ then 1 else any p/*0:01*/ xs/*0:11*/;
do f/*0:01*/ [] = ();
do f/*0:01*/ (x/*0:101*/:xs/*0:11*/) = do f/*1:01*/ xs/*1:11*/ when _/*0:*/ = f/*0:01*/ x/*0:101*/ {
rule #0: _ = f x
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-25 07:00:35
|
Revision: 131
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=131&view=rev
Author: agraef
Date: 2008-05-25 00:00:36 -0700 (Sun, 25 May 2008)
Log Message:
-----------
Make 'all' and 'any' tail-recursive.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/prelude.pure
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-05-25 06:06:17 UTC (rev 130)
+++ pure/trunk/ChangeLog 2008-05-25 07:00:36 UTC (rev 131)
@@ -1,5 +1,7 @@
2008-05-25 Albert Graef <Dr....@t-...>
+ * lib/prelude.pure: Make 'all' and 'any' tail-recursive.
+
* interpreter.cc: Make toplevel if-then-else properly
tail-recursive. Thus, e.g., the following function will now run in
constant stack space: count x = if x<=0 then x else count (x-1);
Modified: pure/trunk/lib/prelude.pure
===================================================================
--- pure/trunk/lib/prelude.pure 2008-05-25 06:06:17 UTC (rev 130)
+++ pure/trunk/lib/prelude.pure 2008-05-25 07:00:36 UTC (rev 131)
@@ -173,10 +173,10 @@
functions have slightly different names). */
all p [] = 1;
-all p (x:xs) = p x && all p xs;
+all p (x:xs) = if p x then all p xs else 0;
any p [] = 0;
-any p (x:xs) = p x || any p xs;
+any p (x:xs) = if p x then 1 else any p xs;
do f [] = ();
do f (x:xs) = do f xs when _ = f x end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-25 06:06:08
|
Revision: 130
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=130&view=rev
Author: agraef
Date: 2008-05-24 23:06:17 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Add comment about licensing of examples.
Modified Paths:
--------------
pure/trunk/README
Modified: pure/trunk/README
===================================================================
--- pure/trunk/README 2008-05-25 05:42:48 UTC (rev 129)
+++ pure/trunk/README 2008-05-25 06:06:17 UTC (rev 130)
@@ -19,7 +19,10 @@
LICENSE
-GPL V3 or later. See the accompanying COPYING file for details.
+GPL V3 or later. See the accompanying COPYING file for details. Note that the
+sample scripts in the examples subdir, even though they are bundled with the
+sources, are considered to be in the public domain, so feel free to use them
+for whatever purpose.
INSTALLATION
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-25 05:42:39
|
Revision: 129
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=129&view=rev
Author: agraef
Date: 2008-05-24 22:42:48 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Make toplevel if-then-else properly tail-recursive.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
pure/trunk/test/test004.log
pure/trunk/test/test004.pure
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-05-24 19:58:42 UTC (rev 128)
+++ pure/trunk/ChangeLog 2008-05-25 05:42:48 UTC (rev 129)
@@ -1,3 +1,11 @@
+2008-05-25 Albert Graef <Dr....@t-...>
+
+ * interpreter.cc: Make toplevel if-then-else properly
+ tail-recursive. Thus, e.g., the following function will now run in
+ constant stack space: count x = if x<=0 then x else count (x-1);
+ This also works with nested if-then-else constructs, as long as
+ they form the right-hand side of an equation.
+
2008-05-24 Albert Graef <Dr....@t-...>
* interpreter.cc, runtime.cc: Fix more memory allocation bugs in
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-05-24 19:58:42 UTC (rev 128)
+++ pure/trunk/interpreter.cc 2008-05-25 05:42:48 UTC (rev 129)
@@ -3197,6 +3197,15 @@
return 0;
}
+void interpreter::toplevel_codegen(expr x)
+{
+ assert(!x.is_null());
+ if (x.tag() == EXPR::COND)
+ toplevel_cond(x.xval1(), x.xval2(), x.xval3());
+ else
+ act_env().CreateRet(codegen(x));
+}
+
Value *interpreter::codegen(expr x)
{
assert(!x.is_null());
@@ -3487,6 +3496,40 @@
return phi;
}
+void interpreter::toplevel_cond(expr x, expr y, expr z)
+{
+ // emit tail-recursive code for a toplevel if-then-else
+ Env& f = act_env();
+ assert(f.f!=0);
+ // emit the code for x
+ Value *iv = 0;
+ if (x.ttag() == EXPR::INT)
+ // optimize the case that x is an ::int (constant or application)
+ iv = get_int(x);
+ else if (x.ttag() != 0) {
+ // wrong type of constant; raise an exception
+ // XXXTODO: we might want to optionally invoke the debugger here
+ unwind(symtab.failed_cond_sym().f);
+ return;
+ } else
+ // typeless expression, will be checked at runtime
+ iv = get_int(x);
+ // emit the condition (turn the previous result into a flag)
+ Value *condv = f.builder.CreateICmpNE(iv, Zero, "cond");
+ // create the basic blocks for the branches
+ BasicBlock *thenbb = new BasicBlock("then");
+ BasicBlock *elsebb = new BasicBlock("else");
+ // create the branch instruction and emit the 'then' block
+ f.builder.CreateCondBr(condv, thenbb, elsebb);
+ f.f->getBasicBlockList().push_back(thenbb);
+ f.builder.SetInsertPoint(thenbb);
+ toplevel_codegen(y);
+ // emit the 'else' block
+ f.f->getBasicBlockList().push_back(elsebb);
+ f.builder.SetInsertPoint(elsebb);
+ toplevel_codegen(z);
+}
+
// Other value boxes. These just call primitives in the runtime which take
// care of constructing these values.
@@ -4321,11 +4364,11 @@
f.f->getBasicBlockList().push_back(matchedbb);
f.builder.SetInsertPoint(matchedbb);
#if DEBUG>1
- if (!f.name.empty()) { ostringstream msg;
- msg << "exit " << f.name << ", result: " << pm->r[0].rhs;
- debug(msg.str().c_str()); }
+ if (!f.name.empty()) { ostringstream msg;
+ msg << "exit " << f.name << ", result: " << pm->r[0].rhs;
+ debug(msg.str().c_str()); }
#endif
- f.CreateRet(codegen(pm->r[0].rhs));
+ toplevel_codegen(pm->r[0].rhs);
} else {
// build the initial stack of expressions to be matched
list<Value*>xs;
@@ -4607,7 +4650,7 @@
msg << "exit " << f.name << ", result: " << rr.rhs;
debug(msg.str().c_str()); }
#endif
- f.CreateRet(codegen(rr.rhs));
+ toplevel_codegen(rr.rhs);
break;
}
// check the guard
@@ -4647,7 +4690,7 @@
msg << "exit " << f.name << ", result: " << rr.rhs;
debug(msg.str().c_str()); }
#endif
- f.CreateRet(codegen(rr.rhs));
+ toplevel_codegen(rr.rhs);
rulebb = nextbb;
}
if (f.fmap.size() > 1) f.fmap_idx = 0;
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-05-24 19:58:42 UTC (rev 128)
+++ pure/trunk/interpreter.hh 2008-05-25 05:42:48 UTC (rev 129)
@@ -416,6 +416,7 @@
pure_expr *doeval(expr x, pure_expr*& e);
pure_expr *dodefn(env vars, expr lhs, expr rhs, pure_expr*& e);
llvm::Value *codegen(expr x);
+ void toplevel_codegen(expr x);
llvm::Value *builtin_codegen(expr x);
llvm::Value *get_int(expr x);
llvm::Value *get_double(expr x);
@@ -428,6 +429,7 @@
llvm::Value *call(llvm::Value *x);
llvm::Value *apply(llvm::Value *x, llvm::Value *y);
llvm::Value *cond(expr x, expr y, expr z);
+ void toplevel_cond(expr x, expr y, expr z);
llvm::Value *fbox(Env& f, bool thunked = false);
llvm::Value *cbox(int32_t tag);
llvm::Value *ibox(llvm::Value *i);
Modified: pure/trunk/test/test004.log
===================================================================
--- pure/trunk/test/test004.log 2008-05-24 19:58:42 UTC (rev 128)
+++ pure/trunk/test/test004.log 2008-05-25 05:42:48 UTC (rev 129)
@@ -75,6 +75,15 @@
}
count2 100;
0
+count3 n/*0:1*/::int = if n/*0:1*/<=0 then n/*0:1*/ else count3 (n/*0:1*/-1);
+{
+ rule #0: count3 n::int = if n<=0 then n else count3 (n-1)
+ state 0: #0
+ <var>::int state 1
+ state 1: #0
+}
+count3 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
Modified: pure/trunk/test/test004.pure
===================================================================
--- pure/trunk/test/test004.pure 2008-05-24 19:58:42 UTC (rev 128)
+++ pure/trunk/test/test004.pure 2008-05-25 05:42:48 UTC (rev 129)
@@ -35,12 +35,17 @@
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;
+// Definitions involving toplevel if-then-else are properly tail-recursive as
+// well.
+
+count3 n::int = if n<=0 then n else count3 (n-1);
+
+count3 100;
+//count3 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
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-24 19:58:34
|
Revision: 128
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=128&view=rev
Author: agraef
Date: 2008-05-24 12:58:42 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Fix sscanf %n conversion.
Modified Paths:
--------------
pure/trunk/lib/system.pure
pure/trunk/test/test011.log
pure/trunk/test/test011.pure
Modified: pure/trunk/lib/system.pure
===================================================================
--- pure/trunk/lib/system.pure 2008-05-24 19:30:07 UTC (rev 127)
+++ pure/trunk/lib/system.pure 2008-05-24 19:58:42 UTC (rev 128)
@@ -349,7 +349,7 @@
// null byte.
buf = check_buf (calloc size 1);
res = case t of
- "n" = pure_fscanf_int fp s buf;
+ "n" = pure_sscanf_int u s buf;
"d" = pure_sscanf_int u s buf;
"g" = pure_sscanf_double u s buf;
"s" = pure_sscanf_string u s buf;
Modified: pure/trunk/test/test011.log
===================================================================
--- pure/trunk/test/test011.log 2008-05-24 19:30:07 UTC (rev 127)
+++ pure/trunk/test/test011.log 2008-05-24 19:58:42 UTC (rev 128)
@@ -1042,8 +1042,8 @@
state 0: #0
<var> state 1
state 1: #0
-}; do_sscanf (u/*0:0101*/,nread/*0:01101*/,ret/*0:0111*/) (scanf_format_spec t/*0:101*/ s/*0:11*/) = u/*0:*/,nread/*8:01101*/+res/*4:*/,ret/*1:*/ when size/*0:01*/,s/*0:1*/ = if t/*0:101*/=="s" then guestimate/*1*/ s/*0:11*/ else 16,s/*0:11*/; buf/*0:*/ = check_buf/*2*/ (calloc size/*0:01*/ 1); res/*0:*/ = case t/*2:101*/ of "n" = pure_fscanf_int fp s/*2:1*/ buf/*1:*/; "d" = pure_sscanf_int u/*3:0101*/ s/*2:1*/ buf/*1:*/; "g" = pure_sscanf_double u/*3:0101*/ s/*2:1*/ buf/*1:*/; "s" = pure_sscanf_string u/*3:0101*/ s/*2:1*/ buf/*1:*/; "p" = pure_sscanf_pointer u/*3:0101*/ s/*2:1*/ buf/*1:*/; _/*0:*/ = throw (this_cant_happen ret/*3:0111*/) {
- rule #0: "n" = pure_fscanf_int fp s buf
+}; do_sscanf (u/*0:0101*/,nread/*0:01101*/,ret/*0:0111*/) (scanf_format_spec t/*0:101*/ s/*0:11*/) = u/*0:*/,nread/*8:01101*/+res/*4:*/,ret/*1:*/ when size/*0:01*/,s/*0:1*/ = if t/*0:101*/=="s" then guestimate/*1*/ s/*0:11*/ else 16,s/*0:11*/; buf/*0:*/ = check_buf/*2*/ (calloc size/*0:01*/ 1); res/*0:*/ = case t/*2:101*/ of "n" = pure_sscanf_int u/*3:0101*/ s/*2:1*/ buf/*1:*/; "d" = pure_sscanf_int u/*3:0101*/ s/*2:1*/ buf/*1:*/; "g" = pure_sscanf_double u/*3:0101*/ s/*2:1*/ buf/*1:*/; "s" = pure_sscanf_string u/*3:0101*/ s/*2:1*/ buf/*1:*/; "p" = pure_sscanf_pointer u/*3:0101*/ s/*2:1*/ buf/*1:*/; _/*0:*/ = throw (this_cant_happen ret/*3:0111*/) {
+ rule #0: "n" = pure_sscanf_int u s buf
rule #1: "d" = pure_sscanf_int u s buf
rule #2: "g" = pure_sscanf_double u s buf
rule #3: "s" = pure_sscanf_string u s buf
@@ -1113,7 +1113,7 @@
<var> state 1
state 1: #0
} {
- rule #0: res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end
+ rule #0: res = case t of "n" = pure_sscanf_int u s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end
state 0: #0
<var> state 1
state 1: #0
@@ -1151,7 +1151,7 @@
<var> state 1
state 1: #0
} end; do_sscanf (_/*0:0101*/,_/*0:01101*/,ret/*0:0111*/) _/*0:1*/ = throw (this_cant_happen ret/*0:0111*/) {
- rule #0: do_sscanf (u,nread,ret) (scanf_format_spec t s) = u,nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret; u = drop res u end
+ rule #0: do_sscanf (u,nread,ret) (scanf_format_spec t s) = u,nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_sscanf_int u s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret; u = drop res u end
rule #1: do_sscanf (u,nread,ret) (scanf_format_str s) = u,nread+res,ret when res = pure_sscanf u s; ret = if res>=0 then ret else throw (scanf_error ret); u = drop res u end
rule #2: do_sscanf (_,_,ret) _ = throw (this_cant_happen ret)
state 0: #0 #1 #2
@@ -1970,7 +1970,7 @@
state 4: #0
}
{
- rule #0: sscanf s::string format::string = tuple$reverse ret when _,_,ret = catch error_handler (foldl do_sscanf (s,0,[])$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw scanf_malloc_error if null buf; check_buf buf = buf; guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end; do_sscanf (u,nread,ret) (scanf_format_spec t s) = u,nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret; u = drop res u end; do_sscanf (u,nread,ret) (scanf_format_str s) = u,nread+res,ret when res = pure_sscanf u s; ret = if res>=0 then ret else throw (scanf_error ret); u = drop res u end; do_sscanf (_,_,ret) _ = throw (this_cant_happen ret) end
+ rule #0: sscanf s::string format::string = tuple$reverse ret when _,_,ret = catch error_handler (foldl do_sscanf (s,0,[])$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw scanf_malloc_error if null buf; check_buf buf = buf; guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end; do_sscanf (u,nread,ret) (scanf_format_spec t s) = u,nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_sscanf_int u s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret; u = drop res u end; do_sscanf (u,nread,ret) (scanf_format_str s) = u,nread+res,ret when res = pure_sscanf u s; ret = if res>=0 then ret else throw (scanf_error ret); u = drop res u end; do_sscanf (_,_,ret) _ = throw (this_cant_happen ret) end
state 0: #0
<var>::string state 1
state 1: #0
@@ -2114,3 +2114,7 @@
()
sscanf "this" "that";
<stdin>:7.0-19: unhandled exception 'scanf_error ()' while evaluating 'sscanf "this" "that"'
+sscanf "this that" "this%n that%n";
+4,9
+sscanf "this that" "this%n%s%n";
+4,"that",9
Modified: pure/trunk/test/test011.pure
===================================================================
--- pure/trunk/test/test011.pure 2008-05-24 19:30:07 UTC (rev 127)
+++ pure/trunk/test/test011.pure 2008-05-24 19:58:42 UTC (rev 128)
@@ -5,3 +5,5 @@
sscanf "this" "%p";
sscanf "this" "this";
sscanf "this" "that";
+sscanf "this that" "this%n that%n";
+sscanf "this that" "this%n%s%n";
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-24 19:29:59
|
Revision: 127
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=127&view=rev
Author: agraef
Date: 2008-05-24 12:30:07 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Fix memory allocation bugs in exception handling.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
pure/trunk/runtime.cc
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-05-24 19:27:27 UTC (rev 126)
+++ pure/trunk/ChangeLog 2008-05-24 19:30:07 UTC (rev 127)
@@ -1,5 +1,8 @@
2008-05-24 Albert Graef <Dr....@t-...>
+ * interpreter.cc, runtime.cc: Fix more memory allocation bugs in
+ exception handling.
+
* runtime.cc, lib/system.pure: Bugfixes in the scanf
functions. Reported by Jiri Spitz.
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-05-24 19:27:27 UTC (rev 126)
+++ pure/trunk/interpreter.cc 2008-05-24 19:30:07 UTC (rev 127)
@@ -3902,7 +3902,7 @@
assert(f);
vector<Value*> args;
if (tag > 0)
- args.push_back(call("pure_new", cbox(tag)));
+ args.push_back(cbox(tag));
else
args.push_back(NullExprPtr);
Env& e = act_env();
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-05-24 19:27:27 UTC (rev 126)
+++ pure/trunk/runtime.cc 2008-05-24 19:30:07 UTC (rev 127)
@@ -276,14 +276,13 @@
if (!interpreter::g_interp) return 0;
pure_expr *f = pure_const(interpreter::g_interp->symtab.signal_sym().f);
pure_expr *x = pure_int(sig);
- return pure_new_internal(pure_apply2(f, x));
+ return pure_apply2(f, x);
}
static inline pure_expr* stack_exception()
{
if (!interpreter::g_interp) return 0;
- return pure_new_internal
- (pure_const(interpreter::g_interp->symtab.segfault_sym().f));
+ return pure_const(interpreter::g_interp->symtab.segfault_sym().f);
}
extern "C"
@@ -612,7 +611,6 @@
abort(); // no exception handler, bail out
else {
interp.estk.front().e = e;
- assert(!e || e->refc > 0);
longjmp(interp.estk.front().jmp, 1);
}
}
@@ -669,9 +667,7 @@
size_t sz = interp.estk.front().sz;
pure_expr *e = interp.estk.front().e;
interp.estk.pop_front();
- assert(!e || e->refc > 0);
- // make sure that we don't accidentally collect the exception value
- if (e) e->refc++;
+ if (e) pure_new_internal(e);
// collect garbage
pure_expr *tmps = interp.tmps;
while (tmps) {
@@ -683,10 +679,13 @@
if (interp.sstk[i] && interp.sstk[i]->refc > 0)
pure_free_internal(interp.sstk[i]);
interp.sstk_sz = sz;
- if (e && e->refc > 1) e->refc--;
if (!e)
e = pure_new_internal(pure_const(interp.symtab.void_sym().f));
assert(e && e->refc > 0);
+#if DEBUG>1
+ cerr << "pure_catch: exception " << (void*)e << " (refc = " << e->refc
+ << "): " << e << endl;
+#endif
pure_expr *res = pure_apply(h, e);
assert(res);
res->refc++;
@@ -743,9 +742,7 @@
size_t sz = interp.estk.front().sz;
e = interp.estk.front().e;
interp.estk.pop_front();
- assert(!e || e->refc > 0);
- // make sure that we don't accidentally collect the exception value
- if (e) e->refc++;
+ if (e) pure_new_internal(e);
// collect garbage
pure_expr *tmps = interp.tmps;
while (tmps) {
@@ -757,7 +754,11 @@
if (interp.sstk[i] && interp.sstk[i]->refc > 0)
pure_free_internal(interp.sstk[i]);
interp.sstk_sz = sz;
- if (e && e->refc > 1) e->refc--;
+#if DEBUG>1
+ if (e)
+ cerr << "pure_invoke: exception " << (void*)e << " (refc = " << e->refc
+ << "): " << e << endl;
+#endif
MEMDEBUG_SUMMARY(e)
return 0;
} else {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-24 19:27:19
|
Revision: 126
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=126&view=rev
Author: agraef
Date: 2008-05-24 12:27:27 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Fix scanf %n conversion.
Modified Paths:
--------------
pure/trunk/test/test011.log
Modified: pure/trunk/test/test011.log
===================================================================
--- pure/trunk/test/test011.log 2008-05-24 19:26:54 UTC (rev 125)
+++ pure/trunk/test/test011.log 2008-05-24 19:27:27 UTC (rev 126)
@@ -778,67 +778,49 @@
state 0: #0
<var> state 1
state 1: #0
-} end; do_fscanf _/*0:001*/ ret/*0:01*/ _/*0:1*/ = throw (this_cant_happen ret/*0:01*/) {
+} end; do_fscanf _/*0:001*/ (_/*0:0101*/,ret/*0:011*/) _/*0:1*/ = throw (this_cant_happen ret/*0:011*/) {
rule #0: do_fscanf fp (nread,ret) (scanf_format_spec t s) = nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret end
rule #1: do_fscanf fp (nread,ret) (scanf_format_str s) = nread+res,ret when res = pure_fscanf fp s; ret = if res>=0 then ret else throw (scanf_error ret) end
- rule #2: do_fscanf _ ret _ = throw (this_cant_happen ret)
+ rule #2: do_fscanf _ (_,ret) _ = throw (this_cant_happen ret)
state 0: #0 #1 #2
<var> state 1
state 1: #0 #1 #2
- <var> state 2
- <app> state 4
- state 2: #2
- <var> state 3
- state 3: #2
+ <app> state 2
+ state 2: #0 #1 #2
+ <app> state 3
+ state 3: #0 #1 #2
+ , state 4
state 4: #0 #1 #2
<var> state 5
- <app> state 8
- state 5: #2
+ state 5: #0 #1 #2
<var> state 6
- state 6: #2
+ state 6: #0 #1 #2
<var> state 7
+ <app> state 8
state 7: #2
state 8: #0 #1 #2
<var> state 9
- , state 13
+ <app> state 11
+ scanf_format_str state 18
state 9: #2
<var> state 10
state 10: #2
- <var> state 11
- state 11: #2
+ state 11: #0 #2
<var> state 12
+ scanf_format_spec state 15
state 12: #2
- state 13: #0 #1 #2
+ <var> state 13
+ state 13: #2
<var> state 14
- state 14: #0 #1 #2
- <var> state 15
- state 15: #0 #1 #2
+ state 14: #2
+ state 15: #0 #2
<var> state 16
- <app> state 17
- state 16: #2
- state 17: #0 #1 #2
- <var> state 18
- <app> state 20
- scanf_format_str state 27
- state 18: #2
+ state 16: #0 #2
+ <var> state 17
+ state 17: #0 #2
+ state 18: #1 #2
<var> state 19
- state 19: #2
- state 20: #0 #2
- <var> state 21
- scanf_format_spec state 24
- state 21: #2
- <var> state 22
- state 22: #2
- <var> state 23
- state 23: #2
- state 24: #0 #2
- <var> state 25
- state 25: #0 #2
- <var> state 26
- state 26: #0 #2
- state 27: #1 #2
- <var> state 28
- state 28: #1 #2
+ state 19: #1 #2
}; guestimate format/*0:1*/ = n/*0:01*/,format/*0:1*/ when 1,0,_/*0:1101*/,1,s/*0:1111*/ = regex "^%([0-9]*)" REG_EXTENDED format/*0:1*/ 0; n/*0:01*/,format/*0:1*/ = if null s/*0:1111*/ then 1025,"%1024"+tail format/*1:1*/ else eval s/*0:1111*/+1,format/*1:1*/ {
rule #0: n,format = if null s then 1025,"%1024"+tail format else eval s+1,format
state 0: #0
@@ -1168,10 +1150,10 @@
state 0: #0
<var> state 1
state 1: #0
-} end; do_sscanf (_/*0:0101*/,ret/*0:011*/) _/*0:1*/ = throw (this_cant_happen ret/*0:011*/) {
+} end; do_sscanf (_/*0:0101*/,_/*0:01101*/,ret/*0:0111*/) _/*0:1*/ = throw (this_cant_happen ret/*0:0111*/) {
rule #0: do_sscanf (u,nread,ret) (scanf_format_spec t s) = u,nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret; u = drop res u end
rule #1: do_sscanf (u,nread,ret) (scanf_format_str s) = u,nread+res,ret when res = pure_sscanf u s; ret = if res>=0 then ret else throw (scanf_error ret); u = drop res u end
- rule #2: do_sscanf (_,ret) _ = throw (this_cant_happen ret)
+ rule #2: do_sscanf (_,_,ret) _ = throw (this_cant_happen ret)
state 0: #0 #1 #2
<app> state 1
state 1: #0 #1 #2
@@ -1181,60 +1163,42 @@
state 3: #0 #1 #2
<var> state 4
state 4: #0 #1 #2
- <var> state 5
- <app> state 7
- state 5: #2
- <var> state 6
- state 6: #2
+ <app> state 5
+ state 5: #0 #1 #2
+ <app> state 6
+ state 6: #0 #1 #2
+ , state 7
state 7: #0 #1 #2
<var> state 8
- <app> state 11
- state 8: #2
+ state 8: #0 #1 #2
<var> state 9
- state 9: #2
+ state 9: #0 #1 #2
<var> state 10
+ <app> state 11
state 10: #2
state 11: #0 #1 #2
<var> state 12
- , state 16
+ <app> state 14
+ scanf_format_str state 21
state 12: #2
<var> state 13
state 13: #2
- <var> state 14
- state 14: #2
+ state 14: #0 #2
<var> state 15
+ scanf_format_spec state 18
state 15: #2
- state 16: #0 #1 #2
+ <var> state 16
+ state 16: #2
<var> state 17
- state 17: #0 #1 #2
- <var> state 18
- state 18: #0 #1 #2
+ state 17: #2
+ state 18: #0 #2
<var> state 19
- <app> state 20
- state 19: #2
- state 20: #0 #1 #2
- <var> state 21
- <app> state 23
- scanf_format_str state 30
- state 21: #2
+ state 19: #0 #2
+ <var> state 20
+ state 20: #0 #2
+ state 21: #1 #2
<var> state 22
- state 22: #2
- state 23: #0 #2
- <var> state 24
- scanf_format_spec state 27
- state 24: #2
- <var> state 25
- state 25: #2
- <var> state 26
- state 26: #2
- state 27: #0 #2
- <var> state 28
- state 28: #0 #2
- <var> state 29
- state 29: #0 #2
- state 30: #1 #2
- <var> state 31
- state 31: #1 #2
+ state 22: #1 #2
} end;
readline prompt/*0:1*/::string = cstring$c_readline prompt/*0:1*/;
fnmatch pat/*0:001*/::string s/*0:01*/::string flags/*0:1*/::int = c_fnmatch pat/*0:001*/ s/*0:01*/ flags/*0:1*/==0;
@@ -1980,7 +1944,7 @@
state 1: #0
}
{
- rule #0: fscanf fp format::string = tuple$reverse ret when _,ret = catch error_handler (foldl (do_fscanf fp) (0,[])$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw scanf_malloc_error if null buf; check_buf buf = buf; do_fscanf fp (nread,ret) (scanf_format_spec t s) = nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret end; do_fscanf fp (nread,ret) (scanf_format_str s) = nread+res,ret when res = pure_fscanf fp s; ret = if res>=0 then ret else throw (scanf_error ret) end; do_fscanf _ ret _ = throw (this_cant_happen ret); guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end end
+ rule #0: fscanf fp format::string = tuple$reverse ret when _,ret = catch error_handler (foldl (do_fscanf fp) (0,[])$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw scanf_malloc_error if null buf; check_buf buf = buf; do_fscanf fp (nread,ret) (scanf_format_spec t s) = nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret end; do_fscanf fp (nread,ret) (scanf_format_str s) = nread+res,ret when res = pure_fscanf fp s; ret = if res>=0 then ret else throw (scanf_error ret) end; do_fscanf _ (_,ret) _ = throw (this_cant_happen ret); guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end end
state 0: #0
<var> state 1
state 1: #0
@@ -2006,7 +1970,7 @@
state 4: #0
}
{
- rule #0: sscanf s::string format::string = tuple$reverse ret when _,_,ret = catch error_handler (foldl do_sscanf (s,0,[])$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw scanf_malloc_error if null buf; check_buf buf = buf; guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end; do_sscanf (u,nread,ret) (scanf_format_spec t s) = u,nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret; u = drop res u end; do_sscanf (u,nread,ret) (scanf_format_str s) = u,nread+res,ret when res = pure_sscanf u s; ret = if res>=0 then ret else throw (scanf_error ret); u = drop res u end; do_sscanf (_,ret) _ = throw (this_cant_happen ret) end
+ rule #0: sscanf s::string format::string = tuple$reverse ret when _,_,ret = catch error_handler (foldl do_sscanf (s,0,[])$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw scanf_malloc_error if null buf; check_buf buf = buf; guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end; do_sscanf (u,nread,ret) (scanf_format_spec t s) = u,nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret; u = drop res u end; do_sscanf (u,nread,ret) (scanf_format_str s) = u,nread+res,ret when res = pure_sscanf u s; ret = if res>=0 then ret else throw (scanf_error ret); u = drop res u end; do_sscanf (_,_,ret) _ = throw (this_cant_happen ret) end
state 0: #0
<var>::string state 1
state 1: #0
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-24 19:26:46
|
Revision: 125
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=125&view=rev
Author: agraef
Date: 2008-05-24 12:26:54 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Fix scanf %n conversion.
Modified Paths:
--------------
pure/trunk/lib/system.pure
Modified: pure/trunk/lib/system.pure
===================================================================
--- pure/trunk/lib/system.pure 2008-05-24 18:14:05 UTC (rev 124)
+++ pure/trunk/lib/system.pure 2008-05-24 19:26:54 UTC (rev 125)
@@ -286,7 +286,7 @@
res = pure_fscanf fp s;
ret = if res>=0 then ret else throw (scanf_error ret);
end;
- do_fscanf _ ret _ = throw (this_cant_happen ret);
+ do_fscanf _ (_,ret) _ = throw (this_cant_happen ret);
check_buf buf = throw scanf_malloc_error if null buf;
= buf otherwise;
// Compute a reasonable size for a string buffer; if necessary, modify the
@@ -378,7 +378,7 @@
ret = if res>=0 then ret else throw (scanf_error ret);
u = drop res u;
end;
- do_sscanf (_,ret) _ = throw (this_cant_happen ret);
+ do_sscanf (_,_,ret) _ = throw (this_cant_happen ret);
check_buf buf = throw scanf_malloc_error if null buf;
= buf otherwise;
// Compute a reasonable size for a string buffer; if necessary, modify the
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-24 18:14:02
|
Revision: 124
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=124&view=rev
Author: agraef
Date: 2008-05-24 11:14:05 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Fix memory allocation bugs in exception handling.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/runtime.cc
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-05-24 18:12:16 UTC (rev 123)
+++ pure/trunk/interpreter.cc 2008-05-24 18:14:05 UTC (rev 124)
@@ -437,7 +437,7 @@
globals g;
save_globals(g);
pure_expr *e, *res = eval(x, e);
- if (!res && e) pure_freenew(e);
+ if (!res && e) pure_free(e);
restore_globals(g);
return res;
}
@@ -462,7 +462,7 @@
globals g;
save_globals(g);
pure_expr *e, *res = defn(pat, x, e);
- if (!res && e) pure_freenew(e);
+ if (!res && e) pure_free(e);
restore_globals(g);
return res;
}
@@ -744,7 +744,7 @@
if (e) {
msg << "unhandled exception '" << e << "' while evaluating '"
<< *x << "'";
- pure_freenew(e);
+ pure_free(e);
} else
msg << "unhandled exception while evaluating '" << *x << "'";
throw err(msg.str());
@@ -769,7 +769,7 @@
if (e) {
msg << "unhandled exception '" << e << "' while evaluating '"
<< "let " << r->lhs << " = " << r->rhs << "'";
- pure_freenew(e);
+ pure_free(e);
} else
msg << "failed match while evaluating '"
<< "let " << r->lhs << " = " << r->rhs << "'";
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-05-24 18:12:16 UTC (rev 123)
+++ pure/trunk/runtime.cc 2008-05-24 18:14:05 UTC (rev 124)
@@ -612,10 +612,7 @@
abort(); // no exception handler, bail out
else {
interp.estk.front().e = e;
- if (e) {
- assert(e->refc > 0);
- pure_unref_internal(e);
- }
+ assert(!e || e->refc > 0);
longjmp(interp.estk.front().jmp, 1);
}
}
@@ -672,21 +669,25 @@
size_t sz = interp.estk.front().sz;
pure_expr *e = interp.estk.front().e;
interp.estk.pop_front();
+ assert(!e || e->refc > 0);
+ // make sure that we don't accidentally collect the exception value
+ if (e) e->refc++;
// collect garbage
pure_expr *tmps = interp.tmps;
while (tmps) {
pure_expr *next = tmps->xp;
- if (tmps != e) pure_freenew(tmps);
+ pure_freenew(tmps);
tmps = next;
}
for (size_t i = interp.sstk_sz; i-- > sz; )
if (interp.sstk[i] && interp.sstk[i]->refc > 0)
pure_free_internal(interp.sstk[i]);
interp.sstk_sz = sz;
- if (!e) e = pure_const(interp.symtab.void_sym().f);
- assert(e);
- pure_unref_internal(h);
- pure_expr *res = pure_apply2(h, e);
+ if (e && e->refc > 1) e->refc--;
+ if (!e)
+ e = pure_new_internal(pure_const(interp.symtab.void_sym().f));
+ assert(e && e->refc > 0);
+ pure_expr *res = pure_apply(h, e);
assert(res);
res->refc++;
pure_free_internal(x);
@@ -742,17 +743,21 @@
size_t sz = interp.estk.front().sz;
e = interp.estk.front().e;
interp.estk.pop_front();
+ assert(!e || e->refc > 0);
+ // make sure that we don't accidentally collect the exception value
+ if (e) e->refc++;
// collect garbage
pure_expr *tmps = interp.tmps;
while (tmps) {
pure_expr *next = tmps->xp;
- if (tmps != e) pure_freenew(tmps);
+ pure_freenew(tmps);
tmps = next;
}
for (size_t i = interp.sstk_sz; i-- > sz; )
if (interp.sstk[i] && interp.sstk[i]->refc > 0)
pure_free_internal(interp.sstk[i]);
interp.sstk_sz = sz;
+ if (e && e->refc > 1) e->refc--;
MEMDEBUG_SUMMARY(e)
return 0;
} else {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-24 18:12:08
|
Revision: 123
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=123&view=rev
Author: agraef
Date: 2008-05-24 11:12:16 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Fix scanf %n conversion.
Modified Paths:
--------------
pure/trunk/test/test011.log
Modified: pure/trunk/test/test011.log
===================================================================
--- pure/trunk/test/test011.log 2008-05-24 17:10:55 UTC (rev 122)
+++ pure/trunk/test/test011.log 2008-05-24 18:12:16 UTC (rev 123)
@@ -645,11 +645,19 @@
state 1: #0 #1
} end;
scanf format/*0:1*/::string = fscanf stdin format/*0:1*/;
-fscanf fp/*0:01*/ format/*0:1*/::string = tuple$reverse ret/*0:*/ when ret/*0:*/ = catch error_handler/*0*/ (foldl (do_fscanf/*1*/ fp/*1:01*/) []$scanf_split_format format/*1:1*/) {
- rule #0: ret = catch error_handler (foldl (do_fscanf fp) []$scanf_split_format format)
+fscanf fp/*0:01*/ format/*0:1*/::string = tuple$reverse ret/*0:1*/ when _/*0:01*/,ret/*0:1*/ = catch error_handler/*0*/ (foldl (do_fscanf/*1*/ fp/*1:01*/) (0,[])$scanf_split_format format/*1:1*/) {
+ rule #0: _,ret = catch error_handler (foldl (do_fscanf fp) (0,[])$scanf_split_format format)
state 0: #0
- <var> state 1
+ <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 error_handler (scanf_error ret/*0:11*/) = throw (scanf_error (tuple$reverse ret/*0:11*/)); error_handler x/*0:1*/ = throw x/*0:1*/ {
rule #0: error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret))
rule #1: error_handler x = throw x
@@ -666,52 +674,58 @@
state 5: #0 #1
<var> state 6
state 6: #0 #1
-}; check_buf buf/*0:1*/ = throw printf_malloc_error if null buf/*0:1*/; check_buf buf/*0:1*/ = buf/*0:1*/ {
- rule #0: check_buf buf = throw printf_malloc_error if null buf
+}; check_buf buf/*0:1*/ = throw scanf_malloc_error if null buf/*0:1*/; check_buf buf/*0:1*/ = buf/*0:1*/ {
+ rule #0: check_buf buf = throw scanf_malloc_error if null buf
rule #1: check_buf buf = buf
state 0: #0 #1
<var> state 1
state 1: #0 #1
-}; do_fscanf fp/*0:001*/ ret/*0:01*/ (scanf_format_spec t/*0:101*/ s/*0:11*/) = ret/*0:*/ when size/*0:01*/,s/*0:1*/ = if t/*0:101*/=="s" then guestimate/*1*/ s/*0:11*/ else 16,s/*0:11*/; buf/*0:*/ = check_buf/*2*/ (calloc size/*0:01*/ 1); res/*0:*/ = case t/*2:101*/ of "d" = pure_fscanf_int fp/*3:001*/ s/*2:1*/ buf/*1:*/; "g" = pure_fscanf_double fp/*3:001*/ s/*2:1*/ buf/*1:*/; "s" = pure_fscanf_string fp/*3:001*/ s/*2:1*/ buf/*1:*/; "p" = pure_fscanf_pointer fp/*3:001*/ s/*2:1*/ buf/*1:*/; _/*0:*/ = throw (this_cant_happen ret/*3:01*/) {
- rule #0: "d" = pure_fscanf_int fp s buf
- rule #1: "g" = pure_fscanf_double fp s buf
- rule #2: "s" = pure_fscanf_string fp s buf
- rule #3: "p" = pure_fscanf_pointer fp s buf
- rule #4: _ = throw (this_cant_happen ret)
- state 0: #0 #1 #2 #3 #4
+}; do_fscanf fp/*0:001*/ (nread/*0:0101*/,ret/*0:011*/) (scanf_format_spec t/*0:101*/ s/*0:11*/) = nread/*7:0101*/+res/*3:*/,ret/*0:*/ when size/*0:01*/,s/*0:1*/ = if t/*0:101*/=="s" then guestimate/*1*/ s/*0:11*/ else 16,s/*0:11*/; buf/*0:*/ = check_buf/*2*/ (calloc size/*0:01*/ 1); res/*0:*/ = case t/*2:101*/ of "n" = pure_fscanf_int fp/*3:001*/ s/*2:1*/ buf/*1:*/; "d" = pure_fscanf_int fp/*3:001*/ s/*2:1*/ buf/*1:*/; "g" = pure_fscanf_double fp/*3:001*/ s/*2:1*/ buf/*1:*/; "s" = pure_fscanf_string fp/*3:001*/ s/*2:1*/ buf/*1:*/; "p" = pure_fscanf_pointer fp/*3:001*/ s/*2:1*/ buf/*1:*/; _/*0:*/ = throw (this_cant_happen ret/*3:011*/) {
+ rule #0: "n" = pure_fscanf_int fp s buf
+ rule #1: "d" = pure_fscanf_int fp s buf
+ rule #2: "g" = pure_fscanf_double fp s buf
+ rule #3: "s" = pure_fscanf_string fp s buf
+ rule #4: "p" = pure_fscanf_pointer fp s buf
+ rule #5: _ = throw (this_cant_happen ret)
+ state 0: #0 #1 #2 #3 #4 #5
<var> state 1
- "d"::string state 2
- "g"::string state 3
- "s"::string state 4
- "p"::string state 5
- state 1: #4
- state 2: #0 #4
- state 3: #1 #4
- state 4: #2 #4
- state 5: #3 #4
-} end; res/*0:*/ = if res/*0:*/>=0 then res/*0:*/ else throw (scanf_error ret/*4:01*/) when _/*0:*/ = free buf/*1:*/ {
+ "n"::string state 2
+ "d"::string state 3
+ "g"::string state 4
+ "s"::string state 5
+ "p"::string state 6
+ state 1: #5
+ state 2: #0 #5
+ state 3: #1 #5
+ state 4: #2 #5
+ state 5: #3 #5
+ state 6: #4 #5
+} end; res/*0:*/ = if res/*0:*/>=0 then res/*0:*/ else throw (scanf_error ret/*4:011*/) when _/*0:*/ = free buf/*1:*/ {
rule #0: _ = free buf
state 0: #0
<var> state 1
state 1: #0
-} end; val/*0:*/ = case t/*4:101*/ of "d" = get_int buf/*3:*/; "g" = get_double buf/*3:*/; "s" = cstring buf/*3:*/; "p" = get_pointer buf/*3:*/; _/*0:*/ = throw (this_cant_happen ret/*5:01*/) {
- rule #0: "d" = get_int buf
- rule #1: "g" = get_double buf
- rule #2: "s" = cstring buf
- rule #3: "p" = get_pointer buf
- rule #4: _ = throw (this_cant_happen ret)
- state 0: #0 #1 #2 #3 #4
+} end; val/*0:*/ = case t/*4:101*/ of "n" = nread/*5:0101*/+get_int buf/*3:*/; "d" = get_int buf/*3:*/; "g" = get_double buf/*3:*/; "s" = cstring buf/*3:*/; "p" = get_pointer buf/*3:*/; _/*0:*/ = throw (this_cant_happen ret/*5:011*/) {
+ rule #0: "n" = nread+get_int buf
+ rule #1: "d" = get_int buf
+ rule #2: "g" = get_double buf
+ rule #3: "s" = cstring buf
+ rule #4: "p" = get_pointer buf
+ rule #5: _ = throw (this_cant_happen ret)
+ state 0: #0 #1 #2 #3 #4 #5
<var> state 1
- "d"::string state 2
- "g"::string state 3
- "s"::string state 4
- "p"::string state 5
- state 1: #4
- state 2: #0 #4
- state 3: #1 #4
- state 4: #2 #4
- state 5: #3 #4
-} end; _/*0:*/ = if t/*5:101*/=="s" then () else free buf/*3:*/; ret/*0:*/ = val/*1:*/:ret/*6:01*/ {
+ "n"::string state 2
+ "d"::string state 3
+ "g"::string state 4
+ "s"::string state 5
+ "p"::string state 6
+ state 1: #5
+ state 2: #0 #5
+ state 3: #1 #5
+ state 4: #2 #5
+ state 5: #3 #5
+ state 6: #4 #5
+} end; _/*0:*/ = if t/*5:101*/=="s" then () else free buf/*3:*/; ret/*0:*/ = val/*1:*/:ret/*6:011*/ {
rule #0: ret = val:ret
state 0: #0
<var> state 1
@@ -722,7 +736,7 @@
<var> state 1
state 1: #0
} {
- rule #0: val = case t of "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end
+ rule #0: val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end
state 0: #0
<var> state 1
state 1: #0
@@ -732,7 +746,7 @@
<var> state 1
state 1: #0
} {
- rule #0: res = case t of "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end
+ rule #0: res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end
state 0: #0
<var> state 1
state 1: #0
@@ -754,7 +768,7 @@
state 4: #0
<var> state 5
state 5: #0
-} end; do_fscanf fp/*0:001*/ ret/*0:01*/ (scanf_format_str s/*0:11*/) = ret/*0:*/ when res/*0:*/ = pure_fscanf fp/*0:001*/ s/*0:11*/; ret/*0:*/ = if res/*0:*/>=0 then ret/*1:01*/ else throw (scanf_error ret/*1:01*/) {
+} end; do_fscanf fp/*0:001*/ (nread/*0:0101*/,ret/*0:011*/) (scanf_format_str s/*0:11*/) = nread/*2:0101*/+res/*1:*/,ret/*0:*/ when res/*0:*/ = pure_fscanf fp/*0:001*/ s/*0:11*/; ret/*0:*/ = if res/*0:*/>=0 then ret/*1:011*/ else throw (scanf_error ret/*1:011*/) {
rule #0: ret = if res>=0 then ret else throw (scanf_error ret)
state 0: #0
<var> state 1
@@ -765,40 +779,66 @@
<var> state 1
state 1: #0
} end; do_fscanf _/*0:001*/ ret/*0:01*/ _/*0:1*/ = throw (this_cant_happen ret/*0:01*/) {
- rule #0: do_fscanf fp ret (scanf_format_spec t s) = ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret end
- rule #1: do_fscanf fp ret (scanf_format_str s) = ret when res = pure_fscanf fp s; ret = if res>=0 then ret else throw (scanf_error ret) end
+ rule #0: do_fscanf fp (nread,ret) (scanf_format_spec t s) = nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret end
+ rule #1: do_fscanf fp (nread,ret) (scanf_format_str s) = nread+res,ret when res = pure_fscanf fp s; ret = if res>=0 then ret else throw (scanf_error ret) end
rule #2: do_fscanf _ ret _ = throw (this_cant_happen ret)
state 0: #0 #1 #2
<var> state 1
state 1: #0 #1 #2
<var> state 2
- state 2: #0 #1 #2
+ <app> state 4
+ state 2: #2
<var> state 3
- <app> state 4
state 3: #2
state 4: #0 #1 #2
<var> state 5
- <app> state 7
- scanf_format_str state 14
+ <app> state 8
state 5: #2
<var> state 6
state 6: #2
- state 7: #0 #2
- <var> state 8
- scanf_format_spec state 11
- state 8: #2
+ <var> state 7
+ state 7: #2
+ state 8: #0 #1 #2
<var> state 9
+ , state 13
state 9: #2
<var> state 10
state 10: #2
- state 11: #0 #2
+ <var> state 11
+ state 11: #2
<var> state 12
- state 12: #0 #2
- <var> state 13
- state 13: #0 #2
- state 14: #1 #2
+ state 12: #2
+ state 13: #0 #1 #2
+ <var> state 14
+ state 14: #0 #1 #2
<var> state 15
- state 15: #1 #2
+ state 15: #0 #1 #2
+ <var> state 16
+ <app> state 17
+ state 16: #2
+ state 17: #0 #1 #2
+ <var> state 18
+ <app> state 20
+ scanf_format_str state 27
+ state 18: #2
+ <var> state 19
+ state 19: #2
+ state 20: #0 #2
+ <var> state 21
+ scanf_format_spec state 24
+ state 21: #2
+ <var> state 22
+ state 22: #2
+ <var> state 23
+ state 23: #2
+ state 24: #0 #2
+ <var> state 25
+ state 25: #0 #2
+ <var> state 26
+ state 26: #0 #2
+ state 27: #1 #2
+ <var> state 28
+ state 28: #1 #2
}; guestimate format/*0:1*/ = n/*0:01*/,format/*0:1*/ when 1,0,_/*0:1101*/,1,s/*0:1111*/ = regex "^%([0-9]*)" REG_EXTENDED format/*0:1*/ 0; n/*0:01*/,format/*0:1*/ = if null s/*0:1111*/ then 1025,"%1024"+tail format/*1:1*/ else eval s/*0:1111*/+1,format/*1:1*/ {
rule #0: n,format = if null s then 1025,"%1024"+tail format else eval s+1,format
state 0: #0
@@ -904,8 +944,8 @@
state 0: #0
<var> state 1
state 1: #0
-}; format_type x/*0:1*/ = if index "diouxXn" x/*0:1*/>=0 then "d" else if index "eEfg" x/*0:1*/>=0 then "g" else if x/*0:1*/=="]"||x/*0:1*/=="c" then "s" else x/*0:1*/ {
- rule #0: format_type x = if index "diouxXn" x>=0 then "d" else if index "eEfg" x>=0 then "g" else if x=="]"||x=="c" then "s" else x
+}; format_type x/*0:1*/ = if x/*0:1*/=="n" then "n" else if index "diouxX" x/*0:1*/>=0 then "d" else if index "eEfg" x/*0:1*/>=0 then "g" else if x/*0:1*/=="]"||x/*0:1*/=="c" then "s" else x/*0:1*/ {
+ rule #0: format_type x = if x=="n" then "n" else if index "diouxX" x>=0 then "d" else if index "eEfg" x>=0 then "g" else if x=="]"||x=="c" then "s" else x
state 0: #0
<var> state 1
state 1: #0
@@ -922,8 +962,8 @@
<var> state 4
state 4: #0 #1
} end;
-sscanf s/*0:01*/::string format/*0:1*/::string = tuple$reverse ret/*0:1*/ when _/*0:01*/,ret/*0:1*/ = catch error_handler/*0*/ (foldl do_sscanf/*1*/ (s/*1:01*/,[])$scanf_split_format format/*1:1*/) {
- rule #0: _,ret = catch error_handler (foldl do_sscanf (s,[])$scanf_split_format format)
+sscanf s/*0:01*/::string format/*0:1*/::string = tuple$reverse ret/*0:11*/ when _/*0:01*/,_/*0:101*/,ret/*0:11*/ = catch error_handler/*0*/ (foldl do_sscanf/*1*/ (s/*1:01*/,0,[])$scanf_split_format format/*1:1*/) {
+ rule #0: _,_,ret = catch error_handler (foldl do_sscanf (s,0,[])$scanf_split_format format)
state 0: #0
<app> state 1
state 1: #0
@@ -933,8 +973,16 @@
state 3: #0
<var> state 4
state 4: #0
- <var> state 5
+ <app> state 5
state 5: #0
+ <app> state 6
+ state 6: #0
+ , state 7
+ state 7: #0
+ <var> state 8
+ state 8: #0
+ <var> state 9
+ state 9: #0
} end with error_handler (scanf_error ret/*0:11*/) = throw (scanf_error (tuple$reverse ret/*0:11*/)); error_handler x/*0:1*/ = throw x/*0:1*/ {
rule #0: error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret))
rule #1: error_handler x = throw x
@@ -951,8 +999,8 @@
state 5: #0 #1
<var> state 6
state 6: #0 #1
-}; check_buf buf/*0:1*/ = throw printf_malloc_error if null buf/*0:1*/; check_buf buf/*0:1*/ = buf/*0:1*/ {
- rule #0: check_buf buf = throw printf_malloc_error if null buf
+}; check_buf buf/*0:1*/ = throw scanf_malloc_error if null buf/*0:1*/; check_buf buf/*0:1*/ = buf/*0:1*/ {
+ rule #0: check_buf buf = throw scanf_malloc_error if null buf
rule #1: check_buf buf = buf
state 0: #0 #1
<var> state 1
@@ -1012,46 +1060,52 @@
state 0: #0
<var> state 1
state 1: #0
-}; do_sscanf (u/*0:0101*/,ret/*0:011*/) (scanf_format_spec t/*0:101*/ s/*0:11*/) = u/*0:*/,ret/*1:*/ when size/*0:01*/,s/*0:1*/ = if t/*0:101*/=="s" then guestimate/*1*/ s/*0:11*/ else 16,s/*0:11*/; buf/*0:*/ = check_buf/*2*/ (calloc size/*0:01*/ 1); res/*0:*/ = case t/*2:101*/ of "d" = pure_sscanf_int u/*3:0101*/ s/*2:1*/ buf/*1:*/; "g" = pure_sscanf_double u/*3:0101*/ s/*2:1*/ buf/*1:*/; "s" = pure_sscanf_string u/*3:0101*/ s/*2:1*/ buf/*1:*/; "p" = pure_sscanf_pointer u/*3:0101*/ s/*2:1*/ buf/*1:*/; _/*0:*/ = throw (this_cant_happen ret/*3:011*/) {
- rule #0: "d" = pure_sscanf_int u s buf
- rule #1: "g" = pure_sscanf_double u s buf
- rule #2: "s" = pure_sscanf_string u s buf
- rule #3: "p" = pure_sscanf_pointer u s buf
- rule #4: _ = throw (this_cant_happen ret)
- state 0: #0 #1 #2 #3 #4
+}; do_sscanf (u/*0:0101*/,nread/*0:01101*/,ret/*0:0111*/) (scanf_format_spec t/*0:101*/ s/*0:11*/) = u/*0:*/,nread/*8:01101*/+res/*4:*/,ret/*1:*/ when size/*0:01*/,s/*0:1*/ = if t/*0:101*/=="s" then guestimate/*1*/ s/*0:11*/ else 16,s/*0:11*/; buf/*0:*/ = check_buf/*2*/ (calloc size/*0:01*/ 1); res/*0:*/ = case t/*2:101*/ of "n" = pure_fscanf_int fp s/*2:1*/ buf/*1:*/; "d" = pure_sscanf_int u/*3:0101*/ s/*2:1*/ buf/*1:*/; "g" = pure_sscanf_double u/*3:0101*/ s/*2:1*/ buf/*1:*/; "s" = pure_sscanf_string u/*3:0101*/ s/*2:1*/ buf/*1:*/; "p" = pure_sscanf_pointer u/*3:0101*/ s/*2:1*/ buf/*1:*/; _/*0:*/ = throw (this_cant_happen ret/*3:0111*/) {
+ rule #0: "n" = pure_fscanf_int fp s buf
+ rule #1: "d" = pure_sscanf_int u s buf
+ rule #2: "g" = pure_sscanf_double u s buf
+ rule #3: "s" = pure_sscanf_string u s buf
+ rule #4: "p" = pure_sscanf_pointer u s buf
+ rule #5: _ = throw (this_cant_happen ret)
+ state 0: #0 #1 #2 #3 #4 #5
<var> state 1
- "d"::string state 2
- "g"::string state 3
- "s"::string state 4
- "p"::string state 5
- state 1: #4
- state 2: #0 #4
- state 3: #1 #4
- state 4: #2 #4
- state 5: #3 #4
-} end; res/*0:*/ = if res/*0:*/>=0 then res/*0:*/ else throw (scanf_error ret/*4:011*/) when _/*0:*/ = free buf/*1:*/ {
+ "n"::string state 2
+ "d"::string state 3
+ "g"::string state 4
+ "s"::string state 5
+ "p"::string state 6
+ state 1: #5
+ state 2: #0 #5
+ state 3: #1 #5
+ state 4: #2 #5
+ state 5: #3 #5
+ state 6: #4 #5
+} end; res/*0:*/ = if res/*0:*/>=0 then res/*0:*/ else throw (scanf_error ret/*4:0111*/) when _/*0:*/ = free buf/*1:*/ {
rule #0: _ = free buf
state 0: #0
<var> state 1
state 1: #0
-} end; val/*0:*/ = case t/*4:101*/ of "d" = get_int buf/*3:*/; "g" = get_double buf/*3:*/; "s" = cstring buf/*3:*/; "p" = get_pointer buf/*3:*/; _/*0:*/ = throw (this_cant_happen ret/*5:011*/) {
- rule #0: "d" = get_int buf
- rule #1: "g" = get_double buf
- rule #2: "s" = cstring buf
- rule #3: "p" = get_pointer buf
- rule #4: _ = throw (this_cant_happen ret)
- state 0: #0 #1 #2 #3 #4
+} end; val/*0:*/ = case t/*4:101*/ of "n" = nread/*5:01101*/+get_int buf/*3:*/; "d" = get_int buf/*3:*/; "g" = get_double buf/*3:*/; "s" = cstring buf/*3:*/; "p" = get_pointer buf/*3:*/; _/*0:*/ = throw (this_cant_happen ret/*5:0111*/) {
+ rule #0: "n" = nread+get_int buf
+ rule #1: "d" = get_int buf
+ rule #2: "g" = get_double buf
+ rule #3: "s" = cstring buf
+ rule #4: "p" = get_pointer buf
+ rule #5: _ = throw (this_cant_happen ret)
+ state 0: #0 #1 #2 #3 #4 #5
<var> state 1
- "d"::string state 2
- "g"::string state 3
- "s"::string state 4
- "p"::string state 5
- state 1: #4
- state 2: #0 #4
- state 3: #1 #4
- state 4: #2 #4
- state 5: #3 #4
-} end; _/*0:*/ = if t/*5:101*/=="s" then () else free buf/*3:*/; ret/*0:*/ = val/*1:*/:ret/*6:011*/; u/*0:*/ = drop res/*3:*/ u/*7:0101*/ {
+ "n"::string state 2
+ "d"::string state 3
+ "g"::string state 4
+ "s"::string state 5
+ "p"::string state 6
+ state 1: #5
+ state 2: #0 #5
+ state 3: #1 #5
+ state 4: #2 #5
+ state 5: #3 #5
+ state 6: #4 #5
+} end; _/*0:*/ = if t/*5:101*/=="s" then () else free buf/*3:*/; ret/*0:*/ = val/*1:*/:ret/*6:0111*/; u/*0:*/ = drop res/*3:*/ u/*7:0101*/ {
rule #0: u = drop res u
state 0: #0
<var> state 1
@@ -1067,7 +1121,7 @@
<var> state 1
state 1: #0
} {
- rule #0: val = case t of "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end
+ rule #0: val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end
state 0: #0
<var> state 1
state 1: #0
@@ -1077,7 +1131,7 @@
<var> state 1
state 1: #0
} {
- rule #0: res = case t of "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end
+ rule #0: res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end
state 0: #0
<var> state 1
state 1: #0
@@ -1099,7 +1153,7 @@
state 4: #0
<var> state 5
state 5: #0
-} end; do_sscanf (u/*0:0101*/,ret/*0:011*/) (scanf_format_str s/*0:11*/) = u/*0:*/,ret/*1:*/ when res/*0:*/ = pure_sscanf u/*0:0101*/ s/*0:11*/; ret/*0:*/ = if res/*0:*/>=0 then ret/*1:011*/ else throw (scanf_error ret/*1:011*/); u/*0:*/ = drop res/*1:*/ u/*2:0101*/ {
+} end; do_sscanf (u/*0:0101*/,nread/*0:01101*/,ret/*0:0111*/) (scanf_format_str s/*0:11*/) = u/*0:*/,nread/*3:01101*/+res/*2:*/,ret/*1:*/ when res/*0:*/ = pure_sscanf u/*0:0101*/ s/*0:11*/; ret/*0:*/ = if res/*0:*/>=0 then ret/*1:0111*/ else throw (scanf_error ret/*1:0111*/); u/*0:*/ = drop res/*1:*/ u/*2:0101*/ {
rule #0: u = drop res u
state 0: #0
<var> state 1
@@ -1115,8 +1169,8 @@
<var> state 1
state 1: #0
} end; do_sscanf (_/*0:0101*/,ret/*0:011*/) _/*0:1*/ = throw (this_cant_happen ret/*0:011*/) {
- rule #0: do_sscanf (u,ret) (scanf_format_spec t s) = u,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret; u = drop res u end
- rule #1: do_sscanf (u,ret) (scanf_format_str s) = u,ret when res = pure_sscanf u s; ret = if res>=0 then ret else throw (scanf_error ret); u = drop res u end
+ rule #0: do_sscanf (u,nread,ret) (scanf_format_spec t s) = u,nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret; u = drop res u end
+ rule #1: do_sscanf (u,nread,ret) (scanf_format_str s) = u,nread+res,ret when res = pure_sscanf u s; ret = if res>=0 then ret else throw (scanf_error ret); u = drop res u end
rule #2: do_sscanf (_,ret) _ = throw (this_cant_happen ret)
state 0: #0 #1 #2
<app> state 1
@@ -1128,33 +1182,59 @@
<var> state 4
state 4: #0 #1 #2
<var> state 5
- state 5: #0 #1 #2
+ <app> state 7
+ state 5: #2
<var> state 6
- <app> state 7
state 6: #2
state 7: #0 #1 #2
<var> state 8
- <app> state 10
- scanf_format_str state 17
+ <app> state 11
state 8: #2
<var> state 9
state 9: #2
- state 10: #0 #2
- <var> state 11
- scanf_format_spec state 14
- state 11: #2
+ <var> state 10
+ state 10: #2
+ state 11: #0 #1 #2
<var> state 12
+ , state 16
state 12: #2
<var> state 13
state 13: #2
- state 14: #0 #2
+ <var> state 14
+ state 14: #2
<var> state 15
- state 15: #0 #2
- <var> state 16
- state 16: #0 #2
- state 17: #1 #2
+ state 15: #2
+ state 16: #0 #1 #2
+ <var> state 17
+ state 17: #0 #1 #2
<var> state 18
- state 18: #1 #2
+ state 18: #0 #1 #2
+ <var> state 19
+ <app> state 20
+ state 19: #2
+ state 20: #0 #1 #2
+ <var> state 21
+ <app> state 23
+ scanf_format_str state 30
+ state 21: #2
+ <var> state 22
+ state 22: #2
+ state 23: #0 #2
+ <var> state 24
+ scanf_format_spec state 27
+ state 24: #2
+ <var> state 25
+ state 25: #2
+ <var> state 26
+ state 26: #2
+ state 27: #0 #2
+ <var> state 28
+ state 28: #0 #2
+ <var> state 29
+ state 29: #0 #2
+ state 30: #1 #2
+ <var> state 31
+ state 31: #1 #2
} end;
readline prompt/*0:1*/::string = cstring$c_readline prompt/*0:1*/;
fnmatch pat/*0:001*/::string s/*0:01*/::string flags/*0:1*/::int = c_fnmatch pat/*0:001*/ s/*0:01*/ flags/*0:1*/==0;
@@ -1900,7 +1980,7 @@
state 1: #0
}
{
- rule #0: fscanf fp format::string = tuple$reverse ret when ret = catch error_handler (foldl (do_fscanf fp) []$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw printf_malloc_error if null buf; check_buf buf = buf; do_fscanf fp ret (scanf_format_spec t s) = ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret end; do_fscanf fp ret (scanf_format_str s) = ret when res = pure_fscanf fp s; ret = if res>=0 then ret else throw (scanf_error ret) end; do_fscanf _ ret _ = throw (this_cant_happen ret); guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end end
+ rule #0: fscanf fp format::string = tuple$reverse ret when _,ret = catch error_handler (foldl (do_fscanf fp) (0,[])$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw scanf_malloc_error if null buf; check_buf buf = buf; do_fscanf fp (nread,ret) (scanf_format_spec t s) = nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret end; do_fscanf fp (nread,ret) (scanf_format_str s) = nread+res,ret when res = pure_fscanf fp s; ret = if res>=0 then ret else throw (scanf_error ret) end; do_fscanf _ ret _ = throw (this_cant_happen ret); guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end end
state 0: #0
<var> state 1
state 1: #0
@@ -1908,7 +1988,7 @@
state 2: #0
}
{
- rule #0: scanf_split_format format = regexg analyze "(%[*]?[0-9]*([cdiouxXneEfgsp]|\\[\\^?\\]?[^]]+\\]))|(%)|([^%]|%%)+" REG_EXTENDED format 0 with analyze info = if p>=0&&u!1!="*" then scanf_format_spec t (kludge t u) when t = format_type (last u) end else if q>=0 then throw (scanf_format_error q) else scanf_format_str u when _,u = reg 0 info; p,_ = reg 1 info; q,_ = reg 3 info end; format_type x = if index "diouxXn" x>=0 then "d" else if index "eEfg" x>=0 then "g" else if x=="]"||x=="c" then "s" else x; kludge "g" u = init u+"l"+last u; kludge _ u = u end
+ rule #0: scanf_split_format format = regexg analyze "(%[*]?[0-9]*([cdiouxXneEfgsp]|\\[\\^?\\]?[^]]+\\]))|(%)|([^%]|%%)+" REG_EXTENDED format 0 with analyze info = if p>=0&&u!1!="*" then scanf_format_spec t (kludge t u) when t = format_type (last u) end else if q>=0 then throw (scanf_format_error q) else scanf_format_str u when _,u = reg 0 info; p,_ = reg 1 info; q,_ = reg 3 info end; format_type x = if x=="n" then "n" else if index "diouxX" x>=0 then "d" else if index "eEfg" x>=0 then "g" else if x=="]"||x=="c" then "s" else x; kludge "g" u = init u+"l"+last u; kludge _ u = u end
state 0: #0
<var> state 1
state 1: #0
@@ -1926,7 +2006,7 @@
state 4: #0
}
{
- rule #0: sscanf s::string format::string = tuple$reverse ret when _,ret = catch error_handler (foldl do_sscanf (s,[])$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw printf_malloc_error if null buf; check_buf buf = buf; guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end; do_sscanf (u,ret) (scanf_format_spec t s) = u,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret; u = drop res u end; do_sscanf (u,ret) (scanf_format_str s) = u,ret when res = pure_sscanf u s; ret = if res>=0 then ret else throw (scanf_error ret); u = drop res u end; do_sscanf (_,ret) _ = throw (this_cant_happen ret) end
+ rule #0: sscanf s::string format::string = tuple$reverse ret when _,_,ret = catch error_handler (foldl do_sscanf (s,0,[])$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw scanf_malloc_error if null buf; check_buf buf = buf; guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end; do_sscanf (u,nread,ret) (scanf_format_spec t s) = u,nread+res,ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "n" = pure_fscanf_int fp s buf; "d" = pure_sscanf_int u s buf; "g" = pure_sscanf_double u s buf; "s" = pure_sscanf_string u s buf; "p" = pure_sscanf_pointer u s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "n" = nread+get_int buf; "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret; u = drop res u end; do_sscanf (u,nread,ret) (scanf_format_str s) = u,nread+res,ret when res = pure_sscanf u s; ret = if res>=0 then ret else throw (scanf_error ret); u = drop res u end; do_sscanf (_,ret) _ = throw (this_cant_happen ret) end
state 0: #0
<var>::string state 1
state 1: #0
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-24 17:10:46
|
Revision: 122
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=122&view=rev
Author: agraef
Date: 2008-05-24 10:10:55 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Fix scanf %n conversion.
Modified Paths:
--------------
pure/trunk/lib/system.pure
Modified: pure/trunk/lib/system.pure
===================================================================
--- pure/trunk/lib/system.pure 2008-05-24 11:11:10 UTC (rev 121)
+++ pure/trunk/lib/system.pure 2008-05-24 17:10:55 UTC (rev 122)
@@ -245,12 +245,12 @@
scanf format::string = fscanf stdin format;
fscanf fp::pointer format::string = tuple $ reverse ret when
- ret = catch error_handler
- (foldl (do_fscanf fp) [] $ scanf_split_format format);
+ _, ret = catch error_handler
+ (foldl (do_fscanf fp) (0,[]) $ scanf_split_format format);
end with
error_handler (scanf_error ret) = throw (scanf_error (tuple $ reverse ret));
error_handler x = throw x otherwise;
- do_fscanf fp ret (scanf_format_spec t s) = ret
+ do_fscanf fp (nread,ret) (scanf_format_spec t s) = nread+res, ret
when
// 16 bytes should be more than enough to hold any elementary type;
// for the string case, see guestimate below.
@@ -259,6 +259,7 @@
// null byte.
buf = check_buf (calloc size 1);
res = case t of
+ "n" = pure_fscanf_int fp s buf;
"d" = pure_fscanf_int fp s buf;
"g" = pure_fscanf_double fp s buf;
"s" = pure_fscanf_string fp s buf;
@@ -270,6 +271,7 @@
res = if res>=0 then res
else (throw (scanf_error ret) when _ = free buf end);
val = case t of
+ "n" = nread+get_int buf;
"d" = get_int buf;
"g" = get_double buf;
"s" = cstring buf;
@@ -279,13 +281,13 @@
_ = if t=="s" then () else free buf;
ret = val:ret;
end;
- do_fscanf fp ret (scanf_format_str s) = ret
+ do_fscanf fp (nread,ret) (scanf_format_str s) = nread+res, ret
when
res = pure_fscanf fp s;
ret = if res>=0 then ret else throw (scanf_error ret);
end;
do_fscanf _ ret _ = throw (this_cant_happen ret);
- check_buf buf = throw printf_malloc_error if null buf;
+ check_buf buf = throw scanf_malloc_error if null buf;
= buf otherwise;
// Compute a reasonable size for a string buffer; if necessary, modify the
// field width of the format accordingly.
@@ -313,7 +315,8 @@
q, _ = reg 3 info; // q>=0 indicates unrecognized format specifier
end;
format_type x =
- if index "diouxXn" x >= 0 then "d"
+ if x == "n" then "n"
+ else if index "diouxX" x >= 0 then "d"
else if index "eEfg" x >= 0 then "g"
else if x=="]" || x=="c" then "s"
else x;
@@ -332,12 +335,12 @@
extern int pure_sscanf_pointer(char *buf, char *format, void **x);
sscanf s::string format::string = tuple $ reverse ret when
- _, ret = catch error_handler
- (foldl do_sscanf (s,[]) $ scanf_split_format format);
+ _, _, ret = catch error_handler
+ (foldl do_sscanf (s,0,[]) $ scanf_split_format format);
end with
error_handler (scanf_error ret) = throw (scanf_error (tuple $ reverse ret));
error_handler x = throw x otherwise;
- do_sscanf (u,ret) (scanf_format_spec t s) = u, ret
+ do_sscanf (u,nread,ret) (scanf_format_spec t s) = u, nread+res, ret
when
// 16 bytes should be more than enough to hold any elementary type;
// for the string case, see guestimate below.
@@ -346,6 +349,7 @@
// null byte.
buf = check_buf (calloc size 1);
res = case t of
+ "n" = pure_fscanf_int fp s buf;
"d" = pure_sscanf_int u s buf;
"g" = pure_sscanf_double u s buf;
"s" = pure_sscanf_string u s buf;
@@ -357,6 +361,7 @@
res = if res>=0 then res
else (throw (scanf_error ret) when _ = free buf end);
val = case t of
+ "n" = nread+get_int buf;
"d" = get_int buf;
"g" = get_double buf;
"s" = cstring buf;
@@ -367,14 +372,14 @@
ret = val:ret;
u = drop res u;
end;
- do_sscanf (u,ret) (scanf_format_str s) = u, ret
+ do_sscanf (u,nread,ret) (scanf_format_str s) = u, nread+res, ret
when
res = pure_sscanf u s;
ret = if res>=0 then ret else throw (scanf_error ret);
u = drop res u;
end;
do_sscanf (_,ret) _ = throw (this_cant_happen ret);
- check_buf buf = throw printf_malloc_error if null buf;
+ check_buf buf = throw scanf_malloc_error if null buf;
= buf otherwise;
// Compute a reasonable size for a string buffer; if necessary, modify the
// field width of the format accordingly.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-24 11:11:02
|
Revision: 121
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=121&view=rev
Author: agraef
Date: 2008-05-24 04:11:10 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Bugfixes in the scanf functions.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/system.pure
pure/trunk/runtime.cc
pure/trunk/test/test011.log
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-05-24 10:30:04 UTC (rev 120)
+++ pure/trunk/ChangeLog 2008-05-24 11:11:10 UTC (rev 121)
@@ -1,5 +1,8 @@
2008-05-24 Albert Graef <Dr....@t-...>
+ * runtime.cc, lib/system.pure: Bugfixes in the scanf
+ functions. Reported by Jiri Spitz.
+
* pure.cc, runtime.cc, util.cc: Windows/MinGW compatibility
fixes. Suggested by Jiri Spitz.
Modified: pure/trunk/lib/system.pure
===================================================================
--- pure/trunk/lib/system.pure 2008-05-24 10:30:04 UTC (rev 120)
+++ pure/trunk/lib/system.pure 2008-05-24 11:11:10 UTC (rev 121)
@@ -265,7 +265,9 @@
"p" = pure_fscanf_pointer fp s buf;
_ = throw (this_cant_happen ret);
end;
- res = if res>=1 then res
+ // Note: In difference to C scanf, the return value is the number of read
+ // characters here, with -1 denoting an error condition.
+ res = if res>=0 then res
else (throw (scanf_error ret) when _ = free buf end);
val = case t of
"d" = get_int buf;
@@ -350,8 +352,8 @@
"p" = pure_sscanf_pointer u s buf;
_ = throw (this_cant_happen ret);
end;
- // Note: In difference to pure_fscanf, the return value is the number of
- // read characters here, with -1 denoting an error condition.
+ // Note: In difference to C scanf, the return value is the number of read
+ // characters here, with -1 denoting an error condition.
res = if res>=0 then res
else (throw (scanf_error ret) when _ = free buf end);
val = case t of
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-05-24 10:30:04 UTC (rev 120)
+++ pure/trunk/runtime.cc 2008-05-24 11:11:10 UTC (rev 121)
@@ -1742,79 +1742,95 @@
return snprintf(buf, size, format, x);
}
+#define myformat(format) scanf_format((char*)alloca(strlen(format)+3), format)
+
+static inline char *scanf_format(char *buf, const char *format)
+{
+ strcpy(buf, format); strcat(buf, "%n");
+ return buf;
+}
+
extern "C"
int pure_fscanf(FILE *fp, const char *format)
{
- return fscanf(fp, format);
+ int count = -1;
+ fscanf(fp, myformat(format), &count);
+ return count;
}
extern "C"
int pure_fscanf_int(FILE *fp, const char *format, int32_t *x)
{
- return fscanf(fp, format, x);
+ // wrap this up in case int on the target platform is not 32 bit
+ int count = -1, y;
+ fscanf(fp, myformat(format), &y, &count);
+ if (count >= 0) *x = y;
+ return count;
}
extern "C"
int pure_fscanf_double(FILE *fp, const char *format, double *x)
{
- return fscanf(fp, format, x);
+ int count = -1;
+ fscanf(fp, myformat(format), x, &count);
+ return count;
}
extern "C"
int pure_fscanf_string(FILE *fp, const char *format, const char *x)
{
- return fscanf(fp, format, x);
+ int count = -1;
+ fscanf(fp, myformat(format), x, &count);
+ return count;
}
extern "C"
int pure_fscanf_pointer(FILE *fp, const char *format, const void **x)
{
- return fscanf(fp, format, x);
+ int count = -1;
+ fscanf(fp, myformat(format), x, &count);
+ return count;
}
-#define myformat(format) sscanf_format((char*)alloca(strlen(format)+3), format)
-
-static inline char *sscanf_format(char *buf, const char *format)
-{
- strcpy(buf, format); strcat(buf, "%n");
- return buf;
-}
-
extern "C"
int pure_sscanf(const char *buf, const char *format)
{
- int count = -1, res = sscanf(buf, myformat(format), &count);
- return (res >= 0)?count:-1;
+ int count = -1;
+ sscanf(buf, myformat(format), &count);
+ return count;
}
extern "C"
int pure_sscanf_int(const char *buf, const char *format, int32_t *x)
{
// wrap this up in case int on the target platform is not 32 bit
- int count = -1, y, res = sscanf(buf, myformat(format), &y, &count);
- *x = y;
- return (res >= 0)?count:-1;
+ int count = -1, y; sscanf(buf, myformat(format), &y, &count);
+ if (count >= 0) *x = y;
+ return count;
}
extern "C"
int pure_sscanf_double(const char *buf, const char *format, double *x)
{
- int count = -1, res = sscanf(buf, myformat(format), x, &count);
- return (res >= 0)?count:-1;
+ int count = -1;
+ sscanf(buf, myformat(format), x, &count);
+ return count;
}
extern "C"
int pure_sscanf_string(const char *buf, const char *format, char *x)
{
- int count = -1, res = sscanf(buf, myformat(format), x, &count);
- return (res >= 0)?count:-1;
+ int count = -1;
+ sscanf(buf, myformat(format), x, &count);
+ return count;
}
extern "C"
int pure_sscanf_pointer(const char *buf, const char *format, void **x)
{
- int count = -1, res = sscanf(buf, myformat(format), x, &count);
- return (res >= 0)?count:-1;
+ int count = -1;
+ sscanf(buf, myformat(format), x, &count);
+ return count;
}
#include <fnmatch.h>
Modified: pure/trunk/test/test011.log
===================================================================
--- pure/trunk/test/test011.log 2008-05-24 10:30:04 UTC (rev 120)
+++ pure/trunk/test/test011.log 2008-05-24 11:11:10 UTC (rev 121)
@@ -689,7 +689,7 @@
state 3: #1 #4
state 4: #2 #4
state 5: #3 #4
-} end; res/*0:*/ = if res/*0:*/>=1 then res/*0:*/ else throw (scanf_error ret/*4:01*/) when _/*0:*/ = free buf/*1:*/ {
+} end; res/*0:*/ = if res/*0:*/>=0 then res/*0:*/ else throw (scanf_error ret/*4:01*/) when _/*0:*/ = free buf/*1:*/ {
rule #0: _ = free buf
state 0: #0
<var> state 1
@@ -727,7 +727,7 @@
<var> state 1
state 1: #0
} {
- rule #0: res = if res>=1 then res else throw (scanf_error ret) when _ = free buf end
+ rule #0: res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end
state 0: #0
<var> state 1
state 1: #0
@@ -765,7 +765,7 @@
<var> state 1
state 1: #0
} end; do_fscanf _/*0:001*/ ret/*0:01*/ _/*0:1*/ = throw (this_cant_happen ret/*0:01*/) {
- rule #0: do_fscanf fp ret (scanf_format_spec t s) = ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end; res = if res>=1 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret end
+ rule #0: do_fscanf fp ret (scanf_format_spec t s) = ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret end
rule #1: do_fscanf fp ret (scanf_format_str s) = ret when res = pure_fscanf fp s; ret = if res>=0 then ret else throw (scanf_error ret) end
rule #2: do_fscanf _ ret _ = throw (this_cant_happen ret)
state 0: #0 #1 #2
@@ -1900,7 +1900,7 @@
state 1: #0
}
{
- rule #0: fscanf fp format::string = tuple$reverse ret when ret = catch error_handler (foldl (do_fscanf fp) []$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw printf_malloc_error if null buf; check_buf buf = buf; do_fscanf fp ret (scanf_format_spec t s) = ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end; res = if res>=1 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret end; do_fscanf fp ret (scanf_format_str s) = ret when res = pure_fscanf fp s; ret = if res>=0 then ret else throw (scanf_error ret) end; do_fscanf _ ret _ = throw (this_cant_happen ret); guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end end
+ rule #0: fscanf fp format::string = tuple$reverse ret when ret = catch error_handler (foldl (do_fscanf fp) []$scanf_split_format format) end with error_handler (scanf_error ret) = throw (scanf_error (tuple$reverse ret)); error_handler x = throw x; check_buf buf = throw printf_malloc_error if null buf; check_buf buf = buf; do_fscanf fp ret (scanf_format_spec t s) = ret when size,s = if t=="s" then guestimate s else 16,s; buf = check_buf (calloc size 1); res = case t of "d" = pure_fscanf_int fp s buf; "g" = pure_fscanf_double fp s buf; "s" = pure_fscanf_string fp s buf; "p" = pure_fscanf_pointer fp s buf; _ = throw (this_cant_happen ret) end; res = if res>=0 then res else throw (scanf_error ret) when _ = free buf end; val = case t of "d" = get_int buf; "g" = get_double buf; "s" = cstring buf; "p" = get_pointer buf; _ = throw (this_cant_happen ret) end; _ = if t=="s" then () else free buf; ret = val:ret end; do_fscanf fp ret (scanf_format_str s) = ret when res = pure_fscanf fp s; ret = if res>=0 then ret else throw (scanf_error ret) end; do_fscanf _ ret _ = throw (this_cant_happen ret); guestimate format = n,format when 1,0,_,1,s = regex "^%([0-9]*)" REG_EXTENDED format 0; n,format = if null s then 1025,"%1024"+tail format else eval s+1,format end end
state 0: #0
<var> state 1
state 1: #0
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-24 10:29:57
|
Revision: 120
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=120&view=rev
Author: agraef
Date: 2008-05-24 03:30:04 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Bugfixes in pure_sscanf.
Modified Paths:
--------------
pure/trunk/runtime.cc
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-05-24 10:23:49 UTC (rev 119)
+++ pure/trunk/runtime.cc 2008-05-24 10:30:04 UTC (rev 120)
@@ -1791,7 +1791,7 @@
int pure_sscanf_int(const char *buf, const char *format, int32_t *x)
{
// wrap this up in case int on the target platform is not 32 bit
- int count, y, res = sscanf(buf, myformat(format), &y, &count);
+ int count = -1, y, res = sscanf(buf, myformat(format), &y, &count);
*x = y;
return (res >= 0)?count:-1;
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-24 10:23:42
|
Revision: 119
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=119&view=rev
Author: agraef
Date: 2008-05-24 03:23:49 -0700 (Sat, 24 May 2008)
Log Message:
-----------
Bugfixes in pure_sscanf.
Modified Paths:
--------------
pure/trunk/runtime.cc
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-05-24 05:29:06 UTC (rev 118)
+++ pure/trunk/runtime.cc 2008-05-24 10:23:49 UTC (rev 119)
@@ -1783,7 +1783,7 @@
extern "C"
int pure_sscanf(const char *buf, const char *format)
{
- int count, res = sscanf(buf, myformat(format), &count);
+ int count = -1, res = sscanf(buf, myformat(format), &count);
return (res >= 0)?count:-1;
}
@@ -1793,28 +1793,28 @@
// wrap this up in case int on the target platform is not 32 bit
int count, y, res = sscanf(buf, myformat(format), &y, &count);
*x = y;
- return (res > 0)?count:-1;
+ return (res >= 0)?count:-1;
}
extern "C"
int pure_sscanf_double(const char *buf, const char *format, double *x)
{
- int count, res = sscanf(buf, myformat(format), x, &count);
- return (res > 0)?count:-1;
+ int count = -1, res = sscanf(buf, myformat(format), x, &count);
+ return (res >= 0)?count:-1;
}
extern "C"
int pure_sscanf_string(const char *buf, const char *format, char *x)
{
- int count, res = sscanf(buf, myformat(format), x, &count);
- return (res > 0)?count:-1;
+ int count = -1, res = sscanf(buf, myformat(format), x, &count);
+ return (res >= 0)?count:-1;
}
extern "C"
int pure_sscanf_pointer(const char *buf, const char *format, void **x)
{
- int count, res = sscanf(buf, myformat(format), x, &count);
- return (res > 0)?count:-1;
+ int count = -1, res = sscanf(buf, myformat(format), x, &count);
+ return (res >= 0)?count:-1;
}
#include <fnmatch.h>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-05-24 05:29:06
|
Revision: 118
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=118&view=rev
Author: agraef
Date: 2008-05-23 22:29:06 -0700 (Fri, 23 May 2008)
Log Message:
-----------
Fix memleaks in doeval/dodefn.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/funcall.h
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
pure/trunk/runtime.cc
pure/trunk/runtime.h
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-05-24 00:05:42 UTC (rev 117)
+++ pure/trunk/ChangeLog 2008-05-24 05:29:06 UTC (rev 118)
@@ -1,3 +1,8 @@
+2008-05-24 Albert Graef <Dr....@t-...>
+
+ * pure.cc, runtime.cc, util.cc: Windows/MinGW compatibility
+ fixes. Suggested by Jiri Spitz.
+
2008-05-23 Albert Graef <Dr....@t-...>
* runtime.cc: Fix premature freeing of eval result, and a minor
@@ -17,11 +22,6 @@
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/funcall.h
===================================================================
--- pure/trunk/funcall.h 2008-05-24 00:05:42 UTC (rev 117)
+++ pure/trunk/funcall.h 2008-05-24 05:29:06 UTC (rev 118)
@@ -10,74 +10,74 @@
portable. ;-) Maybe we should play some dirty tricks with the C stack
instead? */
-#define funcall(fp,n,x) \
+#define funcall(ret,fp,n,x) \
switch (n) { \
- case 0: return ((pure_expr*(*)())fp)(); \
- case 1: return ((pure_expr*(*)(void*))fp)(x[0]); \
- case 2: return ((pure_expr*(*)(void*,void*))fp)(x[0],x[1]); \
- case 3: return ((pure_expr*(*)(void*,void*,void*))fp)(x[0],x[1],x[2]); \
- case 4: return ((pure_expr*(*)(void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3]); \
- case 5: return ((pure_expr*(*)(void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4]); \
- case 6: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5]); \
- case 7: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6]); \
- case 8: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7]); \
- case 9: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8]); \
- case 10: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9]); \
- case 11: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10]); \
- case 12: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11]); \
- case 13: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12]); \
- case 14: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13]); \
- case 15: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14]); \
- case 16: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15]); \
- case 17: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16]); \
- case 18: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17]); \
- case 19: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18]); \
- case 20: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19]); \
- case 21: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20]); \
- case 22: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21]); \
- case 23: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22]); \
- case 24: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23]); \
- case 25: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24]); \
- case 26: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25]); \
- case 27: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26]); \
- case 28: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27]); \
- case 29: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28]); \
- case 30: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29]); \
- case 31: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30]); \
- case 32: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31]); \
- case 33: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32]); \
- case 34: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33]); \
- case 35: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34]); \
- case 36: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35]); \
- case 37: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36]); \
- case 38: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37]); \
- case 39: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38]); \
- case 40: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39]); \
- case 41: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40]); \
- case 42: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41]); \
- case 43: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42]); \
- case 44: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43]); \
- case 45: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44]); \
- case 46: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45]); \
- case 47: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46]); \
- case 48: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47]); \
- case 49: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48]); \
- case 50: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49]); \
- case 51: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50]); \
- case 52: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51]); \
- case 53: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52]); \
- case 54: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53]); \
- case 55: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54]); \
- case 56: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55]); \
- case 57: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56]); \
- case 58: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57]); \
- case 59: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58]); \
- case 60: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59]); \
- case 61: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60]); \
- case 62: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60],x[61]); \
- case 63: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60],x[61],x[62]); \
- case 64: return ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60],x[61],x[62],x[63]); \
+ case 0: ret = ((pure_expr*(*)())fp)(); break; \
+ case 1: ret = ((pure_expr*(*)(void*))fp)(x[0]); break; \
+ case 2: ret = ((pure_expr*(*)(void*,void*))fp)(x[0],x[1]); break; \
+ case 3: ret = ((pure_expr*(*)(void*,void*,void*))fp)(x[0],x[1],x[2]); break; \
+ case 4: ret = ((pure_expr*(*)(void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3]); break; \
+ case 5: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4]); break; \
+ case 6: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5]); break; \
+ case 7: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6]); break; \
+ case 8: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7]); break; \
+ case 9: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8]); break; \
+ case 10: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9]); break; \
+ case 11: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10]); break; \
+ case 12: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11]); break; \
+ case 13: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12]); break; \
+ case 14: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13]); break; \
+ case 15: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14]); break; \
+ case 16: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15]); break; \
+ case 17: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16]); break; \
+ case 18: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17]); break; \
+ case 19: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18]); break; \
+ case 20: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19]); break; \
+ case 21: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20]); break; \
+ case 22: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21]); break; \
+ case 23: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22]); break; \
+ case 24: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23]); break; \
+ case 25: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24]); break; \
+ case 26: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25]); break; \
+ case 27: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26]); break; \
+ case 28: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27]); break; \
+ case 29: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28]); break; \
+ case 30: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29]); break; \
+ case 31: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30]); break; \
+ case 32: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31]); break; \
+ case 33: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32]); break; \
+ case 34: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33]); break; \
+ case 35: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34]); break; \
+ case 36: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35]); break; \
+ case 37: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36]); break; \
+ case 38: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37]); break; \
+ case 39: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38]); break; \
+ case 40: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39]); break; \
+ case 41: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40]); break; \
+ case 42: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41]); break; \
+ case 43: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42]); break; \
+ case 44: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43]); break; \
+ case 45: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44]); break; \
+ case 46: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45]); break; \
+ case 47: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46]); break; \
+ case 48: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47]); break; \
+ case 49: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48]); break; \
+ case 50: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49]); break; \
+ case 51: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50]); break; \
+ case 52: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51]); break; \
+ case 53: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52]); break; \
+ case 54: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53]); break; \
+ case 55: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54]); break; \
+ case 56: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55]); break; \
+ case 57: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56]); break; \
+ case 58: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57]); break; \
+ case 59: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58]); break; \
+ case 60: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59]); break; \
+ case 61: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60]); break; \
+ case 62: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60],x[61]); break; \
+ case 63: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60],x[61],x[62]); break; \
+ case 64: ret = ((pure_expr*(*)(void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*,void*))fp)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9],x[10],x[11],x[12],x[13],x[14],x[15],x[16],x[17],x[18],x[19],x[20],x[21],x[22],x[23],x[24],x[25],x[26],x[27],x[28],x[29],x[30],x[31],x[32],x[33],x[34],x[35],x[36],x[37],x[38],x[39],x[40],x[41],x[42],x[43],x[44],x[45],x[46],x[47],x[48],x[49],x[50],x[51],x[52],x[53],x[54],x[55],x[56],x[57],x[58],x[59],x[60],x[61],x[62],x[63]); break; \
default: \
assert(n <= MAXARGS && "funcall: function call exceeds maximum #args"); \
- return 0; \
+ ret = 0; break; \
}
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-05-24 00:05:42 UTC (rev 117)
+++ pure/trunk/interpreter.cc 2008-05-24 05:29:06 UTC (rev 118)
@@ -55,7 +55,7 @@
stats(false), temp(0),
ps("> "), lib(""), histfile("/.pure_history"), modname("pure"),
nerrs(0), source_s(0), result(0), mem(0), exps(0), tmps(0),
- module(0), JIT(0), FPM(0)
+ module(0), JIT(0), FPM(0), fptr(0), vptr(0)
{
if (!g_interp) {
g_interp = this;
@@ -191,8 +191,8 @@
// function pointers into the runtime map.
declare_extern((void*)pure_clos,
- "pure_clos", "expr*", -6, "bool", "bool", "int",
- "int", "void*", "int");
+ "pure_clos", "expr*", -7, "bool", "bool", "int", "int",
+ "void*", "void*", "int");
declare_extern((void*)pure_call,
"pure_call", "expr*", 1, "expr*");
declare_extern((void*)pure_const,
@@ -588,7 +588,7 @@
#endif
// do a direct call to the runtime to create the fbox and cache it in
// a global variable
- pure_expr *fv = pure_clos(false, false, f.tag, f.n, f.fp, 0);
+ pure_expr *fv = pure_clos(false, false, f.tag, f.n, f.fp, 0, 0);
GlobalVar& v = globalvars[f.tag];
if (!v.v) {
v.v = new GlobalVariable
@@ -1489,6 +1489,7 @@
#define ValFldIndex Two
#define ValFld2Index Three
#define SubFldIndex(i) UInt(i+2)
+#define NullPtr ConstantPointerNull::get(VoidPtrTy)
#define NullExprPtr ConstantPointerNull::get(ExprPtrTy)
#define NullExprPtrPtr ConstantPointerNull::get(ExprPtrPtrTy)
@@ -2576,6 +2577,15 @@
return f;
}
+Value *interpreter::envptr(Env *f)
+{
+ if (!fptr) return NullPtr;
+ if (!vptr) vptr = new GlobalVariable
+ (VoidPtrTy, false, GlobalVariable::InternalLinkage, 0, "$$fptr$$", module);
+ JIT->updateGlobalMapping(vptr, &fptr);
+ return act_builder().CreateLoad(vptr);
+}
+
pure_expr *interpreter::doeval(expr x, pure_expr*& e)
{
char test;
@@ -2590,7 +2600,8 @@
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 *save_fptr = fptr;
+ fptr = new Env(0, 0, x, false); fptr->refc = 1;
Env &f = *fptr;
push("doeval", &f);
fun_prolog("");
@@ -2612,8 +2623,12 @@
// 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 there are no more references, we can get rid of the environment now.
+ if (fptr->refc == 1)
+ delete fptr;
+ else
+ fptr->refc--;
+ fptr = save_fptr;
// NOTE: Result (if any) is to be freed by the caller.
return res;
}
@@ -2627,7 +2642,8 @@
}
// Create an anonymous function to call in order to evaluate the rhs
// expression, match against the lhs and bind variables in lhs accordingly.
- Env *fptr = new Env(0, 0, rhs, false);
+ Env *save_fptr = fptr;
+ fptr = new Env(0, 0, rhs, false); fptr->refc = 1;
Env &f = *fptr;
push("dodefn", &f);
fun_prolog("");
@@ -2693,8 +2709,12 @@
// 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 there are no more references, we can get rid of the environment now.
+ if (fptr->refc == 1)
+ delete fptr;
+ else
+ fptr->refc--;
+ fptr = save_fptr;
if (!res) {
// We caught an exception, clean up the mess.
for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
@@ -3...
[truncated message content] |
|
From: <ag...@us...> - 2008-05-24 00:05:34
|
Revision: 117
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=117&view=rev
Author: agraef
Date: 2008-05-23 17:05:42 -0700 (Fri, 23 May 2008)
Log Message:
-----------
More Windows compatibility fixes.
Modified Paths:
--------------
pure/trunk/util.cc
Modified: pure/trunk/util.cc
===================================================================
--- pure/trunk/util.cc 2008-05-23 19:40:46 UTC (rev 116)
+++ pure/trunk/util.cc 2008-05-24 00:05:42 UTC (rev 117)
@@ -14,6 +14,8 @@
// disable this if your system doesn't have nl_langinfo()
#define HAVE_LANGINFO_CODESET
#include <langinfo.h>
+#else
+#include <windows.h>
#endif
/* some utf-8 helpers pilfered from the Q source ***************************/
@@ -432,7 +434,7 @@
#endif /* HAVE_LANGINFO_CODESET */
}
-#ifdef __APPLE__
+#if defined(__APPLE__) || defined(__MINGW32__)
#define myiconv(ic, inbuf, inbytes, outbuf, outbytes) \
iconv(ic, (const char**)inbuf, inbytes, outbuf, outbytes)
#else
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
