Thread: [pure-lang-svn] SF.net SVN: pure-lang:[441] pure/trunk
Status: Beta
Brought to you by:
agraef
Menu
▾
▴
pure-lang-svn
|
From: <ag...@us...> - 2008-07-30 20:39:56
|
Revision: 441
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=441&view=rev
Author: agraef
Date: 2008-07-30 20:40:04 +0000 (Wed, 30 Jul 2008)
Log Message:
-----------
Update entity definitions to latest from W3C.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/w3centities.c
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-07-30 20:16:55 UTC (rev 440)
+++ pure/trunk/ChangeLog 2008-07-30 20:40:04 UTC (rev 441)
@@ -1,3 +1,7 @@
+2008-07-30 Albert Graef <Dr....@t-...>
+
+ * w3centities.c: Updated to latest from W3C.
+
2008-07-13 Albert Graef <Dr....@t-...>
* interpreter.cc (codegen): Streamline code for list and tuple
Modified: pure/trunk/w3centities.c
===================================================================
--- pure/trunk/w3centities.c 2008-07-30 20:16:55 UTC (rev 440)
+++ pure/trunk/w3centities.c 2008-07-30 20:40:04 UTC (rev 441)
@@ -1,4 +1,4 @@
-/* generated from w3centities.ent Fri Jan 18 03:24:08 2008 */
+/* generated from w3centities.ent Wed Jul 30 22:28:13 2008 */
typedef struct ENTITY { const char *name; long c; } Entity;
@@ -239,7 +239,7 @@
{ "Lcaron", 0x0013D },
{ "Lcedil", 0x0013B },
{ "Lcy", 0x0041B },
- { "LeftAngleBracket", 0x02329 },
+ { "LeftAngleBracket", 0x027E8 },
{ "LeftArrowBar", 0x021E4 },
{ "LeftArrowRightArrow", 0x021C6 },
{ "LeftCeiling", 0x02308 },
@@ -370,9 +370,9 @@
{ "Otimes", 0x02A37 },
{ "Ouml", 0x000D6 },
{ "OverBar", 0x000AF },
- { "OverBrace", 0x0FE37 },
+ { "OverBrace", 0x023DE },
{ "OverBracket", 0x023B4 },
- { "OverParenthesis", 0x0FE35 },
+ { "OverParenthesis", 0x023DC },
{ "PHgr", 0x003A6 },
{ "PSgr", 0x003A8 },
{ "PartialD", 0x02202 },
@@ -413,7 +413,7 @@
{ "Rfr", 0x0211C },
{ "Rgr", 0x003A1 },
{ "Rho", 0x003A1 },
- { "RightAngleBracket", 0x0232A },
+ { "RightAngleBracket", 0x027E9 },
{ "RightArrowBar", 0x021E5 },
{ "RightArrowLeftArrow", 0x021C4 },
{ "RightCeiling", 0x02309 },
@@ -513,9 +513,9 @@
{ "Ugr", 0x003A5 },
{ "Ugrave", 0x000D9 },
{ "Umacr", 0x0016A },
- { "UnderBrace", 0x0FE38 },
+ { "UnderBrace", 0x023DF },
{ "UnderBracket", 0x023B5 },
- { "UnderParenthesis", 0x0FE36 },
+ { "UnderParenthesis", 0x023DD },
{ "Union", 0x022C3 },
{ "UnionPlus", 0x0228E },
{ "Uogon", 0x00172 },
@@ -1228,9 +1228,9 @@
{ "laemptyv", 0x029B4 },
{ "lagran", 0x02112 },
{ "lambda", 0x003BB },
- { "lang", 0x02329 },
+ { "lang", 0x027E8 },
{ "langd", 0x02991 },
- { "langle", 0x02329 },
+ { "langle", 0x027E8 },
{ "lap", 0x02A85 },
{ "laquo", 0x000AB },
{ "larr", 0x02190 },
@@ -1246,7 +1246,7 @@
{ "latail", 0x02919 },
{ "late", 0x02AAD },
{ "lbarr", 0x0290C },
- { "lbbrk", 0x02997 },
+ { "lbbrk", 0x02772 },
{ "lbrace", 0x0007B },
{ "lbrack", 0x0005B },
{ "lbrke", 0x0298B },
@@ -1596,7 +1596,7 @@
{ "pfr", 0x1D52D },
{ "pgr", 0x003C0 },
{ "phgr", 0x003C6 },
- { "phi", 0x003D5 },
+ { "phi", 0x003C6 },
{ "phiv", 0x003C6 },
{ "phmmat", 0x02133 },
{ "phone", 0x0260E },
@@ -1669,10 +1669,10 @@
{ "racute", 0x00155 },
{ "radic", 0x0221A },
{ "raemptyv", 0x029B3 },
- { "rang", 0x0232A },
+ { "rang", 0x027E9 },
{ "rangd", 0x02992 },
{ "range", 0x029A5 },
- { "rangle", 0x0232A },
+ { "rangle", 0x027E9 },
{ "raquo", 0x000BB },
{ "rarr", 0x02192 },
{ "rarrap", 0x02975 },
@@ -1690,7 +1690,7 @@
{ "ratio", 0x02236 },
{ "rationals", 0x0211A },
{ "rbarr", 0x0290D },
- { "rbbrk", 0x02998 },
+ { "rbbrk", 0x02773 },
{ "rbrace", 0x0007D },
{ "rbrack", 0x0005D },
{ "rbrke", 0x0298C },
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-02 07:07:35
|
Revision: 443
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=443&view=rev
Author: agraef
Date: 2008-08-02 07:07:44 +0000 (Sat, 02 Aug 2008)
Log Message:
-----------
Move map of local function environments to separate class.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
pure/trunk/lexer.ll
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-07-31 12:16:17 UTC (rev 442)
+++ pure/trunk/interpreter.cc 2008-08-02 07:07:44 UTC (rev 443)
@@ -1942,8 +1942,7 @@
args = e.args; envs = e.envs;
b = e.b; local = e.local; parent = e.parent;
}
- fmap = e.fmap; fmap_idx = e.fmap_idx;
- xmap = e.xmap; xtab = e.xtab; prop = e.prop; m = e.m;
+ fmap = e.fmap; xmap = e.xmap; xtab = e.xtab; prop = e.prop; m = e.m;
return *this;
}
@@ -1961,7 +1960,7 @@
interp.JIT->freeMachineCodeForFunction(f);
f->dropAllReferences(); if (h != f) h->dropAllReferences();
fp = 0;
- fmap.clear(); fmap_idx = 0;
+ fmap.clear();
to_be_deleted.push_back(f); if (h != f) to_be_deleted.push_back(h);
} else {
#if DEBUG>2
@@ -1978,8 +1977,7 @@
}
fp = 0;
// delete all nested environments and reinitialize other body-related data
- fmap.clear(); fmap_idx = 0;
- xmap.clear(); xtab.clear(); prop.clear(); m = 0;
+ fmap.clear(); xmap.clear(); xtab.clear(); prop.clear(); m = 0;
// now that all references have been removed, delete the function pointers
for (list<Function*>::iterator fi = to_be_deleted.begin();
fi != to_be_deleted.end(); fi++) {
@@ -2130,7 +2128,7 @@
fenv = *ei++;
}
assert(fenv->act_fmap().find(x.vtag()) != fenv->act_fmap().end());
- fenv = &fenv->act_fmap()[x.vtag()];
+ fenv = &fenv->fmap.act()[x.vtag()];
if (!fenv->local) break;
// fenv now points to the environment of the (local) function
assert(fenv != this && fenv->tag == x.vtag());
@@ -2190,7 +2188,7 @@
if (n == 2 && f.tag() == interp.symtab.catch_sym().f) {
expr h = x.xval1().xval2(), y = x.xval2();
push("catch");
- Env& e = act_fmap()[-x.hash()] = Env(0, 0, y, true, true);
+ Env& e = fmap.act()[-x.hash()] = Env(0, 0, y, true, true);
e.build_map(y); e.promote_map();
pop();
build_map(h);
@@ -2207,14 +2205,14 @@
break;
case EXPR::LAMBDA: {
push("lambda");
- Env& e = act_fmap()[-x.hash()] = Env(0, 1, x.xval2(), true, true);
+ Env& e = fmap.act()[-x.hash()] = Env(0, 1, x.xval2(), true, true);
e.build_map(x.xval2()); e.promote_map();
pop();
break;
}
case EXPR::CASE: {
push("case");
- Env& e = act_fmap()[-x.hash()] = Env(0, 1, x.xval(), true, true);
+ Env& e = fmap.act()[-x.hash()] = Env(0, 1, x.xval(), true, true);
e.build_map(*x.rules()); e.promote_map();
pop();
build_map(x.xval());
@@ -2231,13 +2229,13 @@
for (env::const_iterator p = fe->begin(); p != fe->end(); p++) {
int32_t ftag = p->first;
const env_info& info = p->second;
- act_fmap()[ftag] = Env(ftag, info, false, true);
+ fmap.act()[ftag] = Env(ftag, info, false, true);
}
// Now recursively build the maps for the child environments.
for (env::const_iterator p = fe->begin(); p != fe->end(); p++) {
int32_t ftag = p->first;
const env_info& info = p->second;
- Env& e = act_fmap()[ftag];
+ Env& e = fmap.act()[ftag];
e.build_map(info); e.promote_map();
}
pop();
@@ -2261,7 +2259,7 @@
rulel::const_iterator s = r;
expr y = (++s == end)?x:s->rhs;
push("when");
- Env& e = act_fmap()[-y.hash()] = Env(0, 1, y, true, true);
+ Env& e = fmap.act()[-y.hash()] = Env(0, 1, y, true, true);
e.build_map(x, s, end); e.promote_map();
pop();
build_map(r->rhs);
@@ -2288,9 +2286,9 @@
while (r != info.rules->end()) {
build_map(r->rhs);
if (!r->qual.is_null()) build_map(r->qual);
- r++; fmap_idx++;
+ r++; fmap.next();
}
- fmap_idx = 0;
+ fmap.first();
#if DEBUG>1
if (!local) print_map(std::cerr, this);
#endif
@@ -3120,8 +3118,8 @@
Env& act = act_env();
rulel::const_iterator s = r;
expr y = (++s == end)?x:s->rhs;
- assert(act.act_fmap().find(-y.hash()) != act.act_fmap().end());
- Env& e = act.act_fmap()[-y.hash()];
+ assert(act.fmap.act().find(-y.hash()) != act.fmap.act().end());
+ Env& e = act.fmap.act()[-y.hash()];
push("when", &e);
fun_prolog("anonymous");
BasicBlock *bodybb = BasicBlock::Create("body");
@@ -3548,7 +3546,7 @@
int offs = idx-1;
if (idx == 0) {
// function in current environment ('with'-bound)
- f = &act_env().act_fmap()[tag];
+ f = &act_env().fmap.act()[tag];
} else {
// function in an outer environment, the de Bruijn index idx tells us
// where on the current environment stack it's at
@@ -3556,7 +3554,7 @@
size_t i = idx;
for (; i > 0; e++, i--) assert(e != envstk.end());
// look up the function in the environment
- f = &(*e)->act_fmap()[tag];
+ f = &(*e)->fmap.act()[tag];
}
if (f->n == n) {
// bingo! saturated call
@@ -3694,8 +3692,8 @@
// through pure_catch()
expr h = x.xval1().xval2(), y = x.xval2();
Env& act = act_env();
- assert(act.act_fmap().find(-x.hash()) != act.act_fmap().end());
- Env& e = act.act_fmap()[-x.hash()];
+ assert(act.fmap.act().find(-x.hash()) != act.fmap.act().end());
+ Env& e = act.fmap.act()[-x.hash()];
push("catch", &e);
fun_prolog("anonymous");
e.CreateRet(codegen(y));
@@ -3735,8 +3733,8 @@
// anonymous closure:
case EXPR::LAMBDA: {
Env& act = act_env();
- assert(act.act_fmap().find(-x.hash()) != act.act_fmap().end());
- Env& e = act.act_fmap()[-x.hash()];
+ assert(act.fmap.act().find(-x.hash()) != act.fmap.act().end());
+ Env& e = act.fmap.act()[-x.hash()];
push("lambda", &e);
fun("anonymous", x.pm(), true);
pop(&e);
@@ -3747,8 +3745,8 @@
// case expression: treated like an anonymous closure (see the lambda case
// above) which gets applied to the subject term to be matched
Env& act = act_env();
- assert(act.act_fmap().find(-x.hash()) != act.act_fmap().end());
- Env& e = act.act_fmap()[-x.hash()];
+ assert(act.fmap.act().find(-x.hash()) != act.fmap.act().end());
+ Env& e = act.fmap.act()[-x.hash()];
push("case", &e);
fun("anonymous", x.pm(), true);
pop(&e);
@@ -3774,16 +3772,16 @@
// mutually recursive definitions
for (p = fe->begin(); p != fe->end(); p++) {
int32_t ftag = p->first;
- assert(act.act_fmap().find(ftag) != act.act_fmap().end());
- Env& e = act.act_fmap()[ftag];
+ assert(act.fmap.act().find(ftag) != act.fmap.act().end());
+ Env& e = act.fmap.act()[ftag];
push("with", &e);
- act.act_fmap()[ftag].f = fun_prolog(symtab.sym(ftag).s);
+ act.fmap.act()[ftag].f = fun_prolog(symtab.sym(ftag).s);
pop(&e);
}
for (p = fe->begin(); p != fe->end(); p++) {
int32_t ftag = p->first;
const env_info& info = p->second;
- Env& e = act.act_fmap()[ftag];
+ Env& e = act.fmap.act()[ftag];
push("with", &e);
fun_body(info.m);
pop(&e);
@@ -4078,7 +4076,7 @@
assert(!envstk.empty());
if (idx == 0) {
// function in current environment ('with'-bound)
- Env& f = act_env().act_fmap()[tag];
+ Env& f = act_env().fmap.act()[tag];
return fbox(f, thunked);
}
// If we come here, the function is defined in an outer environment. Locate
@@ -4088,7 +4086,7 @@
size_t i = idx;
for (; i > 0; e++, i--) assert(e != envstk.end());
// look up the function in the environment
- Env& f = (*e)->act_fmap()[tag];
+ Env& f = (*e)->fmap.act()[tag];
assert(f.f);
// Now create the closure. This is essentially just like fbox(), but we are
// called inside a nested environment here, and hence the de Bruijn indices
@@ -5062,7 +5060,7 @@
while (r != rl.end()) {
const rule& rr = rules[*r];
reduced.insert(*r);
- if (f.fmap.size() > 1) f.fmap_idx = *r;
+ if (f.fmap.size() > 1) f.fmap.set(*r);
f.f->getBasicBlockList().push_back(rulebb);
f.builder.SetInsertPoint(rulebb);
#if DEBUG>1
@@ -5120,5 +5118,5 @@
toplevel_codegen(rr.rhs);
rulebb = nextbb;
}
- if (f.fmap.size() > 1) f.fmap_idx = 0;
+ if (f.fmap.size() > 1) f.fmap.first();
}
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-07-31 12:16:17 UTC (rev 442)
+++ pure/trunk/interpreter.hh 2008-08-02 07:07:44 UTC (rev 443)
@@ -88,6 +88,33 @@
typedef list<Env*> EnvStack;
typedef pair<int32_t,uint8_t> xmap_key;
+class FMap {
+ // manage local function environments
+ vector< map<int32_t,Env> > fmap;
+ // current map index
+ size_t idx;
+public:
+ // constructor (create one empty map by default)
+ FMap() : fmap(1), idx(0) {}
+ // assignment
+ FMap& operator= (const FMap& f)
+ { fmap = f.fmap; idx = f.idx; return *this; }
+ // clear local environments
+ void clear() { fmap.clear(); idx = 0; }
+ // resize (set number of maps)
+ void resize(size_t n) { fmap.resize(n); }
+ // current size (number of maps)
+ size_t size() const { return fmap.size(); }
+ // set index to first, next and given map
+ void first() { idx = 0; }
+ void next() { idx++; }
+ void set(size_t n) { idx = n; }
+ // access the current map
+ map<int32_t,Env>& act() { return fmap[idx]; }
+ // access the given map (read-only)
+ const map<int32_t,Env>& act(size_t n) const { return fmap[n]; }
+};
+
struct Env {
// function environment
int32_t tag; // function id, zero for anonymous functions
@@ -106,14 +133,8 @@
map<xmap_key,uint32_t > xmap;
// info about captured variables
list<VarInfo> xtab;
- // local function environments; note that there's actually a separate child
- // environment for each rule of the parent function (this gets initialized
- // to a single empty environment)
- vector< map<int32_t,Env> > fmap;
- // the current fmap index; this gets updated each time a new rule is added
- size_t fmap_idx;
- // convenience function to access the current fmap
- map<int32_t,Env>& act_fmap() { return fmap[fmap_idx]; }
+ // local function environments
+ FMap fmap;
// propagation links for environment variables (pointers to call sites)
// e in prop means that there's a call with de Bruijn index prop[e] at e
map<Env*,uint8_t> prop;
@@ -162,11 +183,11 @@
// default constructor
Env()
: tag(0), n(0), m(0), f(0), h(0), fp(0), args(0), envs(0),
- fmap(1), fmap_idx(0), b(false), local(false), parent(0), refc(0) {}
+ b(false), local(false), parent(0), refc(0) {}
// environment for an anonymous closure with given body x
Env(int32_t _tag, uint32_t _n, expr x, bool _b, bool _local = false)
: tag(_tag), n(_n), m(0), f(0), h(0), fp(0), args(n), envs(0),
- fmap(1), fmap_idx(0), b(_b), local(_local), parent(0), refc(0)
+ b(_b), local(_local), parent(0), refc(0)
{
if (envstk.empty()) {
assert(!local);
@@ -180,7 +201,7 @@
// environment for a named closure with given definition info
Env(int32_t _tag, const env_info& info, bool _b, bool _local = false)
: tag(_tag), n(info.argc), m(0), f(0), h(0), fp(0), args(n), envs(0),
- fmap(1), fmap_idx(0), b(_b), local(_local), parent(0), refc(0)
+ b(_b), local(_local), parent(0), refc(0)
{
if (envstk.empty()) {
assert(!local);
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-07-31 12:16:17 UTC (rev 442)
+++ pure/trunk/lexer.ll 2008-08-02 07:07:44 UTC (rev 443)
@@ -942,8 +942,8 @@
if (e.h && e.h != e.f) e.h->print(os);
e.f->print(os);
for (size_t i = 0, n = e.fmap.size(); i < n; i++) {
- map<int32_t,Env>::const_iterator f;
- for (f = e.fmap[i].begin(); f != e.fmap[i].end(); f++)
+ for (map<int32_t,Env>::const_iterator f = e.fmap.act(i).begin(),
+ end = e.fmap.act(i).end(); f != end; f++)
print_defs(os, f->second);
}
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-04 06:36:03
|
Revision: 444
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=444&view=rev
Author: agraef
Date: 2008-08-04 06:36:13 +0000 (Mon, 04 Aug 2008)
Log Message:
-----------
Refactoring of FMap/Env printing code.
Modified Paths:
--------------
pure/trunk/interpreter.hh
pure/trunk/lexer.ll
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-02 07:07:44 UTC (rev 443)
+++ pure/trunk/interpreter.hh 2008-08-04 06:36:13 UTC (rev 444)
@@ -88,31 +88,28 @@
typedef list<Env*> EnvStack;
typedef pair<int32_t,uint8_t> xmap_key;
-class FMap {
+struct FMap {
// manage local function environments
- vector< map<int32_t,Env> > fmap;
+ vector< map<int32_t,Env> > m;
// current map index
size_t idx;
-public:
// constructor (create one empty map by default)
- FMap() : fmap(1), idx(0) {}
+ FMap() : m(1), idx(0) {}
// assignment
FMap& operator= (const FMap& f)
- { fmap = f.fmap; idx = f.idx; return *this; }
+ { m = f.m; idx = f.idx; return *this; }
// clear local environments
- void clear() { fmap.clear(); idx = 0; }
+ void clear() { m.clear(); idx = 0; }
// resize (set number of maps)
- void resize(size_t n) { fmap.resize(n); }
+ void resize(size_t n) { m.resize(n); }
// current size (number of maps)
- size_t size() const { return fmap.size(); }
+ size_t size() const { return m.size(); }
// set index to first, next and given map
void first() { idx = 0; }
void next() { idx++; }
void set(size_t n) { idx = n; }
// access the current map
- map<int32_t,Env>& act() { return fmap[idx]; }
- // access the given map (read-only)
- const map<int32_t,Env>& act(size_t n) const { return fmap[n]; }
+ map<int32_t,Env>& act() { return m[idx]; }
};
struct Env {
@@ -180,6 +177,8 @@
// interface to CreateRet() which also takes care of collecting temporaries
// and patching up tail calls
llvm::ReturnInst *CreateRet(llvm::Value *v);
+ // print the code of all functions in an environment, recursively
+ void print_defs(ostream& os) const;
// default constructor
Env()
: tag(0), n(0), m(0), f(0), h(0), fp(0), args(0), envs(0),
@@ -580,7 +579,6 @@
// Interface to the lexer.
public:
bool declare_op;
- void print_defs(ostream& os, const Env& e);
private:
bool lex_begin();
void lex_end();
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-02 07:07:44 UTC (rev 443)
+++ pure/trunk/lexer.ll 2008-08-04 06:36:13 UTC (rev 444)
@@ -543,7 +543,7 @@
sout << " " << rules << ";";
if (aflag && m) sout << endl << *m;
if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
- interp.print_defs(sout, fenv->second);
+ fenv->second.print_defs(sout);
} else {
sout << " " << argc << " args, " << rules.size() << " rules";
}
@@ -560,7 +560,7 @@
if (n > 0) {
if (aflag && m) sout << *m << endl;
if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
- interp.print_defs(sout, fenv->second);
+ fenv->second.print_defs(sout);
nrules += n;
++nfuns;
}
@@ -936,14 +936,14 @@
result = k;
}
-void interpreter::print_defs(ostream& os, const Env& e)
+void Env::print_defs(ostream& os) const
{
- if (!e.f) return; // not used, probably a shadowed rule
- if (e.h && e.h != e.f) e.h->print(os);
- e.f->print(os);
- for (size_t i = 0, n = e.fmap.size(); i < n; i++) {
- for (map<int32_t,Env>::const_iterator f = e.fmap.act(i).begin(),
- end = e.fmap.act(i).end(); f != end; f++)
- print_defs(os, f->second);
+ if (!f) return; // not used, probably a shadowed rule
+ if (h && h != f) h->print(os);
+ f->print(os);
+ for (size_t i = 0, n = fmap.m.size(); i < n; i++) {
+ for (map<int32_t,Env>::const_iterator f = fmap.m[i].begin(),
+ end = fmap.m[i].end(); f != end; f++)
+ f->second.print_defs(os);
}
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-04 06:50:13
|
Revision: 445
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=445&view=rev
Author: agraef
Date: 2008-08-04 06:50:23 +0000 (Mon, 04 Aug 2008)
Log Message:
-----------
Move fmap size check into FMap class.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-04 06:36:13 UTC (rev 444)
+++ pure/trunk/interpreter.cc 2008-08-04 06:50:23 UTC (rev 445)
@@ -5060,7 +5060,7 @@
while (r != rl.end()) {
const rule& rr = rules[*r];
reduced.insert(*r);
- if (f.fmap.size() > 1) f.fmap.set(*r);
+ f.fmap.set(*r);
f.f->getBasicBlockList().push_back(rulebb);
f.builder.SetInsertPoint(rulebb);
#if DEBUG>1
@@ -5118,5 +5118,5 @@
toplevel_codegen(rr.rhs);
rulebb = nextbb;
}
- if (f.fmap.size() > 1) f.fmap.first();
+ f.fmap.first();
}
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-04 06:36:13 UTC (rev 444)
+++ pure/trunk/interpreter.hh 2008-08-04 06:50:23 UTC (rev 445)
@@ -102,12 +102,10 @@
void clear() { m.clear(); idx = 0; }
// resize (set number of maps)
void resize(size_t n) { m.resize(n); }
- // current size (number of maps)
- size_t size() const { return m.size(); }
// set index to first, next and given map
void first() { idx = 0; }
void next() { idx++; }
- void set(size_t n) { idx = n; }
+ void set(size_t n) { if (m.size() > 1) idx = n; }
// access the current map
map<int32_t,Env>& act() { return m[idx]; }
};
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-04 06:59:33
|
Revision: 446
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=446&view=rev
Author: agraef
Date: 2008-08-04 06:59:40 +0000 (Mon, 04 Aug 2008)
Log Message:
-----------
Rename Env::print_defs -> print.
Modified Paths:
--------------
pure/trunk/interpreter.hh
pure/trunk/lexer.ll
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-04 06:50:23 UTC (rev 445)
+++ pure/trunk/interpreter.hh 2008-08-04 06:59:40 UTC (rev 446)
@@ -176,7 +176,7 @@
// and patching up tail calls
llvm::ReturnInst *CreateRet(llvm::Value *v);
// print the code of all functions in an environment, recursively
- void print_defs(ostream& os) const;
+ void print(ostream& os) const;
// default constructor
Env()
: tag(0), n(0), m(0), f(0), h(0), fp(0), args(0), envs(0),
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-04 06:50:23 UTC (rev 445)
+++ pure/trunk/lexer.ll 2008-08-04 06:59:40 UTC (rev 446)
@@ -543,7 +543,7 @@
sout << " " << rules << ";";
if (aflag && m) sout << endl << *m;
if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
- fenv->second.print_defs(sout);
+ fenv->second.print(sout);
} else {
sout << " " << argc << " args, " << rules.size() << " rules";
}
@@ -560,7 +560,7 @@
if (n > 0) {
if (aflag && m) sout << *m << endl;
if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
- fenv->second.print_defs(sout);
+ fenv->second.print(sout);
nrules += n;
++nfuns;
}
@@ -936,7 +936,7 @@
result = k;
}
-void Env::print_defs(ostream& os) const
+void Env::print(ostream& os) const
{
if (!f) return; // not used, probably a shadowed rule
if (h && h != f) h->print(os);
@@ -944,6 +944,6 @@
for (size_t i = 0, n = fmap.m.size(); i < n; i++) {
for (map<int32_t,Env>::const_iterator f = fmap.m[i].begin(),
end = fmap.m[i].end(); f != end; f++)
- f->second.print_defs(os);
+ f->second.print(os);
}
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-05 04:34:57
|
Revision: 447
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=447&view=rev
Author: agraef
Date: 2008-08-05 04:35:06 +0000 (Tue, 05 Aug 2008)
Log Message:
-----------
Automatic resizing of FMap structure.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
pure/trunk/lexer.ll
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-04 06:59:40 UTC (rev 446)
+++ pure/trunk/interpreter.cc 2008-08-05 04:35:06 UTC (rev 447)
@@ -2280,8 +2280,6 @@
// build the maps for a global function definition
assert(info.t == env_info::fun);
// we need a separate submap for each rule
- size_t n = info.rules->size();
- fmap.resize(n);
rulel::const_iterator r = info.rules->begin();
while (r != info.rules->end()) {
build_map(r->rhs);
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-04 06:59:40 UTC (rev 446)
+++ pure/trunk/interpreter.hh 2008-08-05 04:35:06 UTC (rev 447)
@@ -86,28 +86,30 @@
#define Builder llvm::IRBuilder
typedef list<Env*> EnvStack;
+typedef map<int32_t,Env> EnvMap;
typedef pair<int32_t,uint8_t> xmap_key;
struct FMap {
// manage local function environments
- vector< map<int32_t,Env> > m;
+ vector<EnvMap*> m;
// current map index
size_t idx;
// constructor (create one empty map by default)
- FMap() : m(1), idx(0) {}
+ FMap() : m(1), idx(0) { m[0] = new EnvMap; }
// assignment
FMap& operator= (const FMap& f)
{ m = f.m; idx = f.idx; return *this; }
// clear local environments
- void clear() { m.clear(); idx = 0; }
- // resize (set number of maps)
- void resize(size_t n) { m.resize(n); }
+ void clear()
+ { for (size_t i = 0, n = m.size(); i < n; i++) delete m[i];
+ m.clear(); idx = 0; }
// set index to first, next and given map
void first() { idx = 0; }
- void next() { idx++; }
+ void next()
+ { if (++idx >= m.size()) { m.resize(idx+1); m[idx] = new EnvMap; } }
void set(size_t n) { if (m.size() > 1) idx = n; }
// access the current map
- map<int32_t,Env>& act() { return m[idx]; }
+ EnvMap& act() { return *m[idx]; }
};
struct Env {
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-04 06:59:40 UTC (rev 446)
+++ pure/trunk/lexer.ll 2008-08-05 04:35:06 UTC (rev 447)
@@ -942,8 +942,8 @@
if (h && h != f) h->print(os);
f->print(os);
for (size_t i = 0, n = fmap.m.size(); i < n; i++) {
- for (map<int32_t,Env>::const_iterator f = fmap.m[i].begin(),
- end = fmap.m[i].end(); f != end; f++)
+ for (EnvMap::const_iterator f = fmap.m[i]->begin(),
+ end = fmap.m[i]->end(); f != end; f++)
f->second.print(os);
}
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-07 08:07:14
|
Revision: 452
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=452&view=rev
Author: agraef
Date: 2008-08-07 08:07:20 +0000 (Thu, 07 Aug 2008)
Log Message:
-----------
Allocate environments in FMap dynamically.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
pure/trunk/lexer.ll
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-05 05:45:03 UTC (rev 451)
+++ pure/trunk/interpreter.cc 2008-08-07 08:07:20 UTC (rev 452)
@@ -1929,6 +1929,28 @@
return os << ")";
}
+FMap& FMap::operator= (const FMap& f)
+{
+ clear(); m.resize(f.m.size());
+ for (size_t i = 0, n = f.m.size(); i < n; i++) m[i] = new EnvMap(*f.m[i]);
+ idx = f.idx; return *this;
+}
+
+void FMap::clear()
+{
+ set<Env*> e;
+ for (size_t i = 0, n = m.size(); i < n; i++) {
+ for (EnvMap::iterator it = m[i]->begin(), end = m[i]->end();
+ it != end; it++)
+ e.insert(it->second);
+ delete m[i];
+ }
+ for (set<Env*>::iterator it = e.begin(), end = e.end();
+ it != end; it++)
+ delete *it;
+ m.clear(); idx = 0;
+}
+
Env& Env::operator= (const Env& e)
{
if (f) {
@@ -2128,7 +2150,7 @@
fenv = *ei++;
}
assert(fenv->act_fmap().find(x.vtag()) != fenv->act_fmap().end());
- fenv = &fenv->fmap.act()[x.vtag()];
+ fenv = fenv->fmap.act()[x.vtag()];
if (!fenv->local) break;
// fenv now points to the environment of the (local) function
assert(fenv != this && fenv->tag == x.vtag());
@@ -2188,7 +2210,8 @@
if (n == 2 && f.tag() == interp.symtab.catch_sym().f) {
expr h = x.xval1().xval2(), y = x.xval2();
push("catch");
- Env& e = fmap.act()[-x.hash()] = Env(0, 0, y, true, true);
+ Env* eptr = fmap.act()[-x.hash()] = new Env(0, 0, y, true, true);
+ Env& e = *eptr;
e.build_map(y); e.promote_map();
pop();
build_map(h);
@@ -2205,14 +2228,16 @@
break;
case EXPR::LAMBDA: {
push("lambda");
- Env& e = fmap.act()[-x.hash()] = Env(0, 1, x.xval2(), true, true);
+ Env* eptr = fmap.act()[-x.hash()] = new Env(0, 1, x.xval2(), true, true);
+ Env& e = *eptr;
e.build_map(x.xval2()); e.promote_map();
pop();
break;
}
case EXPR::CASE: {
push("case");
- Env& e = fmap.act()[-x.hash()] = Env(0, 1, x.xval(), true, true);
+ Env* eptr = fmap.act()[-x.hash()] = new Env(0, 1, x.xval(), true, true);
+ Env& e = *eptr;
e.build_map(*x.rules()); e.promote_map();
pop();
build_map(x.xval());
@@ -2229,13 +2254,13 @@
for (env::const_iterator p = fe->begin(); p != fe->end(); p++) {
int32_t ftag = p->first;
const env_info& info = p->second;
- fmap.act()[ftag] = Env(ftag, info, false, true);
+ fmap.act()[ftag] = new Env(ftag, info, false, true);
}
// Now recursively build the maps for the child environments.
for (env::const_iterator p = fe->begin(); p != fe->end(); p++) {
int32_t ftag = p->first;
const env_info& info = p->second;
- Env& e = fmap.act()[ftag];
+ Env& e = *fmap.act()[ftag];
e.build_map(info); e.promote_map();
}
pop();
@@ -2259,7 +2284,8 @@
rulel::const_iterator s = r;
expr y = (++s == end)?x:s->rhs;
push("when");
- Env& e = fmap.act()[-y.hash()] = Env(0, 1, y, true, true);
+ Env* eptr = fmap.act()[-y.hash()] = new Env(0, 1, y, true, true);
+ Env& e = *eptr;
e.build_map(x, s, end); e.promote_map();
pop();
build_map(r->rhs);
@@ -3117,7 +3143,7 @@
rulel::const_iterator s = r;
expr y = (++s == end)?x:s->rhs;
assert(act.fmap.act().find(-y.hash()) != act.fmap.act().end());
- Env& e = act.fmap.act()[-y.hash()];
+ Env& e = *act.fmap.act()[-y.hash()];
push("when", &e);
fun_prolog("anonymous");
BasicBlock *bodybb = BasicBlock::Create("body");
@@ -3544,7 +3570,7 @@
int offs = idx-1;
if (idx == 0) {
// function in current environment ('with'-bound)
- f = &act_env().fmap.act()[tag];
+ f = act_env().fmap.act()[tag];
} else {
// function in an outer environment, the de Bruijn index idx tells us
// where on the current environment stack it's at
@@ -3552,7 +3578,7 @@
size_t i = idx;
for (; i > 0; e++, i--) assert(e != envstk.end());
// look up the function in the environment
- f = &(*e)->fmap.act()[tag];
+ f = (*e)->fmap.act()[tag];
}
if (f->n == n) {
// bingo! saturated call
@@ -3691,7 +3717,7 @@
expr h = x.xval1().xval2(), y = x.xval2();
Env& act = act_env();
assert(act.fmap.act().find(-x.hash()) != act.fmap.act().end());
- Env& e = act.fmap.act()[-x.hash()];
+ Env& e = *act.fmap.act()[-x.hash()];
push("catch", &e);
fun_prolog("anonymous");
e.CreateRet(codegen(y));
@@ -3732,7 +3758,7 @@
case EXPR::LAMBDA: {
Env& act = act_env();
assert(act.fmap.act().find(-x.hash()) != act.fmap.act().end());
- Env& e = act.fmap.act()[-x.hash()];
+ Env& e = *act.fmap.act()[-x.hash()];
push("lambda", &e);
fun("anonymous", x.pm(), true);
pop(&e);
@@ -3744,7 +3770,7 @@
// above) which gets applied to the subject term to be matched
Env& act = act_env();
assert(act.fmap.act().find(-x.hash()) != act.fmap.act().end());
- Env& e = act.fmap.act()[-x.hash()];
+ Env& e = *act.fmap.act()[-x.hash()];
push("case", &e);
fun("anonymous", x.pm(), true);
pop(&e);
@@ -3771,15 +3797,15 @@
for (p = fe->begin(); p != fe->end(); p++) {
int32_t ftag = p->first;
assert(act.fmap.act().find(ftag) != act.fmap.act().end());
- Env& e = act.fmap.act()[ftag];
+ Env& e = *act.fmap.act()[ftag];
push("with", &e);
- act.fmap.act()[ftag].f = fun_prolog(symtab.sym(ftag).s);
+ act.fmap.act()[ftag]->f = fun_prolog(symtab.sym(ftag).s);
pop(&e);
}
for (p = fe->begin(); p != fe->end(); p++) {
int32_t ftag = p->first;
const env_info& info = p->second;
- Env& e = act.fmap.act()[ftag];
+ Env& e = *act.fmap.act()[ftag];
push("with", &e);
fun_body(info.m);
pop(&e);
@@ -4074,7 +4100,7 @@
assert(!envstk.empty());
if (idx == 0) {
// function in current environment ('with'-bound)
- Env& f = act_env().fmap.act()[tag];
+ Env& f = *act_env().fmap.act()[tag];
return fbox(f, thunked);
}
// If we come here, the function is defined in an outer environment. Locate
@@ -4084,7 +4110,7 @@
size_t i = idx;
for (; i > 0; e++, i--) assert(e != envstk.end());
// look up the function in the environment
- Env& f = (*e)->fmap.act()[tag];
+ Env& f = *(*e)->fmap.act()[tag];
assert(f.f);
// Now create the closure. This is essentially just like fbox(), but we are
// called inside a nested environment here, and hence the de Bruijn indices
@@ -5058,7 +5084,7 @@
while (r != rl.end()) {
const rule& rr = rules[*r];
reduced.insert(*r);
- f.fmap.set(*r);
+ f.fmap.select(*r);
f.f->getBasicBlockList().push_back(rulebb);
f.builder.SetInsertPoint(rulebb);
#if DEBUG>1
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-05 05:45:03 UTC (rev 451)
+++ pure/trunk/interpreter.hh 2008-08-07 08:07:20 UTC (rev 452)
@@ -85,7 +85,7 @@
#define Builder llvm::IRBuilder
typedef list<Env*> EnvStack;
-typedef map<int32_t,Env> EnvMap;
+typedef map<int32_t,Env*> EnvMap;
typedef pair<int32_t,uint8_t> xmap_key;
struct FMap {
@@ -95,20 +95,15 @@
size_t idx;
// constructor (create one empty map by default)
FMap() : m(1), idx(0) { m[0] = new EnvMap; }
- // clear local environments
- void clear()
- { for (size_t i = 0, n = m.size(); i < n; i++) delete m[i];
- m.clear(); idx = 0; }
// assignment
- FMap& operator= (const FMap& f)
- { clear(); m.resize(f.m.size());
- for (size_t i = 0, n = f.m.size(); i < n; i++) m[i] = new EnvMap(*f.m[i]);
- idx = f.idx; return *this; }
+ FMap& operator= (const FMap& f);
+ // clear local environments
+ void clear();
// set index to first, next and given map
void first() { idx = 0; }
void next()
{ if (++idx >= m.size()) { m.resize(idx+1); m[idx] = new EnvMap; } }
- void set(size_t n) { if (m.size() > 1) idx = n; }
+ void select(size_t n) { if (m.size() > 1) idx = n; }
// access the current map
EnvMap& act() { return *m[idx]; }
};
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-05 05:45:03 UTC (rev 451)
+++ pure/trunk/lexer.ll 2008-08-07 08:07:20 UTC (rev 452)
@@ -941,9 +941,13 @@
if (!f) return; // not used, probably a shadowed rule
if (h && h != f) h->print(os);
f->print(os);
+ set<Env*> e;
for (size_t i = 0, n = fmap.m.size(); i < n; i++) {
for (EnvMap::const_iterator it = fmap.m[i]->begin(),
end = fmap.m[i]->end(); it != end; it++)
- it->second.print(os);
+ if (e.find(it->second) == e.end()) {
+ it->second->print(os);
+ e.insert(it->second);
+ }
}
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-08 08:53:24
|
Revision: 453
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=453&view=rev
Author: agraef
Date: 2008-08-08 08:53:33 +0000 (Fri, 08 Aug 2008)
Log Message:
-----------
Rework FMap structure so that it can accommodate a forest of local environments.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-07 08:07:20 UTC (rev 452)
+++ pure/trunk/interpreter.cc 2008-08-08 08:53:33 UTC (rev 453)
@@ -1932,8 +1932,11 @@
FMap& FMap::operator= (const FMap& f)
{
clear(); m.resize(f.m.size());
- for (size_t i = 0, n = f.m.size(); i < n; i++) m[i] = new EnvMap(*f.m[i]);
- idx = f.idx; return *this;
+ for (size_t i = 0, n = f.m.size(); i < n; i++)
+ m[i] = new EnvMap(*f.m[i]);
+ root = f.root; pred = f.pred; succ = f.succ;
+ idx = f.idx; lastidx = f.lastidx;
+ return *this;
}
void FMap::clear()
@@ -1948,9 +1951,69 @@
for (set<Env*>::iterator it = e.begin(), end = e.end();
it != end; it++)
delete *it;
- m.clear(); idx = 0;
+ m.clear(); root.clear(); pred.clear(); succ.clear();
+ idx = 0; lastidx = -1;
}
+void FMap::next()
+{
+ assert(pred[idx] < 0);
+ if (succ[idx] >= 0)
+ idx = succ[idx];
+ else {
+ // create a new root
+ size_t n = root.size(), k = m.size();
+ root.resize(n+1);
+ m.resize(k+1); pred.resize(k+1); succ.resize(k+1);
+ root[n] = succ[idx] = k;
+ pred[k] = succ[k] = -1;
+ m[k] = new EnvMap;
+ idx = k;
+ }
+ lastidx = -1;
+}
+
+void FMap::select(size_t n)
+{
+ if (root.size() > 1) {
+ assert(n < root.size());
+ idx = root[n];
+ } else
+ idx = 0;
+ lastidx = -1;
+}
+
+void FMap::push()
+{
+ if (lastidx >= 0) {
+ assert(pred[lastidx] == idx);
+ if (succ[lastidx] >= 0)
+ idx = succ[lastidx];
+ else {
+ // create a new child, link from the previous one
+ size_t k = m.size();
+ m.resize(k+1); pred.resize(k+1); succ.resize(k+1);
+ pred[k] = idx; succ[k] = -1;
+ m[k] = new EnvMap(*m[idx]);
+ succ[lastidx] = k;
+ idx = k;
+ }
+ } else if (++idx >= (int32_t)m.size()) {
+ // the first child always immediately follows its parent
+ assert(idx == m.size());
+ m.resize(idx+1); pred.resize(idx+1); succ.resize(idx+1);
+ pred[idx] = idx-1; succ[idx] = -1;
+ m[idx] = new EnvMap(*m[idx-1]);
+ }
+ lastidx = -1;
+}
+
+void FMap::pop()
+{
+ assert(pred[idx] >= 0);
+ lastidx = idx; idx = pred[idx];
+}
+
Env& Env::operator= (const Env& e)
{
if (f) {
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-07 08:07:20 UTC (rev 452)
+++ pure/trunk/interpreter.hh 2008-08-08 08:53:33 UTC (rev 453)
@@ -88,22 +88,49 @@
typedef map<int32_t,Env*> EnvMap;
typedef pair<int32_t,uint8_t> xmap_key;
+/* Manage local function environments. The FMap structure is organized as a
+ forest with one root per rule and one child per 'with' clause. Each node of
+ the forest holds a map mapping function symbols to the corresponding
+ environments. Initially, there is just one root holding an empty map. New
+ roots can be added with 'next', new children with 'push'; 'pop' backs out
+ to the parent level.
+
+ Child nodes are initialized to a copy of its parent map, to which you can
+ then add any local bindings. After the structure has been built, you can
+ use 'first' to reposition the "cursor" so that it points to the first root
+ and then traverse the forest using the same sequence of calls to 'next',
+ 'push' and 'pop'. The 'select' method can be used to position the cursor at
+ the given root. The 'act' method returns the current map.
+
+ Implementation: The forest is encoded as a collection of vectors: 'm' holds
+ the map for each node, 'root' the node number of each root, 'pred' the
+ parent link for each node, and 'succ' the link to the next sibling of each
+ node. A 'pred' value of -1 denotes a root node, in which case 'succ' points
+ to the next root (or contains -1 to indicate the last root). The 'idx'
+ member points to the current node, 'lastidx' to the most recently visited
+ child after a 'pop' operation (-1 otherwise). */
+
struct FMap {
- // manage local function environments
+ // map of each node
vector<EnvMap*> m;
- // current map index
- size_t idx;
+ // vectors encoding the forest structure (see explanation above)
+ vector<int32_t> root, pred, succ;
+ // index of current node and most previously visited child
+ int32_t idx, lastidx;
// constructor (create one empty map by default)
- FMap() : m(1), idx(0) { m[0] = new EnvMap; }
+ FMap() : m(1), root(1, 0), pred(1, -1), succ(1, -1), idx(0), lastidx(-1)
+ { m[0] = new EnvMap; }
// assignment
FMap& operator= (const FMap& f);
- // clear local environments
+ // clear
void clear();
- // set index to first, next and given map
- void first() { idx = 0; }
- void next()
- { if (++idx >= m.size()) { m.resize(idx+1); m[idx] = new EnvMap; } }
- void select(size_t n) { if (m.size() > 1) idx = n; }
+ // set index to first, next and given root node
+ void first() { idx = 0; lastidx = -1; }
+ void next();
+ void select(size_t n);
+ // set index to the parent or next child of the current node
+ void push();
+ void pop();
// access the current map
EnvMap& act() { return *m[idx]; }
};
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-09 10:44:16
|
Revision: 454
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=454&view=rev
Author: agraef
Date: 2008-08-09 10:44:26 +0000 (Sat, 09 Aug 2008)
Log Message:
-----------
Bugfixes in FMap code.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-08 08:53:33 UTC (rev 453)
+++ pure/trunk/interpreter.cc 2008-08-09 10:44:26 UTC (rev 454)
@@ -1955,6 +1955,20 @@
idx = 0; lastidx = -1;
}
+void FMap::first()
+{
+ idx = 0; lastidx = -1;
+ // reset child environments
+ set<Env*> e;
+ for (size_t i = 0, n = m.size(); i < n; i++)
+ for (EnvMap::iterator it = m[i]->begin(), end = m[i]->end();
+ it != end; it++)
+ e.insert(it->second);
+ for (set<Env*>::iterator it = e.begin(), end = e.end();
+ it != end; it++)
+ (*it)->fmap.first();
+}
+
void FMap::next()
{
assert(pred[idx] < 0);
@@ -2000,7 +2014,7 @@
}
} else if (++idx >= (int32_t)m.size()) {
// the first child always immediately follows its parent
- assert(idx == m.size());
+ assert(idx == (int32_t)m.size());
m.resize(idx+1); pred.resize(idx+1); succ.resize(idx+1);
pred[idx] = idx-1; succ[idx] = -1;
m[idx] = new EnvMap(*m[idx-1]);
@@ -2212,7 +2226,7 @@
assert(ei != envstk.end());
fenv = *ei++;
}
- assert(fenv->act_fmap().find(x.vtag()) != fenv->act_fmap().end());
+ assert(fenv->fmap.act().find(x.vtag()) != fenv->fmap.act().end());
fenv = fenv->fmap.act()[x.vtag()];
if (!fenv->local) break;
// fenv now points to the environment of the (local) function
@@ -2369,13 +2383,12 @@
// build the maps for a global function definition
assert(info.t == env_info::fun);
// we need a separate submap for each rule
- rulel::const_iterator r = info.rules->begin();
- while (r != info.rules->end()) {
+ rulel::const_iterator r = info.rules->begin(), end = info.rules->end();
+ while (r != end) {
build_map(r->rhs);
if (!r->qual.is_null()) build_map(r->qual);
- r++; fmap.next();
+ if (++r != end) fmap.next();
}
- fmap.first();
#if DEBUG>1
if (!local) print_map(std::cerr, this);
#endif
@@ -5137,11 +5150,11 @@
Env& f = act_env();
assert(s->tr.empty()); // we're in a final state here
const rulev& rules = pm->r;
- assert(f.fmap.size() == 1 || f.fmap.size() == rules.size());
+ assert(f.fmap.root.size() == 1 || f.fmap.root.size() == rules.size());
const ruleml& rl = s->r;
ruleml::const_iterator r = rl.begin();
assert(r != rl.end());
- assert(f.fmap_idx == 0);
+ assert(f.fmap.idx == 0);
BasicBlock* rulebb = BasicBlock::Create(mklabel("rule.state", s->s, rl.front()));
f.builder.CreateBr(rulebb);
while (r != rl.end()) {
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-08 08:53:33 UTC (rev 453)
+++ pure/trunk/interpreter.hh 2008-08-09 10:44:26 UTC (rev 454)
@@ -125,7 +125,7 @@
// clear
void clear();
// set index to first, next and given root node
- void first() { idx = 0; lastidx = -1; }
+ void first();
void next();
void select(size_t n);
// set index to the parent or next child of the current node
@@ -219,6 +219,7 @@
assert(local);
parent = envstk.front();
}
+ fmap.first();
}
// environment for a named closure with given definition info
Env(int32_t _tag, const env_info& info, bool _b, bool _local = false)
@@ -233,6 +234,7 @@
assert(local);
parent = envstk.front();
}
+ fmap.first();
}
// assignment -- this is only allowed if the lvalue is an uninitialized
// environment for which no LLVM function has been created yet, or if it is
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-10 20:21:17
|
Revision: 461
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=461&view=rev
Author: agraef
Date: 2008-08-10 20:21:23 +0000 (Sun, 10 Aug 2008)
Log Message:
-----------
Optimize toplevel expressions to avoid unnecessary evaluations of constants.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/expr.cc
pure/trunk/expr.hh
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
pure/trunk/test/test015.log
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-10 10:23:24 UTC (rev 460)
+++ pure/trunk/ChangeLog 2008-08-10 20:21:23 UTC (rev 461)
@@ -1,5 +1,8 @@
2008-08-10 Albert Graef <Dr....@t-...>
+ * interpreter.cc (doeval, dodefn): Optimize the case of toplevel
+ evaluations and variable definitions of constant expressions.
+
* interpreter.cc (codegen): Fixed memory leak caused by the new
list and tuple code. Reported by Jiri Spitz.
Modified: pure/trunk/expr.cc
===================================================================
--- pure/trunk/expr.cc 2008-08-10 10:23:24 UTC (rev 460)
+++ pure/trunk/expr.cc 2008-08-10 20:21:23 UTC (rev 461)
@@ -196,6 +196,15 @@
u.tag() == interpreter::g_interp->symtab.pair_sym().f;
}
+bool expr::is_tuplex() const
+{
+ expr x, y;
+ if (is_pair(x, y))
+ return !x.is_pair() && y.is_tuplex();
+ else
+ return true;
+}
+
bool expr::is_cons(expr &x, expr &y) const
{
expr u, v;
@@ -254,6 +263,23 @@
}
}
+bool expr::is_tuplex(exprl &xs) const
+{
+ expr x, y;
+ if (is_pair(x, y))
+ if (x.is_pair()) {
+ xs.clear();
+ return false;
+ } else {
+ xs.push_back(x);
+ return y.is_tuplex(xs);
+ }
+ else {
+ xs.push_back(*this);
+ return true;
+ }
+}
+
env_info::env_info(const env_info& e) : t(e.t), temp(e.temp) {
switch (t) {
case none:
Modified: pure/trunk/expr.hh
===================================================================
--- pure/trunk/expr.hh 2008-08-10 10:23:24 UTC (rev 460)
+++ pure/trunk/expr.hh 2008-08-10 20:21:23 UTC (rev 461)
@@ -468,6 +468,8 @@
// This is always true, as we consider a singleton as a tuple, too. Use
// is_pair() to test for a "real" tuple instead.
bool is_tuple() const { return true; }
+ // Check for proper (normalized) tuples.
+ bool is_tuplex() const;
bool is_cons(expr &x, expr &y) const;
bool is_list(exprl &xs) const;
bool is_listx(exprl &xs) const;
@@ -475,6 +477,7 @@
// Always true (see note above). Use is_pair() && istuple(xs) to test for a
// "real" tuple instead.
bool is_tuple(exprl &xs) const;
+ bool is_tuplex(exprl &xs) const;
};
/* Rules of the form: lhs -> rhs [if qual]. */
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-10 10:23:24 UTC (rev 460)
+++ pure/trunk/interpreter.cc 2008-08-10 20:21:23 UTC (rev 461)
@@ -3062,6 +3062,58 @@
return act_builder().CreateLoad(fptrvar);
}
+pure_expr *interpreter::const_value(expr x)
+{
+ switch (x.tag()) {
+ // constants:
+ case EXPR::INT:
+ return pure_int(x.ival());
+ case EXPR::BIGINT:
+ return pure_mpz(x.zval());
+ case EXPR::DBL:
+ return pure_double(x.dval());
+ case EXPR::STR:
+ return pure_string_dup(x.sval());
+ case EXPR::PTR:
+ return pure_pointer(x.pval());
+ default: {
+ exprl xs;
+ if (x.tag() > 0) {
+ env::const_iterator it = globenv.find(x.tag());
+ map<int32_t,GlobalVar>::iterator v;
+ if (externals.find(x.tag()) != externals.end())
+ return 0;
+ else if (it == globenv.end())
+ // unbound symbol
+ return pure_const(x.tag());
+ else if (it->second.t == env_info::fvar &&
+ (v = globalvars.find(x.tag())) != globalvars.end())
+ // variable
+ return v->second.x;
+ else
+ return 0;
+ } else if (x.is_list(xs) || x.is_pair() && x.is_tuplex(xs)) {
+ // proper lists and tuples
+ size_t i, n = xs.size();
+ pure_expr **xv = (pure_expr**)malloc(n*sizeof(pure_expr*));
+ if (!xv) return 0;
+ exprl::iterator it = xs.begin(), end = xs.end();
+ for (i = 0; it != end; i++, it++)
+ if ((xv[i] = const_value(*it)) == 0) {
+ for (size_t j = 0; j < i; j++)
+ pure_freenew(xv[j]);
+ free(xv);
+ return 0;
+ }
+ pure_expr *res = (x.is_pair()?pure_tuplev:pure_listv)(n, xv);
+ free(xv);
+ return res;
+ } else
+ return 0;
+ }
+ }
+}
+
pure_expr *interpreter::doeval(expr x, pure_expr*& e)
{
char test;
@@ -3069,8 +3121,15 @@
e = pure_const(symtab.segfault_sym().f);
return 0;
}
- // Create an anonymous function to call in order to evaluate the target
- // expression.
+ e = 0;
+ // First check whether the value is actually a constant, then we can skip
+ // the compilation step.
+ clock_t t0 = clock();
+ pure_expr *res = const_value(x);
+ if (interactive && stats) clocks = clock()-t0;
+ if (res) return res;
+ // Not a constant value. Create an anonymous function to call in order to
+ // evaluate the target expression.
/* NOTE: The environment is allocated dynamically, so that its child
environments survive for the entire lifetime of any embedded closures,
which might still be called at a later time. */
@@ -3090,9 +3149,8 @@
// JIT the function.
f.fp = JIT->getPointerToFunction(f.f);
assert(f.fp);
- e = 0;
- clock_t t0 = clock();
- pure_expr *res = pure_invoke(f.fp, &e);
+ t0 = clock();
+ res = pure_invoke(f.fp, &e);
if (interactive && stats) clocks = clock()-t0;
// Get rid of our anonymous function.
JIT->freeMachineCodeForFunction(f.f);
@@ -3107,6 +3165,15 @@
return res;
}
+static pure_expr *pure_subterm(pure_expr *x, const path& p)
+{
+ for (size_t i = 0, n = p.len(); i < n; i++) {
+ assert(x->tag == EXPR::APP);
+ x = x->data.x[p[i]?1:0];
+ }
+ return x;
+}
+
pure_expr *interpreter::dodefn(env vars, expr lhs, expr rhs, pure_expr*& e)
{
char test;
@@ -3114,8 +3181,44 @@
e = pure_const(symtab.segfault_sym().f);
return 0;
}
- // Create an anonymous function to call in order to evaluate the rhs
- // expression, match against the lhs and bind variables in lhs accordingly.
+ e = 0;
+ // First check whether the value is actually a constant, then we can skip
+ // the compilation step.
+ clock_t t0 = clock();
+ pure_expr *res = const_value(rhs);
+ if (res) {
+ matcher m(rule(lhs, rhs));
+ if (m.match(rhs)) {
+ // Bind the variables.
+ for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
+ int32_t tag = it->first;
+ const env_info& info = it->second;
+ assert(info.t == env_info::lvar && info.p);
+ // find the subterm at info.p
+ pure_expr *x = pure_subterm(res, *info.p);
+ // store the value in a global variable of the same name
+ const symbol& sym = symtab.sym(tag);
+ GlobalVar& v = globalvars[tag];
+ if (!v.v) {
+ v.v = new GlobalVariable
+ (ExprPtrTy, false, GlobalVariable::ExternalLinkage, 0, sym.s,
+ module);
+ JIT->addGlobalMapping(v.v, &v.x);
+ }
+ if (v.x) pure_free(v.x);
+ v.x = pure_new(x);
+ }
+ } else {
+ // Failed match, bail out.
+ pure_freenew(res);
+ res = e = 0;
+ }
+ if (interactive && stats) clocks = clock()-t0;
+ return res;
+ }
+ // Not a constant value. Create an anonymous function to call in order to
+ // evaluate the rhs expression, match against the lhs and bind variables in
+ // lhs accordingly.
Env *save_fptr = fptr;
fptr = new Env(0, 0, rhs, false); fptr->refc = 1;
Env &f = *fptr;
@@ -3176,9 +3279,8 @@
// JIT the function.
f.fp = JIT->getPointerToFunction(f.f);
assert(f.fp);
- e = 0;
- clock_t t0 = clock();
- pure_expr *res = pure_invoke(f.fp, &e);
+ t0 = clock();
+ res = pure_invoke(f.fp, &e);
if (interactive && stats) clocks = clock()-t0;
// Get rid of our anonymous function.
JIT->freeMachineCodeForFunction(f.f);
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-10 10:23:24 UTC (rev 460)
+++ pure/trunk/interpreter.hh 2008-08-10 20:21:23 UTC (rev 461)
@@ -485,6 +485,7 @@
Env *find_stacked(int32_t tag);
Env& act_env() { assert(!envstk.empty()); return *envstk.front(); }
Builder& act_builder() { return act_env().builder; }
+ pure_expr *const_value(expr x);
pure_expr *doeval(expr x, pure_expr*& e);
pure_expr *dodefn(env vars, expr lhs, expr rhs, pure_expr*& e);
llvm::Value *codegen(expr x);
Modified: pure/trunk/test/test015.log
===================================================================
--- pure/trunk/test/test015.log 2008-08-10 10:23:24 UTC (rev 460)
+++ pure/trunk/test/test015.log 2008-08-10 20:21:23 UTC (rev 461)
@@ -1,9 +1,3 @@
-{
- rule #0: randlist = [52,72,26,78,46,19,44,72,96,75,46,86,13,84,1,94,67,79,14,61,90,77,36,94,88,44,16,42,47,3,60,79,18,52,89,30,94,38,93,91,33,53,70,97,76,75,9,85,17,1,41,29,37,41,13,38,29,2,23,3,22,52,49,88,77,5,11,54,34,45,58,58,6,81,40,58,19,89,17,20,11,15,99,68,81,64,32,73,82,72,65,35,61,41,81,77,27,4,60,51,63,18,27,45,64,74,41,61,61,85,18,30,2,0,95,99,20,60,93,55,54,43,44,30,20,21,4,20,57,91,41,65,35,58,39,3,28,9,44,92,92,60,86,1,68,84,12,5,1,39,86,1,92,88,66,65,7,9,0,52,78,65,54,79,72,25,25,13,48,46,10,50,85,1,82,96,1,92,6,3,19,27,44,64,15,48,64,53,35,39,72,72,30,10,91,74,23,65,36,2,84,4,5,42,47,50,98,60,91,75,71,97,2,26,1,8,15,11,75,93,12,59,12,59,6,25,41,94,35,1,97,76,86,40,86,3,20,42,98,56,57,46,46,76,30,41,9,13,69,18,89,73,30,14,82,44,59,97,50,89,72,26,45,26,96,1,94,90,9,52,8,79,86,9,88,0,20,47,64,93,9,57,50,65,89,73,68,80,24,76,76,54,48,41,7,52,50,75,13,0,76,10,96,8,11,89,74,21,58,24,88,39,5,92,45,87,23,48,57,85,21,92,3,40,5,10,52,57,11,4,50,72,49,34,3,36,91,50,86,92,1,28,23,71,10,77,24,43,59,51,76,72,80,74,50,81,5,57,86,55,82,12,71,0,3,29,67,30,43,27,12,13,10,41,82,26,14,1,22,35,76,42,68,52,32,14,37,74,72,73,17,55,68,87,55,34,53,96,92,75,68,33,36,70,66,39,1,40,66,21,8,61,1,21,20,37,39,29,52,79,39,72,69,63,12,73,16,2,21,17,17,52,31,90,44,7,13,53,64,84,96,34,36,71,4,12,25,96,83,68,68,80,52,58,68,46,75,27,31,6,14,47,23,94,33,26,17,87,86,47,21,77,10,20,23,16,26,80,10,25,87,21,66,62,79,34,63,25,3,80,40,43,75,78,48,71,38,2,41,90,61,83,75,60,86,40,23,58,10,49,84,70,10,69,3,42,73,27,33,31,21,60,57,7,47,16,29,65,99,9,5,2,93,6,71,55,41,98,46,69,68,53,57,54,60,37,89,24,41,57,29,83,26,26,49,6,10,23,61,70,25,80,12,40,80,16,44,69,2,54,50,91,43,86,83,66,87,91,15,9,67,13,89,31,7,58,21,69,30,80,87,74,57,86,84,64,9,62,80,93,44,10,94,85,13,84,68,55,98,34,75,20,42,85,2,25,53,62,77,62,79,11,88,77,85,47,77,28,29,19,29,47,31,40,59,41,86,4,4,76,43,49,53,95,45,96,38,46,3,33,86,94,70,24,19,86,69,16,85,18,6,91,31,19,28,99,24,84,42,45,71,50,30,34,0,82,36,87,27,60,76,21,19,37,65,20,42,43,5,87,66,30,11,92,93,41,21,69,28,29,63,54,58,74,6,95,72,8,96,10,9,44,38,71,93,29,94,17,2,38,94,71,46,33,82,58,89,70,91,89,63,35,6,79,62,45,74,29,62,52,79,69,23,20,57,55,90,98,43,40,1,47,54,4,47,72,23,35,96,7,15,17,67,19,74,8,97,31,70,51,89,91,14,69,82,74,99,83,77,66,66,24,13,58,37,17,99,59,75,99,61,9,8,86,55,56,22,55,81,58,73,29,91,47,15,16,73,82,97,4,7,72,53,92,7,23,92,30,72,99,25,48,12,51,99,85,31,42,59,32,45,46,86,55,63,5,46,21,45,9,72,86,17,76,28,35,96,0,25,26,87,9,89,32,80,72,47,26,48,50,95,63,6,61,43,21,1,43,90,57,35,25,30,89,3,84,5,72,1,15,9,36,55,67,31,51,81,79,84,52,56,40,77,91,66,9,83,39,1,22,72,23,64,0,97,9,6,54,66,18,51,18,99,6,94,59,54,92,8,32,9,24,87,67,67,23,80,56,57,60,53,90,89,57,82,2,45,28,57,21,7,20,76,57,85,80,69,59,31,34,74,83,1,45,31,39,19,69,43,84,6,35,91,52,99,52,86,75,50,21,46,2,0,7,55,50,49,58,13,88,6,91,72,1,89,69,50,83,88,21,54,72,54,82,48,47,2,31,70,39]
- state 0: #0
- <var> state 1
- state 1: #0
-}
let randlist = [52,72,26,78,46,19,44,72,96,75,46,86,13,84,1,94,67,79,14,61,90,77,36,94,88,44,16,42,47,3,60,79,18,52,89,30,94,38,93,91,33,53,70,97,76,75,9,85,17,1,41,29,37,41,13,38,29,2,23,3,22,52,49,88,77,5,11,54,34,45,58,58,6,81,40,58,19,89,17,20,11,15,99,68,81,64,32,73,82,72,65,35,61,41,81,77,27,4,60,51,63,18,27,45,64,74,41,61,61,85,18,30,2,0,95,99,20,60,93,55,54,43,44,30,20,21,4,20,57,91,41,65,35,58,39,3,28,9,44,92,92,60,86,1,68,84,12,5,1,39,86,1,92,88,66,65,7,9,0,52,78,65,54,79,72,25,25,13,48,46,10,50,85,1,82,96,1,92,6,3,19,27,44,64,15,48,64,53,35,39,72,72,30,10,91,74,23,65,36,2,84,4,5,42,47,50,98,60,91,75,71,97,2,26,1,8,15,11,75,93,12,59,12,59,6,25,41,94,35,1,97,76,86,40,86,3,20,42,98,56,57,46,46,76,30,41,9,13,69,18,89,73,30,14,82,44,59,97,50,89,72,26,45,26,96,1,94,90,9,52,8,79,86,9,88,0,20,47,64,93,9,57,50,65,89,73,68,80,24,76,76,54,48,41,7,52,50,75,13,0,76,10,96,8,11,89,74,21,58,24,88,39,5,92,45,87,23,48,57,85,21,92,3,40,5,10,52,57,11,4,50,72,49,34,3,36,91,50,86,92,1,28,23,71,10,77,24,43,59,51,76,72,80,74,50,81,5,57,86,55,82,12,71,0,3,29,67,30,43,27,12,13,10,41,82,26,14,1,22,35,76,42,68,52,32,14,37,74,72,73,17,55,68,87,55,34,53,96,92,75,68,33,36,70,66,39,1,40,66,21,8,61,1,21,20,37,39,29,52,79,39,72,69,63,12,73,16,2,21,17,17,52,31,90,44,7,13,53,64,84,96,34,36,71,4,12,25,96,83,68,68,80,52,58,68,46,75,27,31,6,14,47,23,94,33,26,17,87,86,47,21,77,10,20,23,16,26,80,10,25,87,21,66,62,79,34,63,25,3,80,40,43,75,78,48,71,38,2,41,90,61,83,75,60,86,40,23,58,10,49,84,70,10,69,3,42,73,27,33,31,21,60,57,7,47,16,29,65,99,9,5,2,93,6,71,55,41,98,46,69,68,53,57,54,60,37,89,24,41,57,29,83,26,26,49,6,10,23,61,70,25,80,12,40,80,16,44,69,2,54,50,91,43,86,83,66,87,91,15,9,67,13,89,31,7,58,21,69,30,80,87,74,57,86,84,64,9,62,80,93,44,10,94,85,13,84,68,55,98,34,75,20,42,85,2,25,53,62,77,62,79,11,88,77,85,47,77,28,29,19,29,47,31,40,59,41,86,4,4,76,43,49,53,95,45,96,38,46,3,33,86,94,70,24,19,86,69,16,85,18,6,91,31,19,28,99,24,84,42,45,71,50,30,34,0,82,36,87,27,60,76,21,19,37,65,20,42,43,5,87,66,30,11,92,93,41,21,69,28,29,63,54,58,74,6,95,72,8,96,10,9,44,38,71,93,29,94,17,2,38,94,71,46,33,82,58,89,70,91,89,63,35,6,79,62,45,74,29,62,52,79,69,23,20,57,55,90,98,43,40,1,47,54,4,47,72,23,35,96,7,15,17,67,19,74,8,97,31,70,51,89,91,14,69,82,74,99,83,77,66,66,24,13,58,37,17,99,59,75,99,61,9,8,86,55,56,22,55,81,58,73,29,91,47,15,16,73,82,97,4,7,72,53,92,7,23,92,30,72,99,25,48,12,51,99,85,31,42,59,32,45,46,86,55,63,5,46,21,45,9,72,86,17,76,28,35,96,0,25,26,87,9,89,32,80,72,47,26,48,50,95,63,6,61,43,21,1,43,90,57,35,25,30,89,3,84,5,72,1,15,9,36,55,67,31,51,81,79,84,52,56,40,77,91,66,9,83,39,1,22,72,23,64,0,97,9,6,54,66,18,51,18,99,6,94,59,54,92,8,32,9,24,87,67,67,23,80,56,57,60,53,90,89,57,82,2,45,28,57,21,7,20,76,57,85,80,69,59,31,34,74,83,1,45,31,39,19,69,43,84,6,35,91,52,99,52,86,75,50,21,46,2,0,7,55,50,49,58,13,88,6,91,72,1,89,69,50,83,88,21,54,72,54,82,48,47,2,31,70,39];
{
rule #0: a = set (1..10)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-10 21:33:33
|
Revision: 462
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=462&view=rev
Author: agraef
Date: 2008-08-10 21:33:41 +0000 (Sun, 10 Aug 2008)
Log Message:
-----------
Overhaul of list/tuple generation code.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-10 20:21:23 UTC (rev 461)
+++ pure/trunk/ChangeLog 2008-08-10 21:33:41 UTC (rev 462)
@@ -4,7 +4,9 @@
evaluations and variable definitions of constant expressions.
* interpreter.cc (codegen): Fixed memory leak caused by the new
- list and tuple code. Reported by Jiri Spitz.
+ list and tuple code. Reported by Jiri Spitz. We now also impose a
+ minimum size for speeding up the generated code for smaller list
+ and tuple sizes.
2008-08-09 Albert Graef <Dr....@t-...>
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-10 20:21:23 UTC (rev 461)
+++ pure/trunk/interpreter.cc 2008-08-10 21:33:41 UTC (rev 462)
@@ -3880,7 +3880,6 @@
interactive session. */
expr f; uint32_t n = count_args(x, f);
Value *v; Env *e;
- exprl xs;
if (f.tag() == EXPR::FVAR && (v = funcall(f.vtag(), f.vidx(), n, x)))
// local function call
return v;
@@ -3910,22 +3909,32 @@
argv.push_back(body);
act_env().CreateCall(module->getFunction("pure_new_args"), argv);
return call("pure_catch", handler, body);
- } else if (x.is_list(xs) || x.is_pair() && x.is_tuple(xs)) {
- // optimize the case of proper lists and tuples
- size_t i = 0, n = xs.size();
- vector<Value*> argv(n+1);
- argv[0] = UInt(n);
- for (exprl::iterator it = xs.begin(), end = xs.end(); it != end; it++)
- argv[++i] = codegen(*it);
- act_env().CreateCall(module->getFunction("pure_new_args"), argv);
- v = act_env().CreateCall
- (module->getFunction(x.is_pair()?"pure_tuplel":"pure_listl"), argv);
- vector<Value*> argv1;
- argv1.push_back(NullExprPtr);
- argv1.insert(argv1.end(), argv.begin(), argv.end());
- act_env().CreateCall(module->getFunction("pure_free_args"), argv1);
- return v;
} else {
+#if LIST_KLUDGE>0
+ /* Alternative code for proper lists and tuples, which considerably
+ speeds up compilation for larger sequences. See the comments at the
+ beginning of interpreter.hh for details. */
+ exprl xs;
+ if ((x.is_list(xs) || x.is_pair() && x.is_tuple(xs)) &&
+ xs.size() >= LIST_KLUDGE) {
+ size_t i = 0, n = xs.size();
+ vector<Value*> argv(n+1);
+ argv[0] = UInt(n);
+ for (exprl::iterator it = xs.begin(), end = xs.end(); it != end;
+ it++)
+ argv[++i] = codegen(*it);
+ act_env().CreateCall(module->getFunction("pure_new_args"), argv);
+ v = act_env().CreateCall
+ (module->getFunction(x.is_pair()?"pure_tuplel":"pure_listl"),
+ argv);
+ vector<Value*> argv1;
+ argv1.push_back(NullExprPtr);
+ argv1.insert(argv1.end(), argv.begin(), argv.end());
+ act_env().CreateCall(module->getFunction("pure_free_args"), argv1);
+ return v;
+ }
+ xs.clear();
+#endif
// ordinary function application
Value *u = codegen(x.xval1()), *v = codegen(x.xval2());
return apply(u, v);
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-10 20:21:23 UTC (rev 461)
+++ pure/trunk/interpreter.hh 2008-08-10 21:33:41 UTC (rev 462)
@@ -29,6 +29,14 @@
get tail call elimination. */
#define USE_FASTCC 1
+/* Alternative code generation for the case of proper lists and tuples. This
+ is a kludge to work around performance issues with the JIT which (as of
+ LLVM 2.3) gets very slow with deeply nested call graphs. The code enabled
+ with this option here is actually less efficient for small list/tuple
+ values, which is why we impose a lower bound on the list/tuple size (10 by
+ default, use 0 to disable this option). */
+#define LIST_KLUDGE 10
+
using namespace std;
/* The Pure interpreter. */
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-11 10:01:48
|
Revision: 463
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=463&view=rev
Author: agraef
Date: 2008-08-11 10:01:55 +0000 (Mon, 11 Aug 2008)
Log Message:
-----------
More optimizations of toplevel expressions to avoid unnecessary evaluations of constants.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-10 21:33:41 UTC (rev 462)
+++ pure/trunk/interpreter.cc 2008-08-11 10:01:55 UTC (rev 463)
@@ -3076,6 +3076,8 @@
return pure_string_dup(x.sval());
case EXPR::PTR:
return pure_pointer(x.pval());
+ case EXPR::APP:
+ return const_app_value(x);
default: {
exprl xs;
if (x.tag() > 0) {
@@ -3114,6 +3116,42 @@
}
}
+pure_expr *interpreter::const_app_value(expr x)
+{
+ if (x.tag() == EXPR::APP) {
+ pure_expr *f = 0, *y = 0;
+ if ((f = const_app_value(x.xval1())) && (y = const_value(x.xval2())))
+ return pure_app(f, y);
+ else {
+ if (f) pure_freenew(f);
+ return 0;
+ }
+ } else if (x.tag() > 0) {
+ env::const_iterator it = globenv.find(x.tag());
+ map<int32_t,GlobalVar>::iterator v;
+ if (externals.find(x.tag()) != externals.end())
+ return 0;
+ else if (it == globenv.end())
+ // unbound symbol
+ return pure_const(x.tag());
+ else if (it->second.t == env_info::fvar &&
+ (v = globalvars.find(x.tag())) != globalvars.end()) {
+ // variable value
+ pure_expr *y = v->second.x;
+ // walk down the spine, if any
+ while (y->tag == EXPR::APP) y = y->data.x[0];
+ // check if we got a closure subject to evaluation
+ if (y->tag >= 0 && y->data.clos)
+ return 0;
+ else
+ // not a callable closure, so it must be a constructor term
+ return v->second.x;
+ } else
+ return 0;
+ } else
+ return 0;
+}
+
pure_expr *interpreter::doeval(expr x, pure_expr*& e)
{
char test;
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-10 21:33:41 UTC (rev 462)
+++ pure/trunk/interpreter.hh 2008-08-11 10:01:55 UTC (rev 463)
@@ -494,6 +494,7 @@
Env& act_env() { assert(!envstk.empty()); return *envstk.front(); }
Builder& act_builder() { return act_env().builder; }
pure_expr *const_value(expr x);
+ pure_expr *const_app_value(expr x);
pure_expr *doeval(expr x, pure_expr*& e);
pure_expr *dodefn(env vars, expr lhs, expr rhs, pure_expr*& e);
llvm::Value *codegen(expr x);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-11 10:26:37
|
Revision: 464
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=464&view=rev
Author: agraef
Date: 2008-08-11 10:26:44 +0000 (Mon, 11 Aug 2008)
Log Message:
-----------
OSX compatibility fixes.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/Makefile.in
pure/trunk/configure
pure/trunk/configure.ac
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-11 10:01:55 UTC (rev 463)
+++ pure/trunk/ChangeLog 2008-08-11 10:26:44 UTC (rev 464)
@@ -1,3 +1,10 @@
+2008-08-11 Albert Graef <Dr....@t-...>
+
+ * configure.ac, Makefile.in: Additional configury for proper
+ handling of dynamic linking on OSX (-install_name option,
+ DYLD_LIBRARY_PATH). Reported by Ryan Schmidt. NOTE: This change
+ requires a reconfigure.
+
2008-08-10 Albert Graef <Dr....@t-...>
* interpreter.cc (doeval, dodefn): Optimize the case of toplevel
Modified: pure/trunk/Makefile.in
===================================================================
--- pure/trunk/Makefile.in 2008-08-11 10:01:55 UTC (rev 463)
+++ pure/trunk/Makefile.in 2008-08-11 10:26:44 UTC (rev 464)
@@ -257,15 +257,15 @@
rm -f $(srcdir)/test/*.log
$(srcdir)/test/prelude.log: lib/prelude.pure lib/primitives.pure lib/strings.pure
- LD_LIBRARY_PATH=. PURELIB=$(srcdir)/lib ./pure -n -v$(level) $< > $@ 2>&1
+ @LD_LIB_PATH@=. PURELIB=$(srcdir)/lib ./pure -n -v$(level) $< > $@ 2>&1
%.log: %.pure
- LD_LIBRARY_PATH=. PURELIB=$(srcdir)/lib ./pure -v$(level) < $< > $@ 2>&1
+ @LD_LIB_PATH@=. PURELIB=$(srcdir)/lib ./pure -v$(level) < $< > $@ 2>&1
check: pure
@ echo Running tests.
- @ (export LD_LIBRARY_PATH=.; export PURELIB=$(srcdir)/lib; echo $(ECHO_N) "prelude.pure: "; if ./pure $(ECHO_N) -v$(level) $(srcdir)/lib/prelude.pure 2>&1 | diff -q - $(srcdir)/test/prelude.log > /dev/null; then echo passed; else echo FAILED; fi)
- @ (export LD_LIBRARY_PATH=.; export PURELIB=$(srcdir)/lib; for x in $(notdir $(tests)); do echo $(ECHO_N) "$$x: "; if ./pure -v$(level) < $(srcdir)/test/$$x 2>&1 | diff -q - $(srcdir)/test/"`basename $$x .pure`.log" > /dev/null; then echo passed; else echo FAILED; fi; done)
+ @ (export @LD_LIB_PATH@=.; export PURELIB=$(srcdir)/lib; echo $(ECHO_N) "prelude.pure: "; if ./pure $(ECHO_N) -v$(level) $(srcdir)/lib/prelude.pure 2>&1 | diff -q - $(srcdir)/test/prelude.log > /dev/null; then echo passed; else echo FAILED; fi)
+ @ (export @LD_LIB_PATH@=.; export PURELIB=$(srcdir)/lib; for x in $(notdir $(tests)); do echo $(ECHO_N) "$$x: "; if ./pure -v$(level) < $(srcdir)/test/$$x 2>&1 | diff -q - $(srcdir)/test/"`basename $$x .pure`.log" > /dev/null; then echo passed; else echo FAILED; fi; done)
# DO NOT DELETE
Modified: pure/trunk/configure
===================================================================
--- pure/trunk/configure 2008-08-11 10:01:55 UTC (rev 463)
+++ pure/trunk/configure 2008-08-11 10:26:44 UTC (rev 464)
@@ -662,6 +662,7 @@
PIC
DLLEXT
AUXLIBS
+LD_LIB_PATH
INSTALL_PROGRAM
INSTALL_SCRIPT
INSTALL_DATA
@@ -1853,12 +1854,14 @@
PIC=
DLLEXT=".so"
AUXLIBS=
+LD_LIB_PATH="LD_LIBRARY_PATH"
case "$host" in
*-*-mingw*) AUXLIBS="-DLIBGLOB='\"libglob.dll\"' -DLIBREGEX='\"libgnurx-0.dll\"'";
LIBS="$LIBS -limagehlp -lpsapi";
LDFLAGS="-Wl,--enable-auto-import"; DLLEXT=".dll";;
x86_64-*-linux*) PIC="-fPIC";;
- *-*-darwin*) rdynamic=""; shared="-dynamiclib"; DLLEXT=".dylib";;
+ *-*-darwin*) LD_LIB_PATH="DYLD_LIBRARY_PATH";
+ rdynamic=""; shared="-dynamiclib -install_name \$(libdir)/\$(libpure)"; DLLEXT=".dylib";;
hppa*-hp-hpux*) rdynamic=""; DLLEXT=".sl";;
esac
@@ -1867,6 +1870,7 @@
+
cat >>confdefs.h <<_ACEOF
#define DLLEXT "${DLLEXT}"
_ACEOF
@@ -6136,6 +6140,7 @@
PIC!$PIC$ac_delim
DLLEXT!$DLLEXT$ac_delim
AUXLIBS!$AUXLIBS$ac_delim
+LD_LIB_PATH!$LD_LIB_PATH$ac_delim
INSTALL_PROGRAM!$INSTALL_PROGRAM$ac_delim
INSTALL_SCRIPT!$INSTALL_SCRIPT$ac_delim
INSTALL_DATA!$INSTALL_DATA$ac_delim
@@ -6159,7 +6164,7 @@
LTLIBOBJS!$LTLIBOBJS$ac_delim
_ACEOF
- if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 71; then
+ if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 72; then
break
elif $ac_last_try; then
{ { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5
Modified: pure/trunk/configure.ac
===================================================================
--- pure/trunk/configure.ac 2008-08-11 10:01:55 UTC (rev 463)
+++ pure/trunk/configure.ac 2008-08-11 10:26:44 UTC (rev 464)
@@ -21,12 +21,14 @@
PIC=
DLLEXT=".so"
AUXLIBS=
+LD_LIB_PATH="LD_LIBRARY_PATH"
case "$host" in
*-*-mingw*) AUXLIBS="-DLIBGLOB='\"libglob.dll\"' -DLIBREGEX='\"libgnurx-0.dll\"'";
LIBS="$LIBS -limagehlp -lpsapi";
LDFLAGS="-Wl,--enable-auto-import"; DLLEXT=".dll";;
x86_64-*-linux*) PIC="-fPIC";;
- *-*-darwin*) rdynamic=""; shared="-dynamiclib"; DLLEXT=".dylib";;
+ *-*-darwin*) LD_LIB_PATH="DYLD_LIBRARY_PATH";
+ rdynamic=""; shared="-dynamiclib -install_name \$(libdir)/\$(libpure)"; DLLEXT=".dylib";;
hppa*-hp-hpux*) rdynamic=""; DLLEXT=".sl";;
esac
AC_SUBST(shared)
@@ -34,6 +36,7 @@
AC_SUBST(PIC)
AC_SUBST(DLLEXT)
AC_SUBST(AUXLIBS)
+AC_SUBST(LD_LIB_PATH)
AC_DEFINE_UNQUOTED(DLLEXT, "${DLLEXT}", [Define to the filename extension for shared libraries.])
dnl Check for programs.
AC_PROG_INSTALL
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-11 19:07:46
|
Revision: 465
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=465&view=rev
Author: agraef
Date: 2008-08-11 19:07:48 +0000 (Mon, 11 Aug 2008)
Log Message:
-----------
Fix segfault in catch/throw.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/runtime.cc
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-11 10:26:44 UTC (rev 464)
+++ pure/trunk/ChangeLog 2008-08-11 19:07:48 UTC (rev 465)
@@ -1,5 +1,8 @@
2008-08-11 Albert Graef <Dr....@t-...>
+ * runtime.cc (pure_catch): Fix wrong stack cleanup, causing
+ segfaults with catch/throw. Reported by Libor Spacek.
+
* configure.ac, Makefile.in: Additional configury for proper
handling of dynamic linking on OSX (-install_name option,
DYLD_LIBRARY_PATH). Reported by Ryan Schmidt. NOTE: This change
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-08-11 10:26:44 UTC (rev 464)
+++ pure/trunk/runtime.cc 2008-08-11 19:07:48 UTC (rev 465)
@@ -1299,9 +1299,10 @@
size_t m = x->data.clos->m;
assert(x->data.clos->local || m == 0);
pure_expr **env = 0;
+ size_t oldsz = interp.sstk_sz;;
if (m>0) {
// construct a stack frame
- size_t sz = interp.sstk_sz;;
+ size_t sz = oldsz;
resize_sstk(interp.sstk, interp.sstk_cap, sz, m+1);
pure_expr **sstk = interp.sstk; env = sstk+sz+1;
sstk[sz++] = 0;
@@ -1324,7 +1325,7 @@
}
checkstk(test);
// Push an exception.
- pure_exception ex; ex.e = 0; ex.sz = interp.sstk_sz;
+ pure_exception ex; ex.e = 0; ex.sz = oldsz;
interp.estk.push_front(ex);
// Call the function now. Catch exceptions generated by the runtime.
if (setjmp(interp.estk.front().jmp)) {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-12 06:23:07
|
Revision: 469
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=469&view=rev
Author: agraef
Date: 2008-08-12 06:23:16 +0000 (Tue, 12 Aug 2008)
Log Message:
-----------
Fix memory leaks.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/runtime.cc
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-12 06:16:09 UTC (rev 468)
+++ pure/trunk/ChangeLog 2008-08-12 06:23:16 UTC (rev 469)
@@ -1,3 +1,7 @@
+2008-08-12 Albert Graef <Dr....@t-...>
+
+ * runtime.cc (pure_catch, pure_sys_vars): Fixed memory leaks.
+
2008-08-11 Albert Graef <Dr....@t-...>
* runtime.cc (pure_catch): Fix wrong stack cleanup, causing
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-08-12 06:16:09 UTC (rev 468)
+++ pure/trunk/runtime.cc 2008-08-12 06:23:16 UTC (rev 469)
@@ -44,8 +44,8 @@
// Debug expression allocations. Warns about expression memory leaks.
// NOTE: Bookkeeping starts and ends at each toplevel pure_invoke call.
// Enabling this code will make the interpreter *much* slower.
-#if DEBUG>2
-#if DEBUG>9 // enable this to print each and every expression (de)allocation
+#if MEMDEBUG
+#if MEMDEBUG>1 // enable this to print each and every expression (de)allocation
#define MEMDEBUG_NEW(x) interpreter::g_interp->mem_allocations.insert(x); \
cerr << "NEW: " << (void*)x << ": " << x << endl;
#define MEMDEBUG_FREE(x) interpreter::g_interp->mem_allocations.erase(x); \
@@ -1216,7 +1216,11 @@
argv[n-1] = y;
// make sure that we do not gc the function before calling it
f0->refc++; pure_free_internal(x);
- // construct a stack frame
+ // first push the function object on the shadow stack so that it's
+ // garbage-collected in case of an exception
+ resize_sstk(interp.sstk, interp.sstk_cap, interp.sstk_sz, n+m+2);
+ interp.sstk[interp.sstk_sz++] = f0;
+ // construct a stack frame for the function call
{
size_t sz = interp.sstk_sz;
resize_sstk(interp.sstk, interp.sstk_cap, sz, n+m+1);
@@ -1258,7 +1262,8 @@
#if DEBUG>1
cerr << "pure_apply: result " << f0 << " = " << ret << " -> " << (void*)ret << ", refc = " << ret->refc << endl;
#endif
- pure_free_internal(f0);
+ // pop the function object from the shadow stack
+ pure_free_internal(interp.sstk[--interp.sstk_sz]);
return ret;
} else {
// construct a literal application node
@@ -1352,11 +1357,8 @@
cerr << "pure_catch: exception " << (void*)e << " (refc = " << e->refc
<< "): " << e << endl;
#endif
+ pure_free_internal(x);
pure_expr *res = pure_apply(h, e);
- assert(res);
- res->refc++;
- pure_free_internal(x);
- pure_unref_internal(res);
return res;
} else {
pure_expr *res;
@@ -2859,6 +2861,7 @@
} catch (err &e) {
cerr << "warning: " << e.what() << endl;
}
+ MEMDEBUG_FREE(x)
}
static inline void
@@ -2869,6 +2872,7 @@
} catch (err &e) {
cerr << "warning: " << e.what() << endl;
}
+ pure_freenew(x);
}
extern "C"
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-12 06:49:46
|
Revision: 470
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=470&view=rev
Author: agraef
Date: 2008-08-12 06:49:56 +0000 (Tue, 12 Aug 2008)
Log Message:
-----------
Bugfix in parsing the option string of the 'list' command.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lexer.ll
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-12 06:23:16 UTC (rev 469)
+++ pure/trunk/ChangeLog 2008-08-12 06:49:56 UTC (rev 470)
@@ -1,5 +1,9 @@
2008-08-12 Albert Graef <Dr....@t-...>
+ * lexer.ll: Fixed a bug in option parsing of the 'list' command
+ which would cause an option string starting with '-a' to be
+ interpreted as an ordinary argument.
+
* runtime.cc (pure_catch, pure_sys_vars): Fixed memory leaks.
2008-08-11 Albert Graef <Dr....@t-...>
Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll 2008-08-12 06:23:16 UTC (rev 469)
+++ pure/trunk/lexer.ll 2008-08-12 06:49:56 UTC (rev 470)
@@ -343,7 +343,7 @@
// process option arguments
for (arg = args.l.begin(); arg != args.l.end(); arg++) {
const char *s = arg->c_str();
- if (s[0] != '-' || !s[1] || !strchr("cdefghlstv", s[1])) break;
+ if (s[0] != '-' || !s[1] || !strchr("acdefghlstv", s[1])) break;
while (*++s) {
switch (*s) {
case 'a': aflag = true; break;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-12 12:56:07
|
Revision: 471
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=471&view=rev
Author: agraef
Date: 2008-08-12 12:56:14 +0000 (Tue, 12 Aug 2008)
Log Message:
-----------
Handle SIGFPE.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
pure/trunk/runtime.cc
pure/trunk/runtime.h
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-12 06:49:56 UTC (rev 470)
+++ pure/trunk/ChangeLog 2008-08-12 12:56:14 UTC (rev 471)
@@ -1,5 +1,10 @@
2008-08-12 Albert Graef <Dr....@t-...>
+ * interpreter.cc (builtin_codegen), runtime.cc(bigint_div,
+ bigint_mod): Handle division by zero by throwing a 'signal SIGFPE'
+ exception. Previously, these would just bail out with an unhandled
+ SIGFPE signal.
+
* lexer.ll: Fixed a bug in option parsing of the 'list' command
which would cause an option string starting with '-a' to be
interpreted as an ordinary argument.
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-12 06:49:56 UTC (rev 470)
+++ pure/trunk/interpreter.cc 2008-08-12 12:56:14 UTC (rev 471)
@@ -263,6 +263,8 @@
"pure_catch", "expr*", 2, "expr*", "expr*");
declare_extern((void*)pure_throw,
"pure_throw", "void", 1, "expr*");
+ declare_extern((void*)pure_sigfpe,
+ "pure_sigfpe", "void", 0);
declare_extern((void*)pure_new,
"pure_new", "expr*", 1, "expr*");
@@ -3652,11 +3654,43 @@
return b.CreateSub(u, v);
else if (f.ftag() == symtab.mult_sym().f)
return b.CreateMul(u, v);
- else if (f.ftag() == symtab.div_sym().f)
- return b.CreateSDiv(u, v);
- else if (f.ftag() == symtab.mod_sym().f)
- return b.CreateSRem(u, v);
- else {
+ else if (f.ftag() == symtab.div_sym().f) {
+ // catch division by zero
+ if (x.xval2().tag() == EXPR::INT && x.xval2().ival() == 0) {
+ b.CreateCall(module->getFunction("pure_sigfpe"));
+ return v;
+ } else {
+ BasicBlock *okbb = BasicBlock::Create("ok");
+ BasicBlock *errbb = BasicBlock::Create("err");
+ Value *cmp = b.CreateICmpEQ(v, Zero);
+ b.CreateCondBr(cmp, errbb, okbb);
+ act_env().f->getBasicBlockList().push_back(errbb);
+ b.SetInsertPoint(errbb);
+ b.CreateCall(module->getFunction("pure_sigfpe"));
+ b.CreateRet(NullExprPtr);
+ act_env().f->getBasicBlockList().push_back(okbb);
+ b.SetInsertPoint(okbb);
+ return b.CreateSDiv(u, v);
+ }
+ } else if (f.ftag() == symtab.mod_sym().f) {
+ // catch division by zero
+ if (x.xval2().tag() == EXPR::INT && x.xval2().ival() == 0) {
+ b.CreateCall(module->getFunction("pure_sigfpe"));
+ return v;
+ } else {
+ BasicBlock *okbb = BasicBlock::Create("ok");
+ BasicBlock *errbb = BasicBlock::Create("err");
+ Value *cmp = b.CreateICmpEQ(v, Zero);
+ b.CreateCondBr(cmp, errbb, okbb);
+ act_env().f->getBasicBlockList().push_back(errbb);
+ b.SetInsertPoint(errbb);
+ b.CreateCall(module->getFunction("pure_sigfpe"));
+ b.CreateRet(NullExprPtr);
+ act_env().f->getBasicBlockList().push_back(okbb);
+ b.SetInsertPoint(okbb);
+ return b.CreateSRem(u, v);
+ }
+ } else {
assert(0 && "error in type checker");
return 0;
}
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-08-12 06:49:56 UTC (rev 470)
+++ pure/trunk/runtime.cc 2008-08-12 12:56:14 UTC (rev 471)
@@ -1289,7 +1289,15 @@
}
}
+#include <signal.h>
+
extern "C"
+void pure_sigfpe(void)
+{
+ pure_throw(signal_exception(SIGFPE));
+}
+
+extern "C"
pure_expr *pure_catch(pure_expr *h, pure_expr *x)
{
char test;
@@ -1952,9 +1960,12 @@
return u;
}
+// These raise a SIGFPE signal exception for division by zero.
+
extern "C"
pure_expr *bigint_div(mpz_t x, mpz_t y)
{
+ if (mpz_sgn(y) == 0) pure_sigfpe();
pure_expr *u = pure_bigint(0, 0);
mpz_t& z = u->data.z;
mpz_tdiv_q(z, x, y);
@@ -1964,6 +1975,7 @@
extern "C"
pure_expr *bigint_mod(mpz_t x, mpz_t y)
{
+ if (mpz_sgn(y) == 0) pure_sigfpe();
pure_expr *u = pure_bigint(0, 0);
mpz_t& z = u->data.z;
mpz_tdiv_r(z, x, y);
Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h 2008-08-12 06:49:56 UTC (rev 470)
+++ pure/trunk/runtime.h 2008-08-12 12:56:14 UTC (rev 471)
@@ -340,6 +340,11 @@
void pure_throw(pure_expr* e);
+/* Throw a 'signal SIGFPE' exception. This is used to signal division by
+ zero. */
+
+void pure_sigfpe(void);
+
/* Execute a parameterless fbox x and return its result. If an exception
occurs while x is executed, apply h to the value of the exception
instead. */
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-12 13:44:48
|
Revision: 473
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=473&view=rev
Author: agraef
Date: 2008-08-12 13:44:56 +0000 (Tue, 12 Aug 2008)
Log Message:
-----------
Add handlers for POSIX termination signals.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/pure.cc
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-12 13:28:56 UTC (rev 472)
+++ pure/trunk/ChangeLog 2008-08-12 13:44:56 UTC (rev 473)
@@ -1,5 +1,9 @@
2008-08-12 Albert Graef <Dr....@t-...>
+ * pure.cc (main): Set up handlers for standard POSIX termination
+ signals, mapping these to orderly Pure exceptions of the form
+ 'signal SIG'.
+
* interpreter.cc (builtin_codegen), runtime.cc(bigint_div,
bigint_mod): Handle division by zero by throwing a 'signal SIGFPE'
exception. Previously, these would just bail out with an unhandled
Modified: pure/trunk/pure.cc
===================================================================
--- pure/trunk/pure.cc 2008-08-12 13:28:56 UTC (rev 472)
+++ pure/trunk/pure.cc 2008-08-12 13:44:56 UTC (rev 473)
@@ -162,7 +162,7 @@
return matches;
}
-static void sigint_handler(int sig)
+static void sig_handler(int sig)
{
interpreter::brkflag = sig;
}
@@ -185,13 +185,32 @@
// This is used in advisory stack checks.
interpreter::baseptr = &base;
// make sure that SIGPIPE is ignored
-#ifndef _WIN32
+ /* Set up handlers for all standard POSIX termination signals (except
+ SIGKILL which is unmaskable). SIGPIPE is ignored by default, all others
+ are mapped to Pure exceptions of the form 'signal SIG', so that they can
+ be caught with 'catch' or safely return us to the interpreter's
+ interactive command line. */
+#ifdef SIGHUP
+ signal(SIGHUP, sig_handler);
+#endif
+#ifdef SIGINT
+ signal(SIGINT, sig_handler);
+#endif
+#ifdef SIGPIPE
signal(SIGPIPE, SIG_IGN);
#endif
- /* Set up a SIGINT handler which throws a Pure exception, so that we safely
- return to the interpreter's interactive command line when the user
- interrupts a computation. */
- signal(SIGINT, sigint_handler);
+#ifdef SIGALRM
+ signal(SIGALRM, sig_handler);
+#endif
+#ifdef SIGTERM
+ signal(SIGTERM, sig_handler);
+#endif
+#ifdef SIGUSR1
+ signal(SIGUSR1, sig_handler);
+#endif
+#ifdef SIGUSR2
+ signal(SIGUSR2, sig_handler);
+#endif
// set up an exit function which saves the history if needed
atexit(exit_handler);
// set the system locale
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-12 13:59:49
|
Revision: 474
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=474&view=rev
Author: agraef
Date: 2008-08-12 13:59:55 +0000 (Tue, 12 Aug 2008)
Log Message:
-----------
Add signal constants.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/runtime.cc
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-12 13:44:56 UTC (rev 473)
+++ pure/trunk/ChangeLog 2008-08-12 13:59:55 UTC (rev 474)
@@ -1,5 +1,7 @@
2008-08-12 Albert Graef <Dr....@t-...>
+ * runtime.cc (pure_sys_vars): Add signal constants.
+
* pure.cc (main): Set up handlers for standard POSIX termination
signals, mapping these to orderly Pure exceptions of the form
'signal SIG'.
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-08-12 13:44:56 UTC (rev 473)
+++ pure/trunk/runtime.cc 2008-08-12 13:59:55 UTC (rev 474)
@@ -2938,4 +2938,62 @@
cdf(interp, "REG_ESPACE", pure_int(REG_ESPACE));
// regexec error codes
cdf(interp, "REG_NOMATCH", pure_int(REG_NOMATCH));
+ // signals
+#ifdef SIGHUP
+ cdf(interp, "SIGHUP", pure_int(SIGHUP));
+#endif
+#ifdef SIGINT
+ cdf(interp, "SIGINT", pure_int(SIGINT));
+#endif
+#ifdef SIGQUIT
+ cdf(interp, "SIGQUIT", pure_int(SIGQUIT));
+#endif
+#ifdef SIGILL
+ cdf(interp, "SIGILL", pure_int(SIGILL));
+#endif
+#ifdef SIGABRT
+ cdf(interp, "SIGABRT", pure_int(SIGABRT));
+#endif
+#ifdef SIGFPE
+ cdf(interp, "SIGFPE", pure_int(SIGFPE));
+#endif
+#ifdef SIGKILL
+ cdf(interp, "SIGKILL", pure_int(SIGKILL));
+#endif
+#ifdef SIGSEGV
+ cdf(interp, "SIGSEGV", pure_int(SIGSEGV));
+#endif
+#ifdef SIGPIPE
+ cdf(interp, "SIGPIPE", pure_int(SIGPIPE));
+#endif
+#ifdef SIGALRM
+ cdf(interp, "SIGALRM", pure_int(SIGALRM));
+#endif
+#ifdef SIGTERM
+ cdf(interp, "SIGTERM", pure_int(SIGTERM));
+#endif
+#ifdef SIGUSR1
+ cdf(interp, "SIGUSR1", pure_int(SIGUSR1));
+#endif
+#ifdef SIGUSR2
+ cdf(interp, "SIGUSR2", pure_int(SIGUSR2));
+#endif
+#ifdef SIGCHLD
+ cdf(interp, "SIGCHLD", pure_int(SIGCHLD));
+#endif
+#ifdef SIGCONT
+ cdf(interp, "SIGCONT", pure_int(SIGCONT));
+#endif
+#ifdef SIGSTOP
+ cdf(interp, "SIGSTOP", pure_int(SIGSTOP));
+#endif
+#ifdef SIGTSTP
+ cdf(interp, "SIGTSTP", pure_int(SIGTSTP));
+#endif
+#ifdef SIGTTIN
+ cdf(interp, "SIGTTIN", pure_int(SIGTTIN));
+#endif
+#ifdef SIGTTOU
+ cdf(interp, "SIGTTOU", pure_int(SIGTTOU));
+#endif
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-12 19:20:27
|
Revision: 476
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=476&view=rev
Author: agraef
Date: 2008-08-12 19:20:37 +0000 (Tue, 12 Aug 2008)
Log Message:
-----------
Add 'trap' operation to configure signal handlers.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/system.pure
pure/trunk/runtime.cc
pure/trunk/runtime.h
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-12 19:17:34 UTC (rev 475)
+++ pure/trunk/ChangeLog 2008-08-12 19:20:37 UTC (rev 476)
@@ -1,5 +1,8 @@
2008-08-12 Albert Graef <Dr....@t-...>
+ * runtime.cc/h, lib/system.pure: Add 'trap' operation to configure
+ signal handlers.
+
* runtime.cc (pure_sys_vars): Add signal constants.
* pure.cc (main): Set up handlers for standard POSIX termination
Modified: pure/trunk/lib/system.pure
===================================================================
--- pure/trunk/lib/system.pure 2008-08-12 19:17:34 UTC (rev 475)
+++ pure/trunk/lib/system.pure 2008-08-12 19:20:37 UTC (rev 476)
@@ -47,6 +47,18 @@
errno = pure_errno;
set_errno val::int = pure_set_errno val;
+/* Signal handling. The action parameter of 'trap' can be one of the
+ predefined integer values SIG_TRAP, SIG_IGN and SIG_DFL. SIG_TRAP causes
+ the given signal to be handled by mapping it to a Pure exception of the
+ form 'signal SIG'. SIG_IGN ignores the signal, SIG_DFL reverts to the
+ system's default handling. See 'list -g SIG*' for a list of known signal
+ values on your system. NOTE: Most standard termination signals (SIGINT,
+ SIGTERM, etc.) are already set up at the start of the interpreter to report
+ corresponding Pure exceptions; if this is not desired, you can use 'trap'
+ to either ignore these or revert to the default handlers instead. */
+
+extern void pure_trap(int action, int sig) = trap;
+
/* Time functions. 'time' reports the current time in seconds since the
"epoch" a.k.a. 00:00:00 UTC, Jan 1 1970. The result is always a bigint (in
fact, the time value is already 64 bit on many OSes nowadays). */
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-08-12 19:17:34 UTC (rev 475)
+++ pure/trunk/runtime.cc 2008-08-12 19:20:37 UTC (rev 476)
@@ -1297,7 +1297,23 @@
pure_throw(signal_exception(SIGFPE));
}
+static void sig_handler(int sig)
+{
+ interpreter::brkflag = sig;
+}
+
extern "C"
+void pure_trap(int32_t action, int32_t sig)
+{
+ if (action > 0)
+ signal(sig, sig_handler);
+ else if (action < 0)
+ signal(sig, SIG_IGN);
+ else
+ signal(sig, SIG_DFL);
+}
+
+extern "C"
pure_expr *pure_catch(pure_expr *h, pure_expr *x)
{
char test;
@@ -2938,6 +2954,10 @@
cdf(interp, "REG_ESPACE", pure_int(REG_ESPACE));
// regexec error codes
cdf(interp, "REG_NOMATCH", pure_int(REG_NOMATCH));
+ // signal actions
+ cdf(interp, "SIG_TRAP", pure_int(1));
+ cdf(interp, "SIG_IGN", pure_int(-1));
+ cdf(interp, "SIG_DFL", pure_int(0));
// signals
#ifdef SIGHUP
cdf(interp, "SIGHUP", pure_int(SIGHUP));
Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h 2008-08-12 19:17:34 UTC (rev 475)
+++ pure/trunk/runtime.h 2008-08-12 19:20:37 UTC (rev 476)
@@ -345,6 +345,11 @@
void pure_sigfpe(void);
+/* Configure signal handlers. The second argument is the signal number, the
+ first the action to take (-1 = ignore, 1 = handle, 0 = default). */
+
+void pure_trap(int32_t action, int32_t sig);
+
/* Execute a parameterless fbox x and return its result. If an exception
occurs while x is executed, apply h to the value of the exception
instead. */
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-12 23:49:18
|
Revision: 477
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=477&view=rev
Author: agraef
Date: 2008-08-12 23:49:27 +0000 (Tue, 12 Aug 2008)
Log Message:
-----------
Move check for uncollected temporaries after an exception to the toplevel.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
pure/trunk/runtime.cc
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-12 19:20:37 UTC (rev 476)
+++ pure/trunk/ChangeLog 2008-08-12 23:49:27 UTC (rev 477)
@@ -1,3 +1,11 @@
+2008-08-13 Albert Graef <Dr....@t-...>
+
+ * runtime.cc (pure_catch, pure_invoke): Collecting temporary
+ values after an exception doesn't seem to be safe while an
+ evaluation is still in progress. Moved this to doeval/dodefn in
+ interpreter.cc where we're back at the toplevel and it is safe to
+ do this.
+
2008-08-12 Albert Graef <Dr....@t-...>
* runtime.cc/h, lib/system.pure: Add 'trap' operation to configure
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-12 19:20:37 UTC (rev 476)
+++ pure/trunk/interpreter.cc 2008-08-12 23:49:27 UTC (rev 477)
@@ -3201,6 +3201,22 @@
else
fptr->refc--;
fptr = save_fptr;
+ if (!res) {
+ // collect garbage
+ pure_expr *t = tmps;
+ while (t) {
+ pure_expr *next = t->xp;
+ pure_freenew(t);
+ t = next;
+ }
+ }
+#if DEBUG>1
+ pure_expr *t = tmps;
+ while (t) {
+ if (t != res) std::cerr << "uncollected temporary: " << t << endl;
+ t = t->xp;
+ }
+#endif
// NOTE: Result (if any) is to be freed by the caller.
return res;
}
@@ -3342,7 +3358,21 @@
globalvars.erase(tag);
}
}
+ // collect garbage
+ pure_expr *t = tmps;
+ while (t) {
+ pure_expr *next = t->xp;
+ pure_freenew(t);
+ t = next;
+ }
}
+#if DEBUG>1
+ pure_expr *t = tmps;
+ while (t) {
+ if (t != res) std::cerr << "uncollected temporary: " << t << endl;
+ t = t->xp;
+ }
+#endif
// NOTE: Result (if any) is to be freed by the caller.
return res;
}
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-08-12 19:20:37 UTC (rev 476)
+++ pure/trunk/runtime.cc 2008-08-12 23:49:27 UTC (rev 477)
@@ -1363,6 +1363,8 @@
pure_expr *e = interp.estk.front().e;
interp.estk.pop_front();
if (e) pure_new_internal(e);
+#if 0
+ /* This doesn't seem to be safe here. Defer until later. */
// collect garbage
pure_expr *tmps = interp.tmps;
while (tmps) {
@@ -1370,6 +1372,7 @@
pure_freenew(tmps);
tmps = next;
}
+#endif
for (size_t i = interp.sstk_sz; i-- > sz; )
if (interp.sstk[i] && interp.sstk[i]->refc > 0)
pure_free_internal(interp.sstk[i]);
@@ -1394,7 +1397,7 @@
res = ((pure_expr*(*)())fp)();
// normal return
interp.estk.pop_front();
-#if DEBUG>1
+#if DEBUG>2
pure_expr *tmps = interp.tmps;
while (tmps) {
if (tmps != res) cerr << "uncollected temporary: " << tmps << endl;
@@ -1437,6 +1440,8 @@
e = interp.estk.front().e;
interp.estk.pop_front();
if (e) pure_new_internal(e);
+#if 0
+ /* This doesn't seem to be safe here. Defer until later. */
// collect garbage
pure_expr *tmps = interp.tmps;
while (tmps) {
@@ -1444,6 +1449,7 @@
pure_freenew(tmps);
tmps = next;
}
+#endif
for (size_t i = interp.sstk_sz; i-- > sz; )
if (interp.sstk[i] && interp.sstk[i]->refc > 0)
pure_free_internal(interp.sstk[i]);
@@ -1460,7 +1466,7 @@
// normal return
interp.estk.pop_front();
MEMDEBUG_SUMMARY(res)
-#if DEBUG>1
+#if DEBUG>2
pure_expr *tmps = interp.tmps;
while (tmps) {
if (tmps != res) cerr << "uncollected temporary: " << tmps << endl;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-13 01:07:38
|
Revision: 479
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=479&view=rev
Author: agraef
Date: 2008-08-13 01:07:48 +0000 (Wed, 13 Aug 2008)
Log Message:
-----------
Add signal processing example.
Modified Paths:
--------------
pure/trunk/ChangeLog
Added Paths:
-----------
pure/trunk/examples/signal.pure
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-12 23:58:36 UTC (rev 478)
+++ pure/trunk/ChangeLog 2008-08-13 01:07:48 UTC (rev 479)
@@ -1,5 +1,7 @@
2008-08-13 Albert Graef <Dr....@t-...>
+ * examples/signal.pure: Add signal processing example.
+
* runtime.cc (pure_catch, pure_invoke): Collecting temporary
values after an exception doesn't seem to be safe while an
evaluation is still in progress. Moved this to doeval/dodefn in
Added: pure/trunk/examples/signal.pure
===================================================================
--- pure/trunk/examples/signal.pure (rev 0)
+++ pure/trunk/examples/signal.pure 2008-08-13 01:07:48 UTC (rev 479)
@@ -0,0 +1,30 @@
+
+/* Signal processing example. */
+
+using system;
+extern int getpid();
+
+/* The common POSIX termination signals like SIGHUP, SIGINT, SIGTERM etc. are
+ already remapped to Pure exceptions by the interpreter when it starts.
+ Other kinds of signals can be handled as Pure exceptions, too, if we rebind
+ them with the 'trap' function. (Try 'list -g SIG*' to see which standard
+ signal values are known on your system.) Example: */
+
+trap SIG_TRAP SIGTSTP;
+
+/* Running this function enters an endless loop reporting all signals
+ delivered to the process. */
+
+test = printf "Running as pid %d, try to kill me!\n" getpid, loop;
+
+loop = loop when _ = catch sig check end
+with
+ sig (signal k) = loop when _ = printf "Hey, I got signal %d.\n" k end;
+end;
+
+/* Take a short nap so that the loop doesn't run busily. This also serves the
+ purpose of checking for pending signals. (Note that for performance reasons
+ the Pure interpreter only processes asynchronous signals at certain points,
+ such as the entry of a global Pure function.) */
+
+check = sleep 1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-13 09:06:07
|
Revision: 481
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=481&view=rev
Author: agraef
Date: 2008-08-13 09:06:17 +0000 (Wed, 13 Aug 2008)
Log Message:
-----------
Add support for single precision 'float' arguments and return values to the C interface.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/interpreter.cc
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-13 01:45:47 UTC (rev 480)
+++ pure/trunk/ChangeLog 2008-08-13 09:06:17 UTC (rev 481)
@@ -1,5 +1,9 @@
2008-08-13 Albert Graef <Dr....@t-...>
+ * interpreter.cc (declare_extern, named_type, type_name): Add
+ support for single precision 'float' arguments and return values
+ to the C interface. Reported by Eddie Rucker.
+
* examples/signal.pure: Add signal processing example.
* runtime.cc (pure_catch, pure_invoke): Collecting temporary
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-13 01:45:47 UTC (rev 480)
+++ pure/trunk/interpreter.cc 2008-08-13 09:06:17 UTC (rev 481)
@@ -2567,6 +2567,8 @@
return Type::Int32Ty;
else if (name == "long")
return Type::Int64Ty;
+ else if (name == "float")
+ return Type::FloatTy;
else if (name == "double")
return Type::DoubleTy;
else if (name == "char*")
@@ -2606,6 +2608,8 @@
return "int";
else if (type == Type::Int64Ty)
return "long";
+ else if (type == Type::FloatTy)
+ return "float";
else if (type == Type::DoubleTy)
return "double";
else if (type == CharPtrTy)
@@ -2872,6 +2876,18 @@
phi->addIncoming(intv, intbb);
phi->addIncoming(mpzv, mpzbb);
unboxed[i] = phi;
+ } else if (argt[i] == Type::FloatTy) {
+ BasicBlock *okbb = BasicBlock::Create("ok");
+ Value *idx[2] = { Zero, Zero };
+ Value *tagv = b.CreateLoad(b.CreateGEP(x, idx, idx+2), "tag");
+ b.CreateCondBr
+ (b.CreateICmpEQ(tagv, SInt(EXPR::DBL), "cmp"), okbb, failedbb);
+ f->getBasicBlockList().push_back(okbb);
+ b.SetInsertPoint(okbb);
+ Value *pv = b.CreateBitCast(x, DblExprPtrTy, "dblexpr");
+ idx[1] = ValFldIndex;
+ Value *dv = b.CreateLoad(b.CreateGEP(pv, idx, idx+2), "dblval");
+ unboxed[i] = b.CreateFPTrunc(dv, Type::FloatTy);
} else if (argt[i] == Type::DoubleTy) {
BasicBlock *okbb = BasicBlock::Create("ok");
Value *idx[2] = { Zero, Zero };
@@ -2897,6 +2913,7 @@
} else if (argt[i] == PointerType::get(Type::Int16Ty, 0) ||
argt[i] == PointerType::get(Type::Int32Ty, 0) ||
argt[i] == PointerType::get(Type::Int64Ty, 0) ||
+ argt[i] == PointerType::get(Type::FloatTy, 0) ||
argt[i] == PointerType::get(Type::DoubleTy, 0)) {
BasicBlock *okbb = BasicBlock::Create("ok");
Value *idx[2] = { Zero, Zero };
@@ -2977,6 +2994,9 @@
u = b.CreateCall(module->getFunction("pure_int"), u);
else if (type == Type::Int64Ty)
u = b.CreateCall(module->getFunction("pure_long"), u);
+ else if (type == Type::FloatTy)
+ u = b.CreateCall(module->getFunction("pure_double"),
+ b.CreateFPExt(u, Type::DoubleTy));
else if (type == Type::DoubleTy)
u = b.CreateCall(module->getFunction("pure_double"), u);
else if (type == CharPtrTy)
@@ -2984,6 +3004,7 @@
else if (type == PointerType::get(Type::Int16Ty, 0) ||
type == PointerType::get(Type::Int32Ty, 0) ||
type == PointerType::get(Type::Int64Ty, 0) ||
+ type == PointerType::get(Type::FloatTy, 0) ||
type == PointerType::get(Type::DoubleTy, 0))
u = b.CreateCall(module->getFunction("pure_pointer"),
b.CreateBitCast(u, VoidPtrTy));
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-13 13:13:13
|
Revision: 484
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=484&view=rev
Author: agraef
Date: 2008-08-13 13:13:21 +0000 (Wed, 13 Aug 2008)
Log Message:
-----------
Mask further asynchronous signals in pure_catch while invoking an exception handler.
Modified Paths:
--------------
pure/trunk/interpreter.cc
pure/trunk/interpreter.hh
pure/trunk/runtime.cc
Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc 2008-08-13 12:43:41 UTC (rev 483)
+++ pure/trunk/interpreter.cc 2008-08-13 13:13:21 UTC (rev 484)
@@ -21,6 +21,7 @@
int interpreter::stackmax = 0;
int interpreter::stackdir = 0;
int interpreter::brkflag = 0;
+int interpreter::brkmask = 0;
static void* resolve_external(const std::string& name)
{
Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh 2008-08-13 12:43:41 UTC (rev 483)
+++ pure/trunk/interpreter.hh 2008-08-13 13:13:21 UTC (rev 484)
@@ -583,7 +583,7 @@
static bool g_interactive;
static interpreter* g_interp;
// not saved
- static int brkflag;
+ static int brkflag, brkmask;
static char *baseptr;
static int stackmax;
static int stackdir;
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-08-13 12:43:41 UTC (rev 483)
+++ pure/trunk/runtime.cc 2008-08-13 13:13:21 UTC (rev 484)
@@ -38,12 +38,15 @@
interpreter::stackdir*(&test - interpreter::baseptr) \
>= interpreter::stackmax) \
pure_throw(stack_exception())
-#define checkall(test) if (interpreter::brkflag) \
- pure_throw(signal_exception(interpreter::brkflag)); \
- else if (interpreter::stackmax > 0 && \
+#define checkall(test) if (interpreter::stackmax > 0 && \
interpreter::stackdir*(&test - interpreter::baseptr) \
- >= interpreter::stackmax) \
- pure_throw(stack_exception())
+ >= interpreter::stackmax) { \
+ interpreter::brkmask = 0; \
+ pure_throw(stack_exception()); \
+ } else if (interpreter::brkmask) \
+ interpreter::brkmask = 0; \
+ else if (interpreter::brkflag) \
+ pure_throw(signal_exception(interpreter::brkflag))
// Debug expression allocations. Warns about expression memory leaks.
// NOTE: Bookkeeping starts and ends at each toplevel pure_invoke call.
@@ -1389,6 +1392,8 @@
<< "): " << e << endl;
#endif
pure_free_internal(x);
+ // mask further breaks until the handler starts executing
+ interp.brkmask = 1;
pure_expr *res = pure_apply(h, e);
return res;
} else {
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ag...@us...> - 2008-08-14 07:57:53
|
Revision: 490
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=490&view=rev
Author: agraef
Date: 2008-08-14 07:58:03 +0000 (Thu, 14 Aug 2008)
Log Message:
-----------
Removed obsolete fun and arg functions.
Modified Paths:
--------------
pure/trunk/ChangeLog
pure/trunk/lib/primitives.pure
pure/trunk/runtime.cc
pure/trunk/runtime.h
Modified: pure/trunk/ChangeLog
===================================================================
--- pure/trunk/ChangeLog 2008-08-14 07:30:45 UTC (rev 489)
+++ pure/trunk/ChangeLog 2008-08-14 07:58:03 UTC (rev 490)
@@ -1,3 +1,10 @@
+2008-08-14 Albert Graef <Dr....@t-...>
+
+ * lib/primitives.pure, runtime.cc/h: Removed obsolete fun and arg
+ functions, as 'arg' conflicted with math.pure. Also, applp is now
+ implemented directly in Pure, and the corresponding runtime
+ routine has been removed as well.
+
2008-08-13 Albert Graef <Dr....@t-...>
* interpreter.cc (declare_extern, named_type, type_name): Add
Modified: pure/trunk/lib/primitives.pure
===================================================================
--- pure/trunk/lib/primitives.pure 2008-08-14 07:30:45 UTC (rev 489)
+++ pure/trunk/lib/primitives.pure 2008-08-14 07:58:03 UTC (rev 490)
@@ -45,9 +45,11 @@
/* Predicates to check for function objects, global (unbound) variables,
function applications, proper lists, list nodes and tuples. */
-extern bool funp(expr*), bool lambdap(expr*), bool varp(expr*),
- bool applp(expr*);
+extern bool funp(expr*), bool lambdap(expr*), bool varp(expr*);
+applp (_ _) = 1;
+applp _ = 0 otherwise;
+
listp [] = 1;
listp (x:xs) = listp xs;
listp _ = 0 otherwise;
@@ -60,10 +62,6 @@
tuplep (x,xs) = 1;
tuplep _ = 0 otherwise;
-/* Operations to return the function and the argument in an application. */
-
-extern expr* fun(expr*), expr* arg(expr*);
-
/* Compute a 32 bit hash code of a Pure expression. */
extern int hash(expr*);
Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc 2008-08-14 07:30:45 UTC (rev 489)
+++ pure/trunk/runtime.cc 2008-08-14 07:58:03 UTC (rev 490)
@@ -2391,30 +2391,6 @@
}
extern "C"
-bool applp(const pure_expr *x)
-{
- return (x->tag == EXPR::APP);
-}
-
-extern "C"
-pure_expr *fun(const pure_expr *x)
-{
- if (x->tag == EXPR::APP)
- return x->data.x[0];
- else
- return 0;
-}
-
-extern "C"
-pure_expr *arg(const pure_expr *x)
-{
- if (x->tag == EXPR::APP)
- return x->data.x[1];
- else
- return 0;
-}
-
-extern "C"
int32_t pointer_get_byte(void *ptr)
{
uint8_t *p = (uint8_t*)ptr;
Modified: pure/trunk/runtime.h
===================================================================
--- pure/trunk/runtime.h 2008-08-14 07:30:45 UTC (rev 489)
+++ pure/trunk/runtime.h 2008-08-14 07:58:03 UTC (rev 490)
@@ -531,16 +531,6 @@
bool lambdap(const pure_expr *x);
bool varp(const pure_expr *x);
-/* Check whether an object is a function application, and return the function
- and the argument of an application. Note that these operations can't be
- defined in Pure because of the "head is function" rule which means that in
- a pattern of the form f x, f is always a literal function symbol and not a
- variable. */
-
-bool applp(const pure_expr *x);
-pure_expr *fun(const pure_expr *x);
-pure_expr *arg(const pure_expr *x);
-
/* Direct memory accesses. */
int32_t pointer_get_byte(void *ptr);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
Thanks for helping keep SourceForge clean.
X