pure-lang-svn Mailing List for Pure (Page 25)
Status: Beta
Brought to you by:
agraef
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-19 00:05:03
|
Revision: 266 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=266&view=rev Author: agraef Date: 2008-06-18 17:05:07 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Fix up version number in example. Modified Paths: -------------- pure/trunk/pure.1.in Modified: pure/trunk/pure.1.in =================================================================== --- pure/trunk/pure.1.in 2008-06-18 23:33:49 UTC (rev 265) +++ pure/trunk/pure.1.in 2008-06-19 00:05:07 UTC (rev 266) @@ -983,7 +983,7 @@ argc var argc = 0; argv var argv = []; sysinfo var sysinfo = "i686-pc-linux-gnu"; -version var version = "0.1"; +version var version = "@version@"; 4 variables .fi .PP This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 23:33:44
|
Revision: 265 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=265&view=rev Author: agraef Date: 2008-06-18 16:33:49 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Final touches for 0.4 release. Modified Paths: -------------- pure/trunk/ChangeLog pure/trunk/NEWS Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-06-18 23:04:34 UTC (rev 264) +++ pure/trunk/ChangeLog 2008-06-18 23:33:49 UTC (rev 265) @@ -1,5 +1,7 @@ 2008-06-19 Albert Graef <Dr....@t-...> + * 0.4 release. + * examples/symbolic.pure: Fix DNF example to accommodate changes in the operator system. Modified: pure/trunk/NEWS =================================================================== --- pure/trunk/NEWS 2008-06-18 23:04:34 UTC (rev 264) +++ pure/trunk/NEWS 2008-06-18 23:33:49 UTC (rev 265) @@ -1,4 +1,25 @@ +** Pure 0.4 2008-06-19 + +This release features some more bug and portability fixes, a cleanup of the +source tree and an overhaul of the build system, see the ChangeLog for +details. Building a separate runtime lib on x86-64 works now (but requires a +patched LLVM, see the INSTALL file for details). Moreover, it is now possible +to install different Pure versions in parallel. + +An Emacs mode for Pure and support for executing Pure scripts using "shebangs" +has been added. Paging of the 'list' command is now implemented using the +program specified with the PURE_MORE environment variable. This allows you to +disable this option (if PURE_MORE is undefined) or choose any pager program +and options that you prefer. Define PURE_MORE=more in your shell startup files +to get back the old behaviour of piping 'list' output through 'more'. + +There's also a new syntax for multiple left-hand sides in function definitions +and 'case' rules, as suggested by Jiri Spitz and discussed on the mailing +list. Please refer to the manual page for details. To accommodate this change, +the bitwise operators '&' and '|' were renamed to 'and' and 'or', +respectively. + ** Pure 0.3 2008-06-06 This release sports a lot of improvements as well as bug and portability This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 23:04:25
|
Revision: 264 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=264&view=rev Author: agraef Date: 2008-06-18 16:04:34 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Updated ChangeLog. Modified Paths: -------------- pure/trunk/ChangeLog Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-06-18 23:00:01 UTC (rev 263) +++ pure/trunk/ChangeLog 2008-06-18 23:04:34 UTC (rev 264) @@ -1,3 +1,11 @@ +2008-06-19 Albert Graef <Dr....@t-...> + + * examples/symbolic.pure: Fix DNF example to accommodate changes + in the operator system. + + * interpreter.cc (declare): Fix segfault in reporting of + conflicting fixity declarations. + 2008-06-18 Albert Graef <Dr....@t-...> * runtime.cc, lib/primitives.pure: Add hash function to compute 32 This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 22:59:55
|
Revision: 263 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=263&view=rev Author: agraef Date: 2008-06-18 16:00:01 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Fix DNF example to accommodate changes in the operator system. Modified Paths: -------------- pure/trunk/examples/symbolic.pure Modified: pure/trunk/examples/symbolic.pure =================================================================== --- pure/trunk/examples/symbolic.pure 2008-06-18 22:53:32 UTC (rev 262) +++ pure/trunk/examples/symbolic.pure 2008-06-18 23:00:01 UTC (rev 263) @@ -27,16 +27,12 @@ /* Disjunctive normal form. */ -// Note that 'not' is already declared in the prelude and is being reused -// here, so make sure that these match up with the prelude. -infixl 2 or; infixl 3 and; prefix 3 not; - // eliminate double negations: -not not a = a; +~~a = a; // push negations inward (de Morgan's laws): -not (a or b) = not a and not b; -not (a and b) = not a or not b; +~(a or b) = ~a and ~b; +~(a and b) = ~a or ~b; // distributivity laws: a and (b or c) = a and b or a and c; @@ -47,4 +43,4 @@ a or (b or c) = (a or b) or c; // Example: -a or not (b or (c and not d)); +a or ~(b or (c and ~d)); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 22:53:24
|
Revision: 262 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=262&view=rev Author: agraef Date: 2008-06-18 15:53:32 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Fix segfault in reporting of conflicting fixity declarations. Modified Paths: -------------- pure/trunk/interpreter.cc Modified: pure/trunk/interpreter.cc =================================================================== --- pure/trunk/interpreter.cc 2008-06-18 20:32:46 UTC (rev 261) +++ pure/trunk/interpreter.cc 2008-06-18 22:53:32 UTC (rev 262) @@ -759,8 +759,9 @@ if (sym) { // crosscheck declarations if (sym->prec != prec || sym->fix != fix) { + string id = *it; delete ids; - throw err("conflicting fixity declaration for symbol '"+*it+"'"); + throw err("conflicting fixity declaration for symbol '"+id+"'"); } } else symtab.sym(*it, prec, fix); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 20:32:37
|
Revision: 261 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=261&view=rev Author: agraef Date: 2008-06-18 13:32:46 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Fix 64 bit version. Modified Paths: -------------- pure/trunk/runtime.cc Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-06-18 16:39:50 UTC (rev 260) +++ pure/trunk/runtime.cc 2008-06-18 20:32:46 UTC (rev 261) @@ -1533,7 +1533,7 @@ return string_hash(x->data.s); case EXPR::PTR: #if SIZEOF_VOID_P==8 - return ((uint32_t)(uint64_t)x->data.p) ^ ((uint32_t)(((uint64_t)p)>>32)); + return ((uint32_t)(uint64_t)x->data.p) ^ ((uint32_t)(((uint64_t)x->data.p)>>32)); #else return (uint32_t)x->data.p; #endif This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 16:39:47
|
Revision: 260 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=260&view=rev Author: agraef Date: 2008-06-18 09:39:50 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Updated ChangeLog. Modified Paths: -------------- pure/trunk/ChangeLog Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-06-18 16:38:20 UTC (rev 259) +++ pure/trunk/ChangeLog 2008-06-18 16:39:50 UTC (rev 260) @@ -1,5 +1,8 @@ 2008-06-18 Albert Graef <Dr....@t-...> + * runtime.cc, lib/primitives.pure: Add hash function to compute 32 + bit hash codes of Pure expressions. Suggested by Jiri Spitz. + * parser.yy, lexer.ll, interpreter.hh/cc: Add syntax for multiple left-hand sides in function definitions and 'case' rules, as requested by Jiri Spitz and discussed on the mailing list. See the This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 16:38:11
|
Revision: 259 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=259&view=rev Author: agraef Date: 2008-06-18 09:38:20 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Add hash function to compute 32 bit hash codes of Pure expressions. Modified Paths: -------------- pure/trunk/lib/primitives.pure pure/trunk/runtime.cc pure/trunk/runtime.h Modified: pure/trunk/lib/primitives.pure =================================================================== --- pure/trunk/lib/primitives.pure 2008-06-18 15:44:34 UTC (rev 258) +++ pure/trunk/lib/primitives.pure 2008-06-18 16:38:20 UTC (rev 259) @@ -65,6 +65,10 @@ extern expr* fun(expr*), expr* arg(expr*); +/* Compute a 32 bit hash code of a Pure expression. */ + +extern int hash(expr*); + /* Conversions between the different numeric and pointer types. */ extern expr* pure_intval(expr*), expr* pure_dblval(expr*), Modified: pure/trunk/runtime.cc =================================================================== --- pure/trunk/runtime.cc 2008-06-18 15:44:34 UTC (rev 258) +++ pure/trunk/runtime.cc 2008-06-18 16:38:20 UTC (rev 259) @@ -1474,7 +1474,83 @@ return res; } +static uint32_t mpz_hash(const mpz_t z) +{ + uint32_t h = 0; + int i, len = z->_mp_size; + if (len < 0) len = -len; + if (sizeof(mp_limb_t) == 8) { + for (i=0; i<len; i++) { + h ^= (uint32_t)(uint64_t)z->_mp_d[i]; + h ^= (uint32_t)(((uint64_t)z->_mp_d[i])>>32); + } + } else { + for (i=0; i<len; i++) + h ^= z->_mp_d[i]; + } + if (z->_mp_size < 0) + h = -h; + return h; +} + +static uint32_t double_hash(double d) +{ + uint32_t h; + char *c; + size_t i; + c = (char*)&d; + for (h=0, i=0; i<sizeof(double); i++) { + h += c[i] * 971; + } + return h; +} + +static uint32_t string_hash(char *s) +{ + uint32_t h = 0, g; + while (*s) { + h = (h<<4)+*(s++); + if ((g = (h & 0xf0000000))) { + h = h^(g>>24); + h = h^g; + } + } + return h; +} + extern "C" +uint32_t hash(const pure_expr *x) +{ + char test; + switch (x->tag) { + case EXPR::INT: + return (uint32_t)x->data.i; + case EXPR::BIGINT: + return mpz_hash(x->data.z); + case EXPR::DBL: + return double_hash(x->data.d); + case EXPR::STR: + return string_hash(x->data.s); + case EXPR::PTR: +#if SIZEOF_VOID_P==8 + return ((uint32_t)(uint64_t)x->data.p) ^ ((uint32_t)(((uint64_t)p)>>32)); +#else + return (uint32_t)x->data.p; +#endif + case EXPR::APP: { + checkstk(test); + int h; + h = hash(x->data.x[0]); + h = (h<<1) | (h<0 ? 1 : 0); + h ^= hash(x->data.x[1]); + return (uint32_t)h; + } + default: + return (uint32_t)x->tag; + } +} + +extern "C" bool same(const pure_expr *x, const pure_expr *y) { char test; Modified: pure/trunk/runtime.h =================================================================== --- pure/trunk/runtime.h 2008-06-18 15:44:34 UTC (rev 258) +++ pure/trunk/runtime.h 2008-06-18 16:38:20 UTC (rev 259) @@ -280,6 +280,11 @@ pure_expr *str(const pure_expr *x); pure_expr *eval(const char *s); +/* Compute a 32 bit hash code of a Pure expression. This makes it possible to + use arbitary Pure values as keys in a hash table. */ + +uint32_t hash(const pure_expr *x); + /* Check whether two objects are the "same" (syntactically). */ bool same(const pure_expr *x, const pure_expr *y); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 15:44:27
|
Revision: 258 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=258&view=rev Author: agraef Date: 2008-06-18 08:44:34 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Bugfix: Reset last lhs at the beginning and end of each parse. Modified Paths: -------------- pure/trunk/interpreter.cc Modified: pure/trunk/interpreter.cc =================================================================== --- pure/trunk/interpreter.cc 2008-06-18 15:43:29 UTC (rev 257) +++ pure/trunk/interpreter.cc 2008-06-18 15:44:34 UTC (rev 258) @@ -400,7 +400,9 @@ parser.set_debug_level((verbose&verbosity::parser) != 0); // parse if (result) pure_free(result); result = 0; + last.clear(); parser.parse(); + last.clear(); // finalize lex_end(); } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 15:43:20
|
Revision: 257 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=257&view=rev Author: agraef Date: 2008-06-18 08:43:29 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Bugfix: Handle execeptions in default_lhs(). Modified Paths: -------------- pure/trunk/parser.yy Modified: pure/trunk/parser.yy =================================================================== --- pure/trunk/parser.yy 2008-06-18 08:53:21 UTC (rev 256) +++ pure/trunk/parser.yy 2008-06-18 15:43:29 UTC (rev 257) @@ -275,8 +275,9 @@ | LET simple_rule { action(interp.define($2), delete $2); } | rule -{ rulel *rl = interp.default_lhs(interp.last, $1); - action(interp.add_rules(interp.globenv, rl, true), delete rl); } +{ rulel *rl = 0; + action(interp.add_rules(interp.globenv, + (rl = interp.default_lhs(interp.last, $1)), true), if (rl) delete rl); } | fixity /* Lexical tie-in: We need to tell the lexer that we're defining new operator symbols (interp.declare_op = true) instead of searching for existing ones @@ -577,14 +578,20 @@ rulel : rule { $$ = new rule_info; - rulel *rl = interp.default_lhs($$->l, $1); - try { interp.add_rules($$->e, rl); } - catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } + rulel *rl = 0; + try { + rl = interp.default_lhs($$->l, $1); + interp.add_rules($$->e, rl); + } + catch (err &e) { if (rl) delete rl; interp.error(yyloc, e.what()); } } | rulel ';' rule { $$ = $1; - rulel *rl = interp.default_lhs($$->l, $3); - try { interp.add_rules($$->e, rl); } - catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } + rulel *rl = 0; + try { + rl = interp.default_lhs($$->l, $3); + interp.add_rules($$->e, rl); + } + catch (err &e) { if (rl) delete rl; interp.error(yyloc, e.what()); } } ; /* Same for pattern rules (pattern binding in 'case' clauses). */ @@ -597,14 +604,20 @@ pat_rulel : rule { $$ = new pat_rule_info; - rulel *rl = interp.default_lhs($$->l, $1); - try { interp.add_rules($$->rl, rl, true); } - catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } + rulel *rl = 0; + try { + rl = interp.default_lhs($$->l, $1); + interp.add_rules($$->rl, rl, true); + } + catch (err &e) { if (rl) delete rl; interp.error(yyloc, e.what()); } } | pat_rulel ';' rule { $$ = $1; - rulel *rl = interp.default_lhs($$->l, $3); - try { interp.add_rules($$->rl, rl, true); } - catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } + rulel *rl = 0; + try { + rl = interp.default_lhs($$->l, $3); + interp.add_rules($$->rl, rl, true); + } + catch (err &e) { if (rl) delete rl; interp.error(yyloc, e.what()); } } ; /* Same for simple rules (pattern binding in 'when' clauses, no guards). */ This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 08:53:13
|
Revision: 256 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=256&view=rev Author: agraef Date: 2008-06-18 01:53:21 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Update documentation. Modified Paths: -------------- pure/trunk/pure.1.in Modified: pure/trunk/pure.1.in =================================================================== --- pure/trunk/pure.1.in 2008-06-18 08:52:27 UTC (rev 255) +++ pure/trunk/pure.1.in 2008-06-18 08:53:21 UTC (rev 256) @@ -366,6 +366,20 @@ defined functions and constructors and thus there is no magic to figure out whether an equation is meant as a function definition or a pattern binding. .PP +Expressions are parsed according to the following precedence rules: Lambda +binds most weakly, followed by +.BR when , +.B with +and +.BR case , +followed by conditional expressions (\fBif\fP-\fBthen\fP-\fBelse\fP), followed +by the ``simple'' expressions (i.e., all other kinds of expressions involving +operators, function applications, constants, symbols and other primary +expressions). Precedence and associativity of operator symbols are given by +their declarations (in the prelude or the user's program), and function +application binds stronger than all operators. Parentheses can be used to +override default precedences and associativities as usual. +.PP At the toplevel, a Pure program basically consists of rules a.k.a. equations defining functions, variable definitions a.k.a. global ``pattern bindings'', and expressions to be evaluated. @@ -377,41 +391,11 @@ keyword .B otherwise denoting an empty guard which is always true (this is nothing but syntactic -sugar useful to point out the ``default'' case of a definition; the -interpreter just treats -.B otherwise -as a comment, so it can always be omitted). Moreover, the left-hand side can -be omitted if it is the same as for the previous rule. This provides a -convenient means to write out a collection of equations for the same left-hand -side which discriminates over different conditions: +sugar to point out the ``default'' case of a definition; the interpreter just +treats this as a comment). .sp -.nf -\fIlhs\fR = \fIrhs\fB if \fIguard\fR; - = \fIrhs\fB if \fIguard\fR; - ... - = \fIrhs\fB otherwise\fR; -.fi -.sp -Rules are used to define functions at the toplevel and in \fBwith\fP -expressions, as well as inside \fBcase\fP and \fBwhen\fP expressions for the -purpose of performing pattern bindings (however, for obvious reasons the forms -without a left-hand side or including a guard are not permitted in \fBwhen\fP -expressions). When matching against a function call or the subject term in a -\fBcase\fP expression, the rules are always considered in the order in which -they are written, and the first matching rule (whose guard evaluates to a -nonzero value, if applicable) is picked. (Again, the \fBwhen\fP construct is -treated differently, because each rule is actually a separate pattern -binding.) -.sp -In any case, the left-hand side pattern must not contain repeated variables -(i.e., rules must be ``left-linear''), except for the ``anonymous'' variable -`_' which matches an arbitrary value without binding a variable -symbol. Moreover, a left-hand side variable may be followed by one of the -special type tags \fB::int\fP, \fB::bigint\fP, \fB::double\fP, \fB::string\fP, -to indicate that it can only match a constant value of the corresponding -built-in type. (This is useful if you want to write rules matching \fIany\fP -object of one of these types; note that there is no way to write out all -``constructors'' for the built-in types, as there are infinitely many.) +Pure also provides some abbreviations for factoring out common left-hand or +right-hand sides in collections of rules; see below for details. .TP .B Global variable bindings: let\fR \fIlhs\fR = \fIrhs\fR; This binds every variable in the left-hand side pattern to the corresponding @@ -422,24 +406,77 @@ causes the given value to be evaluated (and the result to be printed, when running in interactive mode). .PP -Expressions are parsed according to the following precedence rules: Lambda -binds most weakly, followed by -.BR when , -.B with -and -.BR case , -followed by conditional expressions (\fBif\fP-\fBthen\fP-\fBelse\fP), followed -by the ``simple'' expressions (i.e., all other kinds of expressions involving -operators, function applications, constants, symbols and other primary -expressions). Precedence and associativity of operator symbols are given by -their declarations (in the prelude or the user's program), and function -application binds stronger than all operators. Parentheses can be used to -override default precedences and associativities as usual. +Basically, the same rule syntax is used to define functions at the toplevel +and in \fBwith\fP expressions, as well as inside \fBcase\fP and \fBwhen\fP +expressions for the purpose of performing pattern bindings (however, for +obvious reasons guards are not permitted in \fBwhen\fP expressions). When +matching against a function call or the subject term in a \fBcase\fP +expression, the rules are always considered in the order in which they are +written, and the first matching rule (whose guard evaluates to a nonzero +value, if applicable) is picked. (Again, the \fBwhen\fP construct is treated +differently, because each rule is actually a separate pattern binding.) .PP -For instance, here are two more function definitions showing most of these -elements in action: +In any case, the left-hand side pattern must not contain repeated variables +(i.e., rules must be ``left-linear''), except for the ``anonymous'' variable +`_' which matches an arbitrary value without binding a variable +symbol. Moreover, a left-hand side variable may be followed by one of the +special type tags \fB::int\fP, \fB::bigint\fP, \fB::double\fP, \fB::string\fP, +to indicate that it can only match a constant value of the corresponding +built-in type. (This is useful if you want to write rules matching \fIany\fP +object of one of these types; note that there is no way to write out all +``constructors'' for the built-in types, as there are infinitely many.) +.PP +The left-hand side of a rule can be omitted if it is the same as for the +previous rule. This provides a convenient means to write out a collection of +equations for the same left-hand side which discriminates over different +conditions: .sp .nf +\fIlhs\fR = \fIrhs\fB if \fIguard\fR; + = \fIrhs\fB if \fIguard\fR; + ... + = \fIrhs\fB otherwise\fR; +.fi +.PP +Pure also allows a collection of rules with different left-hand sides but the +same right-hand side(s) to be abbreviated as follows: +.sp +.nf +\fIlhs\fR | + ... +\fIlhs\fR = \fIrhs\fB; +.fi +.PP +This is useful if you need different specializations of the same rule which +use different type tags on the left-hand side variables. For instance: +.sp +.nf +fact n::int | +fact n::double | +fact n = n*fact(n-1) \fBif\fP n>0; + = 1 \fBotherwise\fP; +.fi +.PP +In fact, the left-hand sides don't have to be related at all, so that you can +also write something like: +.sp +.nf +foo x | bar y = x*y; +.fi +.PP +The same works in +.B case +expressions, which is convenient if different cases should be mapped to the +same value, e.g.: +.sp +.nf +\fBcase\fP ans \fBof\fP "y" | "Y" = 1; _ = 0; \fBend\fP; +.fi +.PP +Here are some more definitions showing most of the elements discussed above in +action: +.sp +.nf fact n = n*fact (n-1) \fBif\fP n>0; = 1 \fBotherwise\fP; @@ -454,7 +491,7 @@ facts; fibs; .fi .PP -And here's a little list comprehension example: Erathosthenes' classical prime +This is a little list comprehension example: Erathosthenes' classical prime sieve. .sp .nf @@ -480,11 +517,11 @@ (catmap (\eq -> if q mod p then [q] else []) qs) end; .fi .PP -List comprehensions are also a useful device to organize backtracking -searches. For instance, here's an algorithm for the n queens problem, which -returns the list of all placements of n queens on an n x n board (encoded as -lists of n pairs (i,j) with i = 1..n), so that no two queens hold each other -in check. +We mention in passing that list comprehensions are also a useful device to +organize backtracking searches. For instance, here's an algorithm for the n +queens problem, which returns the list of all placements of n queens on an n x +n board (encoded as lists of n pairs (i,j) with i = 1..n), so that no two +queens hold each other in check. .sp .nf queens n = search n 1 [] \fBwith\fP This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 08:52:19
|
Revision: 255 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=255&view=rev Author: agraef Date: 2008-06-18 01:52:27 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Updated ChangeLog. Modified Paths: -------------- pure/trunk/ChangeLog Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-06-18 07:45:21 UTC (rev 254) +++ pure/trunk/ChangeLog 2008-06-18 08:52:27 UTC (rev 255) @@ -1,3 +1,13 @@ +2008-06-18 Albert Graef <Dr....@t-...> + + * parser.yy, lexer.ll, interpreter.hh/cc: Add syntax for multiple + left-hand sides in function definitions and 'case' rules, as + requested by Jiri Spitz and discussed on the mailing list. See the + manual page for details. + + * symtable.cc, lib/prelude.pure, lib/primitives.pure: Rename the + bitwise operators '&' and '|' to 'and' and 'or'. + 2008-06-16 Albert Graef <Dr....@t-...> * etc/pure.lang: New language definition file for Andre Simon's This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 07:45:14
|
Revision: 254 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=254&view=rev Author: agraef Date: 2008-06-18 00:45:21 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Add syntax for multiple left-hand sides in function definitions and 'case' rules. Modified Paths: -------------- pure/trunk/interpreter.cc pure/trunk/interpreter.hh pure/trunk/lexer.ll pure/trunk/parser.yy Added Paths: ----------- pure/trunk/test/test012.log pure/trunk/test/test012.pure Modified: pure/trunk/interpreter.cc =================================================================== --- pure/trunk/interpreter.cc 2008-06-18 07:25:20 UTC (rev 253) +++ pure/trunk/interpreter.cc 2008-06-18 07:45:21 UTC (rev 254) @@ -768,7 +768,7 @@ void interpreter::exec(expr *x) { - last = expr(); + last.clear(); if (result) pure_free(result); result = 0; pure_expr *e, *res = eval(*x, e); if ((verbose&verbosity::defs) != 0) cout << *x << ";\n"; @@ -793,7 +793,7 @@ void interpreter::define(rule *r) { - last = expr(); + last.clear(); pure_expr *e, *res = defn(r->lhs, r->rhs, e); if ((verbose&verbosity::defs) != 0) cout << "let " << r->lhs << " = " << r->rhs << ";\n"; @@ -873,41 +873,60 @@ } } -void interpreter::add_rule(rulel &rl, rule *r, bool b) +rulel *interpreter::default_lhs(exprl &l, rulel *rl) { - rule r1 = *r; - if (r->lhs.is_null()) { - // empty lhs, repeat the one from the previous rule - rulel::reverse_iterator last = rl.rbegin(); - if (last == rl.rend()) { - delete r; - throw err("error in function definition (missing left-hand side)"); - } else - r1 = rule(last->lhs, r->rhs, r->qual); + assert(!rl->empty()); + rule& r = rl->front(); + if (r.lhs.is_null()) { + // empty lhs, repeat the ones from the previous rule + assert(rl->size() == 1); + if (l.empty()) { + delete rl; + throw err("error in rule (missing left-hand side)"); + } else { + expr rhs = r.rhs, qual = r.qual; + rl->clear(); + for (exprl::iterator i = l.begin(), end = l.end(); i != end; i++) + rl->push_back(rule(*i, rhs, qual)); + } + } else { + l.clear(); + for (rulel::iterator i = rl->begin(), end = rl->end(); i != end; i++) + l.push_back(i->lhs); } + return rl; +} + +void interpreter::add_rules(rulel &rl, rulel *r, bool b) +{ + for (rulel::iterator ri = r->begin(), end = r->end(); ri != end; ri++) + add_rule(rl, *ri, b); delete r; - closure(r1, b); - rl.push_back(r1); } -void interpreter::add_rule(env &e, expr &l, rule *r, bool toplevel) +void interpreter::add_rules(env &e, rulel *r, bool toplevel) { - rule r1 = *r; - if (r->lhs.is_null()) { - // empty lhs, repeat the one from the previous rule - if (l.is_null()) { - delete r; - throw err("error in function definition (missing left-hand side)"); - } else - r1 = rule(l, r->rhs, r->qual); - } + for (rulel::iterator ri = r->begin(), end = r->end(); ri != end; ri++) + add_rule(e, *ri, toplevel); delete r; - closure(r1, false); +} + +void interpreter::add_rule(rulel &rl, rule &r, bool b) +{ + assert(!r.lhs.is_null()); + closure(r, b); + rl.push_back(r); +} + +void interpreter::add_rule(env &e, rule &r, bool toplevel) +{ + assert(!r.lhs.is_null()); + closure(r, false); if (toplevel) { - compile(r1.rhs); - compile(r1.qual); + compile(r.rhs); + compile(r.qual); } - int32_t f; uint32_t argc = count_args(r1.lhs, f); + int32_t f; uint32_t argc = count_args(r.lhs, f); if (f <= 0) throw err("error in function definition (invalid head symbol)"); env::iterator it = e.find(f); @@ -936,27 +955,25 @@ info = env_info(argc, rulel(), toplevel?temp:0); assert(info.argc == argc); if (toplevel) { - r1.temp = temp; + r.temp = temp; if (override) { rulel::iterator p = info.rules->begin(); for (; p != info.rules->end() && p->temp >= temp; p++) ; - info.rules->insert(p, r1); + info.rules->insert(p, r); } else - info.rules->push_back(r1); + info.rules->push_back(r); } else { - r1.temp = 0; - info.rules->push_back(r1); + r.temp = 0; + info.rules->push_back(r); } - if (l != r1.lhs) l = r1.lhs; - if (toplevel && (verbose&verbosity::defs) != 0) cout << r1 << ";\n"; + if (toplevel && (verbose&verbosity::defs) != 0) cout << r << ";\n"; if (toplevel) mark_dirty(f); } void interpreter::add_simple_rule(rulel &rl, rule *r) { assert(!r->lhs.is_null()); - rule r1 = *r; - rl.push_back(r1); + rl.push_back(*r); delete r; } Modified: pure/trunk/interpreter.hh =================================================================== --- pure/trunk/interpreter.hh 2008-06-18 07:25:20 UTC (rev 253) +++ pure/trunk/interpreter.hh 2008-06-18 07:45:21 UTC (rev 254) @@ -268,7 +268,7 @@ symtable symtab; // the symbol table pure_expr *result; // last computed result clock_t clocks; // last evaluation time, if stats is set - expr last; // last processed lhs + exprl last; // last processed lhs collection env globenv; // global function and variable environment funset dirty; // "dirty" function entries which need a recompile pure_mem *mem; // runtime expression memory @@ -352,8 +352,11 @@ void exec(expr *x); void clear(int32_t f = 0); void clearsym(int32_t f); - void add_rule(rulel &rl, rule *r, bool b); - void add_rule(env &e, expr &l, rule *r, bool toplevel = false); + rulel *default_lhs(exprl &l, rulel *rl); + void add_rules(rulel &rl, rulel *r, bool b); + void add_rules(env &e, rulel *r, bool toplevel = false); + void add_rule(rulel &rl, rule &r, bool b); + void add_rule(env &e, rule &r, bool toplevel = false); void add_simple_rule(rulel &rl, rule *r); void promote_ttags(expr f, expr x, expr u); void promote_ttags(expr f, expr x, expr u, expr v); Modified: pure/trunk/lexer.ll =================================================================== --- pure/trunk/lexer.ll 2008-06-18 07:25:20 UTC (rev 253) +++ pure/trunk/lexer.ll 2008-06-18 07:45:21 UTC (rev 254) @@ -755,7 +755,7 @@ return token::ID; } } -[=;()\[\]\\] return yy::parser::token_type(yytext[0]); +[=|;()\[\]\\] return yy::parser::token_type(yytext[0]); "->" return token::MAPSTO; [[:punct:]]+ { if (yytext[0] == '/' && yytext[1] == '*') REJECT; // comment starter Modified: pure/trunk/parser.yy =================================================================== --- pure/trunk/parser.yy 2008-06-18 07:25:20 UTC (rev 253) +++ pure/trunk/parser.yy 2008-06-18 07:45:21 UTC (rev 254) @@ -59,9 +59,13 @@ sym_info(prec_t p, fix_t f) : prec(p), fix(f) { } }; struct rule_info { - expr l; + exprl l; env e; }; +struct pat_rule_info { + exprl l; + rulel rl; +}; typedef pair<expr,expr> comp_clause; typedef list<comp_clause> comp_clause_list; %} @@ -79,6 +83,7 @@ rule *rval; rulel *rlval; rule_info *rinfo; + pat_rule_info *prinfo; list<string> *slval; comp_clause_list *clauselval; comp_clause *clauseval; @@ -224,23 +229,24 @@ %type <slval> ids names ctypes opt_ctypes %type <info> fixity %type <xval> expr cond simple app prim op qual -%type <xlval> args +%type <xlval> args lhs %type <clauselval> comp_clauses comp_clause_list %type <clauseval> comp_clause -%type <rval> rule simple_rule %type <rinfo> rules rulel -%type <rlval> pat_rules pat_rulel simple_rules simple_rulel +%type <prinfo> pat_rules pat_rulel +%type <rval> simple_rule +%type <rlval> rule simple_rules simple_rulel %destructor { delete $$; } ID fixity expr cond simple app prim op - comp_clauses comp_clause_list args qual rules rulel rule pat_rules pat_rulel - simple_rules simple_rulel simple_rule ids names name + comp_clauses comp_clause_list args lhs qual rules rulel rule + pat_rules pat_rulel simple_rules simple_rulel simple_rule ids names name optalias opt_ctypes ctypes ctype %destructor { mpz_clear(*$$); free($$); } BIGINT %destructor { free($$); } STR %printer { debug_stream() << *$$; } ID name optalias ctype expr cond simple app - prim op args qual rule pat_rules pat_rulel simple_rules simple_rulel - simple_rule + prim op args lhs qual rule simple_rules simple_rulel simple_rule %printer { debug_stream() << $$->e; } rules rulel +%printer { debug_stream() << $$->rl; } pat_rules pat_rulel %printer { debug_stream() << $$; } INT DBL STR %printer { char *s = mpz_get_str(NULL, 10, *$$); debug_stream() << s; free(s); } BIGINT @@ -269,7 +275,8 @@ | LET simple_rule { action(interp.define($2), delete $2); } | rule -{ action(interp.add_rule(interp.globenv, interp.last, $1, true), delete $1); } +{ rulel *rl = interp.default_lhs(interp.last, $1); + action(interp.add_rules(interp.globenv, rl, true), delete rl); } | fixity /* Lexical tie-in: We need to tell the lexer that we're defining new operator symbols (interp.declare_op = true) instead of searching for existing ones @@ -361,7 +368,7 @@ { try { $$ = interp.mklambda_expr($2, $4); } catch (err &e) { interp.error(yyloc, e.what()); $$ = new expr; } } | CASE cond OF pat_rules END -{ $$ = interp.mkcase_expr($2, $4); } +{ $$ = interp.mkcase_expr($2, new rulel($4->rl)); delete $4; } | expr WHEN simple_rules END { try { $$ = interp.mkwhen_expr($1, $3); } catch (err &e) { interp.error(yyloc, e.what()); $$ = new expr; } } @@ -535,16 +542,27 @@ /* Rewriting rule syntax. These generally take the form l = r [if g]; ... For convenience, we also allow a semicolon at the end of a rule list. Moreover, - the left-hand side may be omitted, in which case the left-hand side of the - previous rule is repeated. */ + multiple left-hand sides are permitted (denoting a collection of rules for + the same right-hand side), and the left-hand side may also be omitted, in + which case the left-hand sides of the previous rule are repeated. */ rule -: expr '=' expr qual -{ $$ = new rule(*$1, *$3, *$4); delete $1; delete $3; delete $4; } +: lhs '=' expr qual +{ $$ = new rulel; + for (exprl::iterator l = $1->begin(), end = $1->end(); l != end; l++) + $$->push_back(rule(*l, *$3, *$4)); + delete $1; delete $3; delete $4; } | '=' expr qual -{ $$ = new rule(expr(), *$2, *$3); delete $2; delete $3; } +{ $$ = new rulel(1, rule(expr(), *$2, *$3)); delete $2; delete $3; } ; +lhs +: expr +{ $$ = new exprl; $$->push_back(*$1); delete $1; } +| lhs '|' expr +{ $$ = $1; $$->push_back(*$3); delete $3; } +; + qual : /* empty */ { $$ = new expr(); } | OTHERWISE { $$ = new expr(); } @@ -558,11 +576,15 @@ rulel : rule -{ $$ = new rule_info; try { interp.add_rule($$->e, $$->l, $1); } - catch (err &e) { interp.error(yyloc, e.what()); } } +{ $$ = new rule_info; + rulel *rl = interp.default_lhs($$->l, $1); + try { interp.add_rules($$->e, rl); } + catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } | rulel ';' rule -{ $$ = $1; try { interp.add_rule($$->e, $$->l, $3); } - catch (err &e) { interp.error(yyloc, e.what()); } } +{ $$ = $1; + rulel *rl = interp.default_lhs($$->l, $3); + try { interp.add_rules($$->e, rl); } + catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } ; /* Same for pattern rules (pattern binding in 'case' clauses). */ @@ -574,11 +596,15 @@ pat_rulel : rule -{ $$ = new rulel; try { interp.add_rule(*$$, $1, true); } - catch (err &e) { interp.error(yyloc, e.what()); } } +{ $$ = new pat_rule_info; + rulel *rl = interp.default_lhs($$->l, $1); + try { interp.add_rules($$->rl, rl, true); } + catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } | pat_rulel ';' rule -{ $$ = $1; try { interp.add_rule(*$$, $3, true); } - catch (err &e) { interp.error(yyloc, e.what()); } } +{ $$ = $1; + rulel *rl = interp.default_lhs($$->l, $3); + try { interp.add_rules($$->rl, rl, true); } + catch (err &e) { delete rl; interp.error(yyloc, e.what()); } } ; /* Same for simple rules (pattern binding in 'when' clauses, no guards). */ Added: pure/trunk/test/test012.log =================================================================== --- pure/trunk/test/test012.log (rev 0) +++ pure/trunk/test/test012.log 2008-06-18 07:45:21 UTC (rev 254) @@ -0,0 +1,45 @@ +fact n/*0:1*/::int = n/*0:1*/*fact (n/*0:1*/-1) if n/*0:1*/>0; +fact n/*0:1*/::double = n/*0:1*/*fact (n/*0:1*/-1) if n/*0:1*/>0; +fact n/*0:1*/ = n/*0:1*/*fact (n/*0:1*/-1) if n/*0:1*/>0; +fact n/*0:1*/::int = 1; +fact n/*0:1*/::double = 1; +fact n/*0:1*/ = 1; +{ + rule #0: fact n::int = n*fact (n-1) if n>0 + rule #1: fact n::double = n*fact (n-1) if n>0 + rule #2: fact n = n*fact (n-1) if n>0 + rule #3: fact n::int = 1 + rule #4: fact n::double = 1 + rule #5: fact n = 1 + state 0: #0 #1 #2 #3 #4 #5 + <var> state 1 + <var>::int state 2 + <var>::double state 3 + state 1: #2 #5 + state 2: #0 #2 #3 #5 + state 3: #1 #2 #4 #5 +} +fact 10; +3628800 +fact 10L; +3628800L +fact 10.0; +3628800.0 +foo x/*0:1*/ = x/*0:1*/*y; +bar y/*0:1*/ = x*y/*0:1*/; +{ + rule #0: foo x = x*y + state 0: #0 + <var> state 1 + state 1: #0 +} +{ + rule #0: bar y = x*y + state 0: #0 + <var> state 1 + state 1: #0 +} +foo 99; +99*y +bar 99; +x*99 Added: pure/trunk/test/test012.pure =================================================================== --- pure/trunk/test/test012.pure (rev 0) +++ pure/trunk/test/test012.pure 2008-06-18 07:45:21 UTC (rev 254) @@ -0,0 +1,11 @@ + +fact n::int | +fact n::double | +fact n = n*fact (n-1) if n>0; + = 1 otherwise; + +fact 10; fact 10L; fact 10.0; + +foo x | bar y = x*y; + +foo 99; bar 99; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 07:25:11
|
Revision: 253 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=253&view=rev Author: agraef Date: 2008-06-18 00:25:20 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Rename '|' -> 'or', '&' -> 'and'. Modified Paths: -------------- pure/trunk/test/prelude.log Modified: pure/trunk/test/prelude.log =================================================================== --- pure/trunk/test/prelude.log 2008-06-18 07:24:07 UTC (rev 252) +++ pure/trunk/test/prelude.log 2008-06-18 07:25:20 UTC (rev 253) @@ -79,12 +79,12 @@ x/*0:01*/::int>>y/*0:1*/::int = x/*0:01*/>>y/*0:1*/; x/*0:01*/::int+y/*0:1*/::int = x/*0:01*/+y/*0:1*/; x/*0:01*/::int-y/*0:1*/::int = x/*0:01*/-y/*0:1*/; -x/*0:01*/::int|y/*0:1*/::int = x/*0:01*/|y/*0:1*/; x/*0:01*/::int*y/*0:1*/::int = x/*0:01*/*y/*0:1*/; x/*0:01*/::int/y/*0:1*/::int = x/*0:01*//y/*0:1*/; -x/*0:01*/::int&y/*0:1*/::int = x/*0:01*/&y/*0:1*/; x/*0:01*/::int div y/*0:1*/::int = x/*0:01*/ div y/*0:1*/; x/*0:01*/::int mod y/*0:1*/::int = x/*0:01*/ mod y/*0:1*/; +x/*0:01*/::int or y/*0:1*/::int = x/*0:01*/ or y/*0:1*/; +x/*0:01*/::int and y/*0:1*/::int = x/*0:01*/ and y/*0:1*/; x/*0:01*/::int<y/*0:1*/::int = x/*0:01*/<y/*0:1*/; x/*0:01*/::int>y/*0:1*/::int = x/*0:01*/>y/*0:1*/; x/*0:01*/::int<=y/*0:1*/::int = x/*0:01*/<=y/*0:1*/; @@ -133,12 +133,12 @@ x/*0:01*/::bigint>>y/*0:1*/::int = bigint_shl x/*0:01*/ (-y/*0:1*/); x/*0:01*/::bigint+y/*0:1*/::bigint = bigint_add x/*0:01*/ y/*0:1*/; x/*0:01*/::bigint-y/*0:1*/::bigint = bigint_sub x/*0:01*/ y/*0:1*/; -x/*0:01*/::bigint|y/*0:1*/::bigint = bigint_or x/*0:01*/ y/*0:1*/; x/*0:01*/::bigint*y/*0:1*/::bigint = bigint_mul x/*0:01*/ y/*0:1*/; x/*0:01*/::bigint/y/*0:1*/::bigint = double x/*0:01*//double y/*0:1*/; -x/*0:01*/::bigint&y/*0:1*/::bigint = bigint_and x/*0:01*/ y/*0:1*/; x/*0:01*/::bigint div y/*0:1*/::bigint = bigint_div x/*0:01*/ y/*0:1*/; x/*0:01*/::bigint mod y/*0:1*/::bigint = bigint_mod x/*0:01*/ y/*0:1*/; +x/*0:01*/::bigint or y/*0:1*/::bigint = bigint_or x/*0:01*/ y/*0:1*/; +x/*0:01*/::bigint and y/*0:1*/::bigint = bigint_and x/*0:01*/ y/*0:1*/; x/*0:01*/::bigint<y/*0:1*/::bigint = bigint_cmp x/*0:01*/ y/*0:1*/<0; x/*0:01*/::bigint>y/*0:1*/::bigint = bigint_cmp x/*0:01*/ y/*0:1*/>0; x/*0:01*/::bigint<=y/*0:1*/::bigint = bigint_cmp x/*0:01*/ y/*0:1*/<=0; @@ -147,12 +147,12 @@ x/*0:01*/::bigint!=y/*0:1*/::bigint = bigint_cmp x/*0:01*/ y/*0:1*/!=0; x/*0:01*/::int+y/*0:1*/::bigint = bigint x/*0:01*/+y/*0:1*/; x/*0:01*/::int-y/*0:1*/::bigint = bigint x/*0:01*/-y/*0:1*/; -x/*0:01*/::int|y/*0:1*/::bigint = bigint x/*0:01*/|y/*0:1*/; x/*0:01*/::int*y/*0:1*/::bigint = bigint x/*0:01*/*y/*0:1*/; x/*0:01*/::int/y/*0:1*/::bigint = double x/*0:01*//y/*0:1*/; -x/*0:01*/::int&y/*0:1*/::bigint = bigint x/*0:01*/&y/*0:1*/; x/*0:01*/::int div y/*0:1*/::bigint = bigint x/*0:01*/ div y/*0:1*/; x/*0:01*/::int mod y/*0:1*/::bigint = bigint x/*0:01*/ mod y/*0:1*/; +x/*0:01*/::int or y/*0:1*/::bigint = bigint x/*0:01*/ or y/*0:1*/; +x/*0:01*/::int and y/*0:1*/::bigint = bigint x/*0:01*/ and y/*0:1*/; x/*0:01*/::int<y/*0:1*/::bigint = bigint x/*0:01*/<y/*0:1*/; x/*0:01*/::int>y/*0:1*/::bigint = bigint x/*0:01*/>y/*0:1*/; x/*0:01*/::int<=y/*0:1*/::bigint = bigint x/*0:01*/<=y/*0:1*/; @@ -161,12 +161,12 @@ x/*0:01*/::int!=y/*0:1*/::bigint = bigint x/*0:01*/!=y/*0:1*/; x/*0:01*/::bigint+y/*0:1*/::int = x/*0:01*/+bigint y/*0:1*/; x/*0:01*/::bigint-y/*0:1*/::int = x/*0:01*/-bigint y/*0:1*/; -x/*0:01*/::bigint|y/*0:1*/::int = x/*0:01*/|bigint y/*0:1*/; x/*0:01*/::bigint*y/*0:1*/::int = x/*0:01*/*bigint y/*0:1*/; x/*0:01*/::bigint/y/*0:1*/::int = x/*0:01*//double y/*0:1*/; -x/*0:01*/::bigint&y/*0:1*/::int = x/*0:01*/&bigint y/*0:1*/; x/*0:01*/::bigint div y/*0:1*/::int = x/*0:01*/ div bigint y/*0:1*/; x/*0:01*/::bigint mod y/*0:1*/::int = x/*0:01*/ mod bigint y/*0:1*/; +x/*0:01*/::bigint or y/*0:1*/::int = x/*0:01*/ or bigint y/*0:1*/; +x/*0:01*/::bigint and y/*0:1*/::int = x/*0:01*/ and bigint y/*0:1*/; x/*0:01*/::bigint<y/*0:1*/::int = x/*0:01*/<bigint y/*0:1*/; x/*0:01*/::bigint>y/*0:1*/::int = x/*0:01*/>bigint y/*0:1*/; x/*0:01*/::bigint<=y/*0:1*/::int = x/*0:01*/<=bigint y/*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-18 07:23:59
|
Revision: 252 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=252&view=rev Author: agraef Date: 2008-06-18 00:24:07 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Rename '|' -> 'or', '&' -> 'and'. Modified Paths: -------------- pure/trunk/symtable.cc Modified: pure/trunk/symtable.cc =================================================================== --- pure/trunk/symtable.cc 2008-06-18 07:23:39 UTC (rev 251) +++ pure/trunk/symtable.cc 2008-06-18 07:24:07 UTC (rev 252) @@ -158,20 +158,20 @@ symbol& symtable::bitor_sym() { - symbol *_sym = lookup("|"); + symbol *_sym = lookup("or"); if (_sym) return *_sym; else - return sym("|", 6, infixl); + return sym("or", 6, infixl); } symbol& symtable::bitand_sym() { - symbol *_sym = lookup("&"); + symbol *_sym = lookup("and"); if (_sym) return *_sym; else - return sym("&", 7, infixl); + return sym("and", 7, infixl); } symbol& symtable::shl_sym() This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-18 07:23:30
|
Revision: 251 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=251&view=rev Author: agraef Date: 2008-06-18 00:23:39 -0700 (Wed, 18 Jun 2008) Log Message: ----------- Rename '|' -> 'or', '&' -> 'and'. Modified Paths: -------------- pure/trunk/lib/prelude.pure pure/trunk/lib/primitives.pure Modified: pure/trunk/lib/prelude.pure =================================================================== --- pure/trunk/lib/prelude.pure 2008-06-17 13:44:16 UTC (rev 250) +++ pure/trunk/lib/prelude.pure 2008-06-18 07:23:39 UTC (rev 251) @@ -54,8 +54,8 @@ infix 4 === !== ; // syntactic equality infixr 4 : ; // list cons infixl 5 << >> ; // bit shifts -infixl 6 + - | ; // addition, bitwise or -infixl 7 * / div mod & ; // multiplication, bitwise and +infixl 6 + - or ; // addition, bitwise or +infixl 7 * / div mod and ; // multiplication, bitwise and prefix 7 ~ ; // bitwise not infixr 8 ^ ; // exponentiation prefix 8 # ; // size operator Modified: pure/trunk/lib/primitives.pure =================================================================== --- pure/trunk/lib/primitives.pure 2008-06-17 13:44:16 UTC (rev 250) +++ pure/trunk/lib/primitives.pure 2008-06-18 07:23:39 UTC (rev 251) @@ -102,12 +102,12 @@ x::int+y::int = x+y; x::int-y::int = x-y; -x::int|y::int = x|y; x::int*y::int = x*y; x::int/y::int = x/y; -x::int&y::int = x&y; x::int div y::int = x div y; x::int mod y::int = x mod y; +x::int or y::int = x or y; +x::int and y::int = x and y; x::int<y::int = x<y; x::int>y::int = x>y; @@ -189,12 +189,12 @@ x::bigint+y::bigint = bigint_add x y; x::bigint-y::bigint = bigint_sub x y; -x::bigint|y::bigint = bigint_or x y; x::bigint*y::bigint = bigint_mul x y; x::bigint/y::bigint = double x / double y; -x::bigint&y::bigint = bigint_and x y; x::bigint div y::bigint = bigint_div x y; x::bigint mod y::bigint = bigint_mod x y; +x::bigint or y::bigint = bigint_or x y; +x::bigint and y::bigint = bigint_and x y; x::bigint<y::bigint = bigint_cmp x y < 0; x::bigint>y::bigint = bigint_cmp x y > 0; @@ -207,12 +207,12 @@ x::int+y::bigint = bigint x+y; x::int-y::bigint = bigint x-y; -x::int|y::bigint = bigint x|y; x::int*y::bigint = bigint x*y; x::int/y::bigint = double x/y; -x::int&y::bigint = bigint x&y; x::int div y::bigint = bigint x div y; x::int mod y::bigint = bigint x mod y; +x::int or y::bigint = bigint x or y; +x::int and y::bigint = bigint x and y; x::int<y::bigint = bigint x<y; x::int>y::bigint = bigint x>y; @@ -223,12 +223,12 @@ x::bigint+y::int = x+bigint y; x::bigint-y::int = x-bigint y; -x::bigint|y::int = x|bigint y; x::bigint*y::int = x*bigint y; x::bigint/y::int = x/double y; -x::bigint&y::int = x&bigint y; x::bigint div y::int = x div bigint y; x::bigint mod y::int = x mod bigint y; +x::bigint or y::int = x or bigint y; +x::bigint and y::int = x and bigint y; x::bigint<y::int = x<bigint y; x::bigint>y::int = x>bigint y; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-17 13:44:09
|
Revision: 250 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=250&view=rev Author: agraef Date: 2008-06-17 06:44:16 -0700 (Tue, 17 Jun 2008) Log Message: ----------- Eliminate unused optional argument. Modified Paths: -------------- pure/trunk/interpreter.cc pure/trunk/interpreter.hh Modified: pure/trunk/interpreter.cc =================================================================== --- pure/trunk/interpreter.cc 2008-06-16 14:29:41 UTC (rev 249) +++ pure/trunk/interpreter.cc 2008-06-17 13:44:16 UTC (rev 250) @@ -873,7 +873,7 @@ } } -void interpreter::add_rule(rulel &rl, rule *r, bool b, yy::location* yylloc) +void interpreter::add_rule(rulel &rl, rule *r, bool b) { rule r1 = *r; if (r->lhs.is_null()) { Modified: pure/trunk/interpreter.hh =================================================================== --- pure/trunk/interpreter.hh 2008-06-16 14:29:41 UTC (rev 249) +++ pure/trunk/interpreter.hh 2008-06-17 13:44:16 UTC (rev 250) @@ -352,7 +352,7 @@ void exec(expr *x); void clear(int32_t f = 0); void clearsym(int32_t f); - void add_rule(rulel &rl, rule *r, bool b, yy::location* yylloc = 0); + void add_rule(rulel &rl, rule *r, bool b); void add_rule(env &e, expr &l, rule *r, bool toplevel = false); void add_simple_rule(rulel &rl, rule *r); void promote_ttags(expr f, expr x, expr u); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-16 14:29:33
|
Revision: 249 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=249&view=rev Author: agraef Date: 2008-06-16 07:29:41 -0700 (Mon, 16 Jun 2008) Log Message: ----------- Update installation instructions. Modified Paths: -------------- pure/trunk/INSTALL Modified: pure/trunk/INSTALL =================================================================== --- pure/trunk/INSTALL 2008-06-16 14:00:24 UTC (rev 248) +++ pure/trunk/INSTALL 2008-06-16 14:29:41 UTC (rev 249) @@ -25,8 +25,8 @@ required once. Steps 2-3 can be avoided if binary LLVM packages are available for your system. Additional instructions for compiling Pure from SVN sources can be found in the INSTALLING FROM SVN SOURCES section below. Moreover, you -can refer to the OTHER COMPILATION OPTIONS section below for details about -various options available when building and installing Pure. +can refer to the OTHER BUILD AND INSTALLATION OPTIONS section below for +details about various options available when building and installing Pure. STEP 1. Make sure you have all the necessary dependencies installed (-dev denotes corresponding development packages): @@ -83,9 +83,18 @@ $ make $ sudo make install +The last command installs the pure program, the runtime.h header file, the +runtime library libpure.so and the library scripts under /usr/local; the +installation prefix can be changed with the --prefix configure option, see +OTHER BUILD AND INSTALLATION OPTIONS for details. + +(The runtime.h header file is not needed for normal operation, but can be used +to write C/C++ extensions modules, if you need to access and manipulate Pure +expressions from C/C++.) + On some systems you may have to tell the dynamic linker to update its cache so -that it finds the Pure runtime library, libpure.so. E.g., on Linux this can be -done as follows: +that it finds the Pure runtime library. E.g., on Linux this can be done as +follows: $ sudo /sbin/ldconfig @@ -161,8 +170,8 @@ $ sudo make install -OTHER COMPILATION OPTIONS -===== =========== ======= +OTHER BUILD AND INSTALLATION OPTIONS +===== ===== === ============ ======= The Pure configure script takes a few options which enable you to change the installation path and control a number of other build options. Moreover, there @@ -173,10 +182,10 @@ INSTALLATION PATH ------------ ---- -By default, the pure program, runtime library and library scripts are -installed in /usr/local/bin, /usr/local/lib and /usr/local/lib/pure, -respectively. This can be changed by specifying the desired installation -prefix with the --prefix option, e.g.: +By default, the pure program, the runtime.h header file, the runtime library +and the library scripts are installed in /usr/local/bin, /usr/local/include, +/usr/local/lib and /usr/local/lib/pure, respectively. This can be changed by +specifying the desired installation prefix with the --prefix option, e.g.: $ ./configure --prefix=/usr @@ -195,10 +204,11 @@ Beginning with version 0.4, Pure fully supports parallel installations of different versions of the interpreter without any further ado. To these ends, -bin/pure, lib/libpure.so, lib/pure and man/man1/pure.1 are actually symbolic -links to the current version (bin/pure-x.y, lib/libpure-x.y.so etc., where x.y -is the version number). If you install a new version of the interpreter, the -old version remains available as pure-x.y. +bin/pure, include/pure, lib/libpure.so, lib/pure and man/man1/pure.1 are +actually symbolic links to the current version (bin/pure-x.y, +include/pure-x.y, lib/libpure-x.y.so etc., where x.y is the version +number). If you install a new version of the interpreter, the old version +remains available as pure-x.y. SEPARATE BUILD DIRECTORY -------- ----- --------- This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-16 14:00:15
|
Revision: 248 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=248&view=rev Author: agraef Date: 2008-06-16 07:00:24 -0700 (Mon, 16 Jun 2008) Log Message: ----------- Install runtime.h in include/pure. Modified Paths: -------------- pure/trunk/Makefile.in Modified: pure/trunk/Makefile.in =================================================================== --- pure/trunk/Makefile.in 2008-06-16 13:58:45 UTC (rev 247) +++ pure/trunk/Makefile.in 2008-06-16 14:00:24 UTC (rev 248) @@ -216,20 +216,22 @@ # installation install: pure$(EXE) etc/pure-mode.el pure.1 - for x in $(addprefix $(DESTDIR), $(bindir) $(libdir)/pure-$(version) $(man1dir)); do $(INSTALL) -d $$x; done + for x in $(addprefix $(DESTDIR), $(bindir) $(includedir)/pure-$(version) $(libdir)/pure-$(version) $(man1dir)); do $(INSTALL) -d $$x; done $(INSTALL) pure$(EXE) $(DESTDIR)$(bindir)/pure-$(version)$(EXE) ln -sf $(bindir)/pure-$(version)$(EXE) $(DESTDIR)$(bindir)/pure$(EXE) ifeq ($(sharedlib), yes) $(INSTALL) $(libpure) $(DESTDIR)$(libdir)/$(libpure) ln -sf $(libdir)/$(libpure) $(DESTDIR)$(libdir)/$(libpurelnk) endif + $(INSTALL) runtime.h $(DESTDIR)$(includedir)/pure-$(version) + ln -sf $(includedir)/pure-$(version) $(DESTDIR)$(includedir)/pure for x in $(srcdir)/lib/*.pure; do $(INSTALL) -m 644 $$x $(DESTDIR)$(libdir)/pure-$(version); done ln -sf $(libdir)/pure-$(version) $(DESTDIR)$(libdir)/pure $(INSTALL) -m 644 pure.1 $(DESTDIR)$(man1dir)/pure-$(version).1 ln -sf $(man1dir)/pure-$(version).1 $(DESTDIR)$(man1dir)/pure.1 uninstall: - rm -rf $(DESTDIR)$(bindir)/pure$(EXE) $(DESTDIR)$(bindir)/pure-$(version)$(EXE) $(DESTDIR)$(libdir)/$(libpure) $(DESTDIR)$(libdir)/$(libpurelnk) $(DESTDIR)$(libdir)/pure $(DESTDIR)$(libdir)/pure-$(version) $(DESTDIR)$(man1dir)/pure.1 $(DESTDIR)$(man1dir)/pure-$(version).1 + rm -rf $(DESTDIR)$(bindir)/pure$(EXE) $(DESTDIR)$(bindir)/pure-$(version)$(EXE) $(DESTDIR)$(libdir)/$(libpure) $(DESTDIR)$(libdir)/$(libpurelnk) $(DESTDIR)$(includedir)/pure $(DESTDIR)$(includedir)/pure-$(version) $(DESTDIR)$(libdir)/pure $(DESTDIR)$(libdir)/pure-$(version) $(DESTDIR)$(man1dir)/pure.1 $(DESTDIR)$(man1dir)/pure-$(version).1 # roll a distribution tarball This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-16 13:58:39
|
Revision: 247 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=247&view=rev Author: agraef Date: 2008-06-16 06:58:45 -0700 (Mon, 16 Jun 2008) Log Message: ----------- Fix typo. Modified Paths: -------------- pure/trunk/INSTALL Modified: pure/trunk/INSTALL =================================================================== --- pure/trunk/INSTALL 2008-06-16 09:44:43 UTC (rev 246) +++ pure/trunk/INSTALL 2008-06-16 13:58:45 UTC (rev 247) @@ -328,7 +328,7 @@ distcheck' (the latter is like 'make dist', but also does a test build and installation to verify that your tarball contains all needed bits and pieces). -Last but not least, if you modify configure.ac for some reason then you +Last but not least, if you modify configure.ac for some reason then you can regenerate the configure script and config.h.in with 'make config'. This needs autoconf, of course. (The distribution was prepared using autoconf 2.61.) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-16 10:55:21
|
Revision: 245 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=245&view=rev Author: agraef Date: 2008-06-16 02:44:02 -0700 (Mon, 16 Jun 2008) Log Message: ----------- Update Makefile. Modified Paths: -------------- pure/trunk/Makefile.in Modified: pure/trunk/Makefile.in =================================================================== --- pure/trunk/Makefile.in 2008-06-16 08:36:20 UTC (rev 244) +++ pure/trunk/Makefile.in 2008-06-16 09:44:02 UTC (rev 245) @@ -106,9 +106,10 @@ OBJECT = $(subst .cc,.o,$(filter %.cc,$(SOURCE) $(EXTRA_SOURCE))) DISTFILES = COPYING ChangeLog INSTALL NEWS README TODO \ -Makefile.in aclocal.m4 configure.ac configure config.h.in \ -config.guess config.sub install-sh $(SOURCE) $(EXTRA_SOURCE) w3centities.c \ -pure.cc pure.1 pure.1.in pure-mode.el.in pure.xml pure.vim \ +Makefile.in configure.ac configure config.h.in \ +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 lib/*.pure test/*.pure test/*.log .PHONY: all html dvi ps pdf clean realclean depend install uninstall strip \ @@ -116,7 +117,7 @@ # compilation -all: pure$(EXE) pure-mode.el pure.1 +all: pure$(EXE) etc/pure-mode.el pure.1 ifeq ($(sharedlib), yes) pure$(EXE): pure.o $(libpure) @@ -149,10 +150,10 @@ # create pure-mode.el from pure-mode.el.in -pure-mode.el: Makefile pure-mode.el.in - rm -f pure-mode.el pure-mode.el.tmp - sed -e 's,@bindir\@,$(bindir),g' -e 's,@libdir\@,$(libdir),g' pure-mode.el.in >pure-mode.el.tmp - mv pure-mode.el.tmp pure-mode.el +etc/pure-mode.el: Makefile etc/pure-mode.el.in + rm -f etc/pure-mode.el etc/pure-mode.el.tmp + sed -e 's,@bindir\@,$(bindir),g' -e 's,@libdir\@,$(libdir),g' etc/pure-mode.el.in >etc/pure-mode.el.tmp + mv etc/pure-mode.el.tmp etc/pure-mode.el # create the manpage from pure.1.in @@ -192,7 +193,7 @@ rm -f *~ *.bak *.html *.dvi *.ps *.pdf pure$(EXE) $(OBJECT) pure.o $(libpurelnk) $(libpure) parser.output distclean: clean - rm -f Makefile config.h config.log config.status pure-mode.el $(dist).tar.gz + rm -f Makefile config.h config.log config.status etc/pure-mode.el $(dist).tar.gz realclean: distclean rm -f $(addprefix $(srcdir)/, test/*.log $(EXTRA_SOURCE) pure.1) @@ -214,7 +215,7 @@ # installation -install: pure$(EXE) pure-mode.el pure.1 +install: pure$(EXE) etc/pure-mode.el pure.1 for x in $(addprefix $(DESTDIR), $(bindir) $(libdir)/pure-$(version) $(man1dir)); do $(INSTALL) -d $$x; done $(INSTALL) pure$(EXE) $(DESTDIR)$(bindir)/pure-$(version)$(EXE) ln -sf $(bindir)/pure-$(version)$(EXE) $(DESTDIR)$(bindir)/pure$(EXE) @@ -232,9 +233,9 @@ # roll a distribution tarball -dist: +dist: pure.1 rm -rf $(dist) - mkdir $(dist) && mkdir $(dist)/examples && mkdir $(dist)/lib && mkdir $(dist)/test + mkdir $(dist) && mkdir $(dist)/config && mkdir $(dist)/etc && mkdir $(dist)/examples && 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: <ag...@us...> - 2008-06-16 10:01:59
|
Revision: 246 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=246&view=rev Author: agraef Date: 2008-06-16 02:44:43 -0700 (Mon, 16 Jun 2008) Log Message: ----------- Update usage and installation instructions. Modified Paths: -------------- pure/trunk/INSTALL pure/trunk/README Modified: pure/trunk/INSTALL =================================================================== --- pure/trunk/INSTALL 2008-06-16 09:44:02 UTC (rev 245) +++ pure/trunk/INSTALL 2008-06-16 09:44:43 UTC (rev 246) @@ -324,12 +324,15 @@ documentation in a variety of formats (this requires groff); see the Makefile for details. -Last but not least, maintainers can roll distribution tarballs with 'make -dist' and 'make distcheck' (the latter is like 'make dist', but also does a -test build and installation to verify that your tarball contains all needed -bits and pieces). +Maintainers can roll distribution tarballs with 'make dist' and 'make +distcheck' (the latter is like 'make dist', but also does a test build and +installation to verify that your tarball contains all needed bits and pieces). +Last but not least, if you modify configure.ac for some reason then you +regenerate the configure script and config.h.in with 'make config'. This needs +autoconf, of course. (The distribution was prepared using autoconf 2.61.) + SYSTEM NOTES ====== ===== Modified: pure/trunk/README =================================================================== --- pure/trunk/README 2008-06-16 09:44:02 UTC (rev 245) +++ pure/trunk/README 2008-06-16 09:44:43 UTC (rev 246) @@ -70,27 +70,23 @@ > Pure scripts are just ordinary text files, which can be created with any text -editor. For Emacs users, the most convenient way to edit and run Pure scripts -is Emacs Pure mode which works with both GNU Emacs and XEmacs. You'll have to -install the pure-mode.el file from the Pure source directory into your Emacs -site-lisp directory, and enable the mode in your .emacs file as explained at -the beginning of the pure-mode.el file. Then you can just open and edit a Pure -script in Emacs, and run it inside an Emacs buffer with Ctrl-C Ctrl-C. Syntax -highlighting, auto-indentation and command line completion are also supported. +editor. The distribution contains some language definition files and +programming modes to provide syntax highlighting in various popular text +editors, such as Emacs, Kate and Vim. The Emacs mode also lets you run the +Pure interpreter in an Emacs buffer, this is probably the most convenient +interface to the interpreter if you're friends with Emacs. A syntax file for +Andre Simon's highlight program is also included, this lets you pretty-print +Pure source in various output formats such as HTML and LaTeX. You can find all +this stuff in the etc subdirectory in the source distribution, installation +instructions are included in the files. -The source directory also contains Pure syntax highlighting files for Kate and -Vim. You can install these into your .kde/share/apps/katepart/syntax and -.vim/syntax directories, respectively. (The Vim mode must also be enabled in -your vim startup file; see the comments at the beginning of pure.vim for -details.) +Online documentation is available as a manual page, which contains detailed +information on how to use the interpreter and a description of the Pure +language. You can invoke the manpage with 'man pure' after installation or +using the 'help' command inside the interpreter. When using Emacs, it can be +displayed using Emacs' built-in manpage reader (the 'help' command won't work +if the interpreter is running in an Emacs buffer). -Online documentation is available as a manpage, which contains detailed -information on how to use the interpreter and a brief description of the Pure -language. You can invoke the manpage with 'man pure' after installation, or -using the 'help' command inside the interpreter, or with Emacs' built-in -manpage reader (the 'help' command won't work if the interpreter is running -inside an Emacs buffer). - Some example programs can be found in the examples subdir in the sources; in particular, have a look at the hello.pure program which will quickly give you an idea how Pure programs look like. You should also browse the scripts in the @@ -100,7 +96,7 @@ This is currently all you get; more elaborate documentation of the Pure language still needs to be written. But Pure is a really simple language; if you have some experience using FPLs then you should be able to find your way -with the manpage and the provided examples. Of course, you can also post +with the manual page and the provided examples. Of course, you can also post questions to the Pure mailing list (see http://pure-lang.sf.net). Enjoy! :) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-16 08:36:15
|
Revision: 244 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=244&view=rev Author: agraef Date: 2008-06-16 01:36:20 -0700 (Mon, 16 Jun 2008) Log Message: ----------- Updated ChangeLog. Modified Paths: -------------- pure/trunk/ChangeLog Modified: pure/trunk/ChangeLog =================================================================== --- pure/trunk/ChangeLog 2008-06-16 07:59:35 UTC (rev 243) +++ pure/trunk/ChangeLog 2008-06-16 08:36:20 UTC (rev 244) @@ -1,3 +1,16 @@ +2008-06-16 Albert Graef <Dr....@t-...> + + * etc/pure.lang: New language definition file for Andre Simon's + highlight program (http:/www.andre-simon.de/). This allows you to + format Pure sources with syntax highlighting as HTML and LaTeX + files, for instance. + + * configure.ac, Makefile.in: Clean up the source tree. Moved + auxiliary configure files and the syntax highlighting and + programming mode stuff into separate config and etc + subdirectories. Moreover, Makefile.in now has a target to + regenerate the configury using autoconf and autoheader. + 2008-06-15 Albert Graef <Dr....@t-...> * matcher.hh: gcc 4.3 compatibility fixes. Suggested by Toni This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-16 07:59:29
|
Revision: 243 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=243&view=rev Author: agraef Date: 2008-06-16 00:59:35 -0700 (Mon, 16 Jun 2008) Log Message: ----------- Add syntax highlighting file for Andre Simon's highlight program. Added Paths: ----------- pure/trunk/etc/pure.lang Added: pure/trunk/etc/pure.lang =================================================================== --- pure/trunk/etc/pure.lang (rev 0) +++ pure/trunk/etc/pure.lang 2008-06-16 07:59:35 UTC (rev 243) @@ -0,0 +1,33 @@ +# Pure language definition file for highlight (http:/www.andre-simon.de/). +# Copy this to your /usr/share/highlight/langDefs directory. + +$DESCRIPTION=Pure + +# Pure keywords. +$KW_LIST(kwa)=infix infixl infixr prefix postfix nullary case else end extern +if let of otherwise then using when with + +# Type identifiers used as tags and in extern declarations. +$KW_LIST(kwc)=bigint bool char short int long double expr string pointer void + +# Other special symbols (lambda, parens, list brackets, type tags). +$SYMBOLS= \ ( ) [ ] :: + +# Double-quoted strings and escapes. +$STRINGDELIMITERS=" +$ESCCHAR=\ +$ALLOWEXTESCAPE=false + +# Comments (same as in C++, comments may not be nested). +$SL_COMMENT=// +$ML_COMMENT=/* */ +$ALLOWNESTEDCOMMENTS=false + +# Shebang (actually treated as a comment in Pure). +$DIRECTIVE=#! + +# Pure is case-sensitive. +$IGNORECASE=false + +# We don't have an indentation style (yet). +$REFORMATTING=false This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <ag...@us...> - 2008-06-16 07:56:56
|
Revision: 242 http://pure-lang.svn.sourceforge.net/pure-lang/?rev=242&view=rev Author: agraef Date: 2008-06-16 00:57:01 -0700 (Mon, 16 Jun 2008) Log Message: ----------- Move syntax highlighting stuff to a separate etc directory. Added Paths: ----------- pure/trunk/etc/ pure/trunk/etc/pure-mode.el.in pure/trunk/etc/pure.vim pure/trunk/etc/pure.xml Removed Paths: ------------- pure/trunk/pure-mode.el.in pure/trunk/pure.vim pure/trunk/pure.xml Copied: pure/trunk/etc/pure-mode.el.in (from rev 233, pure/trunk/pure-mode.el.in) =================================================================== --- pure/trunk/etc/pure-mode.el.in (rev 0) +++ pure/trunk/etc/pure-mode.el.in 2008-06-16 07:57:01 UTC (rev 242) @@ -0,0 +1,1711 @@ +;;; pure-mode.el --- edit and run Pure scripts -*- Emacs-Lisp -*- + +;; Copyright (C) 1997-2002 Free Software Foundation, Inc. +;; Copyright (C) 1999-2002 Albert Graef +;; Copyright (C) 2008 Albert Graef + +;; Distributed under GPL V3 (or later; see the accompanying COPYING file). + +;; Author/Maintainer: Albert Graef +;; <ag...@mu..., Dr....@t-...> + +;; This is a quick and dirty hack of Q mode, which in turn was based on +;; various different language modes like Prolog mode and Emacs Lisp mode. It +;; desperately needs an overhaul; in particular, auto-indentation is pretty +;; much broken right now. (Watch out for XXXFIXME.) + +;; INSTALLATION: If necessary, edit the values of the `pure-prog' and +;; `pure-lib-dir' variables below. + +(defvar pure-prog "@bindir@/pure") +(defvar pure-lib-dir "@libdir@/pure") + +;; Then copy this file to your site-lisp directory. The easiest way to make +;; Pure mode available in emacs is to add the following to your emacs startup +;; file: + +;; (require 'pure-mode) + +;; To enable Pure mode for *.pure files, add the following to your emacs +;; startup file: + +;; (setq auto-mode-alist (cons '("\\.pure$" . pure-mode) auto-mode-alist)) + +;; Furthermore, you can enable font lock (syntax highlighting) as follows: + +;; (add-hook 'pure-mode-hook 'turn-on-font-lock) +;; (add-hook 'pure-eval-mode-hook 'turn-on-font-lock) + +;; Well, that's the way it works with XEmacs and newer GNU Emacs versions. For +;; older versions of GNU Emacs you might have to try something like: + +;; (global-font-lock-mode t) +;; (add-hook 'pure-mode-hook (lambda () (font-lock-mode 1))) +;; (add-hook 'pure-eval-mode-hook (lambda () (font-lock-mode 1))) + +;; Using the Pure-Eval hook you can also rebind the cursor up and down keys to +;; the history cycling commands: + +;; (add-hook 'pure-eval-mode-hook +;; (lambda () +;; (define-key pure-eval-mode-map [up] 'comint-previous-input) +;; (define-key pure-eval-mode-map [down] 'comint-next-input))) + +;; Finally, you might wish to add some global key bindings, e.g.: + +;; (global-set-key "\C-c\M-p" 'run-pure) + +;; NOTE: For reading the Pure online documentation, simply use Emacs' built-in +;; manpage reader (M-? RET in XEmacs). Pure's 'help' command won't work in an +;; Emacs buffer. + +(require 'comint) + +;; customizable variables + +(defgroup pure nil "Major mode for editing and running Pure scripts." + :group 'languages) + +(defcustom pure-default-rhs-indent 32 + "*Default indentation of the right-hand side of a rule." + :type 'integer + :group 'pure ) + +(defcustom pure-extra-decl-indent 2 + "*Extra indentation of continuation lines in declarations." + :type 'integer + :group 'pure ) + +(defcustom pure-extra-qual-indent 2 + "*Extra indentation of qualifiers in rules." + :type 'integer + :group 'pure ) + +(defcustom pure-hanging-comment-ender-p t + "*Controls what \\[fill-paragraph] does to Pure block comment enders. +When set to nil, Pure block comment enders are left on their own line. +When set to t, block comment enders will be placed at the end of the +previous line (i.e. they `hang' on that line)." + :type 'boolean + :group 'pure) + +(defcustom pure-hanging-comment-starter-p t + "*Controls what \\[fill-paragraph] does to Pure block comment starters. +When set to nil, Pure block comment starters are left on their own line. +When set to t, text that follows a block comment starter will be +placed on the same line as the block comment starter (i.e. the text +`hangs' on that line)." + :type 'boolean + :group 'pure) + +(defcustom pure-prog-name pure-prog + "*Name of the interpreter executable." + :type 'string + :group 'pure) + +(defcustom pure-histfile "~/.pure_history" + "*Name of the command history file." + :type 'string + :group 'pure) + +(defcustom pure-histsize 500 + "*Size of the command history." + :type 'integer + :group 'pure) + +(defcustom pure-query-before-kill nil + "*Indicates that the user should be prompted before zapping an existing +interpreter process when starting a new one." + :type 'boolean + :group 'pure) + +(defcustom pure-prompt-regexp "^> \\|^[A-Za-z_0-9-]*> \\|^: " + "*Regexp to match prompts in the Pure interpreter. If you customize the +interpreter's default prompt, you will have to change this value accordingly." + :type 'regexp + :group 'pure) + +(defcustom pure-msg-regexp + "^[ \t]*\\(\\([^:\n]+\\):\\([0-9]+\\)\\(\\.[0-9]+\\)?\\):" +"*Regexp to match error and warning messages with source line references in +the Pure eval buffer. Expression 1 denotes the whole source line info, +expression 2 the file name and expression 3 the corresponding line number." + :type 'regexp + :group 'pure) + +(defcustom pure-mode-hook nil + "*Hook for customising Pure mode. +For instance, add `turn-on-font-lock' to enable syntax highlighting." + :type 'hook + :group 'pure) + +(defcustom pure-eval-mode-hook nil + "*Hook for customising Pure eval mode. +For instance, add `turn-on-font-lock' to enable syntax highlighting." + :type 'hook + :group 'pure) + +;; the following are used internally + +(defvar pure-output-list nil) +(defvar pure-output-string nil) +(defvar pure-receive-in-progress nil) +(defvar pure-last-dir nil) +(defvar pure-last-script nil) +(defvar pure-last-path nil) + +;; font-lock support + +(defvar pure-eval-font-lock-keywords + (list +; (list pure-prompt-regexp 0 'font-lock-preprocessor-face t) + (list pure-msg-regexp 0 'font-lock-warning-face t) + (list "::\\([A-Za-z_][A-Za-z_0-9]*\\)" 1 'font-lock-type-face) + (list + (concat "\\<\\(" + "case\\|e\\(lse\\|nd\\|xtern\\)\\|i\\(f\\|nfix[lr]?\\)\\|let\\|" + "nullary\\|o\\(f\\|therwise\\)\\|p\\(refix\\|ostfix\\)\\|" + "then\\|using\\|w\\(hen\\|ith\\)" + "\\)\\>") + 0 'font-lock-keyword-face)) + "Rules for fontifying in Pure-Eval mode.") + +(defvar pure-font-lock-keywords + (list + (list "^#!.*" 0 'font-lock-comment-face t) + (list "::\\([A-Za-z_][A-Za-z_0-9]*\\)" 1 'font-lock-type-face) + (list + (concat "\\<\\(" + "case\\|e\\(lse\\|nd\\|xtern\\)\\|i\\(f\\|nfix[lr]?\\)\\|let\\|" + "nullary\\|o\\(f\\|therwise\\)\\|p\\(refix\\|ostfix\\)\\|" + "then\\|using\\|w\\(hen\\|ith\\)" + "\\)\\>") + 0 'font-lock-keyword-face)) + "Rules for fontifying Pure scripts.") + +;; keymaps + +(defvar pure-mode-map nil) +(cond ((not pure-mode-map) + (setq pure-mode-map (make-sparse-keymap)) + (define-key pure-mode-map "\C-c\C-c" 'pure-run-script) + (define-key pure-mode-map "\C-c\C-u" 'pure-current-msg) + (define-key pure-mode-map "\C-c\C-n" 'pure-next-msg) + (define-key pure-mode-map "\C-c\C-p" 'pure-prev-msg) + (define-key pure-mode-map "\C-c\C-e" 'pure-last-msg) + (define-key pure-mode-map "\C-c\C-a" 'pure-first-msg) + (define-key pure-mode-map "\C-c\C-f" 'pure-find-script) + (define-key pure-mode-map "\C-c\C-v" 'pure-goto-input-line) + (define-key pure-mode-map "\t" 'pure-indent-line) + (define-key pure-mode-map "(" 'pure-electric-delim) + (define-key pure-mode-map ")" 'pure-electric-delim) + (define-key pure-mode-map "[" 'pure-electric-delim) + (define-key pure-mode-map "]" 'pure-electric-delim) + (define-key pure-mode-map "=" 'pure-electric-delim) + (define-key pure-mode-map "\e\C-i" 'pure-move-to-indent-column) + (define-key pure-mode-map "\e\C-q" 'pure-indent-current-rule))) + +(defvar pure-eval-mode-map nil) +(cond ((not pure-eval-mode-map) + (setq pure-eval-mode-map (copy-keymap comint-mode-map)) + (define-key pure-eval-mode-map "\t" 'comint-dynamic-complete) + (define-key pure-eval-mode-map "\C-a" 'comint-bol) + (define-key pure-eval-mode-map [home] 'comint-bol) +;; (define-key pure-eval-mode-map [up] 'comint-previous-input) +;; (define-key pure-eval-mode-map [down] 'comint-next-input) + (define-key pure-eval-mode-map [return] 'pure-current-msg-or-send) + (if (string-match "XEmacs\\|Lucid" emacs-version) + (define-key pure-eval-mode-map [button2] 'pure-mouse-msg) + (define-key pure-eval-mode-map [mouse-2] 'pure-mouse-msg)) + (define-key pure-eval-mode-map "\C-c\C-u" 'pure-current-msg) + (define-key pure-eval-mode-map "\C-c\C-n" 'pure-next-msg) + (define-key pure-eval-mode-map "\C-c\C-p" 'pure-prev-msg) + (define-key pure-eval-mode-map "\C-c\C-e" 'pure-last-msg) + (define-key pure-eval-mode-map "\C-c\C-a" 'pure-first-msg) + (define-key pure-eval-mode-map "\C-c\C-f" 'pure-find-script) + (define-key pure-eval-mode-map "\C-c\C-v" 'pure-goto-input-line))) + +;; menus + +(defsubst pure-region-is-active-p () + ;; Return t when the region is active. The determination of region + ;; activeness is different in both Emacs and XEmacs. + (cond + ;; XEmacs + ((and (fboundp 'region-active-p) + zmacs-regions) + (region-active-p)) + ;; Emacs + ((boundp 'mark-active) mark-active) + ;; fallback; shouldn't get here + (t (mark t)))) + +(defvar pure-mode-menu + (list "Pure" + ["Describe Pure Mode" describe-mode t] + ["Customize" (customize-group 'pure) t] + "-" + ["Move to `=' Column" pure-move-to-indent-column t] + ["Indent Current Rule" pure-indent-current-rule t] + ["Indent Line or Region" pure-indent-line-or-region t] + ["Comment Out Region" comment-region (pure-region-is-active-p)] + ["Uncomment Region" uncomment-region (pure-region-is-active-p)] + ["Fill Comment Paragraph" pure-fill-paragraph t] + "-" + ["Run Script" pure-run-script t] + ["Find Main Script" pure-find-script pure-last-script] + ["Goto Input Line" pure-goto-input-line + (get-process "pure-eval")] + "-" + ["Current Message" pure-current-msg + (get-buffer "*pure-eval*")] + ["First Message" pure-first-msg + (get-buffer "*pure-eval*")] + ["Next Message" pure-next-msg + (get-buffer "*pure-eval*")] + ["Previous Message" pure-prev-msg + (get-buffer "*pure-eval*")] + ["Last Message" pure-last-msg + (get-buffer "*pure-eval*")]) + "Menu for Pure mode.") + +(defvar pure-eval-mode-menu + (list "Pure-Eval" + ["Describe Pure-Eval Mode" describe-mode t] + ["Customize" (customize-group 'pure) t] + "-" + ["Find Main Script" pure-find-script pure-last-script] + ["Goto Input Line" pure-goto-input-line + (get-process "pure-eval")] + "-" + ["Current Message" pure-current-msg + (get-buffer "*pure-eval*")] + ["First Message" pure-first-msg + (get-buffer "*pure-eval*")] + ["Next Message" pure-next-msg + (get-buffer "*pure-eval*")] + ["Previous Message" pure-prev-msg + (get-buffer "*pure-eval*")] + ["Last Message" pure-last-msg + (get-buffer "*pure-eval*")] + "-" + ["Complete Symbol" comint-dynamic-complete + (pure-at-command-prompt-p)]) + "Menu for Pure-Eval mode.") + +;; some helper functions for pure/pure-eval-mode: check that we're on the +;; command resp. debugger prompt + +(defun pure-at-pmark-p () + (and (get-buffer "*pure-eval*") + (get-process "pure-eval") + (progn (set-buffer "*pure-eval*") (comint-after-pmark-p)))) + +(defun pure-at-command-prompt-p () + (and + (pure-at-pmark-p) + (save-excursion + (forward-line 0) + (looking-at pure-prompt-regexp)))) + +(defun pure-at-debug-prompt-p () + (and + (pure-at-pmark-p) + (save-excursion + (forward-line 0) + (looking-at ":")))) + +;; Pure mode + +;;;###autoload +(defun pure-mode () + "Major mode for editing Pure scripts. + +Provides the `pure-run-script' (\\[pure-run-script]) command to run the +interpreter on the script in the current buffer. It will be verified that the +buffer has a file associated with it, and you will be prompted to save edited +buffers when invoking this command. Special commands to quickly locate the +main script and the input line of the Pure eval buffer, and to visit the +source lines shown in error messages are provided as well (see +`pure-eval-mode'). + +These operations can be selected from the Pure mode menu (accessible from +the menu bar), which also provides commands for reading the online +help and customizing the Pure/Pure-Eval mode setup. + +Command list: + +\\{pure-mode-map} +Entry to this mode calls the value of pure-mode-hook if that value is +non-nil." + (interactive) + (kill-all-local-variables) + (set-syntax-table (make-syntax-table)) + (modify-syntax-entry ?_ "_") + (modify-syntax-entry ?\. "_") + (modify-syntax-entry ?\+ ".") + (modify-syntax-entry ?\- ".") + (modify-syntax-entry ?\= ".") + (modify-syntax-entry ?\< ".") + (modify-syntax-entry ?\> ".") + (modify-syntax-entry ?\$ ".") + (modify-syntax-entry ?\| ".") + ;; comment syntax a la C++ mode +; (cond +; ;; XEmacs 19 & 20 +; ((memq '8-bit c-emacs-features) +; (modify-syntax-entry ?/ ". 1456") +; (modify-syntax-entry ?* ". 23")) +; ;; Emacs 19 & 20 +; ((memq '1-bit c-emacs-features) +; (modify-syntax-entry ?/ ". 124b") +; (modify-syntax-entry ?* ". 23")) +; ;; incompatible +; (t (error "Pure Mode is incompatible with this version of Emacs"))) + (cond + ((string-match "XEmacs\\|Lucid" emacs-version) + (modify-syntax-entry ?/ ". 1456") + (modify-syntax-entry ?* ". 23")) + (t + (modify-syntax-entry ?/ ". 124b") + (modify-syntax-entry ?* ". 23"))) + (modify-syntax-entry ?\n "> b") + (modify-syntax-entry ?\^m "> b") + (setq major-mode 'pure-mode) + (setq mode-name "Pure") + (use-local-map pure-mode-map) + (make-local-variable 'paragraph-start) +;; (setq paragraph-start (concat "^$\\|" page-delimiter)) +;; (setq paragraph-start (concat "^//\\|^$\\|" page-delimiter)) + (setq paragraph-start (concat page-delimiter "\\|$")) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t) + (if (boundp 'fill-paragraph-function) + (progn + (make-local-variable 'fill-paragraph-function) + (setq fill-paragraph-function 'pure-fill-paragraph))) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'pure-indent-line) + (make-local-variable 'indent-region-function) + (setq indent-region-function 'pure-indent-region) + (make-local-variable 'comment-start) + (make-local-variable 'comment-end) + (make-local-variable 'comment-column) + (make-local-variable 'comment-start-skip) + (make-local-variable 'comment-multi-line) + (setq comment-column 48 + comment-start "// " + comment-end "" + comment-start-skip "/\\*+ *\\|// *\\|^#! *" + comment-multi-line nil + ) + (make-local-variable 'comment-indent-function) + (setq comment-indent-function 'pure-comment-indent) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '(pure-font-lock-keywords nil nil ((?_ . "w")))) + (require 'easymenu) + (easy-menu-define pure-mode-menu-map pure-mode-map + "Menu keymap for Pure mode." pure-mode-menu) + (easy-menu-add pure-mode-menu-map pure-mode-map) + (run-hooks 'pure-mode-hook)) + +;; Pure eval mode + +(defun pure-eval-mode () + + "Major mode for interacting with the Pure interpreter, based on comint-mode. + +Provides the `pure-current-msg-or-send' (\\[pure-current-msg-or-send]) +command, which, when point is at an error message describing a source +reference, visits the given line in the corresponding source file in another +window. Otherwise it runs the `comint-send-input' command, which usually +submits a command line to the interpreter, or copies it to the command prompt +when point is not at the current command line. + +Error messages are indicated with a special font, and in XEmacs they will also +be highlighted when the mouse passes over them. Moreover, pressing the middle +mouse button (button2) over such a message visits the corresponding source +line in another window (`pure-mouse-msg' command); anywhere else, the middle +mouse button invokes the usual `mouse-yank' command, so that you can also use +the mouse to perform xterm-like cut and paste in the Pure-Eval buffer. + +You can also use the `pure-first-msg' (\\[pure-first-msg]), `pure-next-msg' +(\\[pure-next-msg]), `pure-prev-msg' (\\[pure-prev-msg]) and `pure-last-msg' +(\\[pure-last-msg]) commands to scan through error messages found in the +buffer. The `pure-find-script' (\\[pure-find-script]) command lets you visit +the script that is currently running, and `pure-goto-input-line' +(\\[pure-goto-input-line]) quickly takes you to the prompt at the current +input line in the Pure eval buffer. (These commands are also provided in Pure +mode. If you like, you can bind them globally, so that you can invoke them +from other kinds of buffers as well.) + +Besides this, you can use the usual comint commands, see the description of +`comint-mode' for details. Some important commands are listed below: + +\\[comint-previous-input] and \\[comint-next-input] cycle through the command history. +\\[comint-previous-matching-input] and \\[comint-next-matching-input] search the command history. +\\[comint-interrupt-subjob] sends a Ctl-C to the interpreter. +\\[comint-send-eof] sends a Ctl-D to the interpreter. +\\[comint-dynamic-list-input-ring] lists the command history. +\\[comint-dynamic-complete] performs symbol and filename completion. + +Note that in difference to standard comint mode, the C-a/home keys are rebound +to `comint-bol', to mimic the behaviour of the default binding of these keys +in the interpreter. + +Most of these operations can also be selected from the Comint and Pure-Eval +mode menus accessible from the menu bar. The Pure-Eval menu also provides +operations for reading the online help and customizing Pure/Pure-Eval mode +setup. Moreover, a History menu is provided from which the most recent +commands can be selected. + +The interpreter's prompt and lines containing error messages are described by +the variables `pure-prompt-regexp' and `pure-msg-regexp'. The history file and +size is given by the `pure-histfile' and `pure-histsize' variables. Note that +when the `pure-gnuclient' customization option is enabled, then Pure-Eval mode +automatically tracks the current prompt string and hence you can safely use +the `prompt' command in the interpreter. + +A complete command list is given below: + +\\{pure-eval-mode-map} +Entry to this mode runs the hooks on `comint-mode-hook' and +`pure-eval-mode-hook' (in that order)." + + (interactive) + (kill-all-local-variables) + (comint-mode) + (set-syntax-table (make-syntax-table)) + (modify-syntax-entry ?_ "_") + (modify-syntax-entry ?\. "_") + (modify-syntax-entry ?\+ ".") + (modify-syntax-entry ?\- ".") + (modify-syntax-entry ?\= ".") + (modify-syntax-entry ?\< ".") + (modify-syntax-entry ?\> ".") + (modify-syntax-entry ?\| ".") + (modify-syntax-entry ?\$ ".") + (modify-syntax-entry ?\/ ". 12") + (modify-syntax-entry ?\* ".") + (modify-syntax-entry ?\n ">") + (modify-syntax-entry ?\^m ">") + (setq major-mode 'pure-eval-mode) + (setq mode-name "Pure-Eval") + (use-local-map pure-eval-mode-map) + (setq comint-prompt-regexp pure-prompt-regexp) + (make-local-variable 'paragraph-start) + (setq paragraph-start comint-prompt-regexp) + (make-local-variable 'comment-start) + (make-local-variable 'comment-end) + (make-local-variable 'comment-column) + (make-local-variable 'comment-start-skip) + (make-local-variable 'comment-multi-line) + (setq comment-column 48 + comment-start-skip "// *\\|^#! *" + comment-multi-line nil) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '(pure-eval-font-lock-keywords nil nil ((?_ . "w")))) + (setq comint-input-ring-file-name pure-histfile + comint-input-ring-size pure-histsize + comint-dynamic-complete-functions + '(pure-complete comint-dynamic-complete-filename)) + ;; mouse-sensitive messages (requires XEmacs) + (cond + ((string-match "XEmacs\\|Lucid" emacs-version) + (require 'mode-motion) + (setq mode-motion-hook 'pure-motion-hook))) + (comint-read-input-ring t) + (require 'easymenu) + (easy-menu-define pure-eval-mode-menu-map pure-eval-mode-map + "Menu keymap for Pure mode." pure-eval-mode-menu) + (easy-menu-add pure-eval-mode-menu-map pure-eval-mode-map) + (run-hooks 'pure-eval-mode-hook)) + +(if (string-match "XEmacs" emacs-version) +(defun pure-motion-hook (event) + (mode-motion-highlight-internal + event + #'beginning-of-line + #'(lambda () + (if (looking-at pure-msg-regexp) + (end-of-line)))) +)) + +;; run a Q script in a Q eval buffer + +;; make sure win32 XEmacs quotes arguments containing whitespace + +(if (string-match "XEmacs.*-win32" (emacs-version)) + (defun pure-quote-arg (x) + (if (string-match "[ \t]" x) (concat "\"" x "\"") x)) + (defun pure-quote-arg (x) x)) + +;;;###autoload +(defun run-pure (&rest args) + + "Run the interpreter with given arguments, in buffer *pure-eval*. + +The interpreter is invoked in the directory of the current buffer (current +default directory if no file is associated with the current buffer). +If buffer exists but process is not running, make new process. +If buffer exists and process is running, kill it and start a new one. + +Program used comes from variable `pure-prog-name'. The buffer is put in Pure +eval mode, giving commands for visiting source files, sending input, +manipulating the command history, etc. See `pure-eval-mode'. + +\(Type \\[describe-mode] in the Pure eval buffer for a list of commands.)" + + (interactive) + (let* ((dir (if buffer-file-name + (file-name-directory (buffer-file-name)) + default-directory)) + (pure-eval-active (not (null (get-buffer "*pure-eval*")))) + (pure-eval-running (comint-check-proc "*pure-eval*")) + (pure-eval-buffer (get-buffer-create "*pure-eval*"))) + (if (and pure-eval-running + pure-query-before-kill + (not + (y-or-n-p + "An interpreter process is still running. Start a new one? "))) + (message "Aborted") + (set-buffer pure-eval-buffer) + ;; give process some time to terminate, then blast it away + (if pure-eval-running + (progn + (comint-send-eof) + (sleep-for .5))) + (if (comint-check-proc "*pure-eval*") + (progn + (comint-kill-subjob) + (sleep-for .1))) + (cd dir) + (if (not pure-eval-active) + (pure-eval-mode) + (if (and pure-eval-running + (or (not (string-equal + comint-input-ring-file-name pure-histfile)) + (not (= comint-input-ring-size pure-histsize)))) + ;; reset history in case any of the options have changed + (progn + (comint-write-input-ring) + (setq comint-input-ring-file-name pure-histfile + comint-input-ring-size pure-histsize) + (comint-read-input-ring t)))) + (goto-char (point-max)) + ;; invoke the interpreter + (setenv "PURE_MORE" nil) ; disable paging in the interpreter + (comint-exec pure-eval-buffer "pure-eval" pure-prog-name nil + (append (list "-q" "-i") args)) + ;; set up process parameters + (setq pure-output-list nil + pure-output-string nil + pure-receive-in-progress nil + pure-last-script nil + pure-last-dir dir + pure-last-path nil) + (set-process-sentinel (get-process "pure-eval") 'pure-eval-sentinel) + (if (not pure-query-before-kill) + (process-kill-without-query (get-process "pure-eval"))) + ;; switch to and go to the end of the eval buffer + (pop-to-buffer "*pure-eval*") + (goto-char (point-max)))) + ) + +(defun pure-run-script () + "Run the interpreter with the script in the current buffer, in buffer +*pure-eval*. See `run-pure' for details." + (interactive) + (let ((script-file + (if (buffer-file-name) + (file-name-nondirectory (buffer-file-name)) + (error "Buffer is not associated with any file")))) + (save-some-buffers) + (run-pure script-file) + (setq pure-last-script script-file))) + +;; find a script in the current directory or on the Pure library path + +(defun pure-locate-script (file) + (let ((script (locate-library file t (list "." pure-lib-dir)))) + (if script + script + (error (concat "File " file " not found"))))) + +;; visit source lines of error and debugging messages + +(defun pure-current-msg () + "Show the source line referenced by an error message on the current line +in the Pure eval buffer." + (interactive) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (cond + ((save-excursion (forward-line 0) (looking-at pure-msg-regexp)) + (forward-line 0) (recenter 0) + (let (visit-buffer + visit-line + (file (match-string 2)) (line (match-string 3))) + (setq visit-buffer (find-file-noselect (pure-locate-script file))) + (setq visit-line (string-to-number line)) + (message "%s, line %s" file line) + (switch-to-buffer-other-window visit-buffer) + (goto-line visit-line))) + (t + (select-window actwindow) + (error "No message found"))))) + +(defun pure-current-msg-or-send () + "Depending on whether point is at an error message, either execute a +`pure-current-msg' or a `comint-send-input' command. This must be invoked +from the Pure eval buffer." + (interactive) + (if (save-excursion (forward-line 0) (looking-at pure-msg-regexp)) + (pure-current-msg) + (comint-send-input))) + +(defun pure-next-msg (&optional count) + "Advance to the next Pure error message below the current line in the Pure +eval buffer, and show the referenced source line in another window. When used +with a numeric argument n, advance to the nth message below the current line +(move backwards if numeric argument is negative). + +Note that this command can easily be fooled if the running script produces +some output, or you insert some text, which looks like an error message, so +you should take care what you're doing." + (interactive "P") + (if (and (numberp count) (< count 0)) + (pure-prev-msg (- count)) + (if (null count) (setq count 1)) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (if (looking-at pure-msg-regexp) + (if (save-excursion (end-of-line) (not (eobp))) + (forward-line 1) + (error "No more messages"))) + (let ((pos (re-search-forward pure-msg-regexp nil t count))) + (if pos + (let ((file (match-string 2)) (line (match-string 3))) + (goto-char pos) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line)) + (select-window actwindow) + (error "No more messages")))))) + +(defun pure-prev-msg (&optional count) + "Advance to previous Pure error messages above the current line in the Pure +eval buffer, and show the referenced source line in another window. Like +`pure-next-msg', but moves backward." + (interactive "P") + (if (and (numberp count) (< count 0)) + (pure-next-msg (- count)) + (if (null count) (setq count 1)) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (let ((pos (re-search-backward pure-msg-regexp nil t count))) + (if pos + (let ((file (match-string 2)) (line (match-string 3))) + (goto-char pos) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line)) + (select-window actwindow) + (error "No more messages")))))) + +(defun pure-last-msg () + "Advance to the last message in a contiguous sequence of error messages at +or below the current line, and show the referenced source line in another +window." + (interactive) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (let ((pos + (if (looking-at pure-msg-regexp) + (point) + (re-search-forward pure-msg-regexp nil t)))) + (if pos + (progn + (goto-char pos) + (while (and (save-excursion (end-of-line) (not (eobp))) + (save-excursion (forward-line 1) + (looking-at pure-msg-regexp))) + (forward-line 1)) + (let ((file (match-string 2)) (line (match-string 3))) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line))) + (select-window actwindow) + (error "No more messages"))))) + +(defun pure-first-msg () + "Advance to the first message in a contiguous sequence of error messages at +or above the current line, and show the referenced source line in another +window." + (interactive) + (let ((actwindow (selected-window))) + (if (get-buffer "*pure-eval*") + (pop-to-buffer "*pure-eval*") + (error "No script is running")) + (forward-line 0) + (let ((pos + (if (looking-at pure-msg-regexp) + (point) + (re-search-backward pure-msg-regexp nil t)))) + (if pos + (progn + (goto-char pos) + (while (and (not (bobp)) + (save-excursion (forward-line -1) + (looking-at pure-msg-regexp))) + (forward-line -1)) + (let ((file (match-string 2)) (line (match-string 3))) + (recenter 0) + (find-file-other-window (pure-locate-script file)) + (goto-line (string-to-number line)) + (message "%s, line %s" file line))) + (select-window actwindow) + (error "No more messages"))))) + +(defun pure-mouse-msg (event) + "Show the source line referenced by an error message under the mouse." + (interactive "e") + (mouse-set-point event) + (if (save-excursion (forward-line 0) (looking-at pure-msg-regexp)) + (progn (forward-line 0) (pure-current-msg)) + (mouse-yank event))) + +;; visit main script and the eval buffer + +(defun pure-find-script () + "Visit the script currently running in the Pure eval buffer." + (interactive) + (if (and pure-last-dir pure-last-script) + (if (not (string-equal (concat pure-last-dir pure-last-script) + (buffer-file-name))) + (find-file-other-window (concat pure-last-dir pure-last-script))) + (error "No script is running"))) + +(defun pure-goto-input-line () + "Move to the prompt in the Pure eval buffer." + (interactive) + (if (get-buffer "*pure-eval*") + (progn (pop-to-buffer "*pure-eval*") (goto-char (point-max))) + (error "No script is running"))) + +;; completion + +(defun pure-complete () + "Perform completion on the token preceding point." + (interactive) + (if (pure-at-command-prompt-p) + (let* ((end (point)) + (command + (save-excursion + ;; skip back one word/identifier or operator (punctuation) + (skip-syntax-backward "w_") + (and (eq (point) end) + (skip-syntax-backward ".")) + (and (looking-at pure-prompt-regexp) + (goto-char (match-end 0))) + (buffer-substring-no-properties (point) end)))) + (pure-send-list-and-digest + (list (concat "completion_matches " command "\n"))) + ;; Sort the list + (setq pure-output-list + (sort pure-output-list 'string-lessp)) + ;; Remove duplicates + (let* ((x pure-output-list) + (y (cdr x))) + (while y + (if (string-equal (car x) (car y)) + (setcdr x (setq y (cdr y))) + (setq x y + y (cdr y))))) + ;; And let comint handle the rest + (comint-dynamic-simple-complete command pure-output-list)))) + +;; send commands to the Q interpreter and digest their results + +(defun pure-output-digest (proc string) + (setq string (concat pure-output-string string)) + (while (string-match "\n" string) + (setq pure-output-list + (append pure-output-list + (list (substring string 0 (match-beginning 0)))) + string (substring string (match-end 0)))) + (if (string-match pure-prompt-regexp string) + (setq pure-receive-in-progress nil)) + (setq pure-output-string string)) + +(defun pure-send-list-and-digest (list) + (let* ((pure-eval-buffer (get-buffer "*pure-eval*")) + (proc (get-buffer-process pure-eval-buffer)) + (filter (process-filter proc)) + string) + (set-process-filter proc 'pure-output-digest) + (setq pure-output-list nil) + (unwind-protect + (while (setq string (car list)) + (setq pure-output-string nil + pure-receive-in-progress t) + (comint-send-string proc string) + (while pure-receive-in-progress + (accept-process-output proc)) + (setq list (cdr list))) + (set-process-filter proc filter)))) + +;; perform cleanup when the interpreter process is killed + +(defun pure-eval-sentinel (proc msg) + (if (null (buffer-name (process-buffer proc))) + ;; buffer has been killed + (set-process-buffer proc nil) + (set-buffer (process-buffer proc)) + (comint-write-input-ring) + (setq pure-last-dir nil + pure-last-script nil) + (goto-char (point-max)) + (insert "\n*** Process Pure-Eval finished ***\n"))) + +;; make sure that the history is written when exiting emacs +(add-hook 'kill-emacs-hook + (lambda () + (let ((pure-eval-buffer (get-buffer "*pure-eval*"))) + (cond + (pure-eval-buffer + (set-buffer pure-eval-buffer) + (comint-write-input-ring)))))) + +;; autoindent and fill support (preliminary) + +;; XXXFIXME: This needs to be completely rewritten. We still use the Q +;; indentation rules here (with some minor tweaks), which don't work all that +;; well even in Q mode. + +(defun pure-electric-delim (arg) + "Insert character and correct line's indentation." + (interactive "P") + (if (and (not arg) + (save-excursion + (skip-chars-backward " \t") + (bolp))) + (progn + (insert last-command-char) + (pure-indent-line) + (delete-char -1))) + (self-insert-command (prefix-numeric-value arg))) + +;; find the position of the previous rule's rhs (`=' delimiter) +(defun pure-prev-rhs () + (if (not (pure-backward-to-delim "=")) + nil + ;; back up to beginning of rule, then find 1st `=' at toplevel + (beginning-of-rule) + (if (not (pure-forward-to-delim "=")) + nil ; this shouldn't happen + (backward-char) + (point)))) + +(defvar pure-qual-keywords "\\<\\(if\\|otherwise\\|when\\|with\\)\\>") + +(defun pure-at-qual () + (and (looking-at pure-qual-keywords) + (or (not (looking-at "else")) + (save-excursion + (backward-word 1) + (not (looking-at "or")))))) + +;; find the position of the previous qualifier or conditional keyword (if, +;; else, otherwise, etc.) +(defun pure-prev-qual () + (if (not (pure-backward-to-regexp pure-qual-keywords)) nil + (let ((success t) (done nil)) + (while (and success (not done)) + (setq done (pure-at-qual)) + (setq success (or done (pure-backward-to-regexp pure-qual-keywords)))) + (if (not done) nil + (let* ((p0 (point)) + (p (progn (beginning-of-line) + (if (pure-forward-to-regexp pure-qual-keywords) + (backward-word 1)) + (if (pure-at-qual) (point) p0)))) + (goto-char p)))))) + +(defun pure-move-to-indent-column () + "At end of line, move forward to the current `=' indentation column, as +given by the most recent rule or the \\[pure-default-rhs-indent] variable." + (interactive) + (if (save-excursion + (skip-chars-forward " \t") + (eolp)) + (let ((col (current-column)) + (icol (save-excursion + (if (pure-prev-rhs) + (current-column) + pure-default-rhs-indent)))) + (if (> icol col) + (move-to-column icol t))))) + +(defun pure-comment-indent () + "Compute Pure comment indentation." + (cond ((looking-at "^#!") 0) + ((looking-at "/[/*]") + (let ((indent (pure-calculate-indent))) + (if (consp indent) (car indent) indent))) + (t + (save-excursion + (skip-chars-backward " \t") + (max (current-column) +;; (max (1+ (current-column)) ;Insert one space at least + comment-column))) + )) + +;; FIXME: This stuff (beginning-of-rule, end-of-rule) is broken. It gets +;; caught in block comments easily -- unfortunately, Pure definitions may look a +;; lot like plain comment text ;-). There really seems to be no good way of +;; doing this, because these routines need to be fast, so we can't just parse +;; the whole file any time they are invoked. + +;; As implemented, beginning-of-rule looks for a line starting with a +;; word/symbol constituent, open parentheses, string, or optional whitespace +;; followed by a `=' character, whereas end-of-rule searches for a semicolon +;; at line end (with maybe some single-line comments and whitespace in +;; between). So reasonable formatting styles should all be parsed correctly. + +(defun beginning-of-rule () + "Move backward to beginning of current or previous rule." + (interactive) + (if (or + (if (and (> (current-column) 0) + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*="))) + (progn (beginning-of-line) t) + nil) + (re-search-backward "^\\w\\|^\\s_\\|^\\s(\\|^\\s\"\\|^[ \t]*=" + (point-min) 'mv)) + (let ((p (point))) + (pure-backward-to-noncomment (point-min)) + (if (and (not (bobp)) + (/= (preceding-char) ?\;) + (/= (preceding-char) ?\:)) + (beginning-of-rule) + (goto-char p))))) + +(defun end-of-rule () + "Move forward to end of current or next rule." + (interactive) + (let ((p (point))) + (while (and (re-search-forward +;;; match ";" + whitespace/comment sequence + "\n" +";\\([ \t]+\\|/\\*+\\([^\n\\*]\\|\\*[^\n/]\\)*\\*+/\\)*\\(//.*\\)?\n" + nil 'move) + (/= (1+ (match-beginning 0)) + (save-excursion + (pure-backward-to-noncomment p) + (point))))))) + +(defun pure-indent-line () + "Indent current line as Pure code. +Return the amount the indentation changed by." + (interactive) + (let ((indent (pure-calculate-indent nil)) + start-of-block + beg shift-amt + (case-fold-search nil) + (pos (- (point-max) (point)))) + (if (listp indent) + (progn + (setq start-of-block (cdr indent)) + (setq indent (car indent))) + (setq start-of-block 0)) + (beginning-of-line) + (setq beg (point)) + (setq indent + (cond ((eq indent nil) (current-indentation)) + ((eq indent t) (pure-calculate-indent-within-comment)) + (t + (skip-chars-forward " \t") + (cond ((looking-at "^#!") 0) + ((= (following-char) ?\)) start-of-block) + (t indent))))) + (skip-chars-forward " \t") + (setq shift-amt (- indent (current-column))) + (if (zerop shift-amt) + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + (delete-region beg (point)) + (indent-to indent) + ;; If initial point was within line's indentation, + ;; position after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos)))) + shift-amt)) + +(defvar pure-decl-keywords + (concat "\\<\\(" + "infix[lr]?\\|let\\|nullary\\|p\\(refix\\|ostfix\\)\\|using" + "\\)\\>")) + +(defun pure-indent-col (col pos) + (if pos + (let ((col2 (save-excursion (goto-char pos) (current-column)))) + (cons col col2)) + col) +) + +;; TODO: proper indentation of parenthesized if-then-else constructs +(defun pure-calculate-indent (&optional parse-start) + "Return appropriate indentation for current line as Pure code. +In usual case returns an integer: the column to indent to. +Returns nil if line starts inside a string, t if in a comment, +\(indent . start-of-block\) if line is within a paren block." + (save-excursion + (beginning-of-line) + (let ((indent-point (point)) + (case-fold-search nil) + state + containing-sexp + (at-decl nil) + (lhs-extra-indent 0) + (rhs-extra-indent + (save-excursion + (skip-chars-forward " \t") + (if (pure-at-qual) pure-extra-qual-indent 0))) + (following-character + (save-excursion (skip-chars-forward " \t") (following-char)))) + (if parse-start + (goto-char parse-start) + (let ((p (point))) + (pure-backward-to-noncomment (point-min)) + (if (and (not (bobp)) + (/= (preceding-char) ?\;)) + (beginning-of-rule) + (goto-char p)))) + ;; extra indent for continuation lines in declarations + (if (and (< (point) indent-point) + (looking-at pure-decl-keywords)) + (setq at-decl t + lhs-extra-indent pure-extra-decl-indent)) + (while (< (point) indent-point) + (setq parse-start (point)) + (setq state (parse-partial-sexp (point) indent-point 0)) + (setq containing-sexp (car (cdr state)))) + ;; the above sometimes craps out even if we're inside a balanced pair + ;; of parens, but the following should work in any case + (if (null containing-sexp) + (setq containing-sexp + (condition-case nil + (scan-lists indent-point -1 1) + (error nil)))) + (if (or (nth 3 state) (nth 4 state)) + ;; return nil or t if should not change this line + (nth 4 state) + ;; Check to see whether we are inside a sexp, on the lhs, rhs, + ;; qualifier, or at the = of a rule. + (goto-char indent-point) + (pure-backward-to-noncomment (or parse-start (point-min))) + (let (p0 p1 p2 p3 col1 col2 col3) + (setq p0 containing-sexp + p1 (save-excursion + (pure-backward-to-delim ";") + (point)) + p2 (save-excursion + (if (pure-prev-rhs) (point) 0)) + p3 (save-excursion + (if (pure-prev-qual) (point) 0))) + (if (> p2 0) + (setq col1 (save-excursion + (goto-char p2) + (current-column)) + col2 (save-excursion + (goto-char p2) + (forward-char) + (skip-chars-forward " \t") + (current-column)) + col3 (save-excursion + (goto-char p3) + (current-column))) + (setq col1 pure-default-rhs-indent + col2 pure-default-rhs-indent + col3 pure-default-rhs-indent)) + (cond + ((and (not (null p0)) (>= p0 (max p1 p2 p3))) + ;; inside a sexp (pair of balanced parens): indent at the column + ;; to the right of the paren + (let ((col (save-excursion (goto-char p0) (current-column)))) + (cons (1+ col) col))) + ((or (= following-character ?=) + (= following-character ?\;) + (and at-decl (= following-character ?|))) + ;; followup eqns (initial =), initial semi, and initial | + ;; in declarations are indented at preceding = + (pure-indent-col col1 p0)) + ((or at-decl (> p1 p2)) + ;; lhs: indent at lhs-extra-indent + (pure-indent-col lhs-extra-indent p0)) + ((> p3 p2) + ;; qualifier/conditional: indent at column of previous qualifier + ;; keyword plus pure-extra-qual-indent if no keyword at bol + (pure-indent-col + (+ col3 (if (= 0 rhs-extra-indent) pure-extra-qual-indent 0)) p0)) + (t + ;; rhs: indent at first token behind preceding = + ;; add rhs-extra-indent for initial qualifier keyword + (pure-indent-col (+ col2 rhs-extra-indent) p0)))))))) + +(defun pure-calculate-indent-within-comment () + "Return the indentation amount for line, assuming that +the current line is to be regarded as part of a block comment." + (let (end star-start) + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (setq star-start (= (following-char) ?\*)) + (skip-chars-backward " \t\n") + (setq end (point)) + (beginning-of-line) + (skip-chars-forward " \t") + (and (re-search-forward "/\\*[ \t]*" end t) + star-start + (goto-char (1+ (match-beginning 0)))) + (current-column)))) + +(defun pure-backward-to-noncomment (lim) + (let (opoint stop) + (while (not stop) + (skip-chars-backward " \t\n\f" lim) + (setq opoint (point)) + (if (and (>= (point) (+ 2 lim)) + (= (preceding-char) ?/) (= (char-after (- (point) 2)) ?*)) + (search-backward "/*" lim 'mv) + (let ((p (max lim (save-excursion (beginning-of-line) (point))))) + (if (nth 4 (parse-partial-sexp p (point))) + (re-search-backward "^#!\\|//" p 'mv) + (goto-char opoint) + (setq stop t))))))) + +(defun pure-forward-to-noncomment (lim) + (forward-char 1) + (while (progn + (skip-chars-forward " \t\n" lim) + (looking-at "^#!\\|//\\|/\\*")) + ;; Skip over comments and labels following openparen. + (if (looking-at "^#!\\|//") + (forward-line 1) + (forward-char 2) + (search-forward "*/" lim 'mv)))) + +;; some added stuff for finding = and ; delimiters in rules + +(defun pure-at-toplevel-p () + (let (p state) + (save-excursion + (setq p (save-excursion + (beginning-of-rule) + (point))) + (setq state (parse-partial-sexp p (point))) + (not (or (nth 1 state) + (nth 3 state) + (nth 4 state)))))) + +(defun pure-backward-to-delim (delim-str) + (let ((success nil)) + (while (and (search-backward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (bobp)))) + (if success (point) nil))) + +(defun pure-forward-to-delim (delim-str) + (let ((success nil)) + (while (and (search-forward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (eobp)))) + (if success (point) nil))) + +(defun pure-backward-to-regexp (delim-str) + (let ((success nil)) + (while (and (re-search-backward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (bobp)))) + (if success (point) nil))) + +(defun pure-forward-to-regexp (delim-str) + (let ((success nil)) + (while (and (re-search-forward delim-str nil 'mv) + (progn + (setq success (pure-at-toplevel-p)) + (not success)) + (not (eobp)))) + (if success (point) nil))) + +(defun pure-indent-current-rule () + "Indent all lines in the current rule." + (interactive) + (let (p) + (save-excursion + (end-of-rule) + (setq p (point-marker)) + (beginning-of-rule) + (while (< (point) p) + (pure-indent-line) + (forward-line 1))))) + +;; this stuff is from (XEmacs) cc-mode + +(defun pure-indent-region (start end) + ;; Indent every line whose first char is between START and END inclusive. + (let (p) + (save-excursion + (goto-char start) + (setq p (copy-marker end)) + (while (and (bolp) + (not (eobp)) + (< (point) p)) + (pure-indent-line) + (forward-line 1))))) + +(defun pure-indent-line-or-region () + "When the region is active, indent it. Otherwise indent the current line." + (interactive) + (if (pure-region-is-active-p) + (pure-indent-region (region-beginning) (region-end)) + (pure-indent-line))) + +;; paragraph fill from (XEmacs) cc-mode, boiled down for Pure mode + +(defmacro pure-safe (&rest body) + ;; safely execute BODY, return nil if an error occurred + (` (condition-case nil + (progn (,@ body)) + (error nil)))) + +(defmacro pure-forward-sexp (&optional arg) + ;; like forward-sexp except + ;; 1. this is much stripped down from the XEmacs version + ;; 2. this cannot be used as a command, so we're insulated from + ;; XEmacs' losing efforts to make forward-sexp more user + ;; friendly + ;; 3. Preserves the semantics most of CC Mode is based on + (or arg (setq arg 1)) + `(goto-char (or (scan-sexps (point) ,arg) + ,(if (numberp arg) + (if (> arg 0) `(point-max) `(point-min)) + `(if (> ,arg 0) (point-max) (point-min)))))) + +(defmacro pure-backward-sexp (&optional arg) + ;; See pure-forward-sexp and reverse directions + (or arg (setq arg 1)) + `(pure-forward-sexp ,(if (numberp arg) (- arg) `(- ,arg)))) + +(defsubst pure-point (position) + ;; Returns the value of point at certain commonly referenced POSITIONs. + ;; POSITION can be one of the following symbols: + ;; + ;; bol -- beginning of line + ;; eol -- end of line + ;; + ;; This function does not modify point or mark. + (let ((here (point))) + (cond + ((eq position 'bol) (beginning-of-line)) + ((eq position 'eol) (end-of-line)) + (t (error "unknown buffer position requested: %s" position)) + ) + (prog1 + (point) + (goto-char here)))) + +(defun pure-literal-limits (&optional lim near) + ;; Returns a cons of the beginning and end positions of the comment + ;; or string surrounding point (including both delimiters), or nil + ;; if point isn't in one. If LIM is non-nil, it's used as the + ;; "safe" position to start parsing from. If NEAR is non-nil, then + ;; the limits of any literal next to point is returned. "Next to" + ;; means there's only [ \t] between point and the literal. The + ;; search for such a literal is done first in forward direction. + ;; + ;; This is the Emacs 19 version. + (save-excursion + (let* ((pos (point)) +;;; FIXME: need a reasonable replacement for `beginning-of-defun' (bod) here. +;;; (lim (or lim (pure-point 'bod))) + (lim (or lim (point-min))) + (state (parse-partial-sexp lim (point)))) + (cond ((nth 3 state) + ;; String. Search backward for the start. + (while (nth 3 state) + (search-backward (make-string 1 (nth 3 state))) + (setq state (parse-partial-sexp lim (point)))) + (cons (point) (or (pure-safe (pure-forward-sexp 1) (point)) + (point-max)))) + ((nth 7 state) + ;; Line comment. Search from bol for the comment starter. + (beginning-of-line) + (setq state (parse-partial-sexp lim (point)) + lim (point)) + (while (not (nth 7 state)) + (search-forward "//") ; Should never fail. + (setq state (parse-partial-sexp + lim (point) nil nil state) + lim (point))) + (backward-char 2) + (cons (point) (progn (forward-comment 1) (point)))) + ((nth 4 state) + ;; Block comment. Search backward for the comment starter. + (while (nth 4 state) + (search-backward "/*") ; Should never fail. + (setq state (parse-partial-sexp lim (point)))) + (cons (point) (progn (forward-comment 1) (point)))) + ((pure-safe (nth 4 (parse-partial-sexp ; Can't use prev state due + lim (1+ (point))))) ; to bug in Emacs 19.34. + ;; We're standing in a comment starter. + (backward-char 2) + (cons (point) (progn (forward-comment 1) (point)))) + (near + (goto-char pos) + ;; Search forward for a literal. + (skip-chars-forward " \t") + (cond + ((eq (char-syntax (or (char-after) ?\ )) ?\") ; String. + (cons (point) (or (pure-safe (pure-forward-sexp 1) (point)) + (point-max)))) + ((looking-at pure-comment-start-regexp) ; Line or block comment. + (cons (point) (progn (forward-comment 1) (point)))) + (t + ;; Search backward. + (skip-chars-backward " \t") + (let ((end (point)) beg) + (cond + ((eq (char-syntax (or (char-before) ?\ )) ?\") ; String. + (setq beg (pure-safe (pure-backward-sexp 1) (point)))) + ((and (pure-safe (forward-char -2) t) + (looking-at "*/")) + ;; Block comment. Due to the nature of line + ;; comments, they will always be covered by the + ;; normal case above. + (goto-char end) + (forward-comment -1) + ;; If LIM is bogus, beg will be bogus. + (setq beg (point)))) + (if beg (cons beg end)))))) + )))) + +(defconst pure-comment-start-regexp "\\(/[/*]\\|^#!\\)") + +;; FIXME: I'm wondering why this code messes up the fontification of comment +;; paragraphs since the same code apparently works in C/C++ mode, and the +;; comment syntax is also the same. :( This only happens with XEmacs +;; (21.1p10), no problems with GNU Emacs. Maybe the XEmacs font-lock stuff is +;; broken, or has some special built-in support for the C modes? Anyway, if +;; anyone knows how to fix this please let me know. -AG + +(defun pure-fill-paragraph (&optional arg) + "Like \\[fill-paragraph] but handles Pure (i.e., C/C++) style +comments. If any of the current line is a comment or within a comment, +fill the comment or the paragraph of it that point is in, +preserving the comment indentation or line-starting decorations. + +If point is inside multiline string literal, fill it. This currently +does not respect escaped newlines, except for the special case when it +is the very first thing in the string. The intended use for this rule +is in situations like the following: + +description = \"\\ +A very long description of something that you want to fill to make +nicely formatted output.\"\; + +If point is in any other situation, i.e. in normal code, do nothing. + +Optional prefix ARG means justify paragraph as well." + (interactive "*P") + (let* ((point-save (point-marker)) + limits + comment-start-place + (first-line + ;; Check for obvious entry to comment. + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (and (looking-at comment-start-skip) + (setq comment-start-place (point))))) + (re1 "\\|\\([ \t]*/\\*[ \t]*\\|[ \t]*\\*/[ \t]*\\|[ \t/*]*\\)")) + (if (save-excursion + (beginning-of-line) + (looking-at "#!\\|.*//")) + (let ((fill-prefix fill-prefix) + ;; Lines containing just a comment start or just an end + ;; should not be filled into paragraphs they are next + ;; to. + (paragraph-start (concat paragraph-start re1 "$")) + (paragraph-separate (concat paragraph-separate re1 "$"))) + (save-excursion + (beginning-of-line) + ;; Move up to first line of this comment. + (while (and (not (bobp)) + (looking-at "[ \t]*//[ \t]*[^ \t\n]")) + (forward-line -1)) + (if (not (looking-at ".*//[ \t]*[^ \t\n]")) + (forward-line 1)) + ;; Find the comment start in this line. + (re-search-forward "[ \t]*//[ \t]*") + ;; Set the fill-prefix to be what all lines except the first + ;; should start with. But do not alter a user set fill-prefix. + (if (null fill-prefix) + (setq fill-prefix (buffer-substring (match-beginning 0) + (match-end 0)))) + (save-restriction + ;; Narrow down to just the lines of this comment. + (narrow-to-region (pure-point 'bol) + (save-excursion + (forward-line 1) + (while + (looking-at (regexp-quote fill-prefix)) + (forward-line 1)) + (point))) + (or (pure-safe + ;; fill-paragraph sometimes fails to detect when we + ;; are between paragraphs. + (beginning-of-line) + (search-forward fill-prefix (pure-point 'eol)) + (looking-at paragraph-separate)) + ;; Avoids recursion + (let (fill-paragraph-function) + (fill-paragraph arg)))))) + ;; else C style comments + (if (or first-line + ;; t if we enter a comment between start of function and + ;; this line. + (save-excursion + (setq limits (pure-literal-limits)) + (and (consp limits) + (save-excursion + (goto-char (car limits)) + (looking-at pure-comment-start-regexp)))) + ;; t if this line contains a comment starter. + (setq first-line + (save-excursion + (beginning-of-line) + (prog1 + (re-search-forward comment-start-skip + (save-excursion (end-of-line) + (point)) + t) + (setq comment-start-place (point))))) + ;; t if we're in the whitespace after a comment ender + ;; which ends its line. + (and (not limits) + (when (and (looking-at "[ \t]*$") + (save-excursion + (beginning-of-line) + (looking-at ".*\\*/[ \t]*$"))) + (save-excursion + (forward-comment -1) + (setq comment-start-place (point))) + t))) + ;; Inside a comment: fill one comment paragraph. + (let ((fill-prefix + (or + ;; Keep user set fill prefix if any. + fill-prefix + ;; The prefix for each line of this paragraph + ;; is the appropriate part of the start of this line, + ;; up to the column at which text should be indented. + (save-excursion + (beginning-of-line) + (if (looking-at ".*/\\*.*\\*/") + (progn (re-search-forward comment-start-skip) + (make-string (current-column) ?\ )) + (if first-line + (forward-line 1) + (if (and (looking-at "[ \t]*\\*/") + (not (save-excursion + (forward-line -1) + (looking-at ".*/\\*")))) + (forward-line -1))) + + (let ((line-width (progn (end-of-line) + (current-column)))) + (beginning-of-line) + (prog1 + (buffer-substring + (point) + + ;; How shall we decide where the end of the + ;; fill-prefix is? + (progn + (skip-chars-forward " \t*" (pure-point 'eol)) + ;; kludge alert, watch out for */, in + ;; which case fill-prefix should *not* + ;; be "*"! + (if (and (eq (char-after) ?/) + (eq (char-before) ?*)) + (forward-char -1)) + (point))) + + ;; If the comment is only one line followed + ;; by a blank line, calling move-to-column + ;; above may have added some spaces and tabs + ;; to the end of the line; the fill-paragraph + ;; function will then delete it and the + ;; newline following it, so we'll lose a + ;; blank line when we shouldn't. So delete + ;; anything move-to-column added to the end + ;; of the line. We record the line width + ;; instead of the position of the old line + ;; end because move-to-column might break a + ;; tab into spaces, and the new characters + ;; introduced there shouldn't be deleted. + + ;; If you can see a better way to do this, + ;; please make the change. This seems very + ;; messy to me. + (delete-region (progn (move-to-column line-width) + (point)) + (progn (end-of-line) (point))))))))) + + ;; Lines containing just a comment start or just an end + ;; should not be filled into paragraphs they are next + ;; to. + (paragraph-start (concat paragraph-start re1 "$")) + (paragraph-separate (concat paragraph-separate re1 "$")) + (chars-to-delete 0) + ) + (save-restriction + ;; Don't fill the comment together with the code + ;; following it. So temporarily exclude everything + ;; before the comment start, and everything after the + ;; line where the comment ends. If comment-start-place + ;; is non-nil, the comment starter is there. Otherwise, + ;; point is inside the comment. + (narrow-to-region (save-excursion + (if comment-start-place + (goto-char comment-start-place) + (search-backward "/*")) + (if (and (not pure-hanging-comment-starter-p) + (looking-at + (concat pure-comment-start-regexp + "[ \t]*$"))) + (forward-line 1)) + ;; Protect text before the comment + ;; start by excluding it. Add + ;; spaces to bring back proper + ;; indentation of that point. + (let ((column (current-column))) + (prog1 (point) + (setq chars-to-delete column) + (insert-char ?\ column)))) + (save-excursion + (if comment-start-place + (goto-char (+ comment-start-place 2))) + (search-forward "*/" nil 'move) + (if (and (not pure-hanging-comment-ender-p) + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*\\*/"))) + (beginning-of-line) + (forward-line 1)) + (point))) + (or (pure-safe + ;; fill-paragraph sometimes fails to detect when we + ;; are between paragraphs. + (beginning-of-line) + (search-forward fill-prefix (pure-point 'eol)) + (looking-at paragraph-separate)) + ;; Avoids recursion + (let (fill-paragraph-function) + (fill-paragraph arg))) + (save-excursion + ;; Delete the chars we inserted to avoid clobbering + ;; the stuff before the comment start. + (goto-char (point-min)) + (if (> chars-to-delete 0) + (delete-region (point) (+ (point) chars-t... [truncated message content] |