[pure-lang-svn] SF.net SVN: pure-lang:[605] pure/trunk

[<ag...@us...>]

Revision: 605
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=605&view=rev
Author:   agraef
Date:     2008-08-25 10:25:09 +0000 (Mon, 25 Aug 2008)

Log Message:
-----------
Add macro infrastructure.

Modified Paths:
--------------
    pure/trunk/interpreter.cc
    pure/trunk/interpreter.hh
    pure/trunk/lexer.ll
    pure/trunk/parser.yy
    pure/trunk/pure.cc

Modified: pure/trunk/interpreter.cc
===================================================================
--- pure/trunk/interpreter.cc	2008-08-24 23:46:59 UTC (rev 604)
+++ pure/trunk/interpreter.cc	2008-08-25 10:25:09 UTC (rev 605)
@@ -773,9 +773,12 @@
   for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
     int32_t f = it->first;
     const symbol& sym = symtab.sym(f);
-    env::const_iterator jt = globenv.find(f);
-    if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+    env::const_iterator jt = globenv.find(f), kt = macenv.find(f);
+    if (kt != macenv.end()) {
       restore_globals(g);
+      throw err("symbol '"+sym.s+"' is already defined as a macro");
+    } else if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+      restore_globals(g);
       throw err("symbol '"+sym.s+"' is already defined as a constant");
     } else if (jt != globenv.end() && jt->second.t == env_info::fun) {
       restore_globals(g);
@@ -870,9 +873,12 @@
   for (env::const_iterator it = vars.begin(); it != vars.end(); ++it) {
     int32_t f = it->first;
     const symbol& sym = symtab.sym(f);
-    env::const_iterator jt = globenv.find(f);
-    if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+    env::const_iterator jt = globenv.find(f), kt = macenv.find(f);
+    if (kt != macenv.end()) {
       restore_globals(g);
+      throw err("symbol '"+sym.s+"' is already defined as a macro");
+    } else if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+      restore_globals(g);
       throw err("symbol '"+sym.s+"' is already defined as a constant");
     } else if (jt != globenv.end() && jt->second.t == env_info::fvar) {
       restore_globals(g);
@@ -916,9 +922,12 @@
   globals g;
   save_globals(g);
   symbol& sym = symtab.sym(tag);
-  env::const_iterator jt = globenv.find(tag);
-  if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+  env::const_iterator jt = globenv.find(tag), kt = macenv.find(tag);
+  if (kt != macenv.end()) {
     restore_globals(g);
+    throw err("symbol '"+sym.s+"' is already defined as a macro");
+  } else if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+    restore_globals(g);
     throw err("symbol '"+sym.s+"' is already defined as a constant");
   } else if (jt != globenv.end() && jt->second.t == env_info::fvar) {
     restore_globals(g);
@@ -1289,8 +1298,11 @@
       globenv.erase(it);
       clearsym(f);
     }
+    it = macenv.find(f);
+    if (it != macenv.end())
+      macenv.erase(it);
   } else if (f == 0 && temp > 0) {
-    // purge all temporary functions and variables
+    // purge all temporary symbols
     for (env::iterator it = globenv.begin(); it != globenv.end(); ) {
       env::iterator jt = it; ++it;
       int32_t f = jt->first;
@@ -1314,6 +1326,30 @@
 	}
       }
     }
+    for (env::iterator it = macenv.begin(); it != macenv.end(); ) {
+      env::iterator jt = it; ++it;
+      env_info& info = jt->second;
+      if (info.temp >= temp)
+	macenv.erase(jt);
+      else {
+	// purge temporary rules for non-temporary macros
+	bool d = false;
+	rulel& r = *info.rules;
+	for (rulel::iterator it = r.begin(); it != r.end(); )
+	  if (it->temp >= temp) {
+	    d = true;
+	    it = r.erase(it);
+	  } else
+	    ++it;
+	if (d) {
+	  assert(!r.empty());
+	  if (info.m) {
+	    delete info.m;
+	    info.m = 0;
+	  }
+	}
+      }
+    }
     if (temp > 1) --temp;
   }
 }
@@ -1429,6 +1465,48 @@
   delete r;
 }
 
+void interpreter::add_macro_rule(rule *r)
+{
+  assert(!r->lhs.is_null() && r->qual.is_null());
+  closure(*r, false);
+  int32_t f; uint32_t argc = count_args(r->lhs, f);
+  if (f <= 0)
+    throw err("error in macro definition (invalid head symbol)");
+  env::iterator it = macenv.find(f), jt = globenv.find(f);
+  const symbol& sym = symtab.sym(f);
+  if (jt != globenv.end()) {
+    if (it->second.t == env_info::cvar)
+      throw err("symbol '"+sym.s+"' is already defined as a constant");
+    else if (it->second.t == env_info::fvar)
+      throw err("symbol '"+sym.s+"' is already defined as a variable");
+  } else if (it != macenv.end()) {
+    if (it->second.argc != argc) {
+      ostringstream msg;
+      msg << "symbol '" << sym.s
+	  << "' was previously defined with " << it->second.argc << " args";
+      throw err(msg.str());
+    }
+  }
+  env_info &info = macenv[f];
+  if (info.t == env_info::none)
+    info = env_info(argc, rulel(), temp);
+  assert(info.argc == argc);
+  r->temp = temp;
+  if (override) {
+    rulel::iterator p = info.rules->begin();
+    for (; p != info.rules->end() && p->temp >= temp; p++) ;
+    info.rules->insert(p, *r);
+  } else
+    info.rules->push_back(*r);
+  if ((verbose&verbosity::defs) != 0) cout << "def " << *r << ";\n";
+  if (info.m) {
+    // this will be recomputed the next time the macro is needed
+    delete info.m;
+    info.m = 0;
+  }
+  delete r;
+}
+
 void interpreter::closure(expr& l, expr& r, bool b)
 {
   env vars;
@@ -2187,9 +2265,12 @@
   globals g;
   save_globals(g);
   symbol& sym = symtab.sym(tag);
-  env::const_iterator jt = globenv.find(tag);
-  if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+  env::const_iterator jt = globenv.find(tag), kt = macenv.find(tag);
+  if (kt != macenv.end()) {
     restore_globals(g);
+    throw err("symbol '"+sym.s+"' is already defined as a macro");
+  } else if (jt != globenv.end() && jt->second.t == env_info::cvar) {
+    restore_globals(g);
     throw err("symbol '"+sym.s+"' is already defined as a constant");
   } else if (jt != globenv.end() && jt->second.t == env_info::fun) {
     restore_globals(g);

Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh	2008-08-24 23:46:59 UTC (rev 604)
+++ pure/trunk/interpreter.hh	2008-08-25 10:25:09 UTC (rev 605)
@@ -331,6 +331,7 @@
   clock_t clocks;    // last evaluation time, if stats is set
   exprl last;        // last processed lhs collection
   env globenv;       // global function and variable environment
+  env macenv;        // global macro environment
   funset dirty;      // "dirty" function entries which need a recompile
   pure_mem *mem;     // runtime expression memory
   pure_expr *exps;   // head of the free list (available expression nodes)
@@ -444,6 +445,7 @@
   void add_rule(rulel &rl, rule &r, bool b);
   void add_rule(env &e, rule &r, bool toplevel = false);
   void add_simple_rule(rulel &rl, rule *r);
+  void add_macro_rule(rule *r);
   void promote_ttags(expr f, expr x, expr u);
   void promote_ttags(expr f, expr x, expr u, expr v);
   expr bind(env& vars, expr x, bool b = true, path p = path());

Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll	2008-08-24 23:46:59 UTC (rev 604)
+++ pure/trunk/lexer.ll	2008-08-25 10:25:09 UTC (rev 605)
@@ -111,11 +111,12 @@
 
 struct env_sym {
   const symbol* sym;
-  env::const_iterator it;
+  env::const_iterator it, jt;
   extmap::const_iterator xt;
   env_sym(const symbol& _sym, env::const_iterator _it,
+	  env::const_iterator _jt,
 	  extmap::const_iterator _xt)
-    : sym(&_sym), it(_it), xt(_xt) { }
+    : sym(&_sym), it(_it), jt(_jt), xt(_xt) { }
 };
 
 static bool env_compare(env_sym s, env_sym t)
@@ -172,6 +173,7 @@
     int32_t f = it->second.f;
     /* Skip non-toplevel symbols. */
     if (interp.globenv.find(f) == interp.globenv.end() &&
+	interp.macenv.find(f) == interp.macenv.end() &&
 	interp.globalvars.find(f) == interp.globalvars.end() &&
 	interp.externals.find(f) == interp.externals.end()) {
       it++;
@@ -361,7 +363,7 @@
   uint8_t s_verbose = interpreter::g_verbose;
   uint8_t tflag = 0;
   bool aflag = false, dflag = false, eflag = false;
-  bool cflag = false, fflag = false, vflag = false;
+  bool cflag = false, fflag = false, mflag = false, vflag = false;
   bool gflag = false, lflag = false, sflag = false;
   const char *s = yytext+4;
   if (*s && !isspace(*s)) REJECT;
@@ -372,7 +374,7 @@
   // process option arguments
   for (arg = args.l.begin(); arg != args.l.end(); arg++) {
     const char *s = arg->c_str();
-    if (s[0] != '-' || !s[1] || !strchr("acdefghlstv", s[1])) break;
+    if (s[0] != '-' || !s[1] || !strchr("acdefghlmstv", s[1])) break;
     while (*++s) {
       switch (*s) {
       case 'a': aflag = true; break;
@@ -382,6 +384,7 @@
       case 'f': fflag = true; break;
       case 'g': gflag = true; break;
       case 'l': lflag = true; break;
+      case 'm': mflag = true; break;
       case 's': sflag = true; break;
       case 'v': vflag = true; break;
       case 't':
@@ -406,6 +409,7 @@
 -h  Print this list.\n\
 -l  Long format, prints definitions along with the summary symbol\n\
     information. This implies -s.\n\
+-m  Print information about defined macros.\n\
 -s  Summary format, print just summary information about listed symbols.\n\
 -t[level] List only symbols and definitions at the given temporary level\n\
     (the current level by default) or above. Level 1 denotes all temporary\n\
@@ -422,10 +426,12 @@
   if (eflag) interpreter::g_verbose |= verbosity::envs;
   if (aflag) interpreter::g_verbose |= verbosity::code;
   if (dflag) interpreter::g_verbose |= verbosity::dump;
-  if (!cflag && !fflag && !vflag) cflag = fflag = vflag = true;
+  if (!cflag && !fflag && !mflag && !vflag)
+    cflag = fflag = mflag = vflag = true;
   if (lflag) sflag = true;
   {
-    size_t maxsize = 0, nfuns = 0, nvars = 0, ncsts = 0, nrules = 0;
+    size_t maxsize = 0, nfuns = 0, nmacs = 0, nvars = 0, ncsts = 0,
+      nrules = 0, mrules = 0;
     list<env_sym> l; set<int32_t> syms;
     for (env::const_iterator it = interp.globenv.begin();
 	 it != interp.globenv.end(); ++it) {
@@ -462,7 +468,8 @@
       }
       if (!matches) continue;
       syms.insert(f);
-      l.push_back(env_sym(sym, it, interp.externals.find(f)));
+      l.push_back(env_sym(sym, it, interp.macenv.find(f),
+			  interp.externals.find(f)));
       if (sym.s.size() > maxsize) maxsize = sym.s.size();
     }
     if (fflag && tflag == 0) {
@@ -484,11 +491,52 @@
 	    }
 	  }
 	  if (!matches) continue;
-	  l.push_back(env_sym(sym, interp.globenv.end(), it));
+	  l.push_back(env_sym(sym, interp.globenv.end(),
+			      interp.macenv.find(f), it));
 	  if (sym.s.size() > maxsize) maxsize = sym.s.size();
 	}
       }
     }
+    if (mflag) {
+      // also list any symbols defined as macros, unless they've already been
+      // considered
+      for (env::const_iterator it = interp.macenv.begin();
+	   it != interp.macenv.end(); ++it) {
+	int32_t f = it->first;
+	if (syms.find(f) == syms.end()) {
+	  const env_info& e = it->second;
+	  const symbol& sym = interp.symtab.sym(f);
+	  bool matches = e.temp >= tflag;
+	  if (!matches && !sflag && args.l.empty()) {
+	    // if not in summary mode, also list temporary rules for a
+	    // non-temporary symbol
+	    rulel::const_iterator r;
+	    for (r = e.rules->begin(); r != e.rules->end(); r++)
+	      if (r->temp >= tflag) {
+		matches = true;
+		break;
+	      }
+	  }
+	  if (!matches) continue;
+	  if (!args.l.empty()) {
+	    // see whether we actually want the defined symbol to be listed
+	    matches = false;
+	    for (arg = args.l.begin(); arg != args.l.end(); ++arg) {
+	      if (gflag ? (!fnmatch(arg->c_str(), sym.s.c_str(), 0)) :
+		  (*arg == sym.s)) {
+		matches = true;
+		break;
+	      }
+	    }
+	  }
+	  if (!matches) continue;
+	  syms.insert(f);
+	  l.push_back(env_sym(sym, interp.globenv.end(), it,
+			      interp.externals.end()));
+	  if (sym.s.size() > maxsize) maxsize = sym.s.size();
+	}
+      }
+    }
     l.sort(env_compare);
     if (!l.empty() && (aflag||dflag)) interp.compile();
     // we first dump the entire listing into a string and then output that
@@ -499,9 +547,9 @@
       const symbol& sym = *it->sym;
       int32_t ftag = sym.f;
       map<int32_t,Env>::iterator fenv = interp.globalfuns.find(ftag);
-      const env::const_iterator jt = it->it;
+      const env::const_iterator jt = it->it, kt = it->jt;
       const extmap::const_iterator xt = it->xt;
-      if (jt == interp.globenv.end()) {
+      if (jt == interp.globenv.end() && kt == interp.macenv.end()) {
 	assert(xt != interp.externals.end());
 	const ExternInfo& info = xt->second;
 	sout << info << ";";
@@ -511,7 +559,8 @@
 	} else
 	  sout << endl;
 	++nfuns;
-      } else if (jt->second.t == env_info::fvar) {
+      } else if (jt != interp.globenv.end() &&
+		 jt->second.t == env_info::fvar) {
 	nvars++;
 	if (sflag) {
 	  sout << sym.s << string(maxsize-sym.s.size(), ' ')
@@ -522,7 +571,8 @@
 	} else
 	  sout << "let " << sym.s << " = " << *(pure_expr**)jt->second.val
 	       << ";\n";
-      } else if (jt->second.t == env_info::cvar) {
+      } else if (jt != interp.globenv.end() &&
+		 jt->second.t == env_info::cvar) {
 	ncsts++;
 	if (sflag) {
 	  sout << sym.s << string(maxsize-sym.s.size(), ' ')
@@ -553,7 +603,7 @@
 	  }
 	  sout << " " << (int)sym.prec << " " << sym.s << ";\n";
 	}
-	if (xt != interp.externals.end()) {
+	if (fflag && xt != interp.externals.end()) {
 	  const ExternInfo& info = xt->second;
 	  sout << info << ";";
 	  if ((!sflag||lflag) && dflag) {
@@ -562,58 +612,85 @@
 	  } else
 	    sout << endl;
 	}
-	uint32_t argc = jt->second.argc;
-	const rulel& rules = *jt->second.rules;
-	const matcher *m = jt->second.m;
-	if (sflag) {
-	  ++nfuns; nrules += rules.size();
-	  sout << sym.s << string(maxsize-sym.s.size(), ' ') << "  fun";
-	  if (lflag) {
-	    sout << "  " << rules << ";";
-	    if (aflag && m) sout << endl << *m;
-	    if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
-	      fenv->second.print(sout);
+	if (mflag && kt != interp.macenv.end()) {
+	  uint32_t argc = kt->second.argc;
+	  const rulel& rules = *kt->second.rules;
+	  const matcher *m = kt->second.m;
+	  if (sflag) {
+	    ++nmacs; mrules += rules.size();
+	    sout << sym.s << string(maxsize-sym.s.size(), ' ') << "  mac";
+	    if (lflag) {
+	      sout << "  " << rules << ";";
+	      if (aflag && m) sout << endl << *m;
+	    } else {
+	      sout << " " << argc << " args, " << rules.size() << " rules";
+	    }
+	    sout << endl;
 	  } else {
-	    sout << " " << argc << " args, " << rules.size() << " rules";
+	    size_t n = 0;
+	    for (rulel::const_iterator it = rules.begin();
+		 it != rules.end(); ++it) {
+	      if (it->temp >= tflag) {
+		sout << "def " << *it << ";\n";
+		++n;
+	      }
+	    }
+	    if (n > 0) {
+	      if (aflag && m) sout << *m << endl;
+	      mrules += n;
+	      ++nmacs;
+	    }
 	  }
-	  sout << endl;
-	} else {
-	  size_t n = 0;
-	  for (rulel::const_iterator it = rules.begin();
-	       it != rules.end(); ++it) {
-	    if (it->temp >= tflag) {
-	      sout << *it << ";\n";
-	      ++n;
+	}
+	if (fflag && jt != interp.globenv.end()) {
+	  uint32_t argc = jt->second.argc;
+	  const rulel& rules = *jt->second.rules;
+	  const matcher *m = jt->second.m;
+	  if (sflag) {
+	    ++nfuns; nrules += rules.size();
+	    sout << sym.s << string(maxsize-sym.s.size(), ' ') << "  fun";
+	    if (lflag) {
+	      sout << "  " << rules << ";";
+	      if (aflag && m) sout << endl << *m;
+	      if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
+		fenv->second.print(sout);
+	    } else {
+	      sout << " " << argc << " args, " << rules.size() << " rules";
 	    }
+	    sout << endl;
+	  } else {
+	    size_t n = 0;
+	    for (rulel::const_iterator it = rules.begin();
+		 it != rules.end(); ++it) {
+	      if (it->temp >= tflag) {
+		sout << *it << ";\n";
+		++n;
+	      }
+	    }
+	    if (n > 0) {
+	      if (aflag && m) sout << *m << endl;
+	      if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
+		fenv->second.print(sout);
+	      nrules += n;
+	      ++nfuns;
+	    }
 	  }
-	  if (n > 0) {
-	    if (aflag && m) sout << *m << endl;
-	    if (dflag && fenv != interp.globalfuns.end() && fenv->second.f)
-	      fenv->second.print(sout);
-	    nrules += n;
-	    ++nfuns;
-	  }
 	}
       }
     }
     if (sflag) {
-      if (fflag && vflag && cflag)
-	sout << ncsts << " constants, " << nvars << " variables, "
-	     << nfuns << " functions, " << nrules << " rules\n";
-      else if (fflag && cflag)
-	sout << ncsts << " constants, " << nfuns << " functions, "
-	     << nrules << " rules\n";
-      else if (fflag && vflag)
-	sout << nvars << " variables, " << nfuns << " functions, "
-	     << nrules << " rules\n";
-      else if (cflag && vflag)
-	sout << ncsts << " constants, " << nvars << " variables\n";
-      else if (cflag)
-	sout << ncsts << " constants\n";
-      else if (vflag)
-	sout << nvars << " variables\n";
-      else if (fflag)
-	sout << nfuns << " functions, " << nrules << " rules\n";
+      ostringstream summary;
+      if (cflag)
+	summary << ncsts << " constants, ";
+      if (vflag)
+	summary << nvars << " variables, ";
+      if (mflag)
+	summary << nmacs << " macros (" << mrules << " rules), ";
+      if (fflag)
+	summary << nfuns << " functions (" << nrules << " rules), ";
+      string s = summary.str();
+      if (!s.empty())
+	sout << s.substr(0, s.size()-2) << endl;
     }
     FILE *fp;
     const char *more = getenv("PURE_MORE");

Modified: pure/trunk/parser.yy
===================================================================
--- pure/trunk/parser.yy	2008-08-24 23:46:59 UTC (rev 604)
+++ pure/trunk/parser.yy	2008-08-25 10:25:09 UTC (rev 605)
@@ -279,6 +279,8 @@
 { action(interp.define($2), delete $2); }
 | CONST simple_rule
 { action(interp.define_const($2), delete $2); }
+| DEF simple_rule
+{ action(interp.add_macro_rule($2), delete $2); }
 | rule
 { rulel *rl = 0;
   action(interp.add_rules(interp.globenv,
@@ -632,7 +634,8 @@
   catch (err &e) { if (rl) delete rl; interp.error(yyloc, e.what()); } }
 ;
 
-/* Same for simple rules (pattern binding in 'when' clauses, no guards). */
+/* Same for simple rules (pattern binding in 'when' clauses or 'let', 'const',
+   'def', no guards in these cases). */
 
 simple_rule
 : expr '=' expr

Modified: pure/trunk/pure.cc
===================================================================
--- pure/trunk/pure.cc	2008-08-24 23:46:59 UTC (rev 604)
+++ pure/trunk/pure.cc	2008-08-25 10:25:09 UTC (rev 605)
@@ -97,6 +97,7 @@
     int32_t f = it->second.f;
     /* Skip non-toplevel symbols. */
     if (interp.globenv.find(f) == interp.globenv.end() &&
+	interp.macenv.find(f) == interp.macenv.end() &&
 	interp.globalvars.find(f) == interp.globalvars.end() &&
 	interp.externals.find(f) == interp.externals.end()) {
       it++;
@@ -136,6 +137,7 @@
     int32_t f = it->second.f;
     /* Skip non-toplevel symbols. */
     if (interp.globenv.find(f) == interp.globenv.end() &&
+	interp.macenv.find(f) == interp.macenv.end() &&
 	interp.globalvars.find(f) == interp.globalvars.end() &&
 	interp.externals.find(f) == interp.externals.end()) {
       it++;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.