[pure-lang-svn] SF.net SVN: pure-lang: [254] pure/trunk
Status: Beta
Brought to you by:
agraef
Menu
▾
▴
[pure-lang-svn] SF.net SVN: pure-lang: [254] pure/trunk
|
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.
|
