Thread: [pure-lang-svn] SF.net SVN: pure-lang:[566] pure/trunk (Page 3)
Status: Beta
Brought to you by:
agraef
Menu
▾
▴
pure-lang-svn
|
From: <ag...@us...> - 2008-08-22 10:29:50
|
Revision: 566
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=566&view=rev
Author: agraef
Date: 2008-08-22 10:29:59 +0000 (Fri, 22 Aug 2008)
Log Message:
-----------
Final touches (0.5 release).
Modified Paths:
--------------
pure/trunk/INSTALL
pure/trunk/NEWS
pure/trunk/README
Modified: pure/trunk/INSTALL
===================================================================
--- pure/trunk/INSTALL 2008-08-22 10:12:53 UTC (rev 565)
+++ pure/trunk/INSTALL 2008-08-22 10:29:59 UTC (rev 566)
@@ -330,9 +330,9 @@
the latter if you know what you are doing, since it will remove files which
require special tools to be regenerated.)
-There also are a number of targets like 'html' and 'pdf' which generate the
-documentation in a variety of formats (this requires groff); see the Makefile
-for details.
+There also are a number of targets like 'html' (this requires rman) and 'pdf'
+(this requires groff) which generate the documentation in a variety of
+formats; see the Makefile for details.
Maintainers can roll distribution tarballs with 'make dist' and 'make
distcheck' (the latter is like 'make dist', but also does a test build and
@@ -395,8 +395,8 @@
MAC OSX
--- ---
-Pure has been reported to work on OSX, and a port by Ryan Schmidt exists in
-the MacPorts collection, see http://www.macports.org/.
+Pure works fine on OSX, and a port by Ryan Schmidt exists in the MacPorts
+collection, see http://www.macports.org/.
Note that with at least some versions of the Apple gcc compiler, with all
warnings turned on you'll get the (bogus) warning "control reaches end of
@@ -421,6 +421,6 @@
the Pure interpreter and read online documentation in html help format.
-June 2008
+August 2008
Albert Graef <Dr.Graef at t-online.de>
Eddie Rucker <erucker at bmc.edu>
Modified: pure/trunk/NEWS
===================================================================
--- pure/trunk/NEWS 2008-08-22 10:12:53 UTC (rev 565)
+++ pure/trunk/NEWS 2008-08-22 10:29:59 UTC (rev 566)
@@ -1,5 +1,5 @@
-** Pure 0.5 2008-08-20
+** Pure 0.5 2008-08-22
This release sports LLVM 2.3 support and a bunch of bug fixes and improvements
in the language, the standard library and the code generator. As usual, please
Modified: pure/trunk/README
===================================================================
--- pure/trunk/README 2008-08-22 10:12:53 UTC (rev 565)
+++ pure/trunk/README 2008-08-22 10:29:59 UTC (rev 566)
@@ -5,10 +5,10 @@
Pure is a functional programming language based on term rewriting. It has a
modern syntax featuring curried function applications, lexical closures and
equational definitions with pattern matching, and thus is somewhat similar to
-languages of the Haskell and ML variety. But Pure is also a very dynamic and
-reflective language, and is more like Lisp in this respect. The interpreter
-has an LLVM backend to do JIT compilation, hence programs run blazingly fast
-and interfacing to C modules is easy.
+languages of the Haskell and ML variety. But Pure is also a very dynamic
+language, and is more like Lisp in this respect. The interpreter has an LLVM
+backend to do JIT compilation, hence programs run blazingly fast and
+interfacing to C modules is easy.
WHERE TO GET IT
----- -- --- --
@@ -41,7 +41,7 @@
To start the Pure interpreter, just type 'pure' at the command prompt. You'll
be greeted with a sign-on message, after which the interpreter leaves you at
its prompt and you can start typing definitions and expressions to be
-evaluated. Use the 'quit' command to exit the interpreter (on Unix systems you
+evaluated. Use the 'quit' command to exit the interpreter (on most systems you
can also just type EOF a.k.a. Ctrl-D at the beginning of the interpreter's
command line). For instance:
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-22 20:24:39
|
Revision: 575
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=575&view=rev
Author: agraef
Date: 2008-08-22 20:24:48 +0000 (Fri, 22 Aug 2008)
Log Message:
-----------
Remove all special case rules for the real -> complex cases, so that real functions always return real results now.
Modified Paths:
--------------
pure/trunk/lib/math.pure
pure/trunk/lib/primitives.pure
pure/trunk/test/test020.log
Modified: pure/trunk/lib/math.pure
===================================================================
--- pure/trunk/lib/math.pure 2008-08-22 16:34:32 UTC (rev 574)
+++ pure/trunk/lib/math.pure 2008-08-22 20:24:48 UTC (rev 575)
@@ -26,17 +26,16 @@
/* The sqrt function. */
-extern double sqrt(double) = c_sqrt;
+extern double sqrt(double);
-sqrt x::double = c_sqrt x if x>=0 || nanp x;
sqrt x::int | sqrt x::bigint = sqrt (double x);
/* Exponential function and logarithms. */
extern double exp(double), double log(double) = c_log;
-ln x::double = c_log x if x>=0.0 || nanp x;
-log x::double = c_log x/c_log 10.0 if x>=0.0 || nanp x;
+ln x::double = c_log x;
+log x::double = c_log x/c_log 10.0;
exp x::int | exp x::bigint = exp (double x);
ln x::int | ln x::bigint = ln (double x);
@@ -75,8 +74,8 @@
extern double __asinh(double), double __acosh(double), double __atanh(double);
asinh x::double = __asinh x;
-acosh x::double = __acosh x if x>=1.0 || nanp x;
-atanh x::double = __atanh x if abs x<=1.0 || nanp x;
+acosh x::double = __acosh x;
+atanh x::double = __atanh x;
sinh x::int | sinh x::bigint = sinh (double x);
cosh x::int | cosh x::bigint = cosh (double x);
@@ -188,9 +187,6 @@
when r = sqrt (x*x+y*y) end;
sqrt (r<:t) = sqrt r <: t/2;
-// Complex square roots of negative reals.
-sqrt x::double = 0.0 +: sqrt (-x) if x<0;
-
/* Complex exponential and logarithms. */
exp (x+:y) = exp x * (cos y +: sin y);
@@ -202,10 +198,6 @@
log z@(x+:y) |
log z@(r<:t) = ln z / ln 10;
-// Complex logarithms of negative reals.
-ln x::double = ln (abs x) +: arg x if x<0;
-log x::double = ln x / ln 10 if x<0;
-
/* Complex trig functions. */
sin (x+:y) = sin x*cosh y +: cos x*sinh y;
@@ -246,10 +238,6 @@
= -inf +: 0.0 if z==-1;
= ln ((1+z)/(1-z))/2;
-// These inverse hyperbolic trigs have complex results for some reals.
-acosh x::double = acosh (x+:0);
-atanh x::double = atanh (x+:0);
-
/* Complex arithmetic. */
-(x+:y) = -x +: -y;
@@ -319,9 +307,6 @@
(r1<:t1)^x2 = r1^x2 <: t1*x2;
x1^z2@(r2<:t2) = (x1<:0) ^ z2;
-// Complex powers of negative reals.
-x1::double^x2::double = exp (ln x1*x2) if x1<0;
-
/* Equality. */
(x1+:y1) == (x2+:y2) = x1==x2 && y1==y2;
Modified: pure/trunk/lib/primitives.pure
===================================================================
--- pure/trunk/lib/primitives.pure 2008-08-22 16:34:32 UTC (rev 574)
+++ pure/trunk/lib/primitives.pure 2008-08-22 20:24:48 UTC (rev 575)
@@ -350,13 +350,11 @@
pow x::bigint y::int = bigint_pow x y if y>=0;
/* The ^ operator. Computes inexact powers for any combination of int, bigint
- and double operands. The result is always a double. Note that x may be
- negative only if y is integer, but see math.pure which deals with the
- general case x<0 using complex numbers. */
+ and double operands. The result is always a double. */
extern double pow(double, double) = c_pow;
-x::double^y::double = c_pow x y if x>=0 || frac y==0.0 || nanp x || nanp y;
+x::double^y::double = c_pow x y;
x::int^y::int |
x::bigint^y::bigint |
x::int^y::bigint |
@@ -364,8 +362,7 @@
x::double^y::int |
x::double^y::bigint = c_pow x (double y);
x::int^y::double |
-x::bigint^y::double = c_pow (double x) y if x>=0 || frac y==0.0 || nanp y;
- = double x^y otherwise;
+x::bigint^y::double = c_pow (double x) y;
/* Pointer arithmetic. We do this using bigints, so that the code is portable
to 64 bit systems. */
Modified: pure/trunk/test/test020.log
===================================================================
--- pure/trunk/test/test020.log 2008-08-22 16:34:32 UTC (rev 574)
+++ pure/trunk/test/test020.log 2008-08-22 20:24:48 UTC (rev 575)
@@ -184,13 +184,13 @@
}
*** UNARY ***
sqrt,1,1.00
-sqrt,-1,0.00+:1.00
+sqrt,-1,nan
sqrt,0,0.00
sqrt,0.00,0.00
sqrt,1.20,1.10
-sqrt,-1.20,0.00+:1.10
+sqrt,-1.20,nan
sqrt,1L%3L,0.577
-sqrt,(-1L)%4L,0.00+:0.500
+sqrt,(-1L)%4L,nan
sqrt,1+:2,1.27+:0.786
sqrt,-1+:2,0.786+:1.27
sqrt,1+:-2,1.27+:0.786
@@ -204,7 +204,7 @@
sqrt,3.10<:2.50,1.76<:1.25
sqrt,2L%3L<:2,0.816<:1.00
sqrt,1L%2L<:3L%4L,0.707<:0.375
-sqrt,-inf,0.00+:inf
+sqrt,-inf,nan
sqrt,nan,nan
sin,1,0.841
sin,-1,-0.841
@@ -276,13 +276,13 @@
tan,-inf,nan
tan,nan,nan
ln,1,0.00
-ln,-1,0.00+:3.14
+ln,-1,nan
ln,0,-inf
ln,0.00,-inf
ln,1.20,0.182
-ln,-1.20,0.182+:3.14
+ln,-1.20,nan
ln,1L%3L,-1.10
-ln,(-1L)%4L,-1.39+:3.14
+ln,(-1L)%4L,nan
ln,1+:2,0.805+:1.11
ln,-1+:2,0.805+:2.03
ln,1+:-2,0.805+:-1.11
@@ -296,16 +296,16 @@
ln,3.10<:2.50,2.74<:1.15
ln,2L%3L<:2,2.04<:1.77
ln,1L%2L<:3L%4L,1.02<:2.32
-ln,-inf,inf+:3.14
+ln,-inf,nan
ln,nan,nan
log,1,0.00
-log,-1,0.00+:1.36
+log,-1,nan
log,0,-inf
log,0.00,-inf
log,1.20,0.0792
-log,-1.20,0.0792+:1.36
+log,-1.20,nan
log,1L%3L,-0.477
-log,(-1L)%4L,-0.602+:1.36
+log,(-1L)%4L,nan
log,1+:2,0.349+:0.481
log,-1+:2,0.349+:0.884
log,1+:-2,0.349+:-0.481
@@ -319,7 +319,7 @@
log,3.10<:2.50,1.19<:1.15
log,2L%3L<:2,0.886<:1.77
log,1L%2L<:3L%4L,0.444<:2.32
-log,-inf,inf+:1.36
+log,-inf,nan
log,nan,nan
exp,1,2.72
exp,-1,0.368
@@ -506,13 +506,13 @@
asinh,-inf,-inf
asinh,nan,nan
acosh,1,0.00
-acosh,-1,0.00+:3.14
-acosh,0,0.00+:1.57
-acosh,0.00,0.00+:1.57
+acosh,-1,nan
+acosh,0,nan
+acosh,0.00,nan
acosh,1.20,0.622
-acosh,-1.20,-0.622+:3.14
-acosh,1L%3L,0.00+:1.23
-acosh,(-1L)%4L,0.00+:1.82
+acosh,-1.20,nan
+acosh,1L%3L,nan
+acosh,(-1L)%4L,nan
acosh,1+:2,1.53+:1.14
acosh,-1+:2,1.43+:1.59
acosh,1+:-2,0.653+:0.103
@@ -526,14 +526,14 @@
acosh,3.10<:2.50,1.34+:1.60
acosh,2L%3L<:2,0.563+:1.65
acosh,1L%2L<:3L%4L,0.355+:1.22
-acosh,-inf,nan+:nan
+acosh,-inf,nan
acosh,nan,nan
atanh,1,inf
atanh,-1,-inf
atanh,0,0.00
atanh,0.00,0.00
-atanh,1.20,1.20+:-1.57
-atanh,-1.20,-1.20+:1.57
+atanh,1.20,nan
+atanh,-1.20,nan
atanh,1L%3L,0.347
atanh,(-1L)%4L,-0.255
atanh,1+:2,0.173+:1.18
@@ -549,7 +549,7 @@
atanh,3.10<:2.50,-0.254+:1.37
atanh,2L%3L<:2,-0.202+:0.571
atanh,1L%2L<:3L%4L,0.335+:0.369
-atanh,-inf,nan+:nan
+atanh,-inf,nan
atanh,nan,nan
abs,1,1
abs,-1,1
@@ -3155,10 +3155,10 @@
(^),-1,-1,-1.00
(^),-1,0,1.00
(^),-1,0.00,1.00
-(^),-1,1.20,-0.809+:-0.588
-(^),-1,-1.20,-0.809+:0.588
-(^),-1,1L%3L,0.500+:0.866
-(^),-1,(-1L)%4L,0.707+:-0.707
+(^),-1,1.20,nan
+(^),-1,-1.20,nan
+(^),-1,1L%3L,nan
+(^),-1,(-1L)%4L,nan
(^),-1,1+:2,-0.00187+:2.29e-19
(^),-1,-1+:2,-0.00187+:-2.29e-19
(^),-1,1+:-2,-535.+:6.56e-14
@@ -3172,7 +3172,7 @@
(^),-1,3.10<:2.50,0.000152+:-0.00294
(^),-1,2L%3L<:2,0.0958+:-0.114
(^),-1,1L%2L<:3L%4L,0.140+:0.313
-(^),-1,-inf,nan+:nan
+(^),-1,-inf,1.00
(^),-1,nan,nan
(^),0,1,0.00
(^),0,-1,inf
@@ -3247,10 +3247,10 @@
(^),-1.20,-1,-0.833
(^),-1.20,0,1.00
(^),-1.20,0.00,1.00
-(^),-1.20,1.20,-1.01+:-0.732
-(^),-1.20,-1.20,-0.650+:0.472
-(^),-1.20,1L%3L,0.531+:0.920
-(^),-1.20,(-1L)%4L,0.676+:-0.676
+(^),-1.20,1.20,nan
+(^),-1.20,-1.20,nan
+(^),-1.20,1L%3L,nan
+(^),-1.20,(-1L)%4L,nan
(^),-1.20,1+:2,-0.00209+:-0.000799
(^),-1.20,-1+:2,-0.00145+:-0.000555
(^),-1.20,1+:-2,-600.+:229.
@@ -3264,7 +3264,7 @@
(^),-1.20,3.10<:2.50,0.000711+:-0.00173
(^),-1.20,2L%3L<:2,0.103+:-0.0976
(^),-1.20,1L%2L<:3L%4L,0.129+:0.343
-(^),-1.20,-inf,nan+:nan
+(^),-1.20,-inf,0.00
(^),-1.20,nan,nan
(^),1L%3L,1,0.333
(^),1L%3L,-1,3.00
@@ -3293,10 +3293,10 @@
(^),(-1L)%4L,-1,-4.00
(^),(-1L)%4L,0,1.00
(^),(-1L)%4L,0.00,1.00
-(^),(-1L)%4L,1.20,-0.153+:-0.111
-(^),(-1L)%4L,-1.20,-4.27+:3.10
-(^),(-1L)%4L,1L%3L,0.315+:0.546
-(^),(-1L)%4L,(-1L)%4L,1.00+:-1.00
+(^),(-1L)%4L,1.20,nan
+(^),(-1L)%4L,-1.20,nan
+(^),(-1L)%4L,1L%3L,nan
+(^),(-1L)%4L,(-1L)%4L,nan
(^),(-1L)%4L,1+:2,0.000435+:0.000168
(^),(-1L)%4L,-1+:2,0.00697+:0.00269
(^),(-1L)%4L,1+:-2,125.+:-48.3
@@ -3310,7 +3310,7 @@
(^),(-1L)%4L,3.10<:2.50,-0.0536+:0.0748
(^),(-1L)%4L,2L%3L<:2,-0.0308+:-0.217
(^),(-1L)%4L,1L%2L<:3L%4L,0.161+:0.129
-(^),(-1L)%4L,-inf,nan+:nan
+(^),(-1L)%4L,-inf,inf
(^),(-1L)%4L,nan,nan
(^),1+:2,1,1.00+:2.00
(^),1+:2,-1,0.200+:-0.400
@@ -3615,10 +3615,10 @@
(^),-inf,-1,-0.00
(^),-inf,0,1.00
(^),-inf,0.00,1.00
-(^),-inf,1.20,-inf+:-inf
-(^),-inf,-1.20,-0.00+:0.00
-(^),-inf,1L%3L,inf+:inf
-(^),-inf,(-1L)%4L,0.00+:-0.00
+(^),-inf,1.20,inf
+(^),-inf,-1.20,0.00
+(^),-inf,1L%3L,inf
+(^),-inf,(-1L)%4L,0.00
(^),-inf,1+:2,nan+:nan
(^),-inf,-1+:2,nan+:nan
(^),-inf,1+:-2,nan+:nan
@@ -3632,7 +3632,7 @@
(^),-inf,3.10<:2.50,nan+:nan
(^),-inf,2L%3L<:2,nan+:nan
(^),-inf,1L%2L<:3L%4L,nan+:nan
-(^),-inf,-inf,nan+:nan
+(^),-inf,-inf,0.00
(^),-inf,nan,nan
(^),nan,1,nan
(^),nan,-1,nan
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-23 11:43:07
|
Revision: 580
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=580&view=rev
Author: agraef
Date: 2008-08-23 11:43:17 +0000 (Sat, 23 Aug 2008)
Log Message:
-----------
Fix result type of (^) operation in real/polar cases.
Modified Paths:
--------------
pure/trunk/lib/math.pure
pure/trunk/test/test020.log
Modified: pure/trunk/lib/math.pure
===================================================================
--- pure/trunk/lib/math.pure 2008-08-23 11:18:41 UTC (rev 579)
+++ pure/trunk/lib/math.pure 2008-08-23 11:43:17 UTC (rev 580)
@@ -295,8 +295,8 @@
z1@(_+:_)^x2 |
z1@(_<:_)^x2 = exp (ln z1*x2);
-x1^z2@(_+:_) |
-x1^z2@(_<:_) = exp (ln (complex x1)*z2);
+x1^z2@(_+:_) = exp (ln (rect x1)*z2);
+x1^z2@(_<:_) = exp (ln (polar x1)*z2);
/* Equality. */
Modified: pure/trunk/test/test020.log
===================================================================
--- pure/trunk/test/test020.log 2008-08-23 11:18:41 UTC (rev 579)
+++ pure/trunk/test/test020.log 2008-08-23 11:43:17 UTC (rev 580)
@@ -3143,12 +3143,12 @@
(^),1,1.20+:-4.30,1.00+:0.00
(^),1,1L%2L+:1,1.00+:0.00
(^),1,1L%2L+:3L%4L,1.00+:0.00
-(^),1,3<:1,1.00+:0.00
-(^),1,3<:-2.14,1.00+:-0.00
-(^),1,3.00<:-3,1.00+:-0.00
-(^),1,3.10<:2.50,1.00+:0.00
-(^),1,2L%3L<:2,1.00+:0.00
-(^),1,1L%2L<:3L%4L,1.00+:0.00
+(^),1,3<:1,1.00<:0.00
+(^),1,3<:-2.14,1.00<:-0.00
+(^),1,3.00<:-3,1.00<:-0.00
+(^),1,3.10<:2.50,1.00<:0.00
+(^),1,2L%3L<:2,1.00<:0.00
+(^),1,1L%2L<:3L%4L,1.00<:0.00
(^),1,-inf,1.00
(^),1,nan,1.00
(^),-1,1,-1.00
@@ -3166,12 +3166,12 @@
(^),-1,1.20+:-4.30,-5.95e+05+:-4.33e+05
(^),-1,1L%2L+:1,2.65e-18+:0.0432
(^),-1,1L%2L+:3L%4L,5.80e-18+:0.0948
-(^),-1,3<:1,0.000133+:-0.000334
-(^),-1,3<:-2.14,1.03e+03+:2.58e+03
-(^),-1,3.00<:-3,-3.76+:-0.356
-(^),-1,3.10<:2.50,0.000152+:-0.00294
-(^),-1,2L%3L<:2,0.0958+:-0.114
-(^),-1,1L%2L<:3L%4L,0.140+:0.313
+(^),-1,3<:1,0.000360<:-1.19
+(^),-1,3<:-2.14,2.78e+03<:1.19
+(^),-1,3.00<:-3,3.78<:-3.05
+(^),-1,3.10<:2.50,0.00294<:-1.52
+(^),-1,2L%3L<:2,0.149<:-0.872
+(^),-1,1L%2L<:3L%4L,0.343<:1.15
(^),-1,-inf,1.00
(^),-1,nan,nan
(^),0,1,0.00
@@ -3189,12 +3189,12 @@
(^),0,1.20+:-4.30,nan+:nan
(^),0,1L%2L+:1,nan+:nan
(^),0,1L%2L+:3L%4L,nan+:nan
-(^),0,3<:1,nan+:nan
-(^),0,3<:-2.14,nan+:nan
-(^),0,3.00<:-3,nan+:nan
-(^),0,3.10<:2.50,nan+:nan
-(^),0,2L%3L<:2,nan+:nan
-(^),0,1L%2L<:3L%4L,nan+:nan
+(^),0,3<:1,0.00<:nan
+(^),0,3<:-2.14,inf<:nan
+(^),0,3.00<:-3,inf<:nan
+(^),0,3.10<:2.50,inf<:nan
+(^),0,2L%3L<:2,inf<:nan
+(^),0,1L%2L<:3L%4L,0.00<:nan
(^),0,-inf,inf
(^),0,nan,nan
(^),0.00,1,0.00
@@ -3212,12 +3212,12 @@
(^),0.00,1.20+:-4.30,nan+:nan
(^),0.00,1L%2L+:1,nan+:nan
(^),0.00,1L%2L+:3L%4L,nan+:nan
-(^),0.00,3<:1,nan+:nan
-(^),0.00,3<:-2.14,nan+:nan
-(^),0.00,3.00<:-3,nan+:nan
-(^),0.00,3.10<:2.50,nan+:nan
-(^),0.00,2L%3L<:2,nan+:nan
-(^),0.00,1L%2L<:3L%4L,nan+:nan
+(^),0.00,3<:1,0.00<:nan
+(^),0.00,3<:-2.14,inf<:nan
+(^),0.00,3.00<:-3,inf<:nan
+(^),0.00,3.10<:2.50,inf<:nan
+(^),0.00,2L%3L<:2,inf<:nan
+(^),0.00,1L%2L<:3L%4L,0.00<:nan
(^),0.00,-inf,inf
(^),0.00,nan,nan
(^),1.20,1,1.20
@@ -3235,12 +3235,12 @@
(^),1.20,1.20+:-4.30,0.881+:-0.879
(^),1.20,1L%2L+:1,1.08+:0.199
(^),1.20,1L%2L+:3L%4L,1.09+:0.149
-(^),1.20,3<:1,1.20+:0.597
-(^),1.20,3<:-2.14,0.667+:-0.331
-(^),1.20,3.00<:-3,0.580+:-0.0449
-(^),1.20,3.10<:2.50,0.600+:0.211
-(^),1.20,2L%3L<:2,0.945+:0.105
-(^),1.20,1L%2L<:3L%4L,1.07+:0.0664
+(^),1.20,3<:1,1.34<:0.460
+(^),1.20,3<:-2.14,0.744<:-0.460
+(^),1.20,3.00<:-3,0.582<:-0.0772
+(^),1.20,3.10<:2.50,0.636<:0.338
+(^),1.20,2L%3L<:2,0.951<:0.111
+(^),1.20,1L%2L<:3L%4L,1.07<:0.0621
(^),1.20,-inf,0.00
(^),1.20,nan,nan
(^),-1.20,1,-1.20
@@ -3258,12 +3258,12 @@
(^),-1.20,1.20+:-4.30,-9.05e+05+:1.42e+05
(^),-1.20,1L%2L+:1,-0.00858+:0.0466
(^),-1.20,1L%2L+:3L%4L,-0.0142+:0.103
-(^),-1.20,3<:1,0.000360+:-0.000322
-(^),-1.20,3<:-2.14,1.54e+03+:1.38e+03
-(^),-1.20,3.00<:-3,-2.20+:-0.0377
-(^),-1.20,3.10<:2.50,0.000711+:-0.00173
-(^),-1.20,2L%3L<:2,0.103+:-0.0976
-(^),-1.20,1L%2L<:3L%4L,0.129+:0.343
+(^),-1.20,3<:1,0.000483<:-0.731
+(^),-1.20,3<:-2.14,2.07e+03<:0.731
+(^),-1.20,3.00<:-3,2.20<:-3.12
+(^),-1.20,3.10<:2.50,0.00187<:-1.18
+(^),-1.20,2L%3L<:2,0.142<:-0.761
+(^),-1.20,1L%2L<:3L%4L,0.366<:1.21
(^),-1.20,-inf,0.00
(^),-1.20,nan,nan
(^),1L%3L,1,0.333
@@ -3281,12 +3281,12 @@
(^),1L%3L,1.20+:-4.30,0.00312+:-0.268
(^),1L%3L,1L%2L+:1,0.263+:-0.514
(^),1L%3L,1L%2L+:3L%4L,0.392+:-0.424
-(^),1L%3L,3<:1,-0.157+:-0.0607
-(^),1L%3L,3<:-2.14,-5.54+:2.14
-(^),1L%3L,3.00<:-3,23.3+:11.7
-(^),1L%3L,3.10<:2.50,-6.90+:-13.7
-(^),1L%3L,2L%3L<:2,1.07+:-0.838
-(^),1L%3L,1L%2L<:3L%4L,0.623+:-0.245
+(^),1L%3L,3<:1,0.169<:-2.77
+(^),1L%3L,3<:-2.14,5.93<:2.77
+(^),1L%3L,3.00<:-3,26.1<:0.465
+(^),1L%3L,3.10<:2.50,15.3<:-2.04
+(^),1L%3L,2L%3L<:2,1.36<:-0.666
+(^),1L%3L,1L%2L<:3L%4L,0.669<:-0.374
(^),1L%3L,-inf,inf
(^),1L%3L,nan,nan
(^),(-1L)%4L,1,-0.250
@@ -3304,12 +3304,12 @@
(^),(-1L)%4L,1.20+:-4.30,-1.33e+05+:-4.20e+04
(^),(-1L)%4L,1L%2L+:1,0.0212+:0.00396
(^),(-1L)%4L,1L%2L+:3L%4L,0.0409+:0.0240
-(^),(-1L)%4L,3<:1,-8.31e-07+:3.80e-05
-(^),(-1L)%4L,3<:-2.14,-575.+:-2.63e+04
-(^),(-1L)%4L,3.00<:-3,-180.+:-146.
-(^),(-1L)%4L,3.10<:2.50,-0.0536+:0.0748
-(^),(-1L)%4L,2L%3L<:2,-0.0308+:-0.217
-(^),(-1L)%4L,1L%2L<:3L%4L,0.161+:0.129
+(^),(-1L)%4L,3<:1,3.80e-05<:1.59
+(^),(-1L)%4L,3<:-2.14,2.63e+04<:-1.59
+(^),(-1L)%4L,3.00<:-3,232.<:-2.46
+(^),(-1L)%4L,3.10<:2.50,0.0920<:2.19
+(^),(-1L)%4L,2L%3L<:2,0.219<:-1.71
+(^),(-1L)%4L,1L%2L<:3L%4L,0.206<:0.677
(^),(-1L)%4L,-inf,inf
(^),(-1L)%4L,nan,nan
(^),1+:2,1,1.00+:2.00
@@ -3626,12 +3626,12 @@
(^),-inf,1.20+:-4.30,nan+:nan
(^),-inf,1L%2L+:1,nan+:nan
(^),-inf,1L%2L+:3L%4L,nan+:nan
-(^),-inf,3<:1,nan+:nan
-(^),-inf,3<:-2.14,nan+:nan
-(^),-inf,3.00<:-3,nan+:nan
-(^),-inf,3.10<:2.50,nan+:nan
-(^),-inf,2L%3L<:2,nan+:nan
-(^),-inf,1L%2L<:3L%4L,nan+:nan
+(^),-inf,3<:1,inf<:nan
+(^),-inf,3<:-2.14,0.00<:nan
+(^),-inf,3.00<:-3,0.00<:nan
+(^),-inf,3.10<:2.50,0.00<:nan
+(^),-inf,2L%3L<:2,0.00<:nan
+(^),-inf,1L%2L<:3L%4L,inf<:nan
(^),-inf,-inf,0.00
(^),-inf,nan,nan
(^),nan,1,nan
@@ -3649,12 +3649,12 @@
(^),nan,1.20+:-4.30,nan+:nan
(^),nan,1L%2L+:1,nan+:nan
(^),nan,1L%2L+:3L%4L,nan+:nan
-(^),nan,3<:1,nan+:nan
-(^),nan,3<:-2.14,nan+:nan
-(^),nan,3.00<:-3,nan+:nan
-(^),nan,3.10<:2.50,nan+:nan
-(^),nan,2L%3L<:2,nan+:nan
-(^),nan,1L%2L<:3L%4L,nan+:nan
+(^),nan,3<:1,nan<:nan
+(^),nan,3<:-2.14,nan<:nan
+(^),nan,3.00<:-3,nan<:nan
+(^),nan,3.10<:2.50,nan<:nan
+(^),nan,2L%3L<:2,nan<:nan
+(^),nan,1L%2L<:3L%4L,nan<:nan
(^),nan,-inf,nan
(^),nan,nan,nan
atan2,1,1,0.785
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-23 12:49:28
|
Revision: 581
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=581&view=rev
Author: agraef
Date: 2008-08-23 12:49:38 +0000 (Sat, 23 Aug 2008)
Log Message:
-----------
Better definition for complex acosh.
Modified Paths:
--------------
pure/trunk/lib/math.pure
pure/trunk/test/test020.log
Modified: pure/trunk/lib/math.pure
===================================================================
--- pure/trunk/lib/math.pure 2008-08-23 11:43:17 UTC (rev 580)
+++ pure/trunk/lib/math.pure 2008-08-23 12:49:38 UTC (rev 581)
@@ -230,8 +230,8 @@
asinh z@(x+:y) |
asinh z@(r<:t) = ln (z+sqrt (z*z+1));
acosh z@(x+:y) |
-acosh z@(r<:t) = ln (z+sqrt (z*z-1));
-// Alternative definition (Kahan).
+acosh z@(r<:t) = ln (z+sqrt (z-1)*sqrt (z+1));
+// Alternative definition by Kahan. Any reason to prefer that one?
// acosh z@(x+:y) |
// acosh z@(r<:t) = 2*ln (sqrt ((z+1)/2)+sqrt ((z-1)/2));
atanh z@(x+:y) |
Modified: pure/trunk/test/test020.log
===================================================================
--- pure/trunk/test/test020.log 2008-08-23 11:43:17 UTC (rev 580)
+++ pure/trunk/test/test020.log 2008-08-23 12:49:38 UTC (rev 581)
@@ -514,17 +514,17 @@
acosh,1L%3L,nan
acosh,(-1L)%4L,nan
acosh,1+:2,1.53+:1.14
-acosh,-1+:2,-1.53+:-2.00
+acosh,-1+:2,1.53+:2.00
acosh,1+:-2,1.53+:-1.14
-acosh,-1.20+:4.30,-2.20+:-1.84
+acosh,-1.20+:4.30,2.20+:1.84
acosh,1.20+:-4.30,2.20+:-1.30
acosh,1L%2L+:1,0.926+:1.22
acosh,1L%2L+:3L%4L,0.743+:1.17
acosh,3<:1,1.80+:1.02
-acosh,3<:-2.14,-1.80+:2.12
-acosh,3.00<:-3,-1.76+:2.99
-acosh,3.10<:2.50,-1.82+:-2.47
-acosh,2L%3L<:2,-0.589+:-1.81
+acosh,3<:-2.14,1.80+:-2.12
+acosh,3.00<:-3,1.76+:-2.99
+acosh,3.10<:2.50,1.82+:2.47
+acosh,2L%3L<:2,0.589+:1.81
acosh,1L%2L<:3L%4L,0.355+:1.22
acosh,-inf,nan
acosh,nan,nan
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-23 23:56:33
|
Revision: 595
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=595&view=rev
Author: agraef
Date: 2008-08-23 23:56:43 +0000 (Sat, 23 Aug 2008)
Log Message:
-----------
Correct wrong branch cut of complex acos.
Modified Paths:
--------------
pure/trunk/lib/math.pure
pure/trunk/test/test020.log
Modified: pure/trunk/lib/math.pure
===================================================================
--- pure/trunk/lib/math.pure 2008-08-23 23:42:23 UTC (rev 594)
+++ pure/trunk/lib/math.pure 2008-08-23 23:56:43 UTC (rev 595)
@@ -213,7 +213,7 @@
asin z@(x+:y) |
asin z@(r<:t) = -i*ln (i*z+sqrt (1-z*z));
acos z@(x+:y) |
-acos z@(r<:t) = -i*ln (z+sqrt (z*z-1));
+acos z@(r<:t) = -i*ln (z+i*sqrt (1-z*z));
atan z@(x+:y) |
atan z@(r<:t) = (ln (1+i*z)-ln (1-i*z))/(2*i);
Modified: pure/trunk/test/test020.log
===================================================================
--- pure/trunk/test/test020.log 2008-08-23 23:42:23 UTC (rev 594)
+++ pure/trunk/test/test020.log 2008-08-23 23:56:43 UTC (rev 595)
@@ -461,17 +461,17 @@
acos,1L%3L,1.23
acos,(-1L)%4L,1.82
acos,1+:2,1.14+:-1.53
-acos,-1+:2,-2.00+:1.53
-acos,1+:-2,-1.14+:-1.53
-acos,-1.20+:4.30,-1.84+:2.20
-acos,1.20+:-4.30,-1.30+:-2.20
+acos,-1+:2,2.00+:-1.53
+acos,1+:-2,1.14+:1.53
+acos,-1.20+:4.30,1.84+:-2.20
+acos,1.20+:-4.30,1.30+:2.20
acos,1L%2L+:1,1.22+:-0.926
acos,1L%2L+:3L%4L,1.17+:-0.743
acos,3<:1,1.02+:-1.80
acos,3<:-2.14,2.12+:1.80
acos,3.00<:-3,2.99+:1.76
-acos,3.10<:2.50,-2.47+:1.82
-acos,2L%3L<:2,-1.81+:0.589
+acos,3.10<:2.50,2.47+:-1.82
+acos,2L%3L<:2,1.81+:-0.589
acos,1L%2L<:3L%4L,1.22+:-0.355
acos,-inf,nan
acos,nan,nan
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-24 09:57:28
|
Revision: 600
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=600&view=rev
Author: agraef
Date: 2008-08-24 09:57:38 +0000 (Sun, 24 Aug 2008)
Log Message:
-----------
do operations now implemented with $$.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/prelude.pure
pure/trunk/test/prelude.log
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-24 02:19:25 UTC (rev 599)
+++ pure/trunk/ChangeLog 2008-08-24 09:57:38 UTC (rev 600)
@@ -2,6 +2,8 @@
* 0.5 release.
+ * lib/prelude.pure: do operations now implemented with $$.
+
* test/test020.pure, test/test021.pure: Cosmetic changes, added
math.pure tests for checking exact/inexact/symbolic results.
Modified: pure/trunk/lib/prelude.pure
===================================================================
--- pure/trunk/lib/prelude.pure 2008-08-24 02:19:25 UTC (rev 599)
+++ pure/trunk/lib/prelude.pure 2008-08-24 09:57:38 UTC (rev 600)
@@ -227,7 +227,7 @@
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;
+do f (x:xs) = f x $$ do f xs;
drop n::int [] = [];
drop n::int (x:xs)
@@ -403,11 +403,11 @@
accum us _ _ _ = reverse us;
end;
-dowith f (x:xs) (y:ys) = dowith f xs ys when _ = f x y end;
+dowith f (x:xs) (y:ys) = f x y $$ dowith f xs ys;
dowith f _ _ = () otherwise;
dowith3 f (x:xs) (y:ys) (z:zs)
- = dowith3 f xs ys zs when _ = f x y z end;
+ = f x y z $$ dowith3 f xs ys zs;
dowith3 f _ _ _ = () otherwise;
unzip [] = [],[];
Modified: pure/trunk/test/prelude.log
===================================================================
--- pure/trunk/test/prelude.log 2008-08-24 02:19:25 UTC (rev 599)
+++ pure/trunk/test/prelude.log 2008-08-24 09:57:38 UTC (rev 600)
@@ -299,12 +299,7 @@
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*/;
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
- state 0: #0
- <var> state 1
- state 1: #0
-} end;
+do f/*0:01*/ (x/*0:101*/:xs/*0:11*/) = f/*0:01*/ x/*0:101*/$$do f/*0:01*/ xs/*0:11*/;
drop n/*0:01*/::int [] = [];
drop n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = drop (n/*0:01*/-1) xs/*0:11*/ if n/*0:01*/>0;
drop n/*0:01*/::int (x/*0:101*/:xs/*0:11*/) = x/*0:101*/:xs/*0:11*/;
@@ -1072,19 +1067,9 @@
<var> state 43
state 43: #0 #1
} end;
-dowith f/*0:001*/ (x/*0:0101*/:xs/*0:011*/) (y/*0:101*/:ys/*0:11*/) = dowith f/*1:001*/ xs/*1:011*/ ys/*1:11*/ when _/*0:*/ = f/*0:001*/ x/*0:0101*/ y/*0:101*/ {
- rule #0: _ = f x y
- state 0: #0
- <var> state 1
- state 1: #0
-} end;
+dowith f/*0:001*/ (x/*0:0101*/:xs/*0:011*/) (y/*0:101*/:ys/*0:11*/) = f/*0:001*/ x/*0:0101*/ y/*0:101*/$$dowith f/*0:001*/ xs/*0:011*/ ys/*0:11*/;
dowith f/*0:001*/ _/*0:01*/ _/*0:1*/ = ();
-dowith3 f/*0:0001*/ (x/*0:00101*/:xs/*0:0011*/) (y/*0:0101*/:ys/*0:011*/) (z/*0:101*/:zs/*0:11*/) = dowith3 f/*1:0001*/ xs/*1:0011*/ ys/*1:011*/ zs/*1:11*/ when _/*0:*/ = f/*0:0001*/ x/*0:00101*/ y/*0:0101*/ z/*0:101*/ {
- rule #0: _ = f x y z
- state 0: #0
- <var> state 1
- state 1: #0
-} end;
+dowith3 f/*0:0001*/ (x/*0:00101*/:xs/*0:0011*/) (y/*0:0101*/:ys/*0:011*/) (z/*0:101*/:zs/*0:11*/) = f/*0:0001*/ x/*0:00101*/ y/*0:0101*/ z/*0:101*/$$dowith3 f/*0:0001*/ xs/*0:0011*/ ys/*0:011*/ zs/*0:11*/;
dowith3 f/*0:0001*/ _/*0:001*/ _/*0:01*/ _/*0:1*/ = ();
unzip [] = [],[];
unzip ((x/*0:10101*/,y/*0:1011*/):us/*0:11*/) = x/*1:10101*/:xs/*0:01*/,y/*1:1011*/:ys/*0:1*/ when xs/*0:01*/,ys/*0:1*/ = accum/*0*/ [] [] us/*0:11*/ {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-25 10:25:06
|
Revision: 605
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=605&view=rev
Author: agraef
Date: 2008-08-25 10:25:09 +0000 (Mon, 25 Aug 2008)
Log Message:
-----------
Add macro infrastructure.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
pure/trunk/lexer.ll
pure/trunk/parser.yy
pure/trunk/pure.cc
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-24 23:46:59 UTC (rev 604)
+++ pure/trunk/interpreter.cc 2008-08-25 10:25:09 UTC (rev 605)
@@ -773,9 +773,12 @@
for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
int32_t f = it->first;
const symbol& sym = symtab.sym(f);
- env::const_iterator jt = globenv.find(f);
- if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+ env::const_iterator jt = globenv.find(f), kt = macenv.find(f);
+ if (kt != macenv.end()) {
restore_globals(g);
+ throw err("symbol '"+sym.s+"' is already defined as a macro");
+ } else if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+ restore_globals(g);
throw err("symbol '"+sym.s+"' is already defined as a constant");
} else if (jt != globenv.end() && jt->second.t == env_info::fun) {
restore_globals(g);
@@ -870,9 +873,12 @@
for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
int32_t f = it->first;
const symbol& sym = symtab.sym(f);
- env::const_iterator jt = globenv.find(f);
- if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+ env::const_iterator jt = globenv.find(f), kt = macenv.find(f);
+ if (kt != macenv.end()) {
restore_globals(g);
+ throw err("symbol '"+sym.s+"' is already defined as a macro");
+ } else if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+ restore_globals(g);
throw err("symbol '"+sym.s+"' is already defined as a constant");
} else if (jt != globenv.end() && jt->second.t == env_info::fvar) {
restore_globals(g);
@@ -916,9 +922,12 @@
globals g;
save_globals(g);
symbol& sym = symtab.sym(tag);
- env::const_iterator jt = globenv.find(tag);
- if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+ env::const_iterator jt = globenv.find(tag), kt = macenv.find(tag);
+ if (kt != macenv.end()) {
restore_globals(g);
+ throw err("symbol '"+sym.s+"' is already defined as a macro");
+ } else if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+ restore_globals(g);
throw err("symbol '"+sym.s+"' is already defined as a constant");
} else if (jt != globenv.end() && jt->second.t == env_info::fvar) {
restore_globals(g);
@@ -1289,8 +1298,11 @@
globenv.erase(it);
clearsym(f);
}
+ it = macenv.find(f);
+ if (it != macenv.end())
+ macenv.erase(it);
} else if (f == 0 && temp > 0) {
- // purge all temporary functions and variables
+ // purge all temporary symbols
for (env::iterator it = globenv.begin(); it != globenv.end(); ) {
env::iterator jt = it; ++it;
int32_t f = jt->first;
@@ -1314,6 +1326,30 @@
}
}
}
+ for (env::iterator it = macenv.begin(); it != macenv.end(); ) {
+ env::iterator jt = it; ++it;
+ env_info& info = jt->second;
+ if (info.temp >= temp)
+ macenv.erase(jt);
+ else {
+ // purge temporary rules for non-temporary macros
+ bool d = false;
+ rulel& r = *info.rules;
+ for (rulel::iterator it = r.begin(); it != r.end(); )
+ if (it->temp >= temp) {
+ d = true;
+ it = r.erase(it);
+ } else
+ ++it;
+ if (d) {
+ assert(!r.empty());
+ if (info.m) {
+ delete info.m;
+ info.m = 0;
+ }
+ }
+ }
+ }
if (temp > 1) --temp;
}
}
@@ -1429,6 +1465,48 @@
delete r;
}
+void interpreter::add_macro_rule(rule *r)
+{
+ assert(!r->lhs.is_null() && r->qual.is_null());
+ closure(*r, false);
+ int32_t f; uint32_t argc = count_args(r->lhs, f);
+ if (f <= 0)
+ throw err("error in macro definition (invalid head symbol)");
+ env::iterator it = macenv.find(f), jt = globenv.find(f);
+ const symbol& sym = symtab.sym(f);
+ if (jt != globenv.end()) {
+ if (it->second.t == env_info::cvar)
+ throw err("symbol '"+sym.s+"' is already defined as a constant");
+ else if (it->second.t == env_info::fvar)
+ throw err("symbol '"+sym.s+"' is already defined as a variable");
+ } else if (it != macenv.end()) {
+ if (it->second.argc != argc) {
+ ostringstream msg;
+ msg << "symbol '" << sym.s
+ << "' was previously defined with " << it->second.argc << " args";
+ throw err(msg.str());
+ }
+ }
+ env_info &info = macenv[f];
+ if (info.t == env_info::none)
+ info = env_info(argc, rulel(), temp);
+ assert(info.argc == argc);
+ r->temp = temp;
+ if (override) {
+ rulel::iterator p = info.rules->begin();
+ for (; p != info.rules->end() && p->temp >= temp; p++) ;
+ info.rules->insert(p, *r);
+ } else
+ info.rules->push_back(*r);
+ if ((verbose&verbosity::defs) != 0) cout << "def " << *r << ";\n";
+ if (info.m) {
+ // this will be recomputed the next time the macro is needed
+ delete info.m;
+ info.m = 0;
+ }
+ delete r;
+}
+
void interpreter::closure(expr& l, expr& r, bool b)
{
env vars;
@@ -2187,9 +2265,12 @@
globals g;
save_globals(g);
symbol& sym = symtab.sym(tag);
- env::const_iterator jt = globenv.find(tag);
- if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+ env::const_iterator jt = globenv.find(tag), kt = macenv.find(tag);
+ if (kt != macenv.end()) {
restore_globals(g);
+ throw err("symbol '"+sym.s+"' is already defined as a macro");
+ } else if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+ restore_globals(g);
throw err("symbol '"+sym.s+"' is already defined as a constant");
} else if (jt != globenv.end() && jt->second.t == env_info::fun) {
restore_globals(g);
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-24 23:46:59 UTC (rev 604)
+++ pure/trunk/interpreter.hh 2008-08-25 10:25:09 UTC (rev 605)
@@ -331,6 +331,7 @@
clock_t clocks; // last evaluation time, if stats is set
exprl last; // last processed lhs collection
env globenv; // global function and variable environment
+ env macenv; // global macro environment
funset dirty; // "dirty" function entries which need a recompile
pure_mem *mem; // runtime expression memory
pure_expr *exps; // head of the free list (available expression nodes)
@@ -444,6 +445,7 @@
void add_rule(rulel &rl, rule &r, bool b);
void add_rule(env &e, rule &r, bool toplevel = false);
void add_simple_rule(rulel &rl, rule *r);
+ void add_macro_rule(rule *r);
void promote_ttags(expr f, expr x, expr u);
void promote_ttags(expr f, expr x, expr u, expr v);
expr bind(env& vars, expr x, bool b = true, path p = path());
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-24 23:46:59 UTC (rev 604)
+++ pure/trunk/lexer.ll 2008-08-25 10:25:09 UTC (rev 605)
@@ -111,11 +111,12 @@
struct env_sym {
const symbol* sym;
- env::const_iterator it;
+ env::const_iterator it, jt;
extmap::const_iterator xt;
env_sym(const symbol& _sym, env::const_iterator _it,
+ env::const_iterator _jt,
extmap::const_iterator _xt)
- : sym(&_sym), it(_it), xt(_xt) { }
+ : sym(&_sym), it(_it), jt(_jt), xt(_xt) { }
};
static bool env_compare(env_sym s, env_sym t)
@@ -172,6 +173,7 @@
int32_t f = it->second.f;
/* Skip non-toplevel symbols. */
if (interp.globenv.find(f) == interp.globenv.end() &&
+ interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
it++;
@@ -361,7 +363,7 @@
uint8_t s_verbose = interpreter::g_verbose;
uint8_t tflag = 0;
bool aflag = false, dflag = false, eflag = false;
- bool cflag = false, fflag = false, vflag = false;
+ bool cflag = false, fflag = false, mflag = false, vflag = false;
bool gflag = false, lflag = false, sflag = false;
const char *s = yytext+4;
if (*s && !isspace(*s)) REJECT;
@@ -372,7 +374,7 @@
// process option arguments
for (arg = args.l.begin(); arg != args.l.end(); arg++) {
const char *s = arg->c_str();
- if (s[0] != '-' || !s[1] || !strchr("acdefghlstv", s[1])) break;
+ if (s[0] != '-' || !s[1] || !strchr("acdefghlmstv", s[1])) break;
while (*++s) {
switch (*s) {
case 'a': aflag = true; break;
@@ -382,6 +384,7 @@
case 'f': fflag = true; break;
case 'g': gflag = true; break;
case 'l': lflag = true; break;
+ case 'm': mflag = true; break;
case 's': sflag = true; break;
case 'v': vflag = true; break;
case 't':
@@ -406,6 +409,7 @@
-h Print this list.\n\
-l Long format, prints definitions along with the summary symbol\n\
information. This implies -s.\n\
+-m Print information about defined macros.\n\
-s Summary format, print just summary information about listed symbols.\n\
-t[level] List only symbols and definitions at the given temporary level\n\
(the current level by default) or above. Level 1 denotes all temporary\n\
@@ -422,10 +426,12 @@
if (eflag) interpreter::g_verbose |= verbosity::envs;
if (aflag) interpreter::g_verbose |= verbosity::code;
if (dflag) interpreter::g_verbose |= verbosity::dump;
- if (!cflag && !fflag && !vflag) cflag = fflag = vflag = true;
+ if (!cflag && !fflag && !mflag && !vflag)
+ cflag = fflag = mflag = vflag = true;
if (lflag) sflag = true;
{
- size_t maxsize = 0, nfuns = 0, nvars = 0, ncsts = 0, nrules = 0;
+ size_t maxsize = 0, nfuns = 0, nmacs = 0, nvars = 0, ncsts = 0,
+ nrules = 0, mrules = 0;
list<env_sym> l; set<int32_t> syms;
for (env::const_iterator it = interp.globenv.begin();
it != interp.globenv.end(); ++it) {
@@ -462,7 +468,8 @@
}
if (!matches) continue;
syms.insert(f);
- l.push_back(env_sym(sym, it, interp.externals.find(f)));
+ l.push_back(env_sym(sym, it, interp.macenv.find(f),
+ interp.externals.find(f)));
if (sym.s.size() > maxsize) maxsize = sym.s.size();
}
if (fflag && tflag == 0) {
@@ -484,11 +491,52 @@
}
}
if (!matches) continue;
- l.push_back(env_sym(sym, interp.globenv.end(), it));
+ l.push_back(env_sym(sym, interp.globenv.end(),
+ interp.macenv.find(f), it));
if (sym.s.size() > maxsize) maxsize = sym.s.size();
}
}
}
+ if (mflag) {
+ // also list any symbols defined as macros, unless they've already been
+ // considered
+ for (env::const_iterator it = interp.macenv.begin();
+ it != interp.macenv.end(); ++it) {
+ int32_t f = it->first;
+ if (syms.find(f) == syms.end()) {
+ const env_info& e = it->second;
+ const symbol& sym = interp.symtab.sym(f);
+ bool matches = e.temp >= tflag;
+ if (!matches && !sflag && args.l.empty()) {
+ // if not in summary mode, also list temporary rules for a
+ // non-temporary symbol
+ rulel::const_iterator r;
+ for (r = e.rules->begin(); r != e.rules->end(); r++)
+ if (r->temp >= tflag) {
+ matches = true;
+ break;
+ }
+ }
+ if (!matches) continue;
+ if (!args.l.empty()) {
+ // see whether we actually want the defined symbol to be listed
+ matches = false;
+ for (arg = args.l.begin(); arg != args.l.end(); ++arg) {
+ if (gflag ? (!fnmatch(arg->c_str(), sym.s.c_str(), 0)) :
+ (*arg == sym.s)) {
+ matches = true;
+ break;
+ }
+ }
+ }
+ if (!matches) continue;
+ syms.insert(f);
+ l.push_back(env_sym(sym, interp.globenv.end(), it,
+ interp.externals.end()));
+ if (sym.s.size() > maxsize) maxsize = sym.s.size();
+ }
+ }
+ }
l.sort(env_compare);
if (!l.empty() && (aflag||dflag)) interp.compile();
// we first dump the entire listing into a string and then output that
@@ -499,9 +547,9 @@
const symbol& sym = *it->sym;
int32_t ftag = sym.f;
map<int32_t,Env>::iterator fenv = interp.globalfuns.find(ftag);
- const env::const_iterator jt = it->it;
+ const env::const_iterator jt = it->it, kt = it->jt;
const extmap::const_iterator xt = it->xt;
- if (jt == interp.globenv.end()) {
+ if (jt == interp.globenv.end() && kt == interp.macenv.end()) {
assert(xt != interp.externals.end());
const ExternInfo& info = xt->second;
sout << info << ";";
@@ -511,7 +559,8 @@
} else
sout << endl;
++nfuns;
- } else if (jt->second.t == env_info::fvar) {
+ } else if (jt != interp.globenv.end() &&
+ jt->second.t == env_info::fvar) {
nvars++;
if (sflag) {
sout << sym.s << string(maxsize-sym.s.size(), ' ')
@@ -522,7 +571,8 @@
} else
sout << "let " << sym.s << " = " << *(pure_expr**)jt->second.val
<< ";\n";
- } else if (jt->second.t == env_info::cvar) {
+ } else if (jt != interp.globenv.end() &&
+ jt->second.t == env_info::cvar) {
ncsts++;
if (sflag) {
sout << sym.s << string(maxsize-sym.s.size(), ' ')
@@ -553,7 +603,7 @@
}
sout << " " << (int)sym.prec << " " << sym.s << ";\n";
}
- if (xt != interp.externals.end()) {
+ if (fflag && xt != interp.externals.end()) {
const ExternInfo& info = xt->second;
sout << info << ";";
if ((!sflag||lflag) && dflag) {
@@ -562,58 +612,85 @@
} else
sout << endl;
}
- uint32_t argc = jt->second.argc;
- const rulel& rules = *jt->second.rules;
- const matcher *m = jt->second.m;
- if (sflag) {
- ++nfuns; nrules += rules.size();
- sout << sym.s << string(maxsize-sym.s.size(), ' ') << " fun";
- if (lflag) {
- sout << " " << rules << ";";
- if (aflag && m) sout << endl << *m;
- if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
- fenv->second.print(sout);
+ if (mflag && kt != interp.macenv.end()) {
+ uint32_t argc = kt->second.argc;
+ const rulel& rules = *kt->second.rules;
+ const matcher *m = kt->second.m;
+ if (sflag) {
+ ++nmacs; mrules += rules.size();
+ sout << sym.s << string(maxsize-sym.s.size(), ' ') << " mac";
+ if (lflag) {
+ sout << " " << rules << ";";
+ if (aflag && m) sout << endl << *m;
+ } else {
+ sout << " " << argc << " args, " << rules.size() << " rules";
+ }
+ sout << endl;
} else {
- sout << " " << argc << " args, " << rules.size() << " rules";
+ size_t n = 0;
+ for (rulel::const_iterator it = rules.begin();
+ it != rules.end(); ++it) {
+ if (it->temp >= tflag) {
+ sout << "def " << *it << ";\n";
+ ++n;
+ }
+ }
+ if (n > 0) {
+ if (aflag && m) sout << *m << endl;
+ mrules += n;
+ ++nmacs;
+ }
}
- sout << endl;
- } else {
- size_t n = 0;
- for (rulel::const_iterator it = rules.begin();
- it != rules.end(); ++it) {
- if (it->temp >= tflag) {
- sout << *it << ";\n";
- ++n;
+ }
+ if (fflag && jt != interp.globenv.end()) {
+ uint32_t argc = jt->second.argc;
+ const rulel& rules = *jt->second.rules;
+ const matcher *m = jt->second.m;
+ if (sflag) {
+ ++nfuns; nrules += rules.size();
+ sout << sym.s << string(maxsize-sym.s.size(), ' ') << " fun";
+ if (lflag) {
+ sout << " " << rules << ";";
+ if (aflag && m) sout << endl << *m;
+ if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
+ fenv->second.print(sout);
+ } else {
+ sout << " " << argc << " args, " << rules.size() << " rules";
}
+ sout << endl;
+ } else {
+ size_t n = 0;
+ for (rulel::const_iterator it = rules.begin();
+ it != rules.end(); ++it) {
+ if (it->temp >= tflag) {
+ sout << *it << ";\n";
+ ++n;
+ }
+ }
+ if (n > 0) {
+ if (aflag && m) sout << *m << endl;
+ if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
+ fenv->second.print(sout);
+ nrules += n;
+ ++nfuns;
+ }
}
- if (n > 0) {
- if (aflag && m) sout << *m << endl;
- if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
- fenv->second.print(sout);
- nrules += n;
- ++nfuns;
- }
}
}
}
if (sflag) {
- if (fflag && vflag && cflag)
- sout << ncsts << " constants, " << nvars << " variables, "
- << nfuns << " functions, " << nrules << " rules\n";
- else if (fflag && cflag)
- sout << ncsts << " constants, " << nfuns << " functions, "
- << nrules << " rules\n";
- else if (fflag && vflag)
- sout << nvars << " variables, " << nfuns << " functions, "
- << nrules << " rules\n";
- else if (cflag && vflag)
- sout << ncsts << " constants, " << nvars << " variables\n";
- else if (cflag)
- sout << ncsts << " constants\n";
- else if (vflag)
- sout << nvars << " variables\n";
- else if (fflag)
- sout << nfuns << " functions, " << nrules << " rules\n";
+ ostringstream summary;
+ if (cflag)
+ summary << ncsts << " constants, ";
+ if (vflag)
+ summary << nvars << " variables, ";
+ if (mflag)
+ summary << nmacs << " macros (" << mrules << " rules), ";
+ if (fflag)
+ summary << nfuns << " functions (" << nrules << " rules), ";
+ string s = summary.str();
+ if (!s.empty())
+ sout << s.substr(0, s.size()-2) << endl;
}
FILE *fp;
const char *more = getenv("PURE_MORE");
Modified: pure/trunk/parser.yy
===================================================================
--- pure/trunk/parser.yy 2008-08-24 23:46:59 UTC (rev 604)
+++ pure/trunk/parser.yy 2008-08-25 10:25:09 UTC (rev 605)
@@ -279,6 +279,8 @@
{ action(interp.define($2), delete $2); }
| CONST simple_rule
{ action(interp.define_const($2), delete $2); }
+| DEF simple_rule
+{ action(interp.add_macro_rule($2), delete $2); }
| rule
{ rulel *rl = 0;
action(interp.add_rules(interp.globenv,
@@ -632,7 +634,8 @@
catch (err &e) { if (rl) delete rl; interp.error(yyloc, e.what()); } }
;
-/* Same for simple rules (pattern binding in 'when' clauses, no guards). */
+/* Same for simple rules (pattern binding in 'when' clauses or 'let', 'const',
+ 'def', no guards in these cases). */
simple_rule
: expr '=' expr
Modified: pure/trunk/pure.cc
===================================================================
--- pure/trunk/pure.cc 2008-08-24 23:46:59 UTC (rev 604)
+++ pure/trunk/pure.cc 2008-08-25 10:25:09 UTC (rev 605)
@@ -97,6 +97,7 @@
int32_t f = it->second.f;
/* Skip non-toplevel symbols. */
if (interp.globenv.find(f) == interp.globenv.end() &&
+ interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
it++;
@@ -136,6 +137,7 @@
int32_t f = it->second.f;
/* Skip non-toplevel symbols. */
if (interp.globenv.find(f) == interp.globenv.end() &&
+ interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
it++;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-25 19:53:32
|
Revision: 606
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=606&view=rev
Author: agraef
Date: 2008-08-25 19:53:35 +0000 (Mon, 25 Aug 2008)
Log Message:
-----------
Implement matching operation on expression lists.
Modified Paths:
--------------
pure/trunk/matcher.cc
pure/trunk/matcher.hh
Modified: pure/trunk/matcher.cc
===================================================================
--- pure/trunk/matcher.cc 2008-08-25 10:25:09 UTC (rev 605)
+++ pure/trunk/matcher.cc 2008-08-25 19:53:35 UTC (rev 606)
@@ -126,6 +126,14 @@
return 0;
}
+state *matcher::match(state *st, const exprl& x)
+{
+ for (exprl::const_iterator it = x.begin(), end = x.end();
+ it != end && st; it++)
+ st = match(st, *it);
+ return st;
+}
+
/* TA construction algorithm. */
state *matcher::make(const rule& ru, uint32_t skip)
Modified: pure/trunk/matcher.hh
===================================================================
--- pure/trunk/matcher.hh 2008-08-25 10:25:09 UTC (rev 605)
+++ pure/trunk/matcher.hh 2008-08-25 19:53:35 UTC (rev 606)
@@ -161,7 +161,7 @@
state *match(const exprl& xs)
{ assert(start!=0); return match(start, xs); }
state *match(state *st, expr x);
- state *match(state *st, const exprl& x); // XXXTODO
+ state *match(state *st, const exprl& x);
private: // these are used internally by the TA construction algorithm
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-25 19:56:02
|
Revision: 607
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=607&view=rev
Author: agraef
Date: 2008-08-25 19:56:07 +0000 (Mon, 25 Aug 2008)
Log Message:
-----------
Implement macro substitution facility.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-25 19:53:35 UTC (rev 606)
+++ pure/trunk/ChangeLog 2008-08-25 19:56:07 UTC (rev 607)
@@ -1,3 +1,22 @@
+2008-08-25 Albert Graef <Dr....@t-...>
+
+ * parser.yy, lexer.ll, interpreter.cc: Added macro substitution
+ facility. Pure macros are meta functions executed at compile time,
+ which are defined by any number of equations (rewriting rules)
+ prefixed with the 'def' keyword, e.g.:
+
+ def foo (bar x) = foo x+1;
+ def foo x = x;
+
+ Only simple, unconditional rules are supported by now, but these
+ are quite powerful already, since, as shown above, the macro
+ parameters can be arbitrary patterns and macro definitions can
+ also be recursive.
+
+ Pure macros are lexically scoped, i.e., symbols on the rhs of a
+ macro definition can never refer to anything outside the macro
+ definition. (These are also known as "hygienic" macros.)
+
2008-08-24 Albert Graef <Dr....@t-...>
* 0.5 release.
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-25 19:53:35 UTC (rev 606)
+++ pure/trunk/interpreter.cc 2008-08-25 19:56:07 UTC (rev 607)
@@ -739,8 +739,8 @@
globals g;
save_globals(g);
compile();
- // promote type tags and substitute constants:
- env vars; expr u = csubst(subst(vars, x));
+ // promote type tags and substitute macros and constants:
+ env vars; expr u = csubst(macsubst(subst(vars, x)));
compile(u);
x = u;
pure_expr *res = doeval(u, e);
@@ -766,8 +766,8 @@
save_globals(g);
compile();
env vars;
- // promote type tags and substitute constants:
- expr rhs = csubst(subst(vars, x));
+ // promote type tags and substitute macros and constants:
+ expr rhs = csubst(macsubst(subst(vars, x)));
expr lhs = bind(vars, pat);
build_env(vars, lhs);
for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
@@ -866,8 +866,8 @@
save_globals(g);
compile();
env vars;
- // promote type tags and substitute constants:
- expr rhs = csubst(subst(vars, x));
+ // promote type tags and substitute macros and constants:
+ expr rhs = csubst(macsubst(subst(vars, x)));
expr lhs = bind(vars, pat);
build_env(vars, lhs);
for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
@@ -1404,10 +1404,10 @@
assert(!r.lhs.is_null());
closure(r, false);
if (toplevel) {
- // substitute constants:
+ // substitute macros and constants:
expr u = expr(r.lhs),
- v = expr(csubst(r.rhs)),
- w = expr(csubst(r.qual));
+ v = expr(csubst(macsubst(r.rhs))),
+ w = expr(csubst(macsubst(r.qual)));
r = rule(u, v, w);
compile(r.rhs);
compile(r.qual);
@@ -1788,6 +1788,103 @@
}
}
+expr interpreter::fsubst(const env& funs, expr x, uint8_t idx)
+{
+ if (x.is_null()) return x;
+ switch (x.tag()) {
+ // constants:
+ case EXPR::VAR:
+ case EXPR::FVAR:
+ case EXPR::INT:
+ case EXPR::BIGINT:
+ case EXPR::DBL:
+ case EXPR::STR:
+ case EXPR::PTR:
+ return x;
+ // application:
+ case EXPR::APP:
+ if (x.xval1().tag() == EXPR::APP &&
+ x.xval1().xval1().tag() == symtab.catch_sym().f) {
+ expr u = fsubst(funs, x.xval1().xval2(), idx);
+ if (++idx == 0)
+ throw err("error in expression (too many nested closures)");
+ expr v = fsubst(funs, x.xval2(), idx);
+ return expr(symtab.catch_sym().x, u, v);
+ } else {
+ expr u = fsubst(funs, x.xval1(), idx),
+ v = fsubst(funs, x.xval2(), idx);
+ return expr(u, v);
+ }
+ // conditionals:
+ case EXPR::COND: {
+ expr u = fsubst(funs, x.xval1(), idx),
+ v = fsubst(funs, x.xval2(), idx),
+ w = fsubst(funs, x.xval3(), idx);
+ return expr::cond(u, v, w);
+ }
+ // nested closures:
+ case EXPR::LAMBDA: {
+ if (++idx == 0)
+ throw err("error in expression (too many nested closures)");
+ expr u = x.xval1(), v = fsubst(funs, x.xval2(), idx);
+ return expr::lambda(u, v);
+ }
+ case EXPR::CASE: {
+ expr u = fsubst(funs, x.xval(), idx);
+ if (++idx == 0)
+ throw err("error in expression (too many nested closures)");
+ const rulel *r = x.rules();
+ rulel *s = new rulel;
+ for (rulel::const_iterator it = r->begin(); it != r->end(); ++it) {
+ expr u = it->lhs, v = fsubst(funs, it->rhs, idx),
+ w = fsubst(funs, it->qual, idx);
+ s->push_back(rule(u, v, w));
+ }
+ return expr::cases(u, s);
+ }
+ case EXPR::WHEN: {
+ const rulel *r = x.rules();
+ rulel *s = new rulel;
+ for (rulel::const_iterator it = r->begin(); it != r->end(); ++it) {
+ expr u = it->lhs, v = fsubst(funs, it->rhs, idx);
+ s->push_back(rule(u, v));
+ if (++idx == 0)
+ throw err("error in expression (too many nested closures)");
+ }
+ expr u = fsubst(funs, x.xval(), idx);
+ return expr::when(u, s);
+ }
+ case EXPR::WITH: {
+ expr u = fsubst(funs, x.xval(), idx);
+ if (++idx == 0)
+ throw err("error in expression (too many nested closures)");
+ const env *e = x.fenv();
+ env *f = new env;
+ for (env::const_iterator it = e->begin(); it != e->end(); ++it) {
+ int32_t g = it->first;
+ const env_info& info = it->second;
+ const rulel *r = info.rules;
+ rulel s;
+ for (rulel::const_iterator jt = r->begin(); jt != r->end(); ++jt) {
+ expr u = jt->lhs, v = fsubst(funs, jt->rhs, idx),
+ w = fsubst(funs, jt->qual, idx);
+ s.push_back(rule(u, v, w));
+ }
+ (*f)[g] = env_info(info.argc, s, info.temp);
+ }
+ return expr::with(u, f);
+ }
+ default:
+ assert(x.tag() > 0);
+ const symbol& sym = symtab.sym(x.tag());
+ env::const_iterator it = funs.find(sym.f);
+ if (it != funs.end())
+ return expr(EXPR::FVAR, sym.f, idx);
+ else
+ return x;
+ }
+}
+
expr interpreter::csubst(expr x)
{
if (x.is_null()) return x;
@@ -1883,9 +1980,26 @@
}
}
-expr interpreter::fsubst(const env& funs, expr x, uint8_t idx)
+/* Perform simple macro substitutions on a compile time expression. Does
+ applicative-order (depth-first) evaluation using the defined macro
+ substitution rules (which are simple, unconditional term rewriting
+ rules). Everything else but macro applications is considered constant
+ here. When we match a macro call, we perform the corresponding reduction
+ and evaluate the result recursively.
+
+ Note that in contrast to compiled rewriting rules this is essentially a
+ little term rewriting interpreter here, so it's kind of slow compared to
+ compiled code, but for macro substitution it should be good enough. (We
+ can't use compiled code here, since the runtime expression data structure
+ cannot represent special kinds of expressions like anonymous closures, with
+ and when clauses, etc.) */
+
+expr interpreter::macsubst(expr x)
{
+ char test;
if (x.is_null()) return x;
+ if (stackmax > 0 && stackdir*(&test - baseptr) >= stackmax)
+ throw err("recursion too deep in macro expansion");
switch (x.tag()) {
// constants:
case EXPR::VAR:
@@ -1897,63 +2011,245 @@
case EXPR::PTR:
return x;
// application:
+ case EXPR::APP: {
+ expr u = macsubst(x.xval1()),
+ v = macsubst(x.xval2());
+ expr w = expr(u, v);
+ return macval(w);
+ }
+ // conditionals:
+ case EXPR::COND: {
+ expr u = macsubst(x.xval1()),
+ v = macsubst(x.xval2()),
+ w = macsubst(x.xval3());
+ return expr::cond(u, v, w);
+ }
+ // nested closures:
+ case EXPR::LAMBDA: {
+ expr u = x.xval1(), v = macsubst(x.xval2());
+ return expr::lambda(u, v);
+ }
+ case EXPR::CASE: {
+ expr u = macsubst(x.xval());
+ const rulel *r = x.rules();
+ rulel *s = new rulel;
+ for (rulel::const_iterator it = r->begin(); it != r->end(); ++it) {
+ expr u = it->lhs, v = macsubst(it->rhs),
+ w = macsubst(it->qual);
+ s->push_back(rule(u, v, w));
+ }
+ return expr::cases(u, s);
+ }
+ case EXPR::WHEN: {
+ const rulel *r = x.rules();
+ rulel *s = new rulel;
+ for (rulel::const_iterator it = r->begin(); it != r->end(); ++it) {
+ expr u = it->lhs, v = macsubst(it->rhs);
+ s->push_back(rule(u, v));
+ }
+ expr u = macsubst(x.xval());
+ return expr::when(u, s);
+ }
+ case EXPR::WITH: {
+ expr u = macsubst(x.xval());
+ const env *e = x.fenv();
+ env *f = new env;
+ for (env::const_iterator it = e->begin(); it != e->end(); ++it) {
+ int32_t g = it->first;
+ const env_info& info = it->second;
+ const rulel *r = info.rules;
+ rulel s;
+ for (rulel::const_iterator jt = r->begin(); jt != r->end(); ++jt) {
+ expr u = jt->lhs, v = macsubst(jt->rhs),
+ w = macsubst(jt->qual);
+ s.push_back(rule(u, v, w));
+ }
+ (*f)[g] = env_info(info.argc, s, info.temp);
+ }
+ return expr::with(u, f);
+ }
+ default:
+ assert(x.tag() > 0);
+ return macval(x);
+ }
+}
+
+/* Perform a single macro reduction step. */
+
+expr interpreter::varsubst(expr x, uint8_t offs)
+{
+ char test;
+ if (x.is_null()) return x;
+ if (stackmax > 0 && stackdir*(&test - baseptr) >= stackmax)
+ throw err("recursion too deep in macro expansion");
+ switch (x.tag()) {
+ case EXPR::VAR:
+ case EXPR::FVAR:
+ if (((uint32_t)x.vidx()) + offs > 0xff)
+ throw err("error in expression (too many nested closures)");
+ if (x.tag() == EXPR::VAR)
+ return expr(EXPR::VAR, x.vtag(), x.vidx()+offs, x.ttag(), x.vpath());
+ else
+ return expr(EXPR::FVAR, x.vtag(), x.vidx()+offs);
+ // constants:
+ case EXPR::INT:
+ case EXPR::BIGINT:
+ case EXPR::DBL:
+ case EXPR::STR:
+ case EXPR::PTR:
+ return x;
+ // application:
+ case EXPR::APP: {
+ expr u = varsubst(x.xval1(), offs),
+ v = varsubst(x.xval2(), offs);
+ expr w = expr(u, v);
+ return macval(w);
+ }
+ // conditionals:
+ case EXPR::COND: {
+ expr u = varsubst(x.xval1(), offs),
+ v = varsubst(x.xval2(), offs),
+ w = varsubst(x.xval3(), offs);
+ return expr::cond(u, v, w);
+ }
+ // nested closures:
+ case EXPR::LAMBDA: {
+ expr u = x.xval1(), v = varsubst(x.xval2(), offs);
+ return expr::lambda(u, v);
+ }
+ case EXPR::CASE: {
+ expr u = varsubst(x.xval(), offs);
+ const rulel *r = x.rules();
+ rulel *s = new rulel;
+ for (rulel::const_iterator it = r->begin(); it != r->end(); ++it) {
+ expr u = it->lhs, v = varsubst(it->rhs, offs),
+ w = varsubst(it->qual, offs);
+ s->push_back(rule(u, v, w));
+ }
+ return expr::cases(u, s);
+ }
+ case EXPR::WHEN: {
+ const rulel *r = x.rules();
+ rulel *s = new rulel;
+ for (rulel::const_iterator it = r->begin(); it != r->end(); ++it) {
+ expr u = it->lhs, v = varsubst(it->rhs, offs);
+ s->push_back(rule(u, v));
+ }
+ expr u = varsubst(x.xval(), offs);
+ return expr::when(u, s);
+ }
+ case EXPR::WITH: {
+ expr u = varsubst(x.xval(), offs);
+ const env *e = x.fenv();
+ env *f = new env;
+ for (env::const_iterator it = e->begin(); it != e->end(); ++it) {
+ int32_t g = it->first;
+ const env_info& info = it->second;
+ const rulel *r = info.rules;
+ rulel s;
+ for (rulel::const_iterator jt = r->begin(); jt != r->end(); ++jt) {
+ expr u = jt->lhs, v = varsubst(jt->rhs, offs),
+ w = varsubst(jt->qual, offs);
+ s.push_back(rule(u, v, w));
+ }
+ (*f)[g] = env_info(info.argc, s, info.temp);
+ }
+ return expr::with(u, f);
+ }
+ default:
+ assert(x.tag() > 0);
+ return x;
+ }
+}
+
+expr interpreter::macred(expr x, expr y, uint8_t idx)
+{
+ char test;
+ if (y.is_null()) return y;
+ if (stackmax > 0 && stackdir*(&test - baseptr) >= stackmax)
+ throw err("recursion too deep in macro expansion");
+ switch (y.tag()) {
+ // constants:
+ case EXPR::FVAR:
+ case EXPR::INT:
+ case EXPR::BIGINT:
+ case EXPR::DBL:
+ case EXPR::STR:
+ case EXPR::PTR:
+ return y;
+ // lhs variable
+ case EXPR::VAR:
+ if (y.vidx() == idx) {
+ /* Substitute the macro variables, which are the lhs values whose idx
+ match the current idx. Note that the deBruijn indices inside the
+ substituted value must then be shifted by idx, to accommodate for any
+ local environments inside the macro definition. */
+ expr v = varsubst(subterm(x, y.vpath()), idx);
+#if DEBUG>1
+ std::cerr << "macro var: " << y << " = " << v
+ << " (" << (uint32_t)idx << ")" << endl;
+#endif
+ return v;
+ } else
+ return y;
+ // application:
case EXPR::APP:
if (x.xval1().tag() == EXPR::APP &&
x.xval1().xval1().tag() == symtab.catch_sym().f) {
- expr u = fsubst(funs, x.xval1().xval2(), idx);
+ expr u = macred(x, y.xval1().xval2(), idx);
+ expr v = macred(x, y.xval2(), idx);
if (++idx == 0)
throw err("error in expression (too many nested closures)");
- expr v = fsubst(funs, x.xval2(), idx);
return expr(symtab.catch_sym().x, u, v);
} else {
- expr u = fsubst(funs, x.xval1(), idx),
- v = fsubst(funs, x.xval2(), idx);
+ expr u = macred(x, y.xval1(), idx),
+ v = macred(x, y.xval2(), idx);
return expr(u, v);
}
// conditionals:
case EXPR::COND: {
- expr u = fsubst(funs, x.xval1(), idx),
- v = fsubst(funs, x.xval2(), idx),
- w = fsubst(funs, x.xval3(), idx);
+ expr u = macred(x, y.xval1(), idx),
+ v = macred(x, y.xval2(), idx),
+ w = macred(x, y.xval3(), idx);
return expr::cond(u, v, w);
}
// nested closures:
case EXPR::LAMBDA: {
if (++idx == 0)
throw err("error in expression (too many nested closures)");
- expr u = x.xval1(), v = fsubst(funs, x.xval2(), idx);
+ expr u = y.xval1(), v = macred(x, y.xval2(), idx);
return expr::lambda(u, v);
}
case EXPR::CASE: {
- expr u = fsubst(funs, x.xval(), idx);
+ expr u = macred(x, y.xval(), idx);
if (++idx == 0)
throw err("error in expression (too many nested closures)");
- const rulel *r = x.rules();
+ const rulel *r = y.rules();
rulel *s = new rulel;
for (rulel::const_iterator it = r->begin(); it != r->end(); ++it) {
- expr u = it->lhs, v = fsubst(funs, it->rhs, idx),
- w = fsubst(funs, it->qual, idx);
+ expr u = it->lhs, v = macred(x, it->rhs, idx),
+ w = macred(x, it->qual, idx);
s->push_back(rule(u, v, w));
}
return expr::cases(u, s);
}
case EXPR::WHEN: {
- const rulel *r = x.rules();
+ const rulel *r = y.rules();
rulel *s = new rulel;
for (rulel::const_iterator it = r->begin(); it != r->end(); ++it) {
- expr u = it->lhs, v = fsubst(funs, it->rhs, idx);
+ expr u = it->lhs, v = macred(x, it->rhs, idx);
s->push_back(rule(u, v));
if (++idx == 0)
throw err("error in expression (too many nested closures)");
}
- expr u = fsubst(funs, x.xval(), idx);
+ expr u = macred(x, y.xval(), idx);
return expr::when(u, s);
}
case EXPR::WITH: {
- expr u = fsubst(funs, x.xval(), idx);
+ expr u = macred(x, y.xval(), idx);
if (++idx == 0)
throw err("error in expression (too many nested closures)");
- const env *e = x.fenv();
+ const env *e = y.fenv();
env *f = new env;
for (env::const_iterator it = e->begin(); it != e->end(); ++it) {
int32_t g = it->first;
@@ -1961,8 +2257,8 @@
const rulel *r = info.rules;
rulel s;
for (rulel::const_iterator jt = r->begin(); jt != r->end(); ++jt) {
- expr u = jt->lhs, v = fsubst(funs, jt->rhs, idx),
- w = fsubst(funs, jt->qual, idx);
+ expr u = jt->lhs, v = macred(x, jt->rhs, idx),
+ w = macred(x, jt->qual, idx);
s.push_back(rule(u, v, w));
}
(*f)[g] = env_info(info.argc, s, info.temp);
@@ -1970,16 +2266,50 @@
return expr::with(u, f);
}
default:
- assert(x.tag() > 0);
- const symbol& sym = symtab.sym(x.tag());
- env::const_iterator it = funs.find(sym.f);
- if (it != funs.end())
- return expr(EXPR::FVAR, sym.f, idx);
- else
- return x;
+ assert(y.tag() > 0);
+ return y;
}
}
+/* Evaluate a macro call. */
+
+static exprl get_args(expr x)
+{
+ expr y, z;
+ exprl xs;
+ while (x.is_app(y, z)) xs.push_front(z), x = y;
+ return xs;
+}
+
+expr interpreter::macval(expr x)
+{
+ char test;
+ if (x.is_null()) return x;
+ if (stackmax > 0 && stackdir*(&test - baseptr) >= stackmax)
+ throw err("recursion too deep in macro expansion");
+ int32_t f; uint32_t argc = count_args(x, f);
+ if (f <= 0) return x;
+ env::iterator it = macenv.find(f);
+ if (it == macenv.end()) return x;
+ env_info &info = it->second;
+ if (argc != info.argc) return x;
+ if (!info.m)
+ info.m = new matcher(*info.rules, info.argc+1);
+ assert(info.m);
+ exprl args = get_args(x);
+ assert(args.size() == argc);
+ state *st = info.m->match(args);
+ if (st) {
+ assert(!st->r.empty());
+ expr y = macred(x, info.m->r[st->r.front()].rhs);
+#if DEBUG>1
+ std::cerr << "macro expansion: " << x << " -> " << y << endl;
+#endif
+ return macsubst(y);
+ }
+ return x;
+}
+
expr* interpreter::uminop(expr *op, expr *x)
{
if (op->tag() != symtab.sym("-").f) {
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-25 19:53:35 UTC (rev 606)
+++ pure/trunk/interpreter.hh 2008-08-25 19:56:07 UTC (rev 607)
@@ -450,8 +450,12 @@
void promote_ttags(expr f, expr x, expr u, expr v);
expr bind(env& vars, expr x, bool b = true, path p = path());
expr subst(const env& vars, expr x, uint8_t idx = 0);
+ expr fsubst(const env& funs, expr x, uint8_t idx = 0);
expr csubst(expr x);
- expr fsubst(const env& funs, expr x, uint8_t idx = 0);
+ expr macsubst(expr x);
+ expr varsubst(expr x, uint8_t offs);
+ expr macred(expr x, expr y, uint8_t idx = 0);
+ expr macval(expr x);
void closure(expr& l, expr& r, bool b = true);
void closure(rule& r, bool b = true);
expr *uminop(expr *op, expr *x);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-25 20:25:51
|
Revision: 609
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=609&view=rev
Author: agraef
Date: 2008-08-25 20:25:57 +0000 (Mon, 25 Aug 2008)
Log Message:
-----------
Bump version number. (Needs reconfigure.)
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/configure
pure/trunk/configure.ac
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-25 20:24:03 UTC (rev 608)
+++ pure/trunk/ChangeLog 2008-08-25 20:25:57 UTC (rev 609)
@@ -17,6 +17,8 @@
macro definition can never refer to anything outside the macro
definition. (These are also known as "hygienic" macros.)
+ * configure.ac: Bump version number. (Needs reconfigure.)
+
2008-08-24 Albert Graef <Dr....@t-...>
* 0.5 release.
Modified: pure/trunk/configure
===================================================================
--- pure/trunk/configure 2008-08-25 20:24:03 UTC (rev 608)
+++ pure/trunk/configure 2008-08-25 20:25:57 UTC (rev 609)
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.61 for pure 0.5.
+# Generated by GNU Autoconf 2.61 for pure 0.6.
#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
# 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
@@ -572,8 +572,8 @@
# Identity of this package.
PACKAGE_NAME='pure'
PACKAGE_TARNAME='pure'
-PACKAGE_VERSION='0.5'
-PACKAGE_STRING='pure 0.5'
+PACKAGE_VERSION='0.6'
+PACKAGE_STRING='pure 0.6'
PACKAGE_BUGREPORT=''
# Factoring default headers for most tests.
@@ -1199,7 +1199,7 @@
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures pure 0.5 to adapt to many kinds of systems.
+\`configure' configures pure 0.6 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1264,7 +1264,7 @@
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of pure 0.5:";;
+ short | recursive ) echo "Configuration of pure 0.6:";;
esac
cat <<\_ACEOF
@@ -1357,7 +1357,7 @@
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-pure configure 0.5
+pure configure 0.6
generated by GNU Autoconf 2.61
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1371,7 +1371,7 @@
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by pure $as_me 0.5, which was
+It was created by pure $as_me 0.6, which was
generated by GNU Autoconf 2.61. Invocation command line was
$ $0 $@
@@ -5870,7 +5870,7 @@
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by pure $as_me 0.5, which was
+This file was extended by pure $as_me 0.6, which was
generated by GNU Autoconf 2.61. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -5919,7 +5919,7 @@
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
-pure config.status 0.5
+pure config.status 0.6
configured by $0, generated by GNU Autoconf 2.61,
with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
Modified: pure/trunk/configure.ac
===================================================================
--- pure/trunk/configure.ac 2008-08-25 20:24:03 UTC (rev 608)
+++ pure/trunk/configure.ac 2008-08-25 20:25:57 UTC (rev 609)
@@ -2,7 +2,7 @@
dnl To regenerate the configury after changes:
dnl autoconf -I config && autoheader -I config
-AC_INIT(pure, 0.5)
+AC_INIT(pure, 0.6)
AC_CONFIG_AUX_DIR(config)
dnl AC_CONFIG_MACRO_DIR(config)
AC_CONFIG_HEADERS(config.h)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-25 23:58:48
|
Revision: 612
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=612&view=rev
Author: agraef
Date: 2008-08-25 23:58:55 +0000 (Mon, 25 Aug 2008)
Log Message:
-----------
Add optimization rules for some combinators.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/prelude.pure
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-25 23:56:04 UTC (rev 611)
+++ pure/trunk/ChangeLog 2008-08-25 23:58:55 UTC (rev 612)
@@ -1,3 +1,8 @@
+2008-08-26 Albert Graef <Dr....@t-...>
+
+ * lib/prelude.pure: Add optimization rules for ($) and (.) so that
+ they are expanded at compile time if possible.
+
2008-08-25 Albert Graef <Dr....@t-...>
* parser.yy, lexer.ll, interpreter.cc: Added macro substitution
Modified: pure/trunk/lib/prelude.pure
===================================================================
--- pure/trunk/lib/prelude.pure 2008-08-25 23:56:04 UTC (rev 611)
+++ pure/trunk/lib/prelude.pure 2008-08-25 23:58:55 UTC (rev 612)
@@ -91,6 +91,12 @@
uncurry3 f (x,y,z)
= f x y z;
+/* Some convenient optimization rules which eliminate saturated calls of the
+ function composition combinators. */
+
+def f $ x = f x;
+def (f . g) x = f (g x);
+
/* "Mapsto" operator. This constructor is declared here so that it can be used
in other standard library modules to denote special kind of pairs which map
keys to values. Here we only define equality of such pairs. */
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-26 00:00:13
|
Revision: 613
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=613&view=rev
Author: agraef
Date: 2008-08-26 00:00:13 +0000 (Tue, 26 Aug 2008)
Log Message:
-----------
Macro regression tests.
Modified Paths:
--------------
pure/trunk/ChangeLog
Added Paths:
-----------
pure/trunk/test/test022.log
pure/trunk/test/test022.pure
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-25 23:58:55 UTC (rev 612)
+++ pure/trunk/ChangeLog 2008-08-26 00:00:13 UTC (rev 613)
@@ -1,5 +1,7 @@
2008-08-26 Albert Graef <Dr....@t-...>
+ * test/test022.pure: Add macro test script.
+
* lib/prelude.pure: Add optimization rules for ($) and (.) so that
they are expanded at compile time if possible.
Added: pure/trunk/test/test022.log
===================================================================
--- pure/trunk/test/test022.log (rev 0)
+++ pure/trunk/test/test022.log 2008-08-26 00:00:13 UTC (rev 613)
@@ -0,0 +1,100 @@
+def foo (bar x/*0:11*/) = foo x/*0:11*/+1;
+def foo x/*0:1*/ = x/*0:1*/;
+x;
+x
+x+1;
+x+1
+x+1+1;
+x+1+1
+x+1+1+1;
+x+1+1+1
+def goo (bar x/*0:11*/) = goo x/*1:11*/+y/*0:*/ when y/*0:*/ = x/*0:11*/+1 end with bar x/*0:1*/ = 0 end;
+def goo x/*0:1*/ = x/*0:1*/;
+(baz/*2*/ x/*2:*/+y/*0:*/ when y/*0:*/ = baz/*1*/ x/*1:*/+1 {
+ rule #0: y = baz x+1
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end with bar x/*0:1*/ = 0 {
+ rule #0: bar x = 0
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end)+y/*0:*/ when y/*0:*/ = bar (baz/*0*/ x/*0:*/)+1 {
+ rule #0: y = bar (baz x)+1
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end with bar x/*0:1*/ = 0 {
+ rule #0: bar x = 0
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end with baz x/*0:1*/ = x/*0:1*/+1 {
+ rule #0: baz x = x+1
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end when x/*0:*/ = 99 {
+ rule #0: x = 99
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end;
+201+(bar 100+1)
+(baz/*2*/ y/*2:*/+y/*0:*/ when y/*0:*/ = baz/*1*/ y/*1:*/+1 {
+ rule #0: y = baz y+1
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end with bar x/*0:1*/ = 0 {
+ rule #0: bar x = 0
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end)+y/*0:*/ when y/*0:*/ = bar (baz/*0*/ y/*0:*/)+1 {
+ rule #0: y = bar (baz y)+1
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end with bar x/*0:1*/ = 0 {
+ rule #0: bar x = 0
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end with baz x/*0:1*/ = x/*0:1*/+1 {
+ rule #0: baz x = x+1
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end when y/*0:*/ = 99 {
+ rule #0: y = 99
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end;
+201+(bar 100+1)
+bar/*0*/ (bar/*0*/ x/*0:*/) with bar x/*0:1*/ = x/*0:1*/+1 {
+ rule #0: bar x = x+1
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end when x/*0:*/ = 99 {
+ rule #0: x = 99
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end;
+101
+bar/*0*/ (bar/*0*/ y/*0:*/) with bar x/*0:1*/ = x/*0:1*/+1 {
+ rule #0: bar x = x+1
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end when y/*0:*/ = 99 {
+ rule #0: y = 99
+ state 0: #0
+ <var> state 1
+ state 1: #0
+} end;
+101
Added: pure/trunk/test/test022.pure
===================================================================
--- pure/trunk/test/test022.pure (rev 0)
+++ pure/trunk/test/test022.pure 2008-08-26 00:00:13 UTC (rev 613)
@@ -0,0 +1,30 @@
+
+// Macro substitution tests. (Pure 0.6)
+
+/* This macro just removes a 'bar' from its argument and turns it into '+1'.
+ This is done recursively so that bar (...(n times)...(bar x)...) turns
+ into x+1+...(n times)...+1. */
+
+def foo (bar x) = foo x+1;
+def foo x = x;
+
+foo x;
+foo (bar x);
+foo (bar (bar x));
+foo (bar (bar (bar x)));
+
+/* Test for possible name capture issues. Pure is supposed to have hygienic
+ macros. If everything is all right, these tests should both return
+ 201+(bar 100+1). */
+
+def goo (bar x) = goo x+y when y = x+1 end with bar x = 0 end;
+def goo x = x;
+
+goo (bar (bar (baz x))) with baz x = x+1 end when x = 99 end;
+goo (bar (bar (baz y))) with baz x = x+1 end when y = 99 end;
+
+/* These will return just 101, since the 'bar' is locally bound, so the first
+ goo rule doesn't apply. */
+
+goo (bar (bar x)) with bar x = x+1 end when x = 99 end;
+goo (bar (bar y)) with bar x = x+1 end when y = 99 end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-26 22:37:46
|
Revision: 619
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=619&view=rev
Author: agraef
Date: 2008-08-26 22:37:56 +0000 (Tue, 26 Aug 2008)
Log Message:
-----------
Refactoring of symbol table code.
Modified Paths:
--------------
pure/trunk/lexer.ll
pure/trunk/pure.cc
pure/trunk/symtable.hh
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-26 16:10:07 UTC (rev 618)
+++ pure/trunk/lexer.ll 2008-08-26 22:37:56 UTC (rev 619)
@@ -143,7 +143,7 @@
command_generator(const char *text, int state)
{
static int list_index, len;
- static symbol_map::iterator it, end;
+ static int32_t f, n;
const char *name;
assert(interpreter::g_interp);
interpreter& interp = *interpreter::g_interp;
@@ -154,8 +154,7 @@
/* Must do this here, so that symbols are entered into the globalvars
table. */
interp.compile();
- it = interp.symtab.tab.begin();
- end = interp.symtab.tab.end();
+ f = 1; n = interp.symtab.nsyms();
len = strlen(text);
}
@@ -169,18 +168,17 @@
/* Return the next name which partially matches from the
symbol list. */
- while (it != end) {
- int32_t f = it->second.f;
+ while (f <= n) {
/* Skip non-toplevel symbols. */
if (interp.globenv.find(f) == interp.globenv.end() &&
interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
- it++;
+ f++;
continue;
}
- const string& s = it->first;
- it++;
+ const string& s = interp.symtab.sym(f).s;
+ f++;
if (strncmp(s.c_str(), text, len) == 0)
return strdup(s.c_str());
}
Modified: pure/trunk/pure.cc
===================================================================
--- pure/trunk/pure.cc 2008-08-26 16:10:07 UTC (rev 618)
+++ pure/trunk/pure.cc 2008-08-26 22:37:56 UTC (rev 619)
@@ -67,7 +67,7 @@
command_generator(const char *text, int state)
{
static int list_index, len;
- static symbol_map::iterator it, end;
+ static int32_t f, n;
const char *name;
assert(interpreter::g_interp);
interpreter& interp = *interpreter::g_interp;
@@ -78,8 +78,7 @@
/* Must do this here, so that symbols are entered into the globalvars
table. */
interp.compile();
- it = interp.symtab.tab.begin();
- end = interp.symtab.tab.end();
+ f = 1; n = interp.symtab.nsyms();
len = strlen(text);
}
@@ -93,18 +92,17 @@
/* Return the next name which partially matches from the
symbol list. */
- while (it != end) {
- int32_t f = it->second.f;
+ while (f <= n) {
/* Skip non-toplevel symbols. */
if (interp.globenv.find(f) == interp.globenv.end() &&
interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
- it++;
+ f++;
continue;
}
- const string& s = it->first;
- it++;
+ const string& s = interp.symtab.sym(f).s;
+ f++;
if (strncmp(s.c_str(), text, len) == 0)
return strdup(s.c_str());
}
@@ -117,7 +115,7 @@
symbol_generator(const char *text, int state)
{
static int len;
- static symbol_map::iterator it, end;
+ static int32_t f, n;
assert(interpreter::g_interp);
interpreter& interp = *interpreter::g_interp;
@@ -126,25 +124,23 @@
/* Must do this here, so that symbols are entered into the globalvars
table. */
interp.compile();
- it = interp.symtab.tab.begin();
- end = interp.symtab.tab.end();
+ f = 1; n = interp.symtab.nsyms();
len = strlen(text);
}
/* Return the next name which partially matches from the
symbol list. */
- while (it != end) {
- int32_t f = it->second.f;
+ while (f <= n) {
/* Skip non-toplevel symbols. */
if (interp.globenv.find(f) == interp.globenv.end() &&
interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
- it++;
+ f++;
continue;
}
- const string& s = it->first;
- it++;
+ const string& s = interp.symtab.sym(f).s;
+ f++;
if (strncmp(s.c_str(), text, len) == 0)
return strdup(s.c_str());
}
Modified: pure/trunk/symtable.hh
===================================================================
--- pure/trunk/symtable.hh 2008-08-26 16:10:07 UTC (rev 618)
+++ pure/trunk/symtable.hh 2008-08-26 22:37:56 UTC (rev 619)
@@ -32,13 +32,16 @@
class symtable {
int32_t fno;
-public:
map<string, symbol> tab;
vector<symbol*> rtab;
+public:
symtable();
// add default declarations for the builtin constants and operators (to be
// invoked *after* possibly reading the prelude)
void init_builtins();
+ // get current number of symbols in table (symbols are always numbered
+ // consecutively from 1 to nsyms())
+ int32_t nsyms() { return fno; }
// look up an existing symbol (return 0 if not in table)
symbol* lookup(const string& s);
// get a symbol by its name (create if necessary)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-27 00:32:20
|
Revision: 620
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=620&view=rev
Author: agraef
Date: 2008-08-27 00:32:31 +0000 (Wed, 27 Aug 2008)
Log Message:
-----------
Add support for private symbols to symbol table.
Modified Paths:
--------------
pure/trunk/symtable.cc
pure/trunk/symtable.hh
Modified: pure/trunk/symtable.cc
===================================================================
--- pure/trunk/symtable.cc 2008-08-26 22:37:56 UTC (rev 619)
+++ pure/trunk/symtable.cc 2008-08-27 00:32:31 UTC (rev 620)
@@ -42,42 +42,88 @@
segfault_sym();
}
-symbol* symtable::lookup(const string& s)
+symbol* symtable::lookup(const string& s, int32_t modno)
{
- map<string, symbol>::iterator it = tab.find(s);
- if (it == tab.end())
+ sym_map& m = tab[modno];
+ sym_map::iterator it = m.find(s);
+ if (it == m.end() && modno >= 0) {
+ m = tab[-1];
+ it = m.find(s);
+ }
+ if (it == m.end())
return 0;
else
return &it->second;
}
-symbol& symtable::sym(const string& s)
+symbol& symtable::sym(const string& s, int32_t modno)
{
- symbol& _sym = tab[s];
+ symbol* _symp = lookup(s, modno);
+ if (_symp) modno = _symp->modno;
+ symbol& _sym = tab[modno][s];
if (_sym.f == 0) {
if ((uint32_t)++fno > rtab.capacity())
rtab.reserve(rtab.capacity()+1024);
- _sym = symbol(s, fno);
+ _sym = symbol(s, fno, modno);
//cout << "new symbol " << _sym.f << ": " << _sym.s << endl;
rtab[fno] = &_sym;
}
return _sym;
}
-symbol& symtable::sym(const string& s, prec_t prec, fix_t fix)
+symbol& symtable::sym(const string& s, prec_t prec, fix_t fix, int32_t modno)
{
assert(prec <= 10);
- symbol& _sym = tab[s];
+ symbol* _symp = lookup(s, modno);
+ if (_symp) modno = _symp->modno;
+ symbol& _sym = tab[modno][s];
if (_sym.f == 0) {
if ((uint32_t)++fno > rtab.capacity())
rtab.reserve(rtab.capacity()+1024);
- _sym = symbol(s, fno, prec, fix);
+ _sym = symbol(s, fno, prec, fix, modno);
//cout << "new symbol " << _sym.f << ": " << _sym.s << endl;
rtab[fno] = &_sym;
}
return _sym;
}
+symbol* symtable::xlookup(const string& s, int32_t modno)
+{
+ sym_map& m = tab[modno];
+ sym_map::iterator it = m.find(s);
+ if (it == m.end())
+ return 0;
+ else
+ return &it->second;
+}
+
+symbol& symtable::xsym(const string& s, int32_t modno)
+{
+ symbol& _sym = tab[modno][s];
+ if (_sym.f == 0) {
+ if ((uint32_t)++fno > rtab.capacity())
+ rtab.reserve(rtab.capacity()+1024);
+ _sym = symbol(s, fno, modno);
+ //cout << "new symbol " << _sym.f << ": " << _sym.s << endl;
+ rtab[fno] = &_sym;
+ }
+ return _sym;
+}
+
+symbol& symtable::xsym(const string& s, prec_t prec, fix_t fix, int32_t modno)
+{
+ assert(prec <= 10);
+ symbol& _sym = tab[modno][s];
+ if (_sym.f == 0) {
+ if ((uint32_t)++fno > rtab.capacity())
+ rtab.reserve(rtab.capacity()+1024);
+ _sym = symbol(s, fno, prec, fix, modno);
+ //cout << "new symbol " << _sym.f << ": " << _sym.s << endl;
+ rtab[fno] = &_sym;
+ }
+ return _sym;
+}
+
symbol& symtable::sym(int32_t f)
{
assert(f > 0 && (uint32_t)f < rtab.size());
Modified: pure/trunk/symtable.hh
===================================================================
--- pure/trunk/symtable.hh 2008-08-26 22:37:56 UTC (rev 619)
+++ pure/trunk/symtable.hh 2008-08-27 00:32:31 UTC (rev 620)
@@ -20,19 +20,24 @@
string s; // print name
prec_t prec; // precedence level
fix_t fix; // fixity
+ int32_t modno; // module key for private symbol, -1 for global symbol
symbol() : // constructor for dummy entries
- f(0), s(""), prec(10), fix(infix) { }
- symbol(const string& _s, int _f) :
- f(_f), s(_s), prec(10), fix(infix) { x = expr(f); }
- symbol(const string& _s, int _f, prec_t _prec, fix_t _fix) :
- f(_f), s(_s), prec(_prec), fix(_fix) { x = expr(f); }
+ f(0), s(""), prec(10), fix(infix), modno(-1) { }
+ symbol(const string& _s, int _f, int32_t _modno = -1) :
+ f(_f), s(_s), prec(10), fix(infix), modno(_modno) { x = expr(f); }
+ symbol(const string& _s, int _f, prec_t _prec, fix_t _fix,
+ int32_t _modno = -1) :
+ f(_f), s(_s), prec(_prec), fix(_fix), modno(_modno) { x = expr(f); }
};
/* Symbol table. */
+typedef map<string, symbol> sym_map;
+typedef map<int32_t, sym_map> sym_tab;
+
class symtable {
int32_t fno;
- map<string, symbol> tab;
+ sym_tab tab;
vector<symbol*> rtab;
public:
symtable();
@@ -42,11 +47,21 @@
// get current number of symbols in table (symbols are always numbered
// consecutively from 1 to nsyms())
int32_t nsyms() { return fno; }
- // look up an existing symbol (return 0 if not in table)
- symbol* lookup(const string& s);
+ /* The following routines first search for a symbol in the given module,
+ failing that they will also search for a global symbol. (If modno==-1
+ then only global symbols will be searched.) */
+ // look up an existing symbol in given module (return 0 if not in table)
+ symbol* lookup(const string& s, int32_t modno = -1);
// get a symbol by its name (create if necessary)
- symbol& sym(const string& s);
- symbol& sym(const string& s, prec_t prec, fix_t fix);
+ symbol& sym(const string& s, int32_t modno = -1);
+ symbol& sym(const string& s, prec_t prec, fix_t fix, int32_t modno = -1);
+ /* These work like the above, but will only return exact matches in the
+ given module. */
+ symbol* xlookup(const string& s, int32_t modno = -1);
+ symbol& xsym(const string& s, int32_t modno = -1);
+ symbol& xsym(const string& s, prec_t prec, fix_t fix, int32_t modno = -1);
+ // get a symbol by its number
+ symbol& sym(int32_t f);
// retrieve various builtin symbols (create when necessary)
symbol& nil_sym();
symbol& cons_sym();
@@ -80,8 +95,6 @@
symbol& failed_cond_sym() { return sym("failed_cond"); }
symbol& signal_sym() { return sym("signal"); }
symbol& segfault_sym() { return sym("stack_fault"); }
- // get a symbol by its number
- symbol& sym(int32_t f);
};
#endif // ! SYMTABLE_HH
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-27 07:37:17
|
Revision: 622
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=622&view=rev
Author: agraef
Date: 2008-08-27 07:37:26 +0000 (Wed, 27 Aug 2008)
Log Message:
-----------
Add private symbol infrastructure.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
pure/trunk/lexer.ll
pure/trunk/parser.yy
pure/trunk/pure.cc
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-27 07:12:55 UTC (rev 621)
+++ pure/trunk/interpreter.cc 2008-08-27 07:37:26 UTC (rev 622)
@@ -59,7 +59,7 @@
: verbose(0), interactive(false), ttymode(false), override(false),
stats(false), temp(0),
ps("> "), libdir(""), histfile("/.pure_history"), modname("pure"),
- nerrs(0), source_s(0), result(0), mem(0), exps(0), tmps(0),
+ nerrs(0), modno(-1), source_s(0), result(0), mem(0), exps(0), tmps(0),
module(0), JIT(0), FPM(0), fptr(0)
{
if (!g_interp) {
@@ -1166,11 +1166,11 @@
}
}
-void interpreter::declare(prec_t prec, fix_t fix, list<string> *ids)
+void interpreter::declare(bool priv, prec_t prec, fix_t fix, list<string> *ids)
{
for (list<string>::const_iterator it = ids->begin();
it != ids->end(); ++it) {
- symbol* sym = symtab.lookup(*it);
+ symbol* sym = symtab.xlookup(*it, priv?modno:-1);
if (sym) {
// crosscheck declarations
if (sym->prec != prec || sym->fix != fix) {
@@ -1179,7 +1179,7 @@
throw err("conflicting fixity declaration for symbol '"+id+"'");
}
} else {
- int32_t tag = symtab.sym(*it, prec, fix).f;
+ int32_t tag = symtab.xsym(*it, prec, fix, priv?modno:-1).f;
/* KLUDGE: Already create a globalvars entry here, so that the symbol is
properly recognized by the completion routines. */
pure_expr *cv = pure_const(tag);
@@ -2352,7 +2352,7 @@
expr *interpreter::mksym_expr(string *s, int8_t tag)
{
expr *x;
- const symbol &sym = symtab.sym(*s);
+ const symbol &sym = symtab.sym(*s, modno);
if (tag == 0)
if (*s == "_")
// Return a new instance here, since the anonymous variable may have
@@ -2373,7 +2373,7 @@
expr *interpreter::mkas_expr(string *s, expr *x)
{
- const symbol &sym = symtab.sym(*s);
+ const symbol &sym = symtab.sym(*s, modno);
if (sym.f <= 0 || sym.prec < 10 || sym.fix == nullary)
throw err("error in pattern (bad variable symbol '"+sym.s+"')");
if (x->tag() > 0) {
@@ -3405,10 +3405,13 @@
// First check whether there already is a Pure function or global variable
// for this symbol. This is an error (unless it's already declared as an
// external, too).
- symbol& sym = symtab.sym(asname);
- if (globenv.find(sym.f) != globenv.end() &&
- externals.find(sym.f) == externals.end())
+ symbol& sym = symtab.sym(asname, modno);
+ if (sym.modno >= 0)
throw err("symbol '"+name+
+ "' is private in this context");
+ else if (globenv.find(sym.f) != globenv.end() &&
+ externals.find(sym.f) == externals.end())
+ throw err("symbol '"+name+
"' is already defined as a Pure function or variable");
// Create the function type and check for an existing declaration of the
// external.
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-27 07:12:55 UTC (rev 621)
+++ pure/trunk/interpreter.hh 2008-08-27 07:37:26 UTC (rev 622)
@@ -323,6 +323,7 @@
// Interpreter state. For internal use only.
int nerrs; // current error count
string errmsg; // last reported error (runstr)
+ int32_t modno; // current module key
string source; // the source being parsed
const char *source_s; // source pointer if input comes from a string
set<string> sources; // the list of all scripts which have been loaded
@@ -434,7 +435,7 @@
void build_env(env& vars, expr x);
void mark_dirty(int32_t f);
void compile(expr x);
- void declare(prec_t prec, fix_t fix, list<string> *ids);
+ void declare(bool priv, prec_t prec, fix_t fix, list<string> *ids);
void define(rule *r);
void define_const(rule *r);
void exec(expr *x);
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-27 07:12:55 UTC (rev 621)
+++ pure/trunk/lexer.ll 2008-08-27 07:37:26 UTC (rev 622)
@@ -170,7 +170,8 @@
symbol list. */
while (f <= n) {
/* Skip non-toplevel symbols. */
- if (interp.globenv.find(f) == interp.globenv.end() &&
+ if (interp.symtab.sym(f).modno >= 0 ||
+ interp.globenv.find(f) == interp.globenv.end() &&
interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
@@ -436,7 +437,8 @@
int32_t f = it->first;
const env_info& e = it->second;
const symbol& sym = interp.symtab.sym(f);
- if (!((e.t == env_info::fun)?fflag:
+ if (sym.modno >= 0 || // skip private symbols
+ !((e.t == env_info::fun)?fflag:
(e.t == env_info::cvar)?cflag:
(e.t == env_info::fvar)?vflag:0))
continue;
@@ -504,6 +506,7 @@
if (syms.find(f) == syms.end()) {
const env_info& e = it->second;
const symbol& sym = interp.symtab.sym(f);
+ if (sym.modno >= 0) continue; // skip private symbols
bool matches = e.temp >= tflag;
if (!matches && !sflag && args.l.empty()) {
// if not in summary mode, also list temporary rules for a
@@ -912,7 +915,7 @@
yylval->sval = new string(yytext);
return token::ID;
}
- symbol* sym = interp.symtab.lookup(yytext);
+ symbol* sym = interp.symtab.lookup(yytext, interp.modno);
if (sym && sym->prec >= 0 && sym->prec < 10) {
yylval->xval = new expr(sym->x);
return optoken[sym->prec][sym->fix];
@@ -930,12 +933,12 @@
yylval->sval = new string(yytext);
return token::ID;
}
- symbol* sym = interp.symtab.lookup(yytext);
+ symbol* sym = interp.symtab.lookup(yytext, interp.modno);
while (!sym && yyleng > 1) {
if (yyleng == 2 && yytext[0] == '-' && yytext[1] == '>')
return token::MAPSTO;
yyless(yyleng-1);
- sym = interp.symtab.lookup(yytext);
+ sym = interp.symtab.lookup(yytext, interp.modno);
}
if (sym) {
if (sym->prec < 10) {
Modified: pure/trunk/parser.yy
===================================================================
--- pure/trunk/parser.yy 2008-08-27 07:12:55 UTC (rev 621)
+++ pure/trunk/parser.yy 2008-08-27 07:37:26 UTC (rev 622)
@@ -54,9 +54,10 @@
%{
struct sym_info {
+ bool priv;
prec_t prec;
fix_t fix;
- sym_info(prec_t p, fix_t f) : prec(p), fix(f) { }
+ sym_info(bool v, prec_t p, fix_t f) : priv(v), prec(p), fix(f) { }
};
struct rule_info {
exprl l;
@@ -295,15 +296,16 @@
interp.declare_op = true; }
ids
{ interp.declare_op = false;
- action(interp.declare($1->prec, $1->fix, $3), delete $3); delete $1; }
+ action(interp.declare($1->priv, $1->prec, $1->fix, $3), delete $3);
+ delete $1; }
| USING names
{ action(interp.run(*$2), {}); delete $2; }
| EXTERN prototypes
;
fixity
-: FIX INT { $$ = new sym_info($2,$1); }
-| NULLARY { $$ = new sym_info(10,nullary); }
+: FIX INT { $$ = new sym_info(false,$2,$1); }
+| NULLARY { $$ = new sym_info(false,10,nullary); }
;
ids
Modified: pure/trunk/pure.cc
===================================================================
--- pure/trunk/pure.cc 2008-08-27 07:12:55 UTC (rev 621)
+++ pure/trunk/pure.cc 2008-08-27 07:37:26 UTC (rev 622)
@@ -94,7 +94,8 @@
symbol list. */
while (f <= n) {
/* Skip non-toplevel symbols. */
- if (interp.globenv.find(f) == interp.globenv.end() &&
+ if (interp.symtab.sym(f).modno >= 0 ||
+ interp.globenv.find(f) == interp.globenv.end() &&
interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
@@ -132,7 +133,8 @@
symbol list. */
while (f <= n) {
/* Skip non-toplevel symbols. */
- if (interp.globenv.find(f) == interp.globenv.end() &&
+ if (interp.symtab.sym(f).modno >= 0 ||
+ interp.globenv.find(f) == interp.globenv.end() &&
interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-27 09:14:41
|
Revision: 629
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=629&view=rev
Author: agraef
Date: 2008-08-27 09:14:51 +0000 (Wed, 27 Aug 2008)
Log Message:
-----------
Generate module keys.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-27 08:42:15 UTC (rev 628)
+++ pure/trunk/interpreter.cc 2008-08-27 09:14:51 UTC (rev 629)
@@ -59,8 +59,8 @@
: verbose(0), interactive(false), ttymode(false), override(false),
stats(false), temp(0),
ps("> "), libdir(""), histfile("/.pure_history"), modname("pure"),
- nerrs(0), modno(-1), source_s(0), result(0), mem(0), exps(0), tmps(0),
- module(0), JIT(0), FPM(0), fptr(0)
+ nerrs(0), modno(-1), modctr(0), source_s(0), result(0), mem(0), exps(0),
+ tmps(0), module(0), JIT(0), FPM(0), fptr(0)
{
if (!g_interp) {
g_interp = this;
@@ -618,6 +618,7 @@
uint8_t l_temp = temp;
const char *l_source_s = source_s;
string l_srcdir = srcdir;
+ int32_t l_modno = modno;
// save global data
uint8_t s_verbose = g_verbose;
bool s_interactive = g_interactive;
@@ -630,6 +631,7 @@
source = s; declare_op = false;
source_s = 0;
srcdir = dirname(fname);
+ modno = (temp == 0 && !s.empty())?modctr++:-1;
errmsg.clear();
if (check && !interactive) temp = 0;
bool ok = lex_begin(fname);
@@ -656,6 +658,7 @@
temp = l_temp;
source_s = l_source_s;
srcdir = l_srcdir;
+ modno = l_modno;
// return last computed result, if any
return result;
}
@@ -685,6 +688,7 @@
int l_nerrs = nerrs;
const char *l_source_s = source_s;
string l_srcdir = srcdir;
+ int32_t l_modno = modno;
// save global data
uint8_t s_verbose = g_verbose;
bool s_interactive = g_interactive;
@@ -697,6 +701,7 @@
source = ""; declare_op = false;
source_s = s.c_str();
srcdir = "";
+ modno = -1;
errmsg.clear();
bool ok = lex_begin();
if (ok) {
@@ -718,6 +723,7 @@
nerrs = l_nerrs;
source_s = l_source_s;
srcdir = l_srcdir;
+ modno = l_modno;
// return last computed result, if any
return result;
}
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-27 08:42:15 UTC (rev 628)
+++ pure/trunk/interpreter.hh 2008-08-27 09:14:51 UTC (rev 629)
@@ -324,6 +324,7 @@
int nerrs; // current error count
string errmsg; // last reported error (runstr)
int32_t modno; // current module key
+ int32_t modctr; // next available module key
string source; // the source being parsed
const char *source_s; // source pointer if input comes from a string
set<string> sources; // the list of all scripts which have been loaded
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-27 09:16:03
|
Revision: 630
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=630&view=rev
Author: agraef
Date: 2008-08-27 09:16:10 +0000 (Wed, 27 Aug 2008)
Log Message:
-----------
Add 'private' keyword.
Modified Paths:
--------------
pure/trunk/etc/pure-mode.el.in
pure/trunk/etc/pure.lang
pure/trunk/etc/pure.vim
pure/trunk/etc/pure.xml
pure/trunk/lexer.ll
pure/trunk/parser.yy
pure/trunk/pure.1.in
pure/trunk/pure.cc
Modified: pure/trunk/etc/pure-mode.el.in
===================================================================
--- pure/trunk/etc/pure-mode.el.in 2008-08-27 09:14:51 UTC (rev 629)
+++ pure/trunk/etc/pure-mode.el.in 2008-08-27 09:16:10 UTC (rev 630)
@@ -165,7 +165,7 @@
(list
(concat "\\<\\("
"const\\|def\\|extern\\|infix[lr]?\\|"
- "let\\|nullary\\|p\\(refix\\|ostfix\\)\\|"
+ "let\\|nullary\\|p\\(r\\(efix\\|ivate\\)\\|ostfix\\)\\|"
"using"
"\\)\\>")
0 'font-lock-keyword-face))
@@ -179,7 +179,7 @@
(list
(concat "\\<\\("
"case\\|const\\|def\\|e\\(lse\\|nd\\|xtern\\)\\|i\\(f\\|nfix[lr]?\\)\\|"
- "let\\|nullary\\|o\\(f\\|therwise\\)\\|p\\(refix\\|ostfix\\)\\|"
+ "let\\|nullary\\|o\\(f\\|therwise\\)\\|p\\(r\\(efix\\|ivate\\)\\|ostfix\\)\\|"
"then\\|using\\|w\\(hen\\|ith\\)"
"\\)\\>")
0 'font-lock-keyword-face))
Modified: pure/trunk/etc/pure.lang
===================================================================
--- pure/trunk/etc/pure.lang 2008-08-27 09:14:51 UTC (rev 629)
+++ pure/trunk/etc/pure.lang 2008-08-27 09:16:10 UTC (rev 630)
@@ -4,8 +4,8 @@
$DESCRIPTION=Pure
# Pure keywords.
-$KW_LIST(kwa)=infix infixl infixr prefix postfix nullary case const def else
-end extern if let of otherwise then using when with
+$KW_LIST(kwa)=infix infixl infixr prefix postfix nullary private
+case const def else end extern if let of otherwise then using when with
# These aren't really keywords but we want them to stick out anyway.
$KW_LIST(kwb)=catch throw
Modified: pure/trunk/etc/pure.vim
===================================================================
--- pure/trunk/etc/pure.vim 2008-08-27 09:14:51 UTC (rev 629)
+++ pure/trunk/etc/pure.vim 2008-08-27 09:16:10 UTC (rev 630)
@@ -32,7 +32,7 @@
syn region pureString start=+"+ skip=+\\"+ end=+"+
" keywords
-syn keyword pureKeyword infix infixl infixr prefix postfix nullary
+syn keyword pureKeyword infix infixl infixr prefix postfix nullary private
syn keyword pureKeyword case const def else end extern if let of otherwise then
syn keyword pureKeyword using when with
syn keyword pureSpecial catch throw
Modified: pure/trunk/etc/pure.xml
===================================================================
--- pure/trunk/etc/pure.xml 2008-08-27 09:14:51 UTC (rev 629)
+++ pure/trunk/etc/pure.xml 2008-08-27 09:16:10 UTC (rev 630)
@@ -23,6 +23,7 @@
<item> nullary </item>
<item> of </item>
<item> otherwise </item>
+ <item> private </item>
<item> prefix </item>
<item> postfix </item>
<item> then </item>
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-27 09:14:51 UTC (rev 629)
+++ pure/trunk/lexer.ll 2008-08-27 09:16:10 UTC (rev 630)
@@ -134,7 +134,7 @@
static const char *commands[] = {
"cd", "clear", "const", "def", "extern", "help", "infix", "infixl",
"infixr", "let", "list", "ls", "nullary", "override", "postfix", "prefix",
- "pwd", "quit", "run", "save", "stats", "underride", "using", 0
+ "private", "pwd", "quit", "run", "save", "stats", "underride", "using", 0
};
typedef map<string, symbol> symbol_map;
@@ -897,6 +897,7 @@
prefix yylval->fix = prefix; return token::FIX;
postfix yylval->fix = postfix; return token::FIX;
nullary return token::NULLARY;
+private return token::PRIVATE;
const return token::CONST;
def return token::DEF;
let return token::LET;
Modified: pure/trunk/parser.yy
===================================================================
--- pure/trunk/parser.yy 2008-08-27 09:14:51 UTC (rev 629)
+++ pure/trunk/parser.yy 2008-08-27 09:16:10 UTC (rev 630)
@@ -96,6 +96,7 @@
#include "interpreter.hh"
%}
+%token PRIVATE "private"
%token NULLARY "nullary"
%token <fix> FIX "fixity"
Modified: pure/trunk/pure.1.in
===================================================================
--- pure/trunk/pure.1.in 2008-08-27 09:14:51 UTC (rev 629)
+++ pure/trunk/pure.1.in 2008-08-27 09:16:10 UTC (rev 630)
@@ -217,7 +217,7 @@
.PP
There are a few reserved keywords which cannot be used as identifiers. These
are: case const def else end extern if infix infixl infixr let nullary of
-otherwise postfix prefix then using when with.
+otherwise postfix prefix private then using when with.
.PP
Pure is a terse language. You won't see many declarations, and often your
programs will read more like a collection of algebraic specifications (which
Modified: pure/trunk/pure.cc
===================================================================
--- pure/trunk/pure.cc 2008-08-27 09:14:51 UTC (rev 629)
+++ pure/trunk/pure.cc 2008-08-27 09:16:10 UTC (rev 630)
@@ -56,7 +56,7 @@
static const char *commands[] = {
"cd", "clear", "const", "def", "extern", "help", "infix", "infixl",
"infixr", "let", "list", "ls", "nullary", "override", "postfix", "prefix",
- "pwd", "quit", "run", "save", "stats", "underride", "using", 0
+ "private", "pwd", "quit", "run", "save", "stats", "underride", "using", 0
};
/* Generator functions for command completion. */
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-27 10:20:34
|
Revision: 632
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=632&view=rev
Author: agraef
Date: 2008-08-27 10:20:43 +0000 (Wed, 27 Aug 2008)
Log Message:
-----------
Add 'private' declarations.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/parser.yy
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-27 10:10:15 UTC (rev 631)
+++ pure/trunk/ChangeLog 2008-08-27 10:20:43 UTC (rev 632)
@@ -1,3 +1,8 @@
+2008-08-27 Albert Graef <Dr....@t-...>
+
+ * parser.yy, etc.: Symbols can now be declared 'private'. These
+ aren't visible anywhere except in the module that declares them.
+
2008-08-26 Albert Graef <Dr....@t-...>
* test/test022.pure: Add macro test script.
Modified: pure/trunk/parser.yy
===================================================================
--- pure/trunk/parser.yy 2008-08-27 10:10:15 UTC (rev 631)
+++ pure/trunk/parser.yy 2008-08-27 10:20:43 UTC (rev 632)
@@ -291,7 +291,8 @@
/* Lexical tie-in: We need to tell the lexer that we're defining new operator
symbols (interp.declare_op = true) instead of searching for existing ones
in the symbol table. */
-{ if ($1->fix != nullary && $1->prec > 9) {
+{ if ($1->priv && $1->prec > 10 ||
+ !$1->priv && $1->fix != nullary && $1->prec > 9) {
error(yylloc, "invalid fixity declaration"); YYERROR;
} else
interp.declare_op = true; }
@@ -307,6 +308,9 @@
fixity
: FIX INT { $$ = new sym_info(false,$2,$1); }
| NULLARY { $$ = new sym_info(false,10,nullary); }
+| PRIVATE FIX INT { $$ = new sym_info(true,$3,$2); }
+| PRIVATE NULLARY { $$ = new sym_info(true,10,nullary); }
+| PRIVATE { $$ = new sym_info(true,10,infix); }
;
ids
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-27 18:35:51
|
Revision: 635
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=635&view=rev
Author: agraef
Date: 2008-08-27 18:35:59 +0000 (Wed, 27 Aug 2008)
Log Message:
-----------
Bugfixes.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/lexer.ll
pure/trunk/parser.yy
pure/trunk/pure.cc
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-27 18:27:08 UTC (rev 634)
+++ pure/trunk/interpreter.cc 2008-08-27 18:35:59 UTC (rev 635)
@@ -631,7 +631,7 @@
source = s; declare_op = false;
source_s = 0;
srcdir = dirname(fname);
- modno = (temp == 0 && !s.empty())?modctr++:-1;
+ modno = modctr++;
errmsg.clear();
if (check && !interactive) temp = 0;
bool ok = lex_begin(fname);
@@ -701,7 +701,7 @@
source = ""; declare_op = false;
source_s = s.c_str();
srcdir = "";
- modno = -1;
+ modno = modctr++;
errmsg.clear();
bool ok = lex_begin();
if (ok) {
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-27 18:27:08 UTC (rev 634)
+++ pure/trunk/lexer.ll 2008-08-27 18:35:59 UTC (rev 635)
@@ -170,7 +170,8 @@
symbol list. */
while (f <= n) {
/* Skip non-toplevel symbols. */
- if (interp.symtab.sym(f).modno >= 0 ||
+ const symbol& sym = interp.symtab.sym(f);
+ if (sym.modno >= 0 && sym.modno != interp.modno ||
interp.globenv.find(f) == interp.globenv.end() &&
interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
@@ -178,7 +179,7 @@
f++;
continue;
}
- const string& s = interp.symtab.sym(f).s;
+ const string& s = sym.s;
f++;
if (strncmp(s.c_str(), text, len) == 0)
return strdup(s.c_str());
@@ -437,7 +438,7 @@
int32_t f = it->first;
const env_info& e = it->second;
const symbol& sym = interp.symtab.sym(f);
- if (sym.modno >= 0 || // skip private symbols
+ if (sym.modno >= 0 && sym.modno != interp.modno ||
!((e.t == env_info::fun)?fflag:
(e.t == env_info::cvar)?cflag:
(e.t == env_info::fvar)?vflag:0))
@@ -479,7 +480,7 @@
int32_t f = it->first;
if (syms.find(f) == syms.end()) {
const symbol& sym = interp.symtab.sym(f);
- if (sym.modno >= 0) continue; // skip private symbols
+ if (sym.modno >= 0 && sym.modno != interp.modno) continue;
bool matches = true;
if (!args.l.empty()) {
matches = false;
@@ -507,7 +508,7 @@
if (syms.find(f) == syms.end()) {
const env_info& e = it->second;
const symbol& sym = interp.symtab.sym(f);
- if (sym.modno >= 0) continue; // skip private symbols
+ if (sym.modno >= 0 && sym.modno != interp.modno) continue;
bool matches = e.temp >= tflag;
if (!matches && !sflag && args.l.empty()) {
// if not in summary mode, also list temporary rules for a
@@ -737,7 +738,7 @@
else if (args.c > 0) {
list<string>::iterator s;
for (s = args.l.begin(); s != args.l.end(); s++) {
- const symbol *sym = interp.symtab.lookup(*s);
+ const symbol *sym = interp.symtab.lookup(*s, interp.modno);
if (sym && sym->f > 0)
interp.clear(sym->f);
else
Modified: pure/trunk/parser.yy
===================================================================
--- pure/trunk/parser.yy 2008-08-27 18:27:08 UTC (rev 634)
+++ pure/trunk/parser.yy 2008-08-27 18:35:59 UTC (rev 635)
@@ -294,7 +294,7 @@
{ if ($1->priv && $1->prec > 10 ||
!$1->priv && $1->fix != nullary && $1->prec > 9) {
error(yylloc, "invalid fixity declaration"); YYERROR;
- } else
+ } else if ($1->fix == nullary || $1->prec < 10)
interp.declare_op = true; }
ids
{ interp.declare_op = false;
Modified: pure/trunk/pure.cc
===================================================================
--- pure/trunk/pure.cc 2008-08-27 18:27:08 UTC (rev 634)
+++ pure/trunk/pure.cc 2008-08-27 18:35:59 UTC (rev 635)
@@ -94,7 +94,8 @@
symbol list. */
while (f <= n) {
/* Skip non-toplevel symbols. */
- if (interp.symtab.sym(f).modno >= 0 ||
+ const symbol& sym = interp.symtab.sym(f);
+ if (sym.modno >= 0 && sym.modno != interp.modno ||
interp.globenv.find(f) == interp.globenv.end() &&
interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
@@ -102,7 +103,7 @@
f++;
continue;
}
- const string& s = interp.symtab.sym(f).s;
+ const string& s = sym.s;
f++;
if (strncmp(s.c_str(), text, len) == 0)
return strdup(s.c_str());
@@ -133,7 +134,8 @@
symbol list. */
while (f <= n) {
/* Skip non-toplevel symbols. */
- if (interp.symtab.sym(f).modno >= 0 ||
+ const symbol& sym = interp.symtab.sym(f);
+ if (sym.modno >= 0 && sym.modno != interp.modno ||
interp.globenv.find(f) == interp.globenv.end() &&
interp.macenv.find(f) == interp.macenv.end() &&
interp.globalvars.find(f) == interp.globalvars.end() &&
@@ -141,7 +143,7 @@
f++;
continue;
}
- const string& s = interp.symtab.sym(f).s;
+ const string& s = sym.s;
f++;
if (strncmp(s.c_str(), text, len) == 0)
return strdup(s.c_str());
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-27 19:02:28
|
Revision: 636
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=636&view=rev
Author: agraef
Date: 2008-08-27 19:02:39 +0000 (Wed, 27 Aug 2008)
Log Message:
-----------
Added limited support for unicode symbols.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lexer.ll
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-27 18:35:59 UTC (rev 635)
+++ pure/trunk/ChangeLog 2008-08-27 19:02:39 UTC (rev 636)
@@ -1,5 +1,8 @@
2008-08-27 Albert Graef <Dr....@t-...>
+ * lexer.ll: Added limited support for unicode symbols. These can
+ now be declared as operator or nullary symbols.
+
* parser.yy, etc.: Symbols can now be declared 'private'. These
aren't visible anywhere except in the module that declares them.
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-27 18:35:59 UTC (rev 635)
+++ pure/trunk/lexer.ll 2008-08-27 19:02:39 UTC (rev 636)
@@ -929,7 +929,7 @@
}
[@=|;()\[\]\\] return yy::parser::token_type(yytext[0]);
"->" return token::MAPSTO;
-[[:punct:]]+ {
+([[:punct:]]|[\200-\377])+ {
if (yytext[0] == '/' && yytext[1] == '*') REJECT; // comment starter
while (yyleng > 1 && yytext[yyleng-1] == ';') yyless(yyleng-1);
if (interp.declare_op) {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-27 20:35:38
|
Revision: 639
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=639&view=rev
Author: agraef
Date: 2008-08-27 20:35:47 +0000 (Wed, 27 Aug 2008)
Log Message:
-----------
Keep the namespace clean.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/math.pure
pure/trunk/lib/primitives.pure
pure/trunk/lib/strings.pure
pure/trunk/lib/system.pure
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-27 19:33:15 UTC (rev 638)
+++ pure/trunk/ChangeLog 2008-08-27 20:35:47 UTC (rev 639)
@@ -1,5 +1,7 @@
2008-08-27 Albert Graef <Dr....@t-...>
+ * lib/: Clean up the public namespace.
+
* lexer.ll: Added limited support for unicode symbols. These can
now be declared as operator or nullary symbols.
Modified: pure/trunk/lib/math.pure
===================================================================
--- pure/trunk/lib/math.pure 2008-08-27 19:33:15 UTC (rev 638)
+++ pure/trunk/lib/math.pure 2008-08-27 20:35:47 UTC (rev 639)
@@ -32,6 +32,7 @@
/* Exponential function and logarithms. */
+private c_log;
extern double exp(double), double log(double) = c_log;
ln x::double = c_log x;
@@ -71,12 +72,9 @@
/* Hyperbolic functions. */
extern double sinh(double), double cosh(double), double tanh(double);
-extern double __asinh(double), double __acosh(double), double __atanh(double);
+extern double __asinh(double) = asinh, double __acosh(double) = acosh,
+ double __atanh(double) = atanh;
-asinh x::double = __asinh x;
-acosh x::double = __acosh x;
-atanh x::double = __atanh x;
-
sinh x::int | sinh x::bigint = sinh (double x);
cosh x::int | cosh x::bigint = cosh (double x);
tanh x::int | tanh x::bigint = tanh (double x);
@@ -376,8 +374,6 @@
/* Conversions. */
-extern expr* pure_rational(double);
-
rational x@(_%_) = x;
rational x::int |
rational x::bigint = x%1;
@@ -385,6 +381,8 @@
/* The conversion from double doesn't do any rounding, so it is guaranteed
that converting the resulting rational back to double reconstructs the
original value. */
+private pure_rational;
+extern expr* pure_rational(double);
rational x::double = n%d when n,d = pure_rational x end;
rational (x+:y) = rational x +: rational y;
Modified: pure/trunk/lib/primitives.pure
===================================================================
--- pure/trunk/lib/primitives.pure 2008-08-27 19:33:15 UTC (rev 638)
+++ pure/trunk/lib/primitives.pure 2008-08-27 20:35:47 UTC (rev 639)
@@ -77,6 +77,7 @@
/* Conversions between the different numeric and pointer types. */
+private pure_intval pure_dblval pure_bigintval pure_pointerval;
extern expr* pure_intval(expr*), expr* pure_dblval(expr*),
expr* pure_bigintval(expr*), expr* pure_pointerval(expr*);
@@ -221,6 +222,8 @@
/* Bigint arithmetic. */
+private bigint_neg bigint_not bigint_add bigint_sub bigint_mul bigint_div
+ bigint_mod bigint_shl bigint_shr bigint_and bigint_or bigint_cmp;
extern expr* bigint_neg(void*);
extern expr* bigint_not(void*);
extern expr* bigint_add(void*, void*);
@@ -322,6 +325,7 @@
/* The gcd and lcm functions from the GMP library. These return a bigint if at
least one of the arguments is a bigint, a machine int otherwise. */
+private bigint_gcd bigint_lcm;
extern expr* bigint_gcd(void*, void*);
extern expr* bigint_lcm(void*, void*);
@@ -340,6 +344,7 @@
always a bigint. Note that y must always be nonnegative here, but see
math.pure which deals with the case y<0 using rational numbers. */
+private bigint_pow;
extern expr* bigint_pow(void*, int);
pow x::int y::int = bigint_pow (bigint x) y if y>=0;
@@ -352,6 +357,7 @@
/* The ^ operator. Computes inexact powers for any combination of int, bigint
and double operands. The result is always a double. */
+private c_pow;
extern double pow(double, double) = c_pow;
x::double^y::double = c_pow x y;
@@ -382,6 +388,8 @@
/* Direct memory accesses. Use with care ... or else! */
+private pointer_get_byte pointer_get_int pointer_get_double
+ pointer_get_string pointer_get_pointer;
extern int pointer_get_byte(void *ptr);
extern int pointer_get_int(void *ptr);
extern double pointer_get_double(void *ptr);
@@ -394,6 +402,8 @@
get_string x::pointer = pointer_get_string x;
get_pointer x::pointer = pointer_get_pointer x;
+private pointer_put_byte pointer_put_int pointer_put_double
+ pointer_put_string pointer_put_pointer;
extern void pointer_put_byte(void *ptr, int x); // IMPURE!
extern void pointer_put_int(void *ptr, int x); // IMPURE!
extern void pointer_put_double(void *ptr, double x); // IMPURE!
Modified: pure/trunk/lib/strings.pure
===================================================================
--- pure/trunk/lib/strings.pure 2008-08-27 19:33:15 UTC (rev 638)
+++ pure/trunk/lib/strings.pure 2008-08-27 20:35:47 UTC (rev 639)
@@ -28,6 +28,7 @@
was encountered during the most recent invokation of eval(). In that case
each reported error message is terminated with a newline character. */
+private pure_str;
extern void* str(expr*) = pure_str;
extern expr* eval(char*); // IMPURE!
extern char* lasterr();
@@ -36,6 +37,7 @@
/* Convert between Unicode character codes and single character strings. */
+private string_chr string_ord;
extern expr* string_chr(int);
extern expr* string_ord(void*);
@@ -51,6 +53,7 @@
to be malloc'ed). The _cstring routines also convert from the system
encoding. */
+private pure_string pure_cstring pure_string_dup pure_cstring_dup;
extern expr* pure_string(void* s);
extern expr* pure_cstring(void* s);
extern expr* pure_string_dup(void* s);
@@ -68,6 +71,7 @@
char* (employing pointer arithmetic etc.; the usual caveats apply), and has
to be freed explicitly by the caller when no longer needed. */
+private pure_byte_string pure_byte_cstring;
extern expr* pure_byte_string(void *s);
extern expr* pure_byte_cstring(void *s);
@@ -86,6 +90,7 @@
string takes quadratic time; as a remedy, we also offer a linear-time
operation to determine the list of all characters of a string in one go. */
+private string_null string_size string_concat string_char_at string_chars;
extern bool string_null(void*);
extern int string_size(void*);
extern expr* string_concat(void*, void*);
@@ -100,6 +105,7 @@
/* Lexicographic string comparison. */
+private strcmp;
extern int strcmp(void*, void*);
x::string<y::string = strcmp x y < 0;
@@ -111,6 +117,7 @@
/* Compute and find substrings of a string. */
+private string_substr string_index;
extern expr* string_substr(void*, int, int);
extern int string_index(void*, void*);
@@ -122,6 +129,7 @@
/* Concatenate a list of strings. */
+private string_concat_list;
extern expr* string_concat_list(expr*);
strcat xs = string_concat_list xs if listp xs && all stringp xs;
Modified: pure/trunk/lib/system.pure
===================================================================
--- pure/trunk/lib/system.pure 2008-08-27 19:33:15 UTC (rev 638)
+++ pure/trunk/lib/system.pure 2008-08-27 20:35:47 UTC (rev 639)
@@ -34,6 +34,7 @@
regex functions. After loading this module, see list -v for a list of
these. */
+private pure_sys_vars;
extern void pure_sys_vars(); pure_sys_vars;
/* errno and friends. This value and the related routines are indispensable to
@@ -41,12 +42,9 @@
by its very nature, errno is a fairly volatile value, don't expect it to
survive a return to the command line in interactive sessions. */
-extern int pure_errno(), void pure_set_errno(int);
+extern int pure_errno() = errno, void pure_set_errno(int) = set_errno;
extern void perror(char*), char* strerror(int);
-errno = pure_errno;
-set_errno val::int = pure_set_errno val;
-
/* Signal handling. The action parameter of 'trap' can be one of the
predefined integer values SIG_TRAP, SIG_IGN and SIG_DFL. SIG_TRAP causes
the given signal to be handled by mapping it to a Pure exception of the
@@ -125,6 +123,7 @@
routines are actually overridden with more convenient Pure wrappers
below. */
+private c_fgets c_gets;
extern FILE* fopen(char* name, char* mode);
extern FILE* popen(char* cmd, char* mode);
extern int fflush(FILE* fp), int fclose(FILE* fp), int pclose(FILE* fp);
@@ -176,12 +175,16 @@
case of an abnormal condition in the wrapper function (error in format
string, argument mismatch), they will throw an exception. */
+private pure_fprintf pure_fprintf_int pure_fprintf_double
+ pure_fprintf_string pure_fprintf_pointer;
extern int pure_fprintf(FILE *fp, char *format);
extern int pure_fprintf_int(FILE *fp, char *format, int x);
extern int pure_fprintf_double(FILE *fp, char *format, double x);
extern int pure_fprintf_string(FILE *fp, char *format, char *x);
extern int pure_fprintf_pointer(FILE *fp, char *format, void *x);
+private printf_split_format printf_format_spec printf_format_str;
+
printf format::string args = fprintf stdout format args;
fprintf fp::pointer format::string args = count when
@@ -237,6 +240,8 @@
as with printf/fprintf. The implementation actually uses snprintf for
safety, a suitable output buffer is provided automatically. */
+private pure_snprintf pure_snprintf_int pure_snprintf_double
+ pure_snprintf_string pure_snprintf_pointer;
extern int pure_snprintf(void *buf, int, char *format);
extern int pure_snprintf_int(void *buf, int, char *format, int x);
extern int pure_snprintf_double(void *buf, int, char *format, double x);
@@ -292,12 +297,16 @@
"assignment suppression" flag "*" is understood; the corresponding items
will not be returned. */
+private pure_fscanf pure_fscanf_int pure_fscanf_double
+ pure_fscanf_string pure_fscanf_pointer;
extern int pure_fscanf(FILE *fp, char *format);
extern int pure_fscanf_int(FILE *fp, char *format, int *x);
extern int pure_fscanf_double(FILE *fp, char *format, double *x);
extern int pure_fscanf_string(FILE *fp, char *format, void *x);
extern int pure_fscanf_pointer(FILE *fp, char *format, void **x);
+private scanf_split_format scanf_format_spec scanf_format_str;
+
scanf format::string = fscanf stdin format;
fscanf fp::pointer format::string = tuple $ reverse ret when
@@ -385,6 +394,8 @@
/* sscanf: This works exactly like fscanf, but input comes from a string
(first argument) rather than a file. */
+private pure_sscanf pure_sscanf_int pure_sscanf_double
+ pure_sscanf_string pure_sscanf_pointer;
extern int pure_sscanf(char *buf, char *format);
extern int pure_sscanf_int(char *buf, char *format, int *x);
extern int pure_sscanf_double(char *buf, char *format, double *x);
@@ -455,6 +466,7 @@
return value.) We also provide readline's companion, the add_history
function, which you need to add strings to readline's history. */
+private c_readline;
extern void* readline(char* prompt) = c_readline;
extern void add_history(char* s);
@@ -472,6 +484,7 @@
extension to POSIX, Pure also provides the constant GLOB_SIZE which
indicates the buffer size required for glob's globptr argument. */
+private c_fnmatch c_glob globfree globlist;
extern int fnmatch(char* pat, char* s, int flags) = c_fnmatch;
extern int glob(char* pat, int flags, void* errfunc, void* globptr) = c_glob;
extern void globfree(void* globptr);
@@ -491,6 +504,7 @@
difficult calling sequence, hence we provide a couple of high-level wrapper
functions for use in Pure programs below. */
+private regcomp regexec regerror regfree regmatches reglist;
extern int regcomp(void* regptr, char* pat, int cflags);
extern int regexec(void* regptr, char* s, int n, void* matches, int eflags);
extern int regerror(int errcode, void* regptr, void* buf, int size);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-27 22:40:42
|
Revision: 643
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=643&view=rev
Author: agraef
Date: 2008-08-27 22:40:51 +0000 (Wed, 27 Aug 2008)
Log Message:
-----------
Bugfixes.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
pure/trunk/lexer.ll
pure/trunk/pure.cc
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-27 21:31:38 UTC (rev 642)
+++ pure/trunk/interpreter.cc 2008-08-27 22:40:51 UTC (rev 643)
@@ -583,7 +583,7 @@
#define DLLEXT ".so"
#endif
-pure_expr* interpreter::run(const string &_s, bool check)
+pure_expr* interpreter::run(const string &_s, bool check, bool sticky)
{
string s = unixize(_s);
// check for library modules
@@ -631,7 +631,10 @@
source = s; declare_op = false;
source_s = 0;
srcdir = dirname(fname);
- if (!l_interactive || check) modno = modctr++;
+ if (sticky)
+ ; // keep the current module
+ else
+ modno = modctr++;
errmsg.clear();
if (check && !interactive) temp = 0;
bool ok = lex_begin(fname);
@@ -663,7 +666,7 @@
return result;
}
-pure_expr* interpreter::run(const list<string> &sl, bool check)
+pure_expr* interpreter::run(const list<string> &sl, bool check, bool sticky)
{
uint8_t s_verbose = verbose;
// Temporarily suppress verbose output for using clause.
@@ -672,7 +675,7 @@
verbose = 0;
}
for (list<string>::const_iterator s = sl.begin(); s != sl.end(); s++)
- run(*s, check);
+ run(*s, check, sticky);
if (s_verbose) {
compile();
verbose = s_verbose;
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-27 21:31:38 UTC (rev 642)
+++ pure/trunk/interpreter.hh 2008-08-27 22:40:51 UTC (rev 643)
@@ -344,20 +344,27 @@
*************************************************************************/
/* Parse and execute the given source file (stdin if empty), or the given
- list of files. If check is true (the default), a full search is performed
- for relative pathnames (checking include directories and PURELIB to
- locate the script file) and the script is only loaded if it wasn't
- included before. Returns the last computed expression (if any). (This
- expression is owned by the interpreter and must *not* be freed by the
- caller.) This is the main interface function. If interactive is true,
- readline is used to get interactive input from the user, using ps as the
- prompt string. Please note that due to some global data shared by
- different interpreter instances, you can't run two interpreters
- concurrently right now. (It is possible to run them sequentially,
- though.) */
- pure_expr *run(const string& source, bool check = true);
- pure_expr *run(const list<string>& sources, bool check = true);
+ list of files. If 'check' is true (the default), a full search is
+ performed for relative pathnames (checking include directories and
+ PURELIB to locate the script file) and the script is only loaded if it
+ wasn't included before. If 'sticky' is true (default is false), the
+ current module namespace is kept, otherwise a new namespace is created
+ for the loaded module. Using this option isn't recommended, but it is
+ used internally by the 'run' command and the '-i' option to give access
+ to the private symbols of the executed script when running interactively.
+ Returns the last computed expression (if any). (This expression is owned
+ by the interpreter and must *not* be freed by the caller.) This is the
+ main interface function. If interactive is true, readline is used to get
+ interactive input from the user, using ps as the prompt string. Please
+ note that due to some global data shared by different interpreter
+ instances, you can't run two interpreters concurrently right now. (It is
+ possible to run them sequentially, though.) */
+ pure_expr *run(const string& source, bool check = true,
+ bool sticky = false);
+ pure_expr *run(const list<string>& sources, bool check = true,
+ bool sticky = false);
+
/* This works like run() above, but takes the source directly from a
string. No error messages will be printed, instead any errors reported
during the most recent invokation of this method are available in
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-27 21:31:38 UTC (rev 642)
+++ pure/trunk/lexer.ll 2008-08-27 22:40:51 UTC (rev 643)
@@ -773,7 +773,7 @@
else if (args.c > 1)
cerr << "run: extra parameter\n";
else
- interp.run(*args.l.begin(), false);
+ interp.run(*args.l.begin(), false, true);
}
^override.* {
// override command is only permitted in interactive mode
Modified: pure/trunk/pure.cc
===================================================================
--- pure/trunk/pure.cc 2008-08-27 21:31:38 UTC (rev 642)
+++ pure/trunk/pure.cc 2008-08-27 22:40:51 UTC (rev 643)
@@ -362,6 +362,7 @@
}
}
// load scripts specified on the command line
+ int32_t last_modno = interp.modno;
for (; *argv; ++argv)
if (string(*argv).substr(0,2) == "-v") {
uint8_t level = 1;
@@ -371,6 +372,7 @@
} else if (*argv == string("-x")) {
if (*++argv) {
count++; interp.modname = *argv;
+ last_modno = interp.modctr;
interp.run(*argv, false);
} else {
interp.error(prog + ": missing script name");
@@ -387,6 +389,7 @@
;
else if (**argv) {
if (count++ == 0) interp.modname = *argv;
+ last_modno = interp.modctr;
interp.run(*argv, false);
}
if (count > 0 && !force_interactive) {
@@ -420,7 +423,9 @@
histfile = strdup(interp.histfile.c_str());
}
interp.temp = 1;
- interp.run("", false);
+ if (last_modno < 0) force_interactive = false;
+ if (force_interactive) interp.modno = last_modno;
+ interp.run("", false, force_interactive);
if (interp.ttymode) cout << endl;
return 0;
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-27 23:04:18
|
Revision: 644
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=644&view=rev
Author: agraef
Date: 2008-08-27 23:04:26 +0000 (Wed, 27 Aug 2008)
Log Message:
-----------
Add option -p to list only private/public symbols to the 'list' command.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lexer.ll
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-27 22:40:51 UTC (rev 643)
+++ pure/trunk/ChangeLog 2008-08-27 23:04:26 UTC (rev 644)
@@ -1,3 +1,8 @@
+2008-08-28 Albert Graef <Dr....@t-...>
+
+ * lexer.ll: Add option -p to list only private/public symbols to
+ the 'list' command.
+
2008-08-27 Albert Graef <Dr....@t-...>
* lib/: Clean up the public namespace.
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-27 22:40:51 UTC (rev 643)
+++ pure/trunk/lexer.ll 2008-08-27 23:04:26 UTC (rev 644)
@@ -361,7 +361,7 @@
// list command is only permitted in interactive mode
if (!interp.interactive) REJECT;
uint8_t s_verbose = interpreter::g_verbose;
- uint8_t tflag = 0;
+ uint8_t tflag = 0; int pflag = -1;
bool aflag = false, dflag = false, eflag = false;
bool cflag = false, fflag = false, mflag = false, vflag = false;
bool gflag = false, lflag = false, sflag = false;
@@ -374,7 +374,7 @@
// process option arguments
for (arg = args.l.begin(); arg != args.l.end(); arg++) {
const char *s = arg->c_str();
- if (s[0] != '-' || !s[1] || !strchr("acdefghlmstv", s[1])) break;
+ if (s[0] != '-' || !s[1] || !strchr("acdefghlmpstv", s[1])) break;
while (*++s) {
switch (*s) {
case 'a': aflag = true; break;
@@ -385,6 +385,13 @@
case 'g': gflag = true; break;
case 'l': lflag = true; break;
case 'm': mflag = true; break;
+ case 'p':
+ if (isdigit(s[1])) {
+ pflag = strtoul(s+1, 0, 10)>0;
+ while (isdigit(s[1])) ++s;
+ } else
+ pflag = 1;
+ break;
case 's': sflag = true; break;
case 'v': vflag = true; break;
case 't':
@@ -410,6 +417,9 @@
-l Long format, prints definitions along with the summary symbol\n\
information. This implies -s.\n\
-m Print information about defined macros.\n\
+-p[flag] List only private symbols in the current module if flag is\n\
+ nonzero (the default), otherwise list only public symbols of all\n\
+ modules. List both private and public symbols if -p is omitted.\n\
-s Summary format, print just summary information about listed symbols.\n\
-t[level] List only symbols and definitions at the given temporary level\n\
(the current level by default) or above. Level 1 denotes all temporary\n\
@@ -439,6 +449,7 @@
const env_info& e = it->second;
const symbol& sym = interp.symtab.sym(f);
if (sym.modno >= 0 && sym.modno != interp.modno ||
+ pflag >= 0 && (pflag > 0) != (sym.modno >= 0) ||
!((e.t == env_info::fun)?fflag:
(e.t == env_info::cvar)?cflag:
(e.t == env_info::fvar)?vflag:0))
@@ -480,7 +491,9 @@
int32_t f = it->first;
if (syms.find(f) == syms.end()) {
const symbol& sym = interp.symtab.sym(f);
- if (sym.modno >= 0 && sym.modno != interp.modno) continue;
+ if (sym.modno >= 0 && sym.modno != interp.modno ||
+ pflag >= 0 && (pflag > 0) != (sym.modno >= 0))
+ continue;
bool matches = true;
if (!args.l.empty()) {
matches = false;
@@ -508,7 +521,9 @@
if (syms.find(f) == syms.end()) {
const env_info& e = it->second;
const symbol& sym = interp.symtab.sym(f);
- if (sym.modno >= 0 && sym.modno != interp.modno) continue;
+ if (sym.modno >= 0 && sym.modno != interp.modno ||
+ pflag >= 0 && (pflag > 0) != (sym.modno >= 0))
+ continue;
bool matches = e.temp >= tflag;
if (!matches && !sflag && args.l.empty()) {
// if not in summary mode, also list temporary rules for a
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-28 06:55:24
|
Revision: 646
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=646&view=rev
Author: agraef
Date: 2008-08-28 06:55:34 +0000 (Thu, 28 Aug 2008)
Log Message:
-----------
Add NULL and LC_* constants.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/runtime.cc
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-28 00:03:19 UTC (rev 645)
+++ pure/trunk/ChangeLog 2008-08-28 06:55:34 UTC (rev 646)
@@ -1,5 +1,7 @@
2008-08-28 Albert Graef <Dr....@t-...>
+ * runtime.cc (pure_sys_vars): Add NULL and LC_* constants.
+
* lexer.ll: Add option -p to list only private/public symbols to
the 'list' command.
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-08-28 00:03:19 UTC (rev 645)
+++ pure/trunk/runtime.cc 2008-08-28 06:55:34 UTC (rev 646)
@@ -27,6 +27,7 @@
#include <stdarg.h>
#include <unistd.h>
#include <limits.h>
+#include <locale.h>
#include <iostream>
#include <sstream>
@@ -3035,6 +3036,8 @@
df(interp, "stdin", pure_pointer(stdin));
df(interp, "stdout", pure_pointer(stdout));
df(interp, "stderr", pure_pointer(stderr));
+ // null pointer
+ cdf(interp, "NULL", pure_pointer(0));
// clock
cdf(interp, "CLOCKS_PER_SEC", pure_int(CLOCKS_PER_SEC));
// fnmatch, glob
@@ -3140,4 +3143,26 @@
#ifdef SIGTTOU
cdf(interp, "SIGTTOU", pure_int(SIGTTOU));
#endif
+ // setlocale
+#ifdef LC_ALL
+ cdf(interp, "LC_ALL", pure_int(LC_ALL));
+#endif
+#ifdef LC_COLLATE
+ cdf(interp, "LC_COLLATE", pure_int(LC_COLLATE));
+#endif
+#ifdef LC_CTYPE
+ cdf(interp, "LC_CTYPE", pure_int(LC_CTYPE));
+#endif
+#ifdef LC_MESSAGES
+ cdf(interp, "LC_MESSAGES", pure_int(LC_MESSAGES));
+#endif
+#ifdef LC_MONETARY
+ cdf(interp, "LC_MONETARY", pure_int(LC_MONETARY));
+#endif
+#ifdef LC_NUMERIC
+ cdf(interp, "LC_NUMERIC", pure_int(LC_NUMERIC));
+#endif
+#ifdef LC_TIME
+ cdf(interp, "LC_TIME", pure_int(LC_TIME));
+#endif
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-28 08:14:05
|
Revision: 647
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=647&view=rev
Author: agraef
Date: 2008-08-28 08:14:15 +0000 (Thu, 28 Aug 2008)
Log Message:
-----------
Add setlocale function.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/system.pure
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-28 06:55:34 UTC (rev 646)
+++ pure/trunk/ChangeLog 2008-08-28 08:14:15 UTC (rev 647)
@@ -1,5 +1,7 @@
2008-08-28 Albert Graef <Dr....@t-...>
+ * lib/system.pure: Add setlocale function.
+
* runtime.cc (pure_sys_vars): Add NULL and LC_* constants.
* lexer.ll: Add option -p to list only private/public symbols to
Modified: pure/trunk/lib/system.pure
===================================================================
--- pure/trunk/lib/system.pure 2008-08-28 06:55:34 UTC (rev 646)
+++ pure/trunk/lib/system.pure 2008-08-28 08:14:15 UTC (rev 647)
@@ -45,6 +45,40 @@
extern int pure_errno() = errno, void pure_set_errno(int) = set_errno;
extern void perror(char*), char* strerror(int);
+/* POSIX locale handling. Details are platform-specific, but you can expect
+ that at least the categories LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY,
+ LC_NUMERIC and LC_TIME are defined, as well as the following values for the
+ locale parameter: "C" or "POSIX" (the default POSIX locale), "" (the system
+ default locale), and NULL, to just query the current locale.
+
+ Other string values which can be passed as the locale argument depend on
+ the implementation, please check your local setlocale(3) documentation for
+ details. If locale is not NULL, the current locale is changed accordingly.
+ The return value is the new locale, or the current locale when passing NULL
+ for the locale parameter. In either case, the string returned by setlocale
+ is such that it can be passed to setlocale to restore the same locale
+ again. In case of an error, setlocale returns a null pointer.
+
+ Please note that calling this function alters the Pure interpreter's idea
+ of what the current locale is, which will affect the expected encoding of
+ subsequently loaded scripts, among other things. When the interpreter
+ starts up, it always sets the default system locale. Unless your scripts
+ rely on a specific encoding, setting the locale to either "C" or "" should
+ always be safe. */
+
+private c_setlocale;
+extern void* setlocale(int category, void* locale) = c_setlocale;
+
+setlocale category::int locale =
+return (check (c_setlocale category buf)) with
+ check res = cstring_dup res if not null res;
+ = res otherwise;
+ return res = free buf $$ res if not null buf;
+ = res otherwise;
+end when
+ buf = if stringp locale then byte_cstring locale else locale;
+end if stringp locale || pointerp locale && null locale;
+
/* Signal handling. The action parameter of 'trap' can be one of the
predefined integer values SIG_TRAP, SIG_IGN and SIG_DFL. SIG_TRAP causes
the given signal to be handled by mapping it to a Pure exception of the
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X