pure-lang-svn Mailing List for Pure (Page 22)
Status: Beta
Brought to you by:
agraef
Menu
▾
▴
pure-lang-svn — SVN commits.
You can subscribe to this list here.
| 2008 |
Jan
|
Feb
|
Mar
|
Apr
(5) |
May
(141) |
Jun
(184) |
Jul
(97) |
Aug
(232) |
Sep
(196) |
Oct
|
Nov
|
Dec
|
|---|
|
From: <ag...@us...> - 2008-06-30 20:00:46
|
Revision: 345
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=345&view=rev
Author: agraef
Date: 2008-06-30 13:00:55 -0700 (Mon, 30 Jun 2008)
Log Message:
-----------
Fix a segfault in external wrapper routines.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-06-30 19:08:19 UTC (rev 344)
+++ pure/trunk/ChangeLog 2008-06-30 20:00:55 UTC (rev 345)
@@ -1,3 +1,9 @@
+2008-06-30 Albert Graef <Dr....@t-...>
+
+ * interpreter.cc (declare_extern): Fix a segfault in external
+ wrapper routines, due to the shadow stack not being popped when
+ an external fails and thus the default rule gets used.
+
2008-06-29 Albert Graef <Dr....@t-...>
* etc/pure.xml: Improved syntax highlighting for Kate. Fixed up
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-06-30 19:08:19 UTC (rev 344)
+++ pure/trunk/interpreter.cc 2008-06-30 20:00:55 UTC (rev 345)
@@ -2903,10 +2903,19 @@
vector<Value*> myargs(2);
for (size_t i = 0; i < n; ++i) {
myargs[0] = b.CreateCall(module->getFunction("pure_new"), defaultv);
- myargs[1] = args[i];
+ myargs[1] = b.CreateCall(module->getFunction("pure_new"), args[i]);
defaultv = b.CreateCall(module->getFunction("pure_apply"),
myargs.begin(), myargs.end());
}
+ if (n > 0) {
+ vector<Value*> freeargs(3);
+ freeargs[0] = defaultv;
+ freeargs[1] = UInt(n);
+ freeargs[2] = Zero;
+ b.CreateCall(module->getFunction("pure_pop_args"),
+ freeargs.begin(), freeargs.end());
+ b.CreateCall(module->getFunction("pure_unref"), defaultv);
+ }
b.CreateRet(defaultv);
verifyFunction(*f);
if (FPM) FPM->run(*f);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-30 19:08:14
|
Revision: 344
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=344&view=rev
Author: agraef
Date: 2008-06-30 12:08:19 -0700 (Mon, 30 Jun 2008)
Log Message:
-----------
Fix up debugging messages.
Modified Paths:
--------------
pure/trunk/runtime.cc
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-06-30 12:20:06 UTC (rev 343)
+++ pure/trunk/runtime.cc 2008-06-30 19:08:19 UTC (rev 344)
@@ -1228,7 +1228,7 @@
assert(f0->data.clos->env[j]->refc > 0);
f0->data.clos->env[j]->refc++;
}
-#if SSTK_DEBUG>1
+#if SSTK_DEBUG
cerr << "++ stack: (sz = " << sz << ")\n";
for (size_t i = 0; i < sz; i++) {
pure_expr *x = sstk[i];
@@ -1242,13 +1242,20 @@
interp.sstk_sz = sz;
}
#if DEBUG>1
- cerr << "pure_apply: calling " << x << " (" << y << ") -> " << fp << endl;
+ cerr << "pure_apply: calling " << f0 << " -> " << fp << endl;
+ for (size_t j = 0; j < n; j++)
+ cerr << "arg#" << j << " = " << (pure_expr*)argv[j] << " -> " << argv[j] << ", refc = " << ((pure_expr*)argv[j])->refc << endl;
+ for (size_t j = 0; j < m; j++)
+ cerr << "env#" << j << " = " << f0->data.clos->env[j] << " -> " << (void*)f0->data.clos->env[j] << ", refc = " << f0->data.clos->env[j]->refc << endl;
#endif
checkstk(test);
if (m>0)
xfuncall(ret, fp, n, env, argv)
else
funcall(ret, fp, n, argv)
+#if DEBUG>1
+ cerr << "pure_apply: result " << f0 << " = " << ret << " -> " << (void*)ret << ", refc = " << ret->refc << endl;
+#endif
pure_free_internal(f0);
return ret;
} else {
@@ -1300,7 +1307,7 @@
sstk[sz++] = x->data.clos->env[j];
assert(env[j]->refc > 0); env[j]->refc++;
}
-#if SSTK_DEBUG>1
+#if SSTK_DEBUG
cerr << "++ stack: (sz = " << sz << ")\n";
for (size_t i = 0; i < sz; i++) {
pure_expr *x = sstk[i];
@@ -1583,7 +1590,7 @@
x->refc++;
else
pure_new_internal(x);
-#if SSTK_DEBUG>1
+#if SSTK_DEBUG
cerr << "++ stack: (sz = " << sz << ")\n";
for (size_t i = 0; i < sz; i++) {
pure_expr *x = sstk[i];
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-30 12:19:57
|
Revision: 343
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=343&view=rev
Author: agraef
Date: 2008-06-30 05:20:06 -0700 (Mon, 30 Jun 2008)
Log Message:
-----------
Comment changes.
Modified Paths:
--------------
pure/trunk/etc/pure-mode.el.in
Modified: pure/trunk/etc/pure-mode.el.in
===================================================================
--- pure/trunk/etc/pure-mode.el.in 2008-06-30 09:23:13 UTC (rev 342)
+++ pure/trunk/etc/pure-mode.el.in 2008-06-30 12:20:06 UTC (rev 343)
@@ -537,7 +537,7 @@
(end-of-line))))
))
-;; run a Q script in a Q eval buffer
+;; run a Pure script in a Pure Eval buffer
;; make sure win32 XEmacs quotes arguments containing whitespace
@@ -845,7 +845,7 @@
;; And let comint handle the rest
(comint-dynamic-simple-complete command pure-output-list))))
-;; send commands to the Q interpreter and digest their results
+;; send commands to the Pure interpreter and digest their results
(defun pure-output-digest (proc string)
(setq string (concat pure-output-string string))
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-30 09:23:03
|
Revision: 342
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=342&view=rev
Author: agraef
Date: 2008-06-30 02:23:13 -0700 (Mon, 30 Jun 2008)
Log Message:
-----------
Add false and true constants, as requested by Jiri Spitz.
Modified Paths:
--------------
pure/trunk/lib/prelude.pure
Modified: pure/trunk/lib/prelude.pure
===================================================================
--- pure/trunk/lib/prelude.pure 2008-06-30 07:56:07 UTC (rev 341)
+++ pure/trunk/lib/prelude.pure 2008-06-30 09:23:13 UTC (rev 342)
@@ -62,9 +62,14 @@
infixl 9 ! !! ; // indexing, slicing
infixr 9 . ; // function composition
+/* The truth values. These are just integers in Pure, but sometimes it's
+ convenient to refer to them using these symbolic constants. */
+
+def false = 0; def true = 1;
+
/* Pull in the primitives (arithmetic etc.) and the standard string functions.
- Note that the system module is *not* included here, so you have to do that
- yourself if your program does any I/O or uses other system functions. */
+ Note that the math and system modules are *not* included here, so you have
+ to do that yourself if your program requires any of those operations. */
using primitives strings;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-30 07:55:59
|
Revision: 341
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=341&view=rev
Author: agraef
Date: 2008-06-30 00:56:07 -0700 (Mon, 30 Jun 2008)
Log Message:
-----------
Add examples/libor to the distribution.
Modified Paths:
--------------
pure/trunk/Makefile.in
Modified: pure/trunk/Makefile.in
===================================================================
--- pure/trunk/Makefile.in 2008-06-30 01:44:39 UTC (rev 340)
+++ pure/trunk/Makefile.in 2008-06-30 07:56:07 UTC (rev 341)
@@ -110,7 +110,8 @@
config/aclocal.m4 config/config.guess config/config.sub config/install-sh \
$(SOURCE) $(EXTRA_SOURCE) w3centities.c \
pure.cc pure.1 pure.1.in etc/pure-mode.el.in etc/pure.* \
-examples/*.pure examples/*.c lib/*.pure test/*.pure test/*.log
+examples/*.pure examples/*.c examples/libor/*.pure lib/*.pure \
+test/*.pure test/*.log
.PHONY: all html dvi ps pdf clean realclean depend install uninstall strip \
dist distcheck cleanlogs logs check config
@@ -232,7 +233,7 @@
dist: pure.1
rm -rf $(dist)
- mkdir $(dist) && mkdir $(dist)/config && mkdir $(dist)/etc && mkdir $(dist)/examples && mkdir $(dist)/lib && mkdir $(dist)/test
+ mkdir $(dist) && mkdir $(dist)/config && mkdir $(dist)/etc && mkdir $(dist)/examples && mkdir $(dist)/examples/libor && mkdir $(dist)/lib && mkdir $(dist)/test
(builddir=$$PWD; cd $(srcdir); for x in $(DISTFILES); do ln -sf $$PWD/$$x $$builddir/$(dist)/$$x; done)
rm -f $(dist).tar.gz
tar cfzh $(dist).tar.gz $(dist)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ye...@us...> - 2008-06-30 01:44:33
|
Revision: 340
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=340&view=rev
Author: yes
Date: 2008-06-29 18:44:39 -0700 (Sun, 29 Jun 2008)
Log Message:
-----------
created subdir 'libor' in examples with two files: myutils.pure and queens.pure
Added Paths:
-----------
pure/trunk/examples/libor/myutils.pure
pure/trunk/examples/libor/queens.pure
Added: pure/trunk/examples/libor/myutils.pure
===================================================================
--- pure/trunk/examples/libor/myutils.pure (rev 0)
+++ pure/trunk/examples/libor/myutils.pure 2008-06-30 01:44:39 UTC (rev 340)
@@ -0,0 +1,31 @@
+// Dr Libor Spacek, 21th May 2008
+
+//General mathematical iterators over one and two indices
+MathIter1 op i1 i2 f = foldl1 op (map f (i1..i2));
+MathIter2 op i1 i2 j1 j2 f =
+ foldl1 op (map (uncurry f) [x,y; x = i1..i2; y = j1..j2]);
+//Examples on how to use the mathematical iterators
+Sigma i1 i2 f = MathIter1 (+) i1 i2 f;
+Pi i1 i2 f = MathIter1 (*) i1 i2 f;
+Factorial n = Pi 1L n id;
+//Binomial using (k, n-k) symmetry and bignum division
+Binomial n k = (Pi (k+1L) n id) div (Pi 2L (n-k) id) if n-k < k;
+ = (Pi (n-k+1L) n id) div (Pi 2L k id);
+
+// Euclid's recursive greatest common factor algorithm for ints and bignums
+Gcf x 0 | Gcf x 0L = x;
+Gcf x y = Gcf y (x mod y);
+
+// take the head of a list and put it at the end
+rotate (h:t) = reverse (h:(reverse t));
+// protate = rotate n items from the front: use when n is positive: 0<=n<=#n
+protate 0 l = l;
+protate n::int l = cat [(drop n l),(take n l)];
+// rotate n items, generalisation of "rotate the bits instruction"
+// example: head (nrotate (-33) (0..23));
+// what time is 33 hrs before midnight? 15 hrs.
+// The clock was moved -33 mod 24 = -9 hours from midnight (0)
+nrotate n::int l = protate nm l when ll = #l; nm = ll + (n mod ll) end if n<0;
+ = protate nm l when nm = n mod #l end;
+
+
Added: pure/trunk/examples/libor/queens.pure
===================================================================
--- pure/trunk/examples/libor/queens.pure (rev 0)
+++ pure/trunk/examples/libor/queens.pure 2008-06-30 01:44:39 UTC (rev 340)
@@ -0,0 +1,96 @@
+/* Several Solutions to the Queens Problem Dr Libor Spacek, 21th May 2008
+
+ (allqueens n) returns all solutions but is slow
+ (queens n) and (tailqueens n) return one different solution each
+ (thequeens n) does no search and is very fast even for large boards
+
+Examples:
+
+ >allqueens 8; // returns all 92 solutions, as a list of lists
+ >queens 8; // gives solution number 52 in the allqueens' list,
+ >tailqueens 8; // gives solution no. 89, which is a reflection of no. 52
+ >map succ (thequeens 8); // gives solution no. 56 */
+
+// increment and decrement general utility
+succ x::int = 1+x; pred x::int = x-1;
+
+// row j in current column not attacked by any queens in preceding columns?
+safe _ _ [] = 1;
+safe id::int j::int (j2::int:l) = // id is the column positions difference
+ if (j==j2) || (id==j2-j) || (id==j-j2) then 0 else safe (1+id) j l;
+
+allqueens n::int = list (searchall n n []) // returns all possible solutions
+ with
+ searchall n::int 0 p = p;
+ searchall n::int i::int p =
+ tuple [searchall n (i-1) (j:p); j = 1..n; safe 1 j p]
+ end;
+
+// the solution is only the rows permutation, without the ordered columns (1..n)
+// full 2D board coordinates can be reconstructed with zip (1..n) (queens n);
+nullary failed;
+queens n::int = list (search n n n [])
+ with
+ search _ 0 _ p = (); // last i, solved
+ search _ _ 0 _ = failed; // failed, run out of alternative js
+ search n::int i::int j::int p =
+ if (failed === solution) then search n i (j-1) p else j,solution
+ when solution = search n (i-1) n (j:p); end if safe 1 j p;
+ = search n i (j-1) p // also try another j when unsafe
+ end;
+// this concise backtracking tailrecursive version throws a single solution
+tailqueens n::int = catch id (srch n n n [])
+ with srch _ 0 _ p = throw p;
+ srch _ _ 0 _ = failed;
+ srch n::int i::int j::int p = if safe 1 j p then
+ ( if failed === (srch n (i-1) n (j:p)) then srch n i (j-1) p else () )
+ else srch n i (j-1) p
+ end;
+
+/*
+thequeens encodes my no search solution, which is to my knowledge the simplest
+known algorithm for this problem.
+There always exists one fundamental centre-symmetrical solution of this form,
+representing an orbit of just 4 reflected solutions, instead of the usual 8.
+These few lines of code are self-contained (not calling any square checking).
+The solutions had been tested exhaustively for board sizes 0 to 5000 and also
+individually for board size 50000x50000.
+
+Row numbering in 'thequeens' is changed for simplicity to 'C style' 0..n-1
+Solution using 2D board coordinates (1..n)x(1..n) can be easily reconstructed
+with: (fullboard (thequeens n)).
+*/
+
+fullboard simple = zip (1..(#simple)) (map succ simple);
+
+nullary nosolution; // returned for n=2 and n=3 when there are no solutions
+
+thequeens n::int = case n of
+ 1 = [0]; // trivial solution to one square board
+ 2 | 3 = nosolution;
+ n::int = map (newsquare n) (0..(n-1)) // rule for even sized boards n>3
+ with newsquare n::int x::int
+ = (start+2*x) mod n if x < halfn; // right start square is crucial
+ = (start2+2*(x-halfn)) mod n // centre reflections fill the 2nd half
+ end
+ when
+ halfn::int = n div 2; // local variable halfn
+ start::int = if (n mod 3) then (halfn-1) else 1;//(n mod 3) is special
+ start2::int = n-((start + 2*(halfn-1)) mod n)-1 // start reflections
+ end if (n mod 2) == 0; // even sized boards finished
+ = 0:(map succ (thequeens (n-1))) // corner start 0: solves odd size boards!
+end; // end of case and thequeens
+
+
+// The rest are test utilities for the queens problem:
+// checks one queens solution either in 0..7 encoding or in 1..8 encoding.
+// returns 1 for a correct result, including "nosolution" for sizes 2 and 3.
+// returns 0 if a queen attack exists anywhere in the presented 'solution':
+checkqs [] = 1;
+checkqs (s::int:l) = if safe 1 s l then checkqs l else 0;
+checkqs (nosolution) = 1;
+
+// conducts an exhaustive test of solutions for boards of all listed sizes.
+// examples of use: >queenstest (1..1000); >queenstest (5000,4999..4990);
+queenstest [] = 1;
+queenstest (h:l) = if checkqs (thequeens h) then queenstest l else 0;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ye...@us...> - 2008-06-30 01:41:53
|
Revision: 339
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=339&view=rev
Author: yes
Date: 2008-06-29 18:42:01 -0700 (Sun, 29 Jun 2008)
Log Message:
-----------
fixing permissions
Removed Paths:
-------------
pure/trunk/examples/libor/myutils.pure
pure/trunk/examples/libor/queens.pure
Deleted: pure/trunk/examples/libor/myutils.pure
===================================================================
--- pure/trunk/examples/libor/myutils.pure 2008-06-30 01:08:27 UTC (rev 338)
+++ pure/trunk/examples/libor/myutils.pure 2008-06-30 01:42:01 UTC (rev 339)
@@ -1,31 +0,0 @@
-// Dr Libor Spacek, 21th May 2008
-
-//General mathematical iterators over one and two indices
-MathIter1 op i1 i2 f = foldl1 op (map f (i1..i2));
-MathIter2 op i1 i2 j1 j2 f =
- foldl1 op (map (uncurry f) [x,y; x = i1..i2; y = j1..j2]);
-//Examples on how to use the mathematical iterators
-Sigma i1 i2 f = MathIter1 (+) i1 i2 f;
-Pi i1 i2 f = MathIter1 (*) i1 i2 f;
-Factorial n = Pi 1L n id;
-//Binomial using (k, n-k) symmetry and bignum division
-Binomial n k = (Pi (k+1L) n id) div (Pi 2L (n-k) id) if n-k < k;
- = (Pi (n-k+1L) n id) div (Pi 2L k id);
-
-// Euclid's recursive greatest common factor algorithm for ints and bignums
-Gcf x 0 | Gcf x 0L = x;
-Gcf x y = Gcf y (x mod y);
-
-// take the head of a list and put it at the end
-rotate (h:t) = reverse (h:(reverse t));
-// protate = rotate n items from the front: use when n is positive: 0<=n<=#n
-protate 0 l = l;
-protate n::int l = cat [(drop n l),(take n l)];
-// rotate n items, generalisation of "rotate the bits instruction"
-// example: head (nrotate (-33) (0..23));
-// what time is 33 hrs before midnight? 15 hrs.
-// The clock was moved -33 mod 24 = -9 hours from midnight (0)
-nrotate n::int l = protate nm l when ll = #l; nm = ll + (n mod ll) end if n<0;
- = protate nm l when nm = n mod #l end;
-
-
Deleted: pure/trunk/examples/libor/queens.pure
===================================================================
--- pure/trunk/examples/libor/queens.pure 2008-06-30 01:08:27 UTC (rev 338)
+++ pure/trunk/examples/libor/queens.pure 2008-06-30 01:42:01 UTC (rev 339)
@@ -1,96 +0,0 @@
-/* Several Solutions to the Queens Problem Dr Libor Spacek, 21th May 2008
-
- (allqueens n) returns all solutions but is slow
- (queens n) and (tailqueens n) return one different solution each
- (thequeens n) does no search and is very fast even for large boards
-
-Examples:
-
- >allqueens 8; // returns all 92 solutions, as a list of lists
- >queens 8; // gives solution number 52 in the allqueens' list,
- >tailqueens 8; // gives solution no. 89, which is a reflection of no. 52
- >map succ (thequeens 8); // gives solution no. 56 */
-
-// increment and decrement general utility
-succ x::int = 1+x; pred x::int = x-1;
-
-// row j in current column not attacked by any queens in preceding columns?
-safe _ _ [] = 1;
-safe id::int j::int (j2::int:l) = // id is the column positions difference
- if (j==j2) || (id==j2-j) || (id==j-j2) then 0 else safe (1+id) j l;
-
-allqueens n::int = list (searchall n n []) // returns all possible solutions
- with
- searchall n::int 0 p = p;
- searchall n::int i::int p =
- tuple [searchall n (i-1) (j:p); j = 1..n; safe 1 j p]
- end;
-
-// the solution is only the rows permutation, without the ordered columns (1..n)
-// full 2D board coordinates can be reconstructed with zip (1..n) (queens n);
-nullary failed;
-queens n::int = list (search n n n [])
- with
- search _ 0 _ p = (); // last i, solved
- search _ _ 0 _ = failed; // failed, run out of alternative js
- search n::int i::int j::int p =
- if (failed === solution) then search n i (j-1) p else j,solution
- when solution = search n (i-1) n (j:p); end if safe 1 j p;
- = search n i (j-1) p // also try another j when unsafe
- end;
-// this concise backtracking tailrecursive version throws a single solution
-tailqueens n::int = catch id (srch n n n [])
- with srch _ 0 _ p = throw p;
- srch _ _ 0 _ = failed;
- srch n::int i::int j::int p = if safe 1 j p then
- ( if failed === (srch n (i-1) n (j:p)) then srch n i (j-1) p else () )
- else srch n i (j-1) p
- end;
-
-/*
-thequeens encodes my no search solution, which is to my knowledge the simplest
-known algorithm for this problem.
-There always exists one fundamental centre-symmetrical solution of this form,
-representing an orbit of just 4 reflected solutions, instead of the usual 8.
-These few lines of code are self-contained (not calling any square checking).
-The solutions had been tested exhaustively for board sizes 0 to 5000 and also
-individually for board size 50000x50000.
-
-Row numbering in 'thequeens' is changed for simplicity to 'C style' 0..n-1
-Solution using 2D board coordinates (1..n)x(1..n) can be easily reconstructed
-with: (fullboard (thequeens n)).
-*/
-
-fullboard simple = zip (1..(#simple)) (map succ simple);
-
-nullary nosolution; // returned for n=2 and n=3 when there are no solutions
-
-thequeens n::int = case n of
- 1 = [0]; // trivial solution to one square board
- 2 | 3 = nosolution;
- n::int = map (newsquare n) (0..(n-1)) // rule for even sized boards n>3
- with newsquare n::int x::int
- = (start+2*x) mod n if x < halfn; // right start square is crucial
- = (start2+2*(x-halfn)) mod n // centre reflections fill the 2nd half
- end
- when
- halfn::int = n div 2; // local variable halfn
- start::int = if (n mod 3) then (halfn-1) else 1;//(n mod 3) is special
- start2::int = n-((start + 2*(halfn-1)) mod n)-1 // start reflections
- end if (n mod 2) == 0; // even sized boards finished
- = 0:(map succ (thequeens (n-1))) // corner start 0: solves odd size boards!
-end; // end of case and thequeens
-
-
-// The rest are test utilities for the queens problem:
-// checks one queens solution either in 0..7 encoding or in 1..8 encoding.
-// returns 1 for a correct result, including "nosolution" for sizes 2 and 3.
-// returns 0 if a queen attack exists anywhere in the presented 'solution':
-checkqs [] = 1;
-checkqs (s::int:l) = if safe 1 s l then checkqs l else 0;
-checkqs (nosolution) = 1;
-
-// conducts an exhaustive test of solutions for boards of all listed sizes.
-// examples of use: >queenstest (1..1000); >queenstest (5000,4999..4990);
-queenstest [] = 1;
-queenstest (h:l) = if checkqs (thequeens h) then queenstest l else 0;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-30 01:08:18
|
Revision: 338
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=338&view=rev
Author: agraef
Date: 2008-06-29 18:08:27 -0700 (Sun, 29 Jun 2008)
Log Message:
-----------
Rename tarray -> Array.
Modified Paths:
--------------
pure/trunk/examples/array.pure
Modified: pure/trunk/examples/array.pure
===================================================================
--- pure/trunk/examples/array.pure 2008-06-30 00:47:15 UTC (rev 337)
+++ pure/trunk/examples/array.pure 2008-06-30 01:08:27 UTC (rev 338)
@@ -54,11 +54,11 @@
nullary nil;
// array type check
-arrayp (tarray _) = 1;
+arrayp (Array _) = 1;
arrayp _ = 0;
// create an empty array
-emptyarray = tarray nil;
+emptyarray = Array nil;
// create an array from a list
array xs = foldl append emptyarray xs if listp xs;
@@ -67,11 +67,11 @@
array2 xs = array (map array xs);
// create an array of a given size filled with a constant value
-mkarray x n::int = tarray (mkarray x n)
+mkarray x n::int = Array (mkarray x n)
with
mkarray x n::int = nil if n <= 0;
= tip x if n == 1;
- = tarray_mkbin (n mod 2)
+ = array_mkbin (n mod 2)
(mkarray x (n - n div 2))
(mkarray x (n div 2));
end;
@@ -80,7 +80,7 @@
mkarray2 x (n::int, m::int) = mkarray (mkarray x m) n;
// get array size
-#(tarray a) = #a
+#(Array a) = #a
with
#nil = 0;
#(tip _) = 1;
@@ -89,7 +89,7 @@
end;
// get value by index
-(tarray a)!i::int = a!i
+(Array a)!i::int = a!i
with
(tip x)!0 = x;
(bin _ a1 a2)!i::int = a1!(i div 2) if i mod 2 == 0;
@@ -98,14 +98,14 @@
end;
// get value by indices from two-dimensional array
-x@(tarray _)!(i::int, j::int) = x!i!j;
+x@(Array _)!(i::int, j::int) = x!i!j;
// check for an empty array
-null (tarray nil) = 1;
-null (tarray _) = 0;
+null (Array nil) = 1;
+null (Array _) = 0;
// get all array members in list form
-members (tarray a) = members a
+members (Array a) = members a
with
members nil = [];
members (tip x) = [x];
@@ -116,17 +116,17 @@
end;
// get all members of an two-dimensional array in list form
-members2 x@(tarray _) = map members (members x);
+members2 x@(Array _) = map members (members x);
// get the first array member
-first (tarray a) = first a
+first (Array a) = first a
with
first (tip x) = x;
first (bin _ a1 _) = first a1;
end;
// get the last array member
-last (tarray a) = last a
+last (Array a) = last a
with
last (tip x) = x;
last (bin 0 _ a2) = last a2;
@@ -134,41 +134,41 @@
end;
// remove the first member from an array
-rmfirst (tarray a) = tarray (rmfirst a)
+rmfirst (Array a) = Array (rmfirst a)
with
rmfirst (tip _) = nil;
- rmfirst (bin 0 a1 a2) = tarray_mkbin 1 a2 (rmfirst a1);
- rmfirst (bin 1 a1 a2) = tarray_mkbin 0 a2 (rmfirst a1);
+ rmfirst (bin 0 a1 a2) = array_mkbin 1 a2 (rmfirst a1);
+ rmfirst (bin 1 a1 a2) = array_mkbin 0 a2 (rmfirst a1);
end;
// remove the last member from an array
-rmlast (tarray a) = tarray (rmlast a)
+rmlast (Array a) = Array (rmlast a)
with
rmlast (tip _) = nil;
- rmlast (bin 0 a1 a2) = tarray_mkbin 1 a1 (rmlast a2);
- rmlast (bin 1 a1 a2) = tarray_mkbin 0 (rmlast a1) a2;
+ rmlast (bin 0 a1 a2) = array_mkbin 1 a1 (rmlast a2);
+ rmlast (bin 1 a1 a2) = array_mkbin 0 (rmlast a1) a2;
end;
// insert a new member at the beginning of an array
-insert (tarray a) y = tarray (insert a y)
+insert (Array a) y = Array (insert a y)
with
insert nil y = tip y;
insert (tip x) y = bin 0 (tip y) (tip x);
- insert (bin 0 a1 a2) y = tarray_mkbin 1 (insert a2 y) a1;
- insert (bin 1 a1 a2) y = tarray_mkbin 0 (insert a2 y) a1;
+ insert (bin 0 a1 a2) y = array_mkbin 1 (insert a2 y) a1;
+ insert (bin 1 a1 a2) y = array_mkbin 0 (insert a2 y) a1;
end;
// append a new member at the end of an array
-append (tarray a) y = tarray (append a y)
+append (Array a) y = Array (append a y)
with
append nil y = tip y;
append (tip x) y = bin 0 (tip x) (tip y);
- append (bin 0 a1 a2) y = tarray_mkbin 1 (append a1 y) a2;
- append (bin 1 a1 a2) y = tarray_mkbin 0 a1 (append a2 y);
+ append (bin 0 a1 a2) y = array_mkbin 1 (append a1 y) a2;
+ append (bin 1 a1 a2) y = array_mkbin 0 a1 (append a2 y);
end;
// update a given array position with a new value
-update (tarray a) i::int y = tarray (update a i y)
+update (Array a) i::int y = Array (update a i y)
with
update (tip _) 0 y = tip y;
update (bin b a1 a2) i::int y = bin b (update a1 (i div 2) y) a2
@@ -178,11 +178,11 @@
end;
// update a given position of a two-dimensional array with a new value
-update2 x@(tarray a) (i::int, j::int) y
+update2 x@(Array a) (i::int, j::int) y
= update x i (update (x!i) j y);
// compare two arrays for equality
-tarray a == tarray b = a == b
+Array a == Array b = a == b
with
nil == nil = 1;
nil == tip _ = 0;
@@ -196,7 +196,7 @@
end;
// compare two arrays for inequality
-tarray a != tarray b = a != b
+Array a != Array b = a != b
with
nil != nil = 0;
nil != tip _ = 1;
@@ -212,6 +212,6 @@
/* Private functions, don't invoke these directly. */
// construct a binary array node
-tarray_mkbin _ nil a2 = a2;
-tarray_mkbin _ a1 nil = a1;
-tarray_mkbin b a1 a2 = bin b a1 a2;
+array_mkbin _ nil a2 = a2;
+array_mkbin _ a1 nil = a1;
+array_mkbin b a1 a2 = bin b a1 a2;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-29 23:09:51
|
Revision: 336
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=336&view=rev
Author: agraef
Date: 2008-06-29 16:10:00 -0700 (Sun, 29 Jun 2008)
Log Message:
-----------
Overhaul array module.
Modified Paths:
--------------
pure/trunk/examples/array.pure
Modified: pure/trunk/examples/array.pure
===================================================================
--- pure/trunk/examples/array.pure 2008-06-29 08:16:50 UTC (rev 335)
+++ pure/trunk/examples/array.pure 2008-06-29 23:10:00 UTC (rev 336)
@@ -1,3 +1,4 @@
+
/* array.pure: integer-indexed arrays implemented as size-balanced
binary trees. */
@@ -18,275 +19,199 @@
You should have received a copy of the GNU General Public License along
with this program. If not, see <http://www.gnu.org/licenses/>. */
-
-/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- This script implements an efficient variable-sized array data structure
+/* This script implements an efficient variable-sized array data structure
which allows to access and update individual array members, as well as
to add and remove elements at the beginning and end of an array. All these
- operations are carried out in logarithmic time. The implementation is
- based on the same ideas as in Frank Drewes' queue data structure.
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+ operations are carried out in logarithmic time. */
+/* Public operations: ******************************************************
-/*****************************************************************************/
-/* */
-/* DIFFERENCES VERSUS Q LANGUAGE */
-/* */
-/******************************************************************************
+ emptyarray return the empty array
+ array xs create an array from a list xs
+ array2 xs create a two-dimensional array from a list of lists
+ mkarray x n create an array consisting of n x's
+ mkarray2 x (n,m) create a 2D array of n*m x's
+ arrayp x check whether x is an array
- Views are not currently available in Pure and so the data structures are
- displayed as they really are. To view the data as lists you should call
- the function "members".
+ #a size of a
+ a!i return ith member of a
+ a!(i,j) two-dimensional subscript
-******************************************************************************/
+ null a tests whether a is the empty array
+ members a list of values stored in a
+ members2 a list of members in a two-dimensional array
+ first a, last a first and last member of A
+ rmfirst a, rmlast a remove first and last member from a
+ insert a x insert x at the beginning of a
+ append a x append x to the end of a
+ update a i x replace the ith member of a by x
+ update2 a (i,j) x update two-dimensional array
-/*** some declarations ***/
+ *************************************************************************/
-using primitives;
-
-// empty tree constructor
+/* Empty tree constant, consider this private. */
nullary nil;
-
-/******************************************************************************/
-/* */
-/* PUBLIC FUNCTIONS */
-/* */
-/******************************************************************************/
-
-
-/*** The following functions represent the user's interface to the module ***/
-
-
// array type check
-isarray (tarray _) = 1;
-isarray _ = 0;
+arrayp (tarray _) = 1;
+arrayp _ = 0;
-
// create an empty array
emptyarray = tarray nil;
-
// create an array from a list
-array xs
- = tarray (foldl tarray_append nil xs)
- if listp xs;
+array xs = foldl append emptyarray xs if listp xs;
-
// create a two-dimensional array from a two-dimensional list
array2 xs = array (map array xs);
-
// create an array of a given size filled with a constant value
-mkarray x n::int
- = tarray (mkarray_ x n)
- with
- mkarray_ x n::int = nil if n <= 0;
- = tip x if n == 1;
- = tarray_mkbin (n mod 2)
- (mkarray_ x (n - n div 2))
- (mkarray_ x (n div 2))
- end;
+mkarray x n::int = tarray (mkarray x n)
+with
+ mkarray x n::int = nil if n <= 0;
+ = tip x if n == 1;
+ = tarray_mkbin (n mod 2)
+ (mkarray x (n - n div 2))
+ (mkarray x (n div 2));
+end;
-// create two-dimensional array of given dimensions filled with a constant value
+// create a 2D array of given dimensions filled with a constant value
mkarray2 x (n::int, m::int) = mkarray (mkarray x m) n;
-
// get array size
-#(tarray a)
- = size a
- with
- size nil = 0;
- size (tip _) = 1;
- size (bin 0 a1 _) = (size a1) * 2;
- size (bin 1 a1 _) = (size a1) * 2 - 1
- end;
+#(tarray a) = #a
+with
+ #nil = 0;
+ #(tip _) = 1;
+ #(bin 0 a1 _) = #a1 * 2;
+ #(bin 1 a1 _) = #a1 * 2 - 1;
+end;
-
// get value by index
-(tarray a)!i::int
- = ith a i
- with
- ith (tip x) 0 = x;
- ith (bin _ a1 a2) i::int
- = ith a1 (i div 2) if i mod 2 == 0;
- = ith a2 (i div 2) if i mod 2 == 1;
- ith _ _ = throw out_of_bounds
- end;
+(tarray a)!i::int = a!i
+with
+ (tip x)!0 = x;
+ (bin _ a1 a2)!i::int = a1!(i div 2) if i mod 2 == 0;
+ = a2!(i div 2) if i mod 2 == 1;
+ _ ! _ = throw out_of_bounds;
+end;
-
// get value by indices from two-dimensional array
-x@(tarray _)!(i::int, j::int) = (x!i)!j;
+x@(tarray _)!(i::int, j::int) = x!i!j;
-
// check for an empty array
null (tarray nil) = 1;
null (tarray _) = 0;
+// get all array members in list form
+members (tarray a) = members a
+with
+ members nil = [];
+ members (tip x) = [x];
+ members (bin _ a1 a2) = merge (members a1) (members a2);
+ // merge lists xs (even elements) and ys (odd elements)
+ merge [] ys = ys;
+ merge (x:xs) ys = x:merge ys xs;
+end;
-// get all array members in a list form
-members (tarray a)
- = members_ a
- with
- members_ nil = [];
- members_ (tip x) = [x];
- members_ (bin _ a1 a2)
- = tarray_merge (members_ a1)
- (members_ a2)
- end;
-
-
-// get all members of an two-dimensional array in a list form
+// get all members of an two-dimensional array in list form
members2 x@(tarray _) = map members (members x);
-
// get the first array member
-first (tarray a)
- = tarray_first a
- with
- first_ (tip x) = x;
- first_ (bin _ a1 _) = first_ a1
- end;
+first (tarray a) = first a
+with
+ first (tip x) = x;
+ first (bin _ a1 _) = first a1;
+end;
-
// get the last array member
-last (tarray a)
- = last_ a
- with
- last_ (tip x) = x;
- last_ (bin 0 _ a2) = last_ a2;
- last_ (bin 1 a1 _) = last_ a1
- end;
+last (tarray a) = last a
+with
+ last (tip x) = x;
+ last (bin 0 _ a2) = last a2;
+ last (bin 1 a1 _) = last a1;
+end;
-
// remove the first member from an array
-rmfirst (tarray a)
- = tarray (rmfirst_ a)
- with
- rmfirst_ (tip _) = nil;
- rmfirst_ (bin 0 a1 a2)
- = tarray_mkbin 1 a2 (rmfirst_ a1);
- rmfirst_ (bin 1 a1 a2)
- = tarray_mkbin 0 a2 (rmfirst_ a1)
- end;
+rmfirst (tarray a) = tarray (rmfirst a)
+with
+ rmfirst (tip _) = nil;
+ rmfirst (bin 0 a1 a2) = tarray_mkbin 1 a2 (rmfirst a1);
+ rmfirst (bin 1 a1 a2) = tarray_mkbin 0 a2 (rmfirst a1);
+end;
-
// remove the last member from an array
-rmlast (tarray a)
- = tarray (rmlast_ a)
- with
- rmlast_ (tip _) = nil;
- rmlast_ (bin 0 a1 a2)
- = tarray_mkbin 1 a1 (rmlast_ a2);
- rmlast_ (bin 1 a1 a2)
- = tarray_mkbin 0 (rmlast_ a1) a2
- end;
+rmlast (tarray a) = tarray (rmlast a)
+with
+ rmlast (tip _) = nil;
+ rmlast (bin 0 a1 a2) = tarray_mkbin 1 a1 (rmlast a2);
+ rmlast (bin 1 a1 a2) = tarray_mkbin 0 (rmlast a1) a2;
+end;
+// insert a new member at the beginning of an array
+insert (tarray a) y = tarray (insert a y)
+with
+ insert nil y = tip y;
+ insert (tip x) y = bin 0 (tip y) (tip x);
+ insert (bin 0 a1 a2) y = tarray_mkbin 1 (insert a2 y) a1;
+ insert (bin 1 a1 a2) y = tarray_mkbin 0 (insert a2 y) a1;
+end;
-// insert a new member at the array beginning
-insert (tarray a) y
- = tarray (insert_ a y)
- with
- insert_ nil y = tip y;
- insert_ (tip x) y = bin 0 (tip y) (tip x);
- insert_ (bin 0 a1 a2) y
- = tarray_mkbin 1 (insert_ a2 y) a1;
- insert_ (bin 1 a1 a2) y
- = tarray_mkbin 0 (insert_ a2 y) a1
- end;
+// append a new member at the end of an array
+append (tarray a) y = tarray (append a y)
+with
+ append nil y = tip y;
+ append (tip x) y = bin 0 (tip x) (tip y);
+ append (bin 0 a1 a2) y = tarray_mkbin 1 (append a1 y) a2;
+ append (bin 1 a1 a2) y = tarray_mkbin 0 a1 (append a2 y);
+end;
+// update a given array position with a new value
+update (tarray a) i::int y = tarray (update a i y)
+with
+ update (tip _) 0 y = tip y;
+ update (bin b a1 a2) i::int y = bin b (update a1 (i div 2) y) a2
+ if i mod 2 == 0;
+ = bin b a1 (update a2 (i div 2) y)
+ if i mod 2 == 1;
+end;
-// append a new member at the array end
-append (tarray a) y
- = tarray (tarray_append a y);
-
-
-//update a given array position with a new value
-update (tarray a) i::int y
- = tarray (update_ a i y)
- with
- update_ (tip _) 0 y = tip y;
- update_ (bin b a1 a2) i::int y
- = bin b (update_ a1 (i div 2) y) a2
- if i mod 2 == 0;
- = bin b a1 (update_ a2 (i div 2) y)
- if i mod 2 == 1
- end;
-
-
-//update a given position of a two-dimensional array with a new value
+// update a given position of a two-dimensional array with a new value
update2 x@(tarray a) (i::int, j::int) y
= update x i (update (x!i) j y);
+// compare two arrays for equality
+tarray a == tarray b = a == b
+with
+ nil == nil = 1;
+ nil == tip _ = 0;
+ nil == bin _ _ _ = 0;
+ tip _ == nil = 0;
+ tip x == tip y = x == y;
+ tip _ == bin _ _ _ = 0;
+ bin _ _ _ == nil = 0;
+ bin _ _ _ == tip _ = 0;
+ bin b1 a1 a2 == bin b2 a3 a4 = b1 == b2 && a1 == a3 && a2 == a4;
+end;
-/* test for equality of two arrays */
-(tarray a) == (tarray b)
- = eq a b
- with
- eq nil nil = 1;
- eq nil (tip _) = 0;
- eq nil (bin _ _ _) = 0;
- eq (tip _) nil = 0;
- eq (tip x) (tip y) = (x == y);
- eq (tip _) (bin _ _ _) = 0;
- eq (bin _ _ _) nil = 0;
- eq (bin _ _ _) (tip _) = 0;
- eq (bin b1 a1 a2) (bin b2 a3 a4)
- = if (b1 != b2)
- then 0
- else if (a1 != a3)
- then 0
- else (a2 == a4)
- end;
+// compare two arrays for inequality
+tarray a != tarray b = a != b
+with
+ nil != nil = 0;
+ nil != tip _ = 1;
+ nil != bin _ _ _ = 1;
+ tip _ != nil = 1;
+ tip x != tip y = x != y;
+ tip _ != bin _ _ _ = 1;
+ bin _ _ _ != nil = 1;
+ bin _ _ _ != tip _ = 1;
+ bin b1 a1 a2 != bin b2 a3 a4 = b1 != b2 || a1 != a3 || a2 != a4;
+end;
+/* Private functions, don't invoke these directly. */
-/* test for inequality of two arrays */
-(tarray a) != (tarray b)
- = neq a b
- with
- neq nil nil = 0;
- neq nil (tip _) = 1;
- neq nil (bin _ _ _) = 1;
- neq (tip _) nil = 1;
- neq (tip x) (tip y) = (x != y);
- neq (tip _) (bin _ _ _) = 1;
- neq (bin _ _ _) nil = 1;
- neq (bin _ _ _) (tip _) = 1;
- neq (bin b1 a1 a2) (bin b2 a3 a4)
- = if (b1 != b2)
- then 1
- else if (a1 != a3)
- then 1
- else (a2 != a4)
- end;
-
-
-/******************************************************************************/
-/* */
-/* PRIVATE FUNCTIONS */
-/* */
-/******************************************************************************/
-
-/*** The following functions shouldn't be directly used by users ***/
-
-
// construct a binary array node
-
tarray_mkbin _ nil a2 = a2;
tarray_mkbin _ a1 nil = a1;
tarray_mkbin b a1 a2 = bin b a1 a2;
-
-
-// merge lists xs (even elements) and ys
-// (odd elements)
-
-tarray_merge [] ys = ys;
-tarray_merge (x:xs) ys = (x:tarray_merge ys xs);
-
-// append stuff - this is reused
-
-tarray_append nil y = tip y;
-tarray_append (tip x) y = bin 0 (tip x) (tip y);
-tarray_append (bin 0 a1 a2) y = tarray_mkbin 1 (tarray_append a1 y) a2;
-tarray_append (bin 1 a1 a2) y = tarray_mkbin 0 a1 (tarray_append a2 y);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-29 01:50:41
|
Revision: 334
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=334&view=rev
Author: agraef
Date: 2008-06-28 18:50:50 -0700 (Sat, 28 Jun 2008)
Log Message:
-----------
Updated ChangeLog.
Modified Paths:
--------------
pure/trunk/ChangeLog
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-06-29 01:44:52 UTC (rev 333)
+++ pure/trunk/ChangeLog 2008-06-29 01:50:50 UTC (rev 334)
@@ -1,3 +1,13 @@
+2008-06-29 Albert Graef <Dr....@t-...>
+
+ * etc/pure.xml: Improved syntax highlighting for Kate. Fixed up
+ highlighting of quoted string chars, as suggested by Eddie Rucker.
+ Also added folding support for comments and block structure
+ (case/with/when ... end).
+
+ * lib/math.pure: Started module with math operations (exp, ln,
+ trigonometric functions, etc.).
+
2008-06-28 Albert Graef <Dr....@t-...>
* interpreter.cc: Promote type tags and substitute constants on
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-29 01:44:43
|
Revision: 333
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=333&view=rev
Author: agraef
Date: 2008-06-28 18:44:52 -0700 (Sat, 28 Jun 2008)
Log Message:
-----------
Add folding support.
Modified Paths:
--------------
pure/trunk/etc/pure.xml
Modified: pure/trunk/etc/pure.xml
===================================================================
--- pure/trunk/etc/pure.xml 2008-06-28 22:20:35 UTC (rev 332)
+++ pure/trunk/etc/pure.xml 2008-06-29 01:44:52 UTC (rev 333)
@@ -1,12 +1,18 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE language SYSTEM "language.dtd">
-<language name="Pure" version="1.01" kateversion="2.1" section="Sources" extensions="*.pure">
+<language name="Pure" version="1.2" kateversion="2.4" section="Sources" extensions="*.pure">
<highlighting>
+ <list name="blockstarters">
+ <item> case </item>
+ <item> when </item>
+ <item> with </item>
+ </list>
+ <list name="blockenders">
+ <item> end </item>
+ </list>
<list name="keywords">
- <item> case </item>
<item> def </item>
<item> else </item>
- <item> end </item>
<item> extern </item>
<item> if </item>
<item> infix </item>
@@ -20,8 +26,6 @@
<item> postfix </item>
<item> then </item>
<item> using </item>
- <item> when </item>
- <item> with </item>
</list>
<list name="special">
<item> catch </item>
@@ -42,6 +46,9 @@
</list>
<contexts>
<context attribute="Normal Text" lineEndContext="#stay" name="Normal">
+ <DetectSpaces />
+ <keyword attribute="Keyword" context="#stay" String="blockstarters" beginRegion="Block" />
+ <keyword attribute="Keyword" context="#stay" String="blockenders" endRegion="Block" />
<keyword attribute="Keyword" context="#stay" String="keywords"/>
<keyword attribute="Function" context="#stay" String="special"/>
<keyword attribute="Type" context="#stay" String="types"/>
@@ -51,7 +58,7 @@
<Int attribute="Number" context="#stay"/>
<HlCChar attribute="Char" context="#stay"/>
<DetectChar attribute="String" context="String" char="""/>
- <Detect2Chars attribute="Comment" context="Comment1" char="/" char1="*" />
+ <Detect2Chars attribute="Comment" context="Comment1" char="/" char1="*" beginRegion="Comment" />
<Detect2Chars attribute="Comment" context="Comment2" char="/" char1="/"/>
</context>
<context attribute="String" lineEndContext="#pop" name="String">
@@ -59,8 +66,10 @@
<HlCStringChar attribute="String Char" context="#stay"/>
<DetectChar attribute="String" context="#pop" char="""/>
</context>
+ <context attribute="Region Marker" lineEndContext="#pop" name="Region Marker">
+ </context>
<context attribute="Comment" lineEndContext="#stay" name="Comment1">
- <Detect2Chars attribute="Comment" context="#pop" char="*" char1="/"/>
+ <Detect2Chars attribute="Comment" context="#pop" char="*" char1="/" endRegion="Comment"/>
</context>
<context attribute="Comment" lineEndContext="#pop" name="Comment2"/>
</contexts>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-28 20:05:25
|
Revision: 331
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=331&view=rev
Author: agraef
Date: 2008-06-28 13:05:34 -0700 (Sat, 28 Jun 2008)
Log Message:
-----------
Add pi constant.
Modified Paths:
--------------
pure/trunk/lib/math.pure
Modified: pure/trunk/lib/math.pure
===================================================================
--- pure/trunk/lib/math.pure 2008-06-28 19:48:33 UTC (rev 330)
+++ pure/trunk/lib/math.pure 2008-06-28 20:05:34 UTC (rev 331)
@@ -65,6 +65,8 @@
atan2 x::int y::double | atan2 x::bigint y::double = atan2 (double x) y;
atan2 x::double y::int | atan2 x::double y::bigint = atan2 x (double y);
+def pi = 4.0*atan 1.0;
+
/* Exponential function and logarithms. */
extern double exp(double), double log(double) = c_log;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-28 19:48:23
|
Revision: 330
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=330&view=rev
Author: agraef
Date: 2008-06-28 12:48:33 -0700 (Sat, 28 Jun 2008)
Log Message:
-----------
Fix highlighting of strings (thanks to Eddie Rucker).
Modified Paths:
--------------
pure/trunk/etc/pure.xml
Modified: pure/trunk/etc/pure.xml
===================================================================
--- pure/trunk/etc/pure.xml 2008-06-28 18:51:25 UTC (rev 329)
+++ pure/trunk/etc/pure.xml 2008-06-28 19:48:33 UTC (rev 330)
@@ -49,12 +49,14 @@
<RegExpr attribute="Number" context="#stay" String="0x[A-Za-z0-9]+"/>
<Float attribute="Number" context="#stay"/>
<Int attribute="Number" context="#stay"/>
+ <HlCChar attribute="Char" context="#stay"/>
<DetectChar attribute="String" context="String" char="""/>
<Detect2Chars attribute="Comment" context="Comment1" char="/" char1="*" />
<Detect2Chars attribute="Comment" context="Comment2" char="/" char1="/"/>
</context>
- <context attribute="String" lineEndContext="#stay" name="String">
- <RegExp attribute="String" context="#stay" String="\\."/>
+ <context attribute="String" lineEndContext="#pop" name="String">
+ <LineContinue attribute="String" context="#stay"/>
+ <HlCStringChar attribute="String Char" context="#stay"/>
<DetectChar attribute="String" context="#pop" char="""/>
</context>
<context attribute="Comment" lineEndContext="#stay" name="Comment1">
@@ -69,6 +71,7 @@
<itemData name="Type" defStyleNum="dsDataType"/>
<itemData name="Number" defStyleNum="dsDecVal" />
<itemData name="String" defStyleNum="dsString" />
+ <itemData name="String Char" defStyleNum="dsChar"/>
<itemData name="Comment" defStyleNum="dsComment" />
</itemDatas>
</highlighting>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-28 18:51:19
|
Revision: 329
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=329&view=rev
Author: agraef
Date: 2008-06-28 11:51:25 -0700 (Sat, 28 Jun 2008)
Log Message:
-----------
Add math.pure library module.
Added Paths:
-----------
pure/trunk/lib/math.pure
Added: pure/trunk/lib/math.pure
===================================================================
--- pure/trunk/lib/math.pure (rev 0)
+++ pure/trunk/lib/math.pure 2008-06-28 18:51:25 UTC (rev 329)
@@ -0,0 +1,93 @@
+
+/* Pure basic math routines. */
+
+/* Copyright (c) 2008 by Albert Graef <Dr....@t-...>.
+
+ This file is part of the Pure programming language and system.
+
+ Pure is free software: you can redistribute it and/or modify it under the
+ terms of the GNU General Public License as published by the Free Software
+ Foundation, either version 3 of the License, or (at your option) any later
+ version.
+
+ Pure is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+ details.
+
+ You should have received a copy of the GNU General Public License along
+ with this program. If not, see <http://www.gnu.org/licenses/>. */
+
+/* IEEE floating point infinities and NaNs. */
+
+def inf = 1.0e307 * 1.0e307; def nan = inf-inf;
+
+/* Absolute value and sign of a number. */
+
+abs x::int | abs x::bigint | abs x::double
+ = if x>=0 then x else -x;
+sgn x::int | sgn x::bigint | sgn x::double
+ = if x>0 then 1 else if x<0 then -1 else 0;
+
+/* Generic min and max functions. */
+
+min x y = if x<=y then x else y;
+max x y = if x>=y then x else y;
+
+/* Generic succ and pred functions. */
+
+succ x = x+1;
+pred x = x-1;
+
+/* Floor and ceil functions. */
+
+extern double floor(double), double ceil(double);
+
+floor x::int | floor x::bigint = x;
+ceil x::int | ceil x::bigint = x;
+
+/* Trigonometric functions. */
+
+extern double sin(double), double cos(double), double tan(double);
+extern double asin(double), double acos(double), double atan(double);
+extern double atan2(double,double);
+
+sin x::int | sin x::bigint = sin (double x);
+cos x::int | cos x::bigint = cos (double x);
+tan x::int | tan x::bigint = tan (double x);
+
+asin x::int | asin x::bigint = asin (double x);
+acos x::int | acos x::bigint = acos (double x);
+atan x::int | atan x::bigint = atan (double x);
+
+atan2 x::int y::int | atan2 x::bigint y::bigint |
+atan2 x::bigint y::int | atan2 x::int y::bigint = atan2 (double x) (double y);
+atan2 x::int y::double | atan2 x::bigint y::double = atan2 (double x) y;
+atan2 x::double y::int | atan2 x::double y::bigint = atan2 x (double y);
+
+/* Exponential function and logarithms. */
+
+extern double exp(double), double log(double) = c_log;
+
+ln x::double = c_log x if x>=0.0;
+log x::double = c_log x/c_log 10.0 if x>=0.0;
+
+exp x::int | exp x::bigint = exp (double x);
+ln x::int | ln x::bigint = ln (double x);
+log x::int | log x::bigint = log (double x);
+
+/* Hyperbolic functions. */
+
+extern double sinh(double), double cosh(double), double tanh(double);
+extern double asinh(double);
+extern double acosh(double) = c_acosh, double atanh(double) = c_atanh;
+
+acosh x::double = c_acosh x if x>=1.0;
+atanh x::double = c_atanh x if abs x<=1.0;
+
+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);
+asinh x::int | asinh x::bigint = asinh (double x);
+acosh x::int | acosh x::bigint = acosh (double x);
+atanh x::int | atanh x::bigint = atanh (double x);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-28 17:40:38
|
Revision: 328
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=328&view=rev
Author: agraef
Date: 2008-06-28 10:40:47 -0700 (Sat, 28 Jun 2008)
Log Message:
-----------
Refactoring.
Modified Paths:
--------------
pure/trunk/lib/primitives.pure
pure/trunk/test/prelude.log
Modified: pure/trunk/lib/primitives.pure
===================================================================
--- pure/trunk/lib/primitives.pure 2008-06-28 17:01:14 UTC (rev 327)
+++ pure/trunk/lib/primitives.pure 2008-06-28 17:40:47 UTC (rev 328)
@@ -75,24 +75,24 @@
expr* pure_bigintval(expr*), expr* pure_pointerval(expr*);
int x::int = x;
-int x::bigint = pure_intval x;
-int x::double = pure_intval x;
+int x::bigint |
+int x::double |
int x::pointer = pure_intval x;
-bigint x::int = pure_bigintval x;
bigint x::bigint = x;
-bigint x::double = pure_bigintval x;
+bigint x::int |
+bigint x::double |
bigint x::pointer = pure_bigintval x;
-double x::int = pure_dblval x;
+double x::double = x;
+double x::int |
double x::bigint = pure_dblval x;
-double x::double = x;
-pointer x::int = pure_pointerval x;
-pointer x::bigint = pure_pointerval x;
-pointer x::double = pure_pointerval x;
+pointer x::pointer = x;
+pointer x::int |
+pointer x::bigint |
+pointer x::double |
pointer x::string = pure_pointerval x;
-pointer x::pointer = x;
/* Basic int and double arithmetic. The Pure compiler already knows how to
handle these, we just need to supply rules with the right type tags. */
@@ -272,7 +272,7 @@
extern double sqrt(double) = c_sqrt;
-sqrt x::int = c_sqrt (double x) if x>=0;
+sqrt x::int |
sqrt x::bigint = c_sqrt (double x) if x>=0;
sqrt x::double = c_sqrt x if x>=0;
@@ -291,22 +291,22 @@
pow x::bigint y::int = bigint_pow x y if y>=0;
// mixed double/int/bigint
-pow x::double y::int = c_pow x (double y);
+pow x::double y::int |
pow x::double y::bigint = c_pow x (double y);
-pow x::int y::double = c_pow (double x) y if x>=0 || int y==y;
+pow x::int y::double |
pow x::bigint y::double = c_pow (double x) y if x>=0 || int y==y;
/* The ^ operator. Works like pow, but always promotes its operands to double
and returns a double result. */
x::double^y::double = c_pow x y if x>=0 || int y==y;
-x::int^y::int = c_pow (double x) (double y);
-x::bigint^y::bigint = c_pow (double x) (double y);
-x::int^y::bigint = c_pow (double x) (double y);
+x::int^y::int |
+x::bigint^y::bigint |
+x::int^y::bigint |
x::bigint^y::int = c_pow (double x) (double y);
-x::double^y::int = c_pow x (double y);
+x::double^y::int |
x::double^y::bigint = c_pow x (double y);
-x::int^y::double = c_pow (double x) y if x>=0 || int y==y;
+x::int^y::double |
x::bigint^y::double = c_pow (double x) y if x>=0 || int y==y;
/* Pointer arithmetic. We do this using bigints, so that the code is portable
Modified: pure/trunk/test/prelude.log
===================================================================
--- pure/trunk/test/prelude.log 2008-06-28 17:01:14 UTC (rev 327)
+++ pure/trunk/test/prelude.log 2008-06-28 17:40:47 UTC (rev 328)
@@ -60,18 +60,18 @@
int x/*0:1*/::bigint = pure_intval x/*0:1*/;
int x/*0:1*/::double = pure_intval x/*0:1*/;
int x/*0:1*/ = pure_intval x/*0:1*/;
+bigint x/*0:1*/::bigint = x/*0:1*/;
bigint x/*0:1*/::int = pure_bigintval x/*0:1*/;
-bigint x/*0:1*/::bigint = x/*0:1*/;
bigint x/*0:1*/::double = pure_bigintval x/*0:1*/;
bigint x/*0:1*/ = pure_bigintval x/*0:1*/;
+double x/*0:1*/::double = x/*0:1*/;
double x/*0:1*/::int = pure_dblval x/*0:1*/;
double x/*0:1*/::bigint = pure_dblval x/*0:1*/;
-double x/*0:1*/::double = x/*0:1*/;
+pointer x/*0:1*/ = x/*0:1*/;
pointer x/*0:1*/::int = pure_pointerval x/*0:1*/;
pointer x/*0:1*/::bigint = pure_pointerval x/*0:1*/;
pointer x/*0:1*/::double = pure_pointerval x/*0:1*/;
pointer x/*0:1*/::string = pure_pointerval x/*0:1*/;
-pointer x/*0:1*/ = x/*0:1*/;
-x/*0:1*/::int = -x/*0:1*/;
~x/*0:1*/::int = ~x/*0:1*/;
not x/*0:1*/::int = not x/*0:1*/;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-28 17:01:05
|
Revision: 327
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=327&view=rev
Author: agraef
Date: 2008-06-28 10:01:14 -0700 (Sat, 28 Jun 2008)
Log Message:
-----------
Bugfixes: Perform substitutions on the rhs of variable and constant definitions.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-06-28 12:20:43 UTC (rev 326)
+++ pure/trunk/ChangeLog 2008-06-28 17:01:14 UTC (rev 327)
@@ -1,5 +1,8 @@
2008-06-28 Albert Graef <Dr....@t-...>
+ * interpreter.cc: Promote type tags and substitute constants on
+ the rhs of variable and constant definitions.
+
* lib/prelude.pure: Using xs!ns for slicing conflicts with more
general indexing of containers with arbitrary keys. Use !! for
slicing instead. Restrict the definition to lists and tuples, and
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-06-28 12:20:43 UTC (rev 326)
+++ pure/trunk/interpreter.cc 2008-06-28 17:01:14 UTC (rev 327)
@@ -490,7 +490,7 @@
// Evaluate an expression.
-pure_expr *interpreter::eval(expr x)
+pure_expr *interpreter::eval(expr& x)
{
globals g;
save_globals(g);
@@ -500,14 +500,15 @@
return res;
}
-pure_expr *interpreter::eval(expr x, pure_expr*& e)
+pure_expr *interpreter::eval(expr& x, pure_expr*& e)
{
globals g;
save_globals(g);
compile();
- // promote type tags:
+ // promote type tags and substitute constants:
env vars; expr u = subst(vars, x);
compile(u);
+ x = u;
pure_expr *res = doeval(u, e);
restore_globals(g);
return res;
@@ -515,7 +516,7 @@
// Define global variables.
-pure_expr *interpreter::defn(expr pat, expr x)
+pure_expr *interpreter::defn(expr pat, expr& x)
{
globals g;
save_globals(g);
@@ -525,13 +526,15 @@
return res;
}
-pure_expr *interpreter::defn(expr pat, expr x, pure_expr*& e)
+pure_expr *interpreter::defn(expr pat, expr& x, pure_expr*& e)
{
globals g;
save_globals(g);
compile();
env vars;
- expr lhs = bind(vars, pat), rhs = x;
+ // promote type tags and substitute constants:
+ expr rhs = subst(vars, x);
+ expr lhs = bind(vars, pat);
build_env(vars, lhs);
for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
int32_t f = it->first;
@@ -550,6 +553,7 @@
}
}
compile(rhs);
+ x = rhs;
pure_expr *res = dodefn(vars, lhs, rhs, e);
if (!res) return 0;
for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
@@ -564,7 +568,7 @@
// Define global constants (macro definitions).
-pure_expr *interpreter::const_defn(expr pat, expr x)
+pure_expr *interpreter::const_defn(expr pat, expr& x)
{
globals g;
save_globals(g);
@@ -617,13 +621,15 @@
return x;
}
-pure_expr *interpreter::const_defn(expr pat, expr x, pure_expr*& e)
+pure_expr *interpreter::const_defn(expr pat, expr& x, pure_expr*& e)
{
globals g;
save_globals(g);
compile();
env vars;
- expr lhs = bind(vars, pat), rhs = x;
+ // promote type tags and substitute constants:
+ expr rhs = subst(vars, x);
+ expr lhs = bind(vars, pat);
build_env(vars, lhs);
for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
int32_t f = it->first;
@@ -645,6 +651,7 @@
}
}
compile(rhs);
+ x = rhs;
pure_expr *res = doeval(rhs, e);
if (!res) return 0;
// convert the result back to a compile time expression
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-06-28 12:20:43 UTC (rev 326)
+++ pure/trunk/interpreter.hh 2008-06-28 17:01:14 UTC (rev 327)
@@ -304,8 +304,8 @@
evaluation. In such a case, the variant with the extra e parameter
returns the runtime expression thrown by the exception, if any. Both the
result and the exception value (if any) are to be freed by the caller. */
- pure_expr *eval(expr x);
- pure_expr *eval(expr x, pure_expr*& e);
+ pure_expr *eval(expr& x);
+ pure_expr *eval(expr& x, pure_expr*& e);
/* Evaluate an expression and define global variables. This works like
eval() above, but also binds the variables in pat to the corresponding
@@ -315,8 +315,8 @@
matched. Returns a null pointer if an exception occurred during the
evaluation or if the pattern failed to match. Both the result and the
exception value (if any) are to be freed by the caller. */
- pure_expr *defn(expr pat, expr x);
- pure_expr *defn(expr pat, expr x, pure_expr*& e);
+ pure_expr *defn(expr pat, expr& x);
+ pure_expr *defn(expr pat, expr& x, pure_expr*& e);
/* Bind a global variable to a given value. This binds the given variable
symbol directly to the given value, without matching and evaluating
@@ -334,8 +334,8 @@
the left-hand side pattern as usual. Unlike variables, existing constant
symbols cannot be redefined, so they have to be cleared before you can
give them new values. */
- pure_expr *const_defn(expr pat, expr x);
- pure_expr *const_defn(expr pat, expr x, pure_expr*& e);
+ pure_expr *const_defn(expr pat, expr& x);
+ pure_expr *const_defn(expr pat, expr& x, pure_expr*& e);
/* Directly bind a given constant symbol to a given value. */
void const_defn(int32_t tag, pure_expr *x);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-27 22:53:42
|
Revision: 325
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=325&view=rev
Author: agraef
Date: 2008-06-27 15:53:51 -0700 (Fri, 27 Jun 2008)
Log Message:
-----------
Restrict definition of the slicing operation to lists and tuples, and simplify it by using a list comprehension.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/prelude.pure
pure/trunk/test/prelude.log
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-06-27 20:05:31 UTC (rev 324)
+++ pure/trunk/ChangeLog 2008-06-27 22:53:51 UTC (rev 325)
@@ -1,11 +1,13 @@
-2008-06-27 Albert Graef <Dr....@t-...>
+2008-06-28 Albert Graef <Dr....@t-...>
* lib/prelude.pure: Using xs!ns for slicing conflicts with more
general indexing of containers with arbitrary keys. Use !! for
- slicing instead, as suggested by Jiri Spitz. Also make slicing
- fail if indices aren't machine ints, and throw a bad_list_value
- exception if computing the size of the container fails.
+ slicing instead. Restrict the definition to lists and tuples, and
+ simplify it by using a list comprehension. Suggested by Jiri
+ Spitz.
+2008-06-27 Albert Graef <Dr....@t-...>
+
* runtime.cc/h: Added pure_current_interp(), variable and constant
definitions, management of temporary definition levels.
Modified: pure/trunk/lib/prelude.pure
===================================================================
--- pure/trunk/lib/prelude.pure 2008-06-27 20:05:31 UTC (rev 324)
+++ pure/trunk/lib/prelude.pure 2008-06-27 22:53:51 UTC (rev 325)
@@ -186,23 +186,11 @@
end;
/* Slicing. xs!!ns returns the list of xs!n for all members n of the index
- list ns which are in the range 0..#xs-1. This works on any data structure
- with zero-based indices and a contiguous index range. This includes, in
- particular, the list and tuple structures defined above. Note that this
- definition requires that the indices be machine ints, otherwise the
- operation will fail. Also, you'll get a 'bad_list_value' exception if we
- can't determine the size of xs using the # operator. */
+ list ns which are in the range 0..#xs-1. xs must be a (proper) list or
+ tuple, and the indices must be machine ints. */
-xs!![] = [];
-xs!!(n::int:ns) = accum [] (n:ns) with
- accum ys [] = reverse ys;
- accum ys (n::int:ns) = accum (xs!n:ys) ns if n>=0 && n<m;
- = accum ys ns otherwise;
- accum ys (n:ns) = reverse ys+xs!!(n:ns);
- accum ys ns = reverse ys+xs!!ns;
-end when
- m::int = case #xs of m::int = m; _ = throw (bad_list_value xs) end;
-end;
+xs!!ns = [xs!n; n=ns; n>=0 && n<m] when m::int = #xs end
+ if listp xs || tuplep xs;
/* Arithmetic sequences. */
Modified: pure/trunk/test/prelude.log
===================================================================
--- pure/trunk/test/prelude.log 2008-06-27 20:05:31 UTC (rev 324)
+++ pure/trunk/test/prelude.log 2008-06-27 22:53:51 UTC (rev 325)
@@ -591,58 +591,17 @@
state 12: #0 #2
state 13: #1 #2
} end;
-xs/*0:01*/!![] = [];
-xs/*0:01*/!!(n/*0:101*/::int:ns/*0:11*/) = accum/*0*/ [] (n/*1:101*/:ns/*1:11*/) with accum ys/*0:01*/ [] = reverse ys/*0:01*/; accum ys/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = accum/*1*/ (xs/*2:01*/!n/*0:101*/:ys/*0:01*/) ns/*0:11*/ if n/*0:101*/>=0&&n/*0:101*/<m/*1:*/; accum ys/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = accum/*1*/ ys/*0:01*/ ns/*0:11*/; accum ys/*0:01*/ (n/*0:101*/:ns/*0:11*/) = reverse ys/*0:01*/+xs/*2:01*/!!(n/*0:101*/:ns/*0:11*/); accum ys/*0:01*/ ns/*0:1*/ = reverse ys/*0:01*/+xs/*2:01*/!!ns/*0:1*/ {
- rule #0: accum ys [] = reverse ys
- rule #1: accum ys (n::int:ns) = accum (xs!n:ys) ns if n>=0&&n<m
- rule #2: accum ys (n::int:ns) = accum ys ns
- rule #3: accum ys (n:ns) = reverse ys+xs!!(n:ns)
- rule #4: accum ys ns = reverse ys+xs!!ns
- state 0: #0 #1 #2 #3 #4
+xs/*0:01*/!!ns/*0:1*/ = catmap (\n/*0:*/ -> if n/*0:*/>=0&&n/*0:*/<m/*1:*/ then [xs/*2:01*/!n/*0:*/] else [] {
+ rule #0: n = if n>=0&&n<m then [xs!n] else []
+ state 0: #0
<var> state 1
- state 1: #0 #1 #2 #3 #4
- <var> state 2
- [] state 3
- <app> state 4
- state 2: #4
- state 3: #0 #4
- state 4: #1 #2 #3 #4
- <var> state 5
- <app> state 7
- state 5: #4
- <var> state 6
- state 6: #4
- state 7: #1 #2 #3 #4
- <var> state 8
- : state 11
- state 8: #4
- <var> state 9
- state 9: #4
- <var> state 10
- state 10: #4
- state 11: #1 #2 #3 #4
- <var> state 12
- <var>::int state 14
- state 12: #3 #4
- <var> state 13
- state 13: #3 #4
- state 14: #1 #2 #3 #4
- <var> state 15
- state 15: #1 #2 #3 #4
-} end when m/*0:*/::int = case #xs/*0:01*/ of m/*0:*/::int = m/*0:*/; _/*0:*/ = throw (bad_list_value xs/*1:01*/) {
- rule #0: m::int = m
- rule #1: _ = throw (bad_list_value xs)
- state 0: #0 #1
- <var> state 1
- <var>::int state 2
- state 1: #1
- state 2: #0 #1
-} end {
- rule #0: m::int = case #xs of m::int = m; _ = throw (bad_list_value xs) end
+ state 1: #0
+}) ns/*1:1*/ when m/*0:*/::int = #xs/*0:01*/ {
+ rule #0: m::int = #xs
state 0: #0
<var>::int state 1
state 1: #0
-} end;
+} end if listp xs/*0:01*/||tuplep xs/*0:01*/;
n1/*0:0101*/,n2/*0:011*/..m/*0:1*/ = while (\i/*0:*/ -> s/*1:*/*i/*0:*/<=s/*1:*/*m/*3:1*/ {
rule #0: i = s*i<=s*m
state 0: #0
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-27 20:05:22
|
Revision: 324
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=324&view=rev
Author: agraef
Date: 2008-06-27 13:05:31 -0700 (Fri, 27 Jun 2008)
Log Message:
-----------
Bugfixes in slicing operation.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/prelude.pure
pure/trunk/test/prelude.log
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-06-27 19:20:13 UTC (rev 323)
+++ pure/trunk/ChangeLog 2008-06-27 20:05:31 UTC (rev 324)
@@ -2,7 +2,9 @@
* lib/prelude.pure: Using xs!ns for slicing conflicts with more
general indexing of containers with arbitrary keys. Use !! for
- slicing instead. Reported by Jiri Spitz.
+ slicing instead, as suggested by Jiri Spitz. Also make slicing
+ fail if indices aren't machine ints, and throw a bad_list_value
+ exception if computing the size of the container fails.
* runtime.cc/h: Added pure_current_interp(), variable and constant
definitions, management of temporary definition levels.
Modified: pure/trunk/lib/prelude.pure
===================================================================
--- pure/trunk/lib/prelude.pure 2008-06-27 19:20:13 UTC (rev 323)
+++ pure/trunk/lib/prelude.pure 2008-06-27 20:05:31 UTC (rev 324)
@@ -187,18 +187,22 @@
/* Slicing. xs!!ns returns the list of xs!n for all members n of the index
list ns which are in the range 0..#xs-1. This works on any data structure
- with zero-based indices and thus, in particular, on the list and tuple
- structures defined above. */
+ with zero-based indices and a contiguous index range. This includes, in
+ particular, the list and tuple structures defined above. Note that this
+ definition requires that the indices be machine ints, otherwise the
+ operation will fail. Also, you'll get a 'bad_list_value' exception if we
+ can't determine the size of xs using the # operator. */
xs!![] = [];
-xs!!(n:ns) = accum [] (n:ns) with
+xs!!(n::int:ns) = accum [] (n:ns) with
accum ys [] = reverse ys;
accum ys (n::int:ns) = accum (xs!n:ys) ns if n>=0 && n<m;
= accum ys ns otherwise;
- accum ys (n:ns) = accum (xs!n:ys) ns if n>=0 && n<m;
- = accum ys ns otherwise;
+ accum ys (n:ns) = reverse ys+xs!!(n:ns);
accum ys ns = reverse ys+xs!!ns;
-end when m::int = #xs end;
+end when
+ m::int = case #xs of m::int = m; _ = throw (bad_list_value xs) end;
+end;
/* Arithmetic sequences. */
Modified: pure/trunk/test/prelude.log
===================================================================
--- pure/trunk/test/prelude.log 2008-06-27 19:20:13 UTC (rev 323)
+++ pure/trunk/test/prelude.log 2008-06-27 20:05:31 UTC (rev 324)
@@ -592,46 +592,53 @@
state 13: #1 #2
} end;
xs/*0:01*/!![] = [];
-xs/*0:01*/!!(n/*0:101*/:ns/*0:11*/) = accum/*0*/ [] (n/*1:101*/:ns/*1:11*/) with accum ys/*0:01*/ [] = reverse ys/*0:01*/; accum ys/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = accum/*1*/ (xs/*2:01*/!n/*0:101*/:ys/*0:01*/) ns/*0:11*/ if n/*0:101*/>=0&&n/*0:101*/<m/*1:*/; accum ys/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = accum/*1*/ ys/*0:01*/ ns/*0:11*/; accum ys/*0:01*/ (n/*0:101*/:ns/*0:11*/) = accum/*1*/ (xs/*2:01*/!n/*0:101*/:ys/*0:01*/) ns/*0:11*/ if n/*0:101*/>=0&&n/*0:101*/<m/*1:*/; accum ys/*0:01*/ (n/*0:101*/:ns/*0:11*/) = accum/*1*/ ys/*0:01*/ ns/*0:11*/; accum ys/*0:01*/ ns/*0:1*/ = reverse ys/*0:01*/+xs/*2:01*/!!ns/*0:1*/ {
+xs/*0:01*/!!(n/*0:101*/::int:ns/*0:11*/) = accum/*0*/ [] (n/*1:101*/:ns/*1:11*/) with accum ys/*0:01*/ [] = reverse ys/*0:01*/; accum ys/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = accum/*1*/ (xs/*2:01*/!n/*0:101*/:ys/*0:01*/) ns/*0:11*/ if n/*0:101*/>=0&&n/*0:101*/<m/*1:*/; accum ys/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = accum/*1*/ ys/*0:01*/ ns/*0:11*/; accum ys/*0:01*/ (n/*0:101*/:ns/*0:11*/) = reverse ys/*0:01*/+xs/*2:01*/!!(n/*0:101*/:ns/*0:11*/); accum ys/*0:01*/ ns/*0:1*/ = reverse ys/*0:01*/+xs/*2:01*/!!ns/*0:1*/ {
rule #0: accum ys [] = reverse ys
rule #1: accum ys (n::int:ns) = accum (xs!n:ys) ns if n>=0&&n<m
rule #2: accum ys (n::int:ns) = accum ys ns
- rule #3: accum ys (n:ns) = accum (xs!n:ys) ns if n>=0&&n<m
- rule #4: accum ys (n:ns) = accum ys ns
- rule #5: accum ys ns = reverse ys+xs!!ns
- state 0: #0 #1 #2 #3 #4 #5
+ rule #3: accum ys (n:ns) = reverse ys+xs!!(n:ns)
+ rule #4: accum ys ns = reverse ys+xs!!ns
+ state 0: #0 #1 #2 #3 #4
<var> state 1
- state 1: #0 #1 #2 #3 #4 #5
+ state 1: #0 #1 #2 #3 #4
<var> state 2
[] state 3
<app> state 4
- state 2: #5
- state 3: #0 #5
- state 4: #1 #2 #3 #4 #5
+ state 2: #4
+ state 3: #0 #4
+ state 4: #1 #2 #3 #4
<var> state 5
<app> state 7
- state 5: #5
+ state 5: #4
<var> state 6
- state 6: #5
- state 7: #1 #2 #3 #4 #5
+ state 6: #4
+ state 7: #1 #2 #3 #4
<var> state 8
: state 11
- state 8: #5
+ state 8: #4
<var> state 9
- state 9: #5
+ state 9: #4
<var> state 10
- state 10: #5
- state 11: #1 #2 #3 #4 #5
+ state 10: #4
+ state 11: #1 #2 #3 #4
<var> state 12
<var>::int state 14
- state 12: #3 #4 #5
+ state 12: #3 #4
<var> state 13
- state 13: #3 #4 #5
- state 14: #1 #2 #3 #4 #5
+ state 13: #3 #4
+ state 14: #1 #2 #3 #4
<var> state 15
- state 15: #1 #2 #3 #4 #5
-} end when m/*0:*/::int = #xs/*0:01*/ {
- rule #0: m::int = #xs
+ state 15: #1 #2 #3 #4
+} end when m/*0:*/::int = case #xs/*0:01*/ of m/*0:*/::int = m/*0:*/; _/*0:*/ = throw (bad_list_value xs/*1:01*/) {
+ rule #0: m::int = m
+ rule #1: _ = throw (bad_list_value xs)
+ state 0: #0 #1
+ <var> state 1
+ <var>::int state 2
+ state 1: #1
+ state 2: #0 #1
+} end {
+ rule #0: m::int = case #xs of m::int = m; _ = throw (bad_list_value xs) end
state 0: #0
<var>::int state 1
state 1: #0
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-27 19:20:04
|
Revision: 323
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=323&view=rev
Author: agraef
Date: 2008-06-27 12:20:13 -0700 (Fri, 27 Jun 2008)
Log Message:
-----------
Rename the slicing operator to 'svn diff'.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/prelude.pure
pure/trunk/test/prelude.log
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-06-27 18:44:55 UTC (rev 322)
+++ pure/trunk/ChangeLog 2008-06-27 19:20:13 UTC (rev 323)
@@ -1,5 +1,9 @@
2008-06-27 Albert Graef <Dr....@t-...>
+ * lib/prelude.pure: Using xs!ns for slicing conflicts with more
+ general indexing of containers with arbitrary keys. Use !! for
+ slicing instead. Reported by Jiri Spitz.
+
* runtime.cc/h: Added pure_current_interp(), variable and constant
definitions, management of temporary definition levels.
Modified: pure/trunk/lib/prelude.pure
===================================================================
--- pure/trunk/lib/prelude.pure 2008-06-27 18:44:55 UTC (rev 322)
+++ pure/trunk/lib/prelude.pure 2008-06-27 19:20:13 UTC (rev 323)
@@ -59,7 +59,7 @@
prefix 7 ~ ; // bitwise not
infixr 8 ^ ; // exponentiation
prefix 8 # ; // size operator
-infixl 9 ! ; // indexing
+infixl 9 ! !! ; // indexing, slicing
infixr 9 . ; // function composition
/* Pull in the primitives (arithmetic etc.) and the standard string functions.
@@ -185,19 +185,19 @@
accum ys xs = ys,xs;
end;
-/* Slicing. xs!ns returns the list of xs!n for all members n of the index list
- ns which are in the range 0..#xs-1. This works on any data structure with
- zero-based indices and thus, in particular, on the list and tuple
+/* Slicing. xs!!ns returns the list of xs!n for all members n of the index
+ list ns which are in the range 0..#xs-1. This works on any data structure
+ with zero-based indices and thus, in particular, on the list and tuple
structures defined above. */
-xs![] = [];
-xs!(n:ns) = accum [] (n:ns) with
+xs!![] = [];
+xs!!(n:ns) = accum [] (n:ns) with
accum ys [] = reverse ys;
accum ys (n::int:ns) = accum (xs!n:ys) ns if n>=0 && n<m;
= accum ys ns otherwise;
accum ys (n:ns) = accum (xs!n:ys) ns if n>=0 && n<m;
= accum ys ns otherwise;
- accum ys ns = reverse ys+xs!ns;
+ accum ys ns = reverse ys+xs!!ns;
end when m::int = #xs end;
/* Arithmetic sequences. */
Modified: pure/trunk/test/prelude.log
===================================================================
--- pure/trunk/test/prelude.log 2008-06-27 18:44:55 UTC (rev 322)
+++ pure/trunk/test/prelude.log 2008-06-27 19:20:13 UTC (rev 323)
@@ -591,14 +591,14 @@
state 12: #0 #2
state 13: #1 #2
} end;
-xs/*0:01*/![] = [];
-xs/*0:01*/!(n/*0:101*/:ns/*0:11*/) = accum/*0*/ [] (n/*1:101*/:ns/*1:11*/) with accum ys/*0:01*/ [] = reverse ys/*0:01*/; accum ys/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = accum/*1*/ (xs/*2:01*/!n/*0:101*/:ys/*0:01*/) ns/*0:11*/ if n/*0:101*/>=0&&n/*0:101*/<m/*1:*/; accum ys/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = accum/*1*/ ys/*0:01*/ ns/*0:11*/; accum ys/*0:01*/ (n/*0:101*/:ns/*0:11*/) = accum/*1*/ (xs/*2:01*/!n/*0:101*/:ys/*0:01*/) ns/*0:11*/ if n/*0:101*/>=0&&n/*0:101*/<m/*1:*/; accum ys/*0:01*/ (n/*0:101*/:ns/*0:11*/) = accum/*1*/ ys/*0:01*/ ns/*0:11*/; accum ys/*0:01*/ ns/*0:1*/ = reverse ys/*0:01*/+xs/*2:01*/!ns/*0:1*/ {
+xs/*0:01*/!![] = [];
+xs/*0:01*/!!(n/*0:101*/:ns/*0:11*/) = accum/*0*/ [] (n/*1:101*/:ns/*1:11*/) with accum ys/*0:01*/ [] = reverse ys/*0:01*/; accum ys/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = accum/*1*/ (xs/*2:01*/!n/*0:101*/:ys/*0:01*/) ns/*0:11*/ if n/*0:101*/>=0&&n/*0:101*/<m/*1:*/; accum ys/*0:01*/ (n/*0:101*/::int:ns/*0:11*/) = accum/*1*/ ys/*0:01*/ ns/*0:11*/; accum ys/*0:01*/ (n/*0:101*/:ns/*0:11*/) = accum/*1*/ (xs/*2:01*/!n/*0:101*/:ys/*0:01*/) ns/*0:11*/ if n/*0:101*/>=0&&n/*0:101*/<m/*1:*/; accum ys/*0:01*/ (n/*0:101*/:ns/*0:11*/) = accum/*1*/ ys/*0:01*/ ns/*0:11*/; accum ys/*0:01*/ ns/*0:1*/ = reverse ys/*0:01*/+xs/*2:01*/!!ns/*0:1*/ {
rule #0: accum ys [] = reverse ys
rule #1: accum ys (n::int:ns) = accum (xs!n:ys) ns if n>=0&&n<m
rule #2: accum ys (n::int:ns) = accum ys ns
rule #3: accum ys (n:ns) = accum (xs!n:ys) ns if n>=0&&n<m
rule #4: accum ys (n:ns) = accum ys ns
- rule #5: accum ys ns = reverse ys+xs!ns
+ rule #5: accum ys ns = reverse ys+xs!!ns
state 0: #0 #1 #2 #3 #4 #5
<var> state 1
state 1: #0 #1 #2 #3 #4 #5
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-27 18:44:56
|
Revision: 322
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=322&view=rev
Author: agraef
Date: 2008-06-27 11:44:55 -0700 (Fri, 27 Jun 2008)
Log Message:
-----------
Comment change.
Modified Paths:
--------------
pure/trunk/examples/sort.c
Modified: pure/trunk/examples/sort.c
===================================================================
--- pure/trunk/examples/sort.c 2008-06-27 10:28:24 UTC (rev 321)
+++ pure/trunk/examples/sort.c 2008-06-27 18:44:55 UTC (rev 322)
@@ -10,11 +10,12 @@
called from Pure which in turn calls other Pure functions, and takes
generic pure_expr* values as arguments and returns them as results. */
-/* To compile (Linux): 'gcc -shared -o sort.so sort.c -lpure'. This will
- create a dynamic library ready to be loaded by the Pure interpreter.
- (Replace .so with .dylib or .dll on OSX and Windows, respectively. On OSX,
- you also have to replace -shared with -dynamiclib. On Windows you might
- wish to add the '-Wl,--enable-auto-import' linker option.)
+/* To compile (Linux): 'gcc -shared -o sort.so sort.c -lpure' (add -fPIC on 64
+ bit systems). This will create a dynamic library ready to be loaded by the
+ Pure interpreter. (On OSX and Windows, replace .so with .dylib or .dll,
+ respectively. On OSX, you also have to replace -shared with -dynamiclib.
+ On Windows you might wish to add the '-Wl,--enable-auto-import' linker
+ option.)
I suggest that you also set up your LD_LIBRARY_PATH environment variable
(DYLD_LIBRARY_PATH on OSX) so that the dynamic loader finds sort.so without
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-27 10:28:16
|
Revision: 321
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=321&view=rev
Author: agraef
Date: 2008-06-27 03:28:24 -0700 (Fri, 27 Jun 2008)
Log Message:
-----------
Add some more stuff to the public runtime API.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/runtime.cc
pure/trunk/runtime.h
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-06-27 09:24:38 UTC (rev 320)
+++ pure/trunk/ChangeLog 2008-06-27 10:28:24 UTC (rev 321)
@@ -1,5 +1,8 @@
2008-06-27 Albert Graef <Dr....@t-...>
+ * runtime.cc/h: Added pure_current_interp(), variable and constant
+ definitions, management of temporary definition levels.
+
* pure.cc, interpreter.cc, lexer.ll: Fix up completion support,
second attempt (constructor symbols without any rules were
still missing).
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-06-27 09:24:38 UTC (rev 320)
+++ pure/trunk/runtime.cc 2008-06-27 10:28:24 UTC (rev 321)
@@ -801,6 +801,63 @@
pure_unref_internal(x);
}
+extern "C"
+bool pure_let(int32_t sym, pure_expr *x)
+{
+ if (sym <= 0 || !x) return false;
+ try {
+ interpreter& interp = *interpreter::g_interp;
+ interp.defn(sym, x);
+ return true;
+ } catch (err &e) {
+ return false;
+ }
+}
+
+extern "C"
+bool pure_def(int32_t sym, pure_expr *x)
+{
+ if (sym <= 0 || !x) return false;
+ try {
+ interpreter& interp = *interpreter::g_interp;
+ interp.const_defn(sym, x);
+ return true;
+ } catch (err &e) {
+ return false;
+ }
+}
+
+extern "C"
+bool pure_clear(int32_t sym)
+{
+ if (sym > 0) {
+ interpreter& interp = *interpreter::g_interp;
+ interp.clear();
+ return true;
+ } else
+ return false;
+}
+
+extern "C"
+uint8_t pure_save()
+{
+ interpreter& interp = *interpreter::g_interp;
+ if (interp.temp < 0xff)
+ return ++interp.temp;
+ else
+ return 0;
+}
+
+extern "C"
+uint8_t pure_restore()
+{
+ interpreter& interp = *interpreter::g_interp;
+ uint8_t level = interp.temp;
+ interp.clear();
+ if (level > 0 && interp.temp > level-1) --interp.temp;
+ return interp.temp;
+}
+
#ifndef HOST
#define HOST "unknown"
#endif
@@ -939,6 +996,12 @@
interpreter::g_interp = (interpreter*)interp;
}
+extern "C"
+pure_interp *pure_current_interp()
+{
+ return (pure_interp*)interpreter::g_interp;
+}
+
/* END OF PUBLIC API. *******************************************************/
extern "C"
Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h 2008-06-27 09:24:38 UTC (rev 320)
+++ pure/trunk/runtime.h 2008-06-27 10:28:24 UTC (rev 321)
@@ -141,18 +141,14 @@
corresponding values. Parameter pointers may be NULL in which case they are
not set.
- Notes:
+ NOTES: pure_is_mpz takes a pointer to an uninitialized mpz_t and
+ initializes it with a copy of the Pure bigint. pure_is_symbol will return
+ true not only for (constant and unbound variable) symbols, but also for
+ arbitrary closures including local and anonymous functions. In the case of
+ an anonymous closure, the returned symbol will be 0. You can check whether
+ an expression actually represents a named or anonymous closure using the
+ funp and lambdap predicates from the library API (see below). */
- - pure_is_mpz takes a pointer to an uninitialized mpz_t and initializes it
- with a copy of the Pure bigint.
-
- - pure_is_symbol will return true not only for (constant and unbound
- variable) symbols, but also for arbitrary closures including local and
- anonymous functions. In the case of an anonymous closure, the returned
- symbol will be 0. You can check whether an expression actually represents
- a named or anonymous closure using the funp and lambdap predicates from
- the library API (see below). */
-
bool pure_is_symbol(const pure_expr *x, int32_t *sym);
bool pure_is_int(const pure_expr *x, int32_t *i);
bool pure_is_mpz(const pure_expr *x, mpz_t *z);
@@ -221,20 +217,54 @@
void pure_ref(pure_expr *x);
void pure_unref(pure_expr *x);
+/* Variable and constant definitions. These allow you to directly bind
+ variable and constant symbols to pure_expr* values, as the 'let' and 'def'
+ constructs do in the Pure language. The functions return true if
+ successful, false otherwise. */
+
+bool pure_let(int32_t sym, pure_expr *x);
+bool pure_def(int32_t sym, pure_expr *x);
+
+/* Purge the definition of a global (constant, variable or function) symbol. */
+
+bool pure_clear(int32_t sym);
+
+/* Manage temporary definition levels (see the Pure manual for details).
+ pure_save starts a new level, pure_restore returns to the previous level,
+ removing all definitions of the current level. In either case the new level
+ is returned. A zero return value of pure_save indicates an error condition,
+ most likely because the maximum number of levels was exceeded.
+
+ Note that the command line version of the interpreter starts at temporary
+ level 1, while the standalone interpreters created with the public API (see
+ below) start at level 0. Hence in the latter case you first need to invoke
+ pure_save before you can define temporaries. */
+
+uint8_t pure_save();
+uint8_t pure_restore();
+
/* The following routines provide standalone C/C++ applications with fully
initialized interpreter instances which can be used together with the
operations listed above. This is only needed for modules which are not to
- be loaded by the command line version of the interpreter.
+ be loaded by the command line version of the interpreter. */
- The argc, argv parameters passed to pure_create_interp specify the command
- line arguments of the interpreter instance. This includes any scripts that
- are to be loaded on startup as well as any other options understood by the
- command line version of the interpreter (options like -i and -q won't have
- any effect, though, and the interpreter will always be in non-interactive
- mode). The argv vector must be NULL-terminated, and argv[0] should be set
- to the name of the hosting application (usually the main program of the
- application).
+/* The pure_interp type serves as a C proxy for Pure interpreters. Pointers
+ to these are used as C handles for the real Pure interpreter objects (which
+ are actually implemented by a C++ class). If your application needs more
+ elaborate control over interpreters as provided by this API, pure_interp*
+ can be cast to interpreter* (cf. interpreter.hh in the Pure sources). */
+typedef struct _pure_interp pure_interp;
+
+/* Manage interpreter instances. The argc, argv parameters passed to
+ pure_create_interp specify the command line arguments of the interpreter
+ instance. This includes any scripts that are to be loaded on startup as
+ well as any other options understood by the command line version of the
+ interpreter. (Options like -i and -q won't have any effect, though, and the
+ interpreter will always be in non-interactive mode.) The argv vector must
+ be NULL-terminated, and argv[0] should be set to the name of the hosting
+ application (usually the main program of the application).
+
An application may use multiple interpreter instances, but only a single
instance can be active at any one time. By default, the first created
instance will be active, but you can switch between different instances
@@ -242,7 +272,10 @@
destroys an interpreter instance; if the destroyed instance is currently
active, the active instance will be undefined afterwards, so you'll have to
either create or switch to another instance before calling any other
- operations.
+ operations. The pure_current_interp returns the currently active
+ instance. If the application is hosted by the command line interpreter,
+ this will return a handle to the command line interpreter if it is invoked
+ before switching to any other interpreter instance.
Note that when using different interpreter instances in concert, it is
*not* possible to pass pure_expr* values created with one interpreter
@@ -250,11 +283,10 @@
the library API (see below) to first unparse the expression in the source
interpreter and then reparse it in the target interpreter. */
-typedef struct _pure_interp pure_interp; // Pure interpreter handles (opaque).
-
pure_interp *pure_create_interp(int argc, char *argv[]);
void pure_delete_interp(pure_interp *interp);
void pure_switch_interp(pure_interp *interp);
+pure_interp *pure_current_interp();
/* END OF PUBLIC API. *******************************************************/
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-27 09:24:35
|
Revision: 320
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=320&view=rev
Author: agraef
Date: 2008-06-27 02:24:38 -0700 (Fri, 27 Jun 2008)
Log Message:
-----------
Some refactoring in the interpreter interface.
Modified Paths:
--------------
pure/trunk/interpreter.hh
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-06-27 00:27:54 UTC (rev 319)
+++ pure/trunk/interpreter.hh 2008-06-27 09:24:38 UTC (rev 320)
@@ -334,13 +334,19 @@
the left-hand side pattern as usual. Unlike variables, existing constant
symbols cannot be redefined, so they have to be cleared before you can
give them new values. */
-
pure_expr *const_defn(expr pat, expr x);
pure_expr *const_defn(expr pat, expr x, pure_expr*& e);
+
+ /* Directly bind a given constant symbol to a given value. */
void const_defn(int32_t tag, pure_expr *x);
void const_defn(const char *varname, pure_expr *x)
{ const_defn(symtab.sym(varname).f, x); }
+ /* Purge the definition of a (global constant, variable or function)
+ symbol. If the given symbol is zero, pops the most most recent temporary
+ definitions level, removing all definitions in that level. */
+ void clear(int32_t tag = 0);
+
/* Process pending compilations of function definitions. This is also done
automatically when eval() or defn()/const_defn() is invoked. */
void compile();
@@ -369,7 +375,6 @@
void define(rule *r);
void define_const(rule *r);
void exec(expr *x);
- void clear(int32_t f = 0);
void clearsym(int32_t f);
rulel *default_lhs(exprl &l, rulel *rl);
void add_rules(rulel &rl, rulel *r, bool b);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-27 00:27:46
|
Revision: 319
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=319&view=rev
Author: agraef
Date: 2008-06-26 17:27:54 -0700 (Thu, 26 Jun 2008)
Log Message:
-----------
Bugfix in new completion functions.
Modified Paths:
--------------
pure/trunk/lexer.ll
pure/trunk/pure.cc
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-06-27 00:24:41 UTC (rev 318)
+++ pure/trunk/lexer.ll 2008-06-27 00:27:54 UTC (rev 319)
@@ -171,7 +171,8 @@
while (it != end) {
int32_t f = it->second.f;
/* Skip non-toplevel symbols. */
- if (interp.globalvars.find(f) == interp.globalvars.end() &&
+ if (interp.globenv.find(f) == interp.globenv.end() &&
+ interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
it++;
continue;
Modified: pure/trunk/pure.cc
===================================================================
--- pure/trunk/pure.cc 2008-06-27 00:24:41 UTC (rev 318)
+++ pure/trunk/pure.cc 2008-06-27 00:27:54 UTC (rev 319)
@@ -89,7 +89,8 @@
while (it != end) {
int32_t f = it->second.f;
/* Skip non-toplevel symbols. */
- if (interp.globalvars.find(f) == interp.globalvars.end() &&
+ if (interp.globenv.find(f) == interp.globenv.end() &&
+ interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
it++;
continue;
@@ -127,7 +128,8 @@
while (it != end) {
int32_t f = it->second.f;
/* Skip non-toplevel symbols. */
- if (interp.globalvars.find(f) == interp.globalvars.end() &&
+ if (interp.globenv.find(f) == interp.globenv.end() &&
+ interp.globalvars.find(f) == interp.globalvars.end() &&
interp.externals.find(f) == interp.externals.end()) {
it++;
continue;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-27 00:24:33
|
Revision: 318
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=318&view=rev
Author: agraef
Date: 2008-06-26 17:24:41 -0700 (Thu, 26 Jun 2008)
Log Message:
-----------
Add 'def' example.
Modified Paths:
--------------
pure/trunk/examples/hello.pure
Modified: pure/trunk/examples/hello.pure
===================================================================
--- pure/trunk/examples/hello.pure 2008-06-27 00:11:58 UTC (rev 317)
+++ pure/trunk/examples/hello.pure 2008-06-27 00:24:41 UTC (rev 318)
@@ -47,6 +47,12 @@
// Pattern matching definition with 'let'.
let x, y = square x, square (x+2); x; y;
+// We also have constant definitions using 'def' in lieu of 'let'. These
+// cannot be redefined and are substituted directly into other definitions.
+// Try something like 'foo x = pi*x;' and then 'list foo' to see the
+// difference.
+def pi = 3.14159265358979;
+
/* Variations on a theme: The factorial. This illustrates various different
ways to define a simple recursive function. */
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-06-27 00:11:49
|
Revision: 317
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=317&view=rev
Author: agraef
Date: 2008-06-26 17:11:58 -0700 (Thu, 26 Jun 2008)
Log Message:
-----------
Fix up completion support, second attempt.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
pure/trunk/lexer.ll
pure/trunk/pure.cc
pure/trunk/symtable.hh
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-06-26 23:12:44 UTC (rev 316)
+++ pure/trunk/ChangeLog 2008-06-27 00:11:58 UTC (rev 317)
@@ -1,3 +1,9 @@
+2008-06-27 Albert Graef <Dr....@t-...>
+
+ * pure.cc, interpreter.cc, lexer.ll: Fix up completion support,
+ second attempt (constructor symbols without any rules were
+ still missing).
+
2008-06-26 Albert Graef <Dr....@t-...>
* lexer.ll: Fix up list command to properly deal with the new
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-06-26 23:12:44 UTC (rev 316)
+++ pure/trunk/interpreter.cc 2008-06-27 00:11:58 UTC (rev 317)
@@ -926,8 +926,21 @@
delete ids;
throw err("conflicting fixity declaration for symbol '"+id+"'");
}
- } else
- symtab.sym(*it, prec, fix);
+ } else {
+ int32_t tag = symtab.sym(*it, prec, fix).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);
+ assert(JIT);
+ GlobalVar& v = globalvars[tag];
+ if (!v.v) {
+ v.v = new llvm::GlobalVariable
+ (ExprPtrTy, false, llvm::GlobalVariable::InternalLinkage, 0,
+ mkvarlabel(tag), module);
+ JIT->addGlobalMapping(v.v, &v.x);
+ }
+ if (v.x) pure_free(v.x); v.x = pure_new(cv);
+ }
}
delete ids;
}
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-06-26 23:12:44 UTC (rev 316)
+++ pure/trunk/lexer.ll 2008-06-27 00:11:58 UTC (rev 317)
@@ -136,12 +136,13 @@
"run", "save", "stats", "underride", "using", 0
};
+typedef map<string, symbol> symbol_map;
+
static char *
command_generator(const char *text, int state)
{
static int list_index, len;
- static env::iterator it, end;
- static extmap::iterator xit, xend;
+ static symbol_map::iterator it, end;
const char *name;
assert(interpreter::g_interp);
interpreter& interp = *interpreter::g_interp;
@@ -149,10 +150,11 @@
/* New match. */
if (!state) {
list_index = 0;
- it = interp.globenv.begin();
- end = interp.globenv.end();
- xit = interp.externals.begin();
- xend = interp.externals.end();
+ /* 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();
len = strlen(text);
}
@@ -167,22 +169,19 @@
/* Return the next name which partially matches from the
symbol list. */
while (it != end) {
- assert(it->first > 0);
- symbol& sym = interp.symtab.sym(it->first);
+ int32_t f = it->second.f;
+ /* Skip non-toplevel symbols. */
+ if (interp.globalvars.find(f) == interp.globalvars.end() &&
+ interp.externals.find(f) == interp.externals.end()) {
+ it++;
+ continue;
+ }
+ const string& s = it->first;
it++;
- if (strncmp(sym.s.c_str(), text, len) == 0)
- return strdup(sym.s.c_str());
+ if (strncmp(s.c_str(), text, len) == 0)
+ return strdup(s.c_str());
}
- /* Also process the declared externals which don't have any rules yet. */
- while (xit != xend) {
- assert(xit->first > 0);
- symbol& sym = interp.symtab.sym(xit->first);
- xit++;
- if (strncmp(sym.s.c_str(), text, len) == 0)
- return strdup(sym.s.c_str());
- }
-
/* If no names matched, then return NULL. */
return 0;
}
Modified: pure/trunk/pure.cc
===================================================================
--- pure/trunk/pure.cc 2008-06-26 23:12:44 UTC (rev 316)
+++ pure/trunk/pure.cc 2008-06-27 00:11:58 UTC (rev 317)
@@ -54,14 +54,13 @@
/* Generator functions for command completion. */
-typedef map<int32_t,ExternInfo> extmap;
+typedef map<string, symbol> symbol_map;
static char *
command_generator(const char *text, int state)
{
static int list_index, len;
- static env::iterator it, end;
- static extmap::iterator xit, xend;
+ static symbol_map::iterator it, end;
const char *name;
assert(interpreter::g_interp);
interpreter& interp = *interpreter::g_interp;
@@ -69,10 +68,11 @@
/* New match. */
if (!state) {
list_index = 0;
- it = interp.globenv.begin();
- end = interp.globenv.end();
- xit = interp.externals.begin();
- xend = interp.externals.end();
+ /* 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();
len = strlen(text);
}
@@ -87,22 +87,19 @@
/* Return the next name which partially matches from the
symbol list. */
while (it != end) {
- assert(it->first > 0);
- symbol& sym = interp.symtab.sym(it->first);
+ int32_t f = it->second.f;
+ /* Skip non-toplevel symbols. */
+ if (interp.globalvars.find(f) == interp.globalvars.end() &&
+ interp.externals.find(f) == interp.externals.end()) {
+ it++;
+ continue;
+ }
+ const string& s = it->first;
it++;
- if (strncmp(sym.s.c_str(), text, len) == 0)
- return strdup(sym.s.c_str());
+ if (strncmp(s.c_str(), text, len) == 0)
+ return strdup(s.c_str());
}
- /* Also process the declared externals which don't have any rules yet. */
- while (xit != xend) {
- assert(xit->first > 0);
- symbol& sym = interp.symtab.sym(xit->first);
- xit++;
- if (strncmp(sym.s.c_str(), text, len) == 0)
- return strdup(sym.s.c_str());
- }
-
/* If no names matched, then return NULL. */
return 0;
}
@@ -111,39 +108,36 @@
symbol_generator(const char *text, int state)
{
static int len;
- static env::iterator it, end;
- static extmap::iterator xit, xend;
+ static symbol_map::iterator it, end;
assert(interpreter::g_interp);
interpreter& interp = *interpreter::g_interp;
/* New match. */
if (!state) {
- it = interp.globenv.begin();
- end = interp.globenv.end();
- xit = interp.externals.begin();
- xend = interp.externals.end();
+ /* 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();
len = strlen(text);
}
/* Return the next name which partially matches from the
symbol list. */
while (it != end) {
- assert(it->first > 0);
- symbol& sym = interp.symtab.sym(it->first);
+ int32_t f = it->second.f;
+ /* Skip non-toplevel symbols. */
+ if (interp.globalvars.find(f) == interp.globalvars.end() &&
+ interp.externals.find(f) == interp.externals.end()) {
+ it++;
+ continue;
+ }
+ const string& s = it->first;
it++;
- if (strncmp(sym.s.c_str(), text, len) == 0)
- return strdup(sym.s.c_str());
+ if (strncmp(s.c_str(), text, len) == 0)
+ return strdup(s.c_str());
}
- /* Also process the declared externals which don't have any rules yet. */
- while (xit != xend) {
- assert(xit->first > 0);
- symbol& sym = interp.symtab.sym(xit->first);
- xit++;
- if (strncmp(sym.s.c_str(), text, len) == 0)
- return strdup(sym.s.c_str());
- }
-
/* If no names matched, then return NULL. */
return 0;
}
Modified: pure/trunk/symtable.hh
===================================================================
--- pure/trunk/symtable.hh 2008-06-26 23:12:44 UTC (rev 316)
+++ pure/trunk/symtable.hh 2008-06-27 00:11:58 UTC (rev 317)
@@ -32,9 +32,9 @@
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)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
