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

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Revision: 9
          http://pure-lang.svn.sourceforge.net/pure-lang/?rev=9&view=rev
Author:   agraef
Date:     2008-04-30 09:24:09 -0700 (Wed, 30 Apr 2008)

Log Message:
-----------
Various bug and OSX compatibility fixes.

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

Modified: pure/trunk/interpreter.cc
===================================================================

--- pure/trunk/interpreter.cc	2008-04-30 16:23:21 UTC (rev 8)
+++ pure/trunk/interpreter.cc	2008-04-30 16:24:09 UTC (rev 9)
@@ -1321,7 +1321,7 @@
   if (r->size() > 0x100)
     throw err("error in expression (too many nested closures)");
   uint8_t idx = 0;
-  for (rulel::const_reverse_iterator it = r->rbegin();
+  for (rulel::reverse_iterator it = r->rbegin();
        it != r->rend(); ++it, ++idx) {
     env vars;
     expr v = bind(vars, it->lhs), w = it->rhs;
@@ -1402,9 +1402,9 @@
 #define Dbl(d)		ConstantFP::get(Type::DoubleTy, APFloat(d))
 #define Bool(i)		ConstantInt::get(Type::Int1Ty, i)
 #define UInt(i)		ConstantInt::get(Type::Int32Ty, i)
-#define SInt(i)		ConstantInt::get(Type::Int32Ty, i, true)
+#define SInt(i)		ConstantInt::get(Type::Int32Ty, (uint64_t)i, true)
 #define UInt64(i)	ConstantInt::get(Type::Int64Ty, i)
-#define SInt64(i)	ConstantInt::get(Type::Int64Ty, i, true)
+#define SInt64(i)	ConstantInt::get(Type::Int64Ty, (uint64_t)i, true)
 #define False		Bool(0)
 #define True		Bool(1)
 #define Zero		UInt(0)

Modified: pure/trunk/interpreter.hh
===================================================================
--- pure/trunk/interpreter.hh	2008-04-30 16:23:21 UTC (rev 8)
+++ pure/trunk/interpreter.hh	2008-04-30 16:24:09 UTC (rev 9)
@@ -35,17 +35,13 @@
 
 class interpreter;
 
-// Forward declarations.
-union YYSTYPE;
-namespace yy
-{
-  class location;
-  class parser;
-}
+#include "parser.hh"
 
 // Announce to Flex the prototype we want for lexing function, ...
 #define YY_DECL \
-  int yylex (YYSTYPE* yylval, yy::location* yylloc, interpreter& interp)
+  yy::parser::token_type						\
+  yylex (yy::parser::semantic_type* yylval,				\
+	 yy::parser::location_type* yylloc, interpreter& interp)
 // ... and declare it for the parser's sake.
 YY_DECL;
 

Modified: pure/trunk/lexer.ll
===================================================================
--- pure/trunk/lexer.ll	2008-04-30 16:23:21 UTC (rev 8)
+++ pure/trunk/lexer.ll	2008-04-30 16:24:09 UTC (rev 9)
@@ -12,6 +12,16 @@
 #include "parser.hh"
 #include "util.hh"
 
+/* Work around an incompatibility in flex (at least versions 2.5.31 through
+   2.5.33): it generates code that does not conform to C89.  See Debian bug
+   333231 <http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=333231>.  */
+# undef yywrap
+# define yywrap() 1
+
+/* By default yylex returns int, we use token_type.  Unfortunately yyterminate
+   by default returns 0, which is not of token_type.  */
+#define yyterminate() return yy::parser::token_type(0)
+
 using namespace std;
 
 static void my_readline(const char *prompt, char *buf, int &result, int max_size);
@@ -19,7 +29,7 @@
 #define YY_INPUT(buf,result,max_size)					\
   if (interpreter::g_interp->source_s) {				\
     size_t l = strlen(interpreter::g_interp->source_s);			\
-    if (l > max_size) l = max_size;					\
+    if (l > (size_t)max_size) l = (size_t)max_size;			\
     memcpy(buf, interpreter::g_interp->source_s, l);			\
     interpreter::g_interp->source_s += result = l;			\
   } else if ( interpreter::g_interactive &&				\
@@ -39,17 +49,19 @@
     }									\
   }
 
-static int optoken[10][5] = {
-  {NA0, LT0, RT0, PR0, PO0},
-  {NA1, LT1, RT1, PR1, PO1},
-  {NA2, LT2, RT2, PR2, PO2},
-  {NA3, LT3, RT3, PR3, PO3},
-  {NA4, LT4, RT4, PR4, PO4},
-  {NA5, LT5, RT5, PR5, PO5},
-  {NA6, LT6, RT6, PR6, PO6},
-  {NA7, LT7, RT7, PR7, PO7},
-  {NA8, LT8, RT8, PR8, PO8},
-  {NA9, LT9, RT9, PR9, PO9},
+typedef yy::parser::token token;
+
+static yy::parser::token_type optoken[10][5] = {
+  {token::NA0, token::LT0, token::RT0, token::PR0, token::PO0},
+  {token::NA1, token::LT1, token::RT1, token::PR1, token::PO1},
+  {token::NA2, token::LT2, token::RT2, token::PR2, token::PO2},
+  {token::NA3, token::LT3, token::RT3, token::PR3, token::PO3},
+  {token::NA4, token::LT4, token::RT4, token::PR4, token::PO4},
+  {token::NA5, token::LT5, token::RT5, token::PR5, token::PO5},
+  {token::NA6, token::LT6, token::RT6, token::PR6, token::PO6},
+  {token::NA7, token::LT7, token::RT7, token::PR7, token::PO7},
+  {token::NA8, token::LT8, token::RT8, token::PR8, token::PO8},
+  {token::NA9, token::LT9, token::RT9, token::PR9, token::PO9},
 };
 
 struct argl {
@@ -119,11 +131,11 @@
 str   ([^\"\\\n]|\\(.|\n))*
 blank [ \t]
 
-inttag  ::{blank}*int/[^a-zA-Z_0-9]
-binttag ::{blank}*bigint/[^a-zA-Z_0-9]
-dbltag  ::{blank}*double/[^a-zA-Z_0-9]
-strtag  ::{blank}*string/[^a-zA-Z_0-9]
-ptrtag  ::{blank}*pointer/[^a-zA-Z_0-9]
+inttag  ::{blank}*int
+binttag ::{blank}*bigint
+dbltag  ::{blank}*double
+strtag  ::{blank}*string
+ptrtag  ::{blank}*pointer
 
 %x comment xdecl xdecl_comment
 
@@ -149,17 +161,17 @@
 <comment>[\n]+          yylloc->lines(yyleng); yylloc->step();
 <comment>"*"+"/"        yylloc->step(); BEGIN(INITIAL);
 
-<xdecl>{id}	yylval->sval = new string(yytext); return ID;
-<xdecl>[()*,=]	return yytext[0];
+<xdecl>{id}	yylval->sval = new string(yytext); return token::ID;
+<xdecl>[()*,=]	return yy::parser::token_type(yytext[0]);
 <xdecl>"//".*	yylloc->step();
 <xdecl>"/*"	BEGIN(xdecl_comment);
-<xdecl>;	BEGIN(INITIAL); return yytext[0];
+<xdecl>;	BEGIN(INITIAL); return yy::parser::token_type(yytext[0]);
 <xdecl>{blank}+	yylloc->step();
 <xdecl>[\n]+	yylloc->lines(yyleng); yylloc->step();
 <xdecl>.	{
   string msg = "invalid character '"+string(yytext)+"'";
   interp.error(*yylloc, msg);
-  BEGIN(INITIAL); return ERRTOK;
+  BEGIN(INITIAL); return token::ERRTOK;
 }
 
      
@@ -586,54 +598,54 @@
     long n = mpz_get_si(*z);
     free(z);
     yylval->ival = n;
-    return INT;
+    return token::INT;
   } else {
     yylval->zval = z;
-    return BIGINT;
+    return token::BIGINT;
   }
 }
-{float}    yylval->dval = my_strtod(yytext, NULL); return(DBL);
+{float}    yylval->dval = my_strtod(yytext, NULL); return(token::DBL);
 \"{str}\"   {
   char *msg;
   yytext[yyleng-1] = 0;
   yylval->csval = parsestr(yytext+1, msg);
   yytext[yyleng-1] = '"';
   if (msg) interp.error(*yylloc, msg);
-  return STR;
+  return token::STR;
 }
 \"{str}      {
   char *msg;
   interp.error(*yylloc, "unterminated string constant");
   yylval->csval = parsestr(yytext+1, msg);
-  return STR;
+  return token::STR;
 }
-{inttag}   yylval->ival = EXPR::INT; return TAG;
-{binttag}  yylval->ival = EXPR::BIGINT; return TAG;
-{dbltag}   yylval->ival = EXPR::DBL; return TAG;
-{strtag}   yylval->ival = EXPR::STR; return TAG;
-{ptrtag}   yylval->ival = EXPR::PTR; return TAG;
-extern     BEGIN(xdecl); return EXTERN;
-infix      yylval->fix = infix; return FIX;
-infixl     yylval->fix = infixl; return FIX;
-infixr     yylval->fix = infixr; return FIX;
-prefix     yylval->fix = prefix; return FIX;
-postfix    yylval->fix = postfix; return FIX;
-nullary    return NULLARY;
-let        return LET;
-case	   return CASE;
-of	   return OF;
-end	   return END;
-if	   return IF;
-then	   return THEN;
-else	   return ELSE;
-otherwise  return OTHERWISE;
-when	   return WHEN;
-with	   return WITH;
-using	   return USING;
+{inttag}/[^a-zA-Z_0-9]   yylval->ival = EXPR::INT; return token::TAG;
+{binttag}/[^a-zA-Z_0-9]  yylval->ival = EXPR::BIGINT; return token::TAG;
+{dbltag}/[^a-zA-Z_0-9]   yylval->ival = EXPR::DBL; return token::TAG;
+{strtag}/[^a-zA-Z_0-9]   yylval->ival = EXPR::STR; return token::TAG;
+{ptrtag}/[^a-zA-Z_0-9]   yylval->ival = EXPR::PTR; return token::TAG;
+extern     BEGIN(xdecl); return token::EXTERN;
+infix      yylval->fix = infix; return token::FIX;
+infixl     yylval->fix = infixl; return token::FIX;
+infixr     yylval->fix = infixr; return token::FIX;
+prefix     yylval->fix = prefix; return token::FIX;
+postfix    yylval->fix = postfix; return token::FIX;
+nullary    return token::NULLARY;
+let        return token::LET;
+case	   return token::CASE;
+of	   return token::OF;
+end	   return token::END;
+if	   return token::IF;
+then	   return token::THEN;
+else	   return token::ELSE;
+otherwise  return token::OTHERWISE;
+when	   return token::WHEN;
+with	   return token::WITH;
+using	   return token::USING;
 {id}       {
   if (interp.declare_op) {
     yylval->sval = new string(yytext);
-    return ID;
+    return token::ID;
   }
   symbol* sym = interp.symtab.lookup(yytext);
   if (sym && sym->prec >= 0 && sym->prec < 10) {
@@ -641,22 +653,22 @@
     return optoken[sym->prec][sym->fix];
   } else {
     yylval->sval = new string(yytext);
-    return ID;
+    return token::ID;
   }
 }
-[=;()\[\]\\] return yytext[0];
-"->"       return MAPSTO;
+[=;()\[\]\\] return yy::parser::token_type(yytext[0]);
+"->"       return token::MAPSTO;
 [[:punct:]]+  {
   if (yytext[0] == '/' && yytext[1] == '*') REJECT; // comment starter
   while (yyleng > 1 && yytext[yyleng-1] == ';') yyless(yyleng-1);
   if (interp.declare_op) {
     yylval->sval = new string(yytext);
-    return ID;
+    return token::ID;
   }
   symbol* sym = interp.symtab.lookup(yytext);
   while (!sym && yyleng > 1) {
     if (yyleng == 2 && yytext[0] == '-' && yytext[1] == '>')
-      return MAPSTO;
+      return token::MAPSTO;
     yyless(yyleng-1);
     sym = interp.symtab.lookup(yytext);
   }
@@ -666,7 +678,7 @@
       return optoken[sym->prec][sym->fix];
     } else {
       yylval->sval = new string(yytext);
-      return ID;
+      return token::ID;
     }
   } else
     REJECT;
@@ -674,7 +686,7 @@
 .          {
   string msg = "invalid character '"+string(yytext)+"'";
   interp.error(*yylloc, msg);
-  return ERRTOK;
+  return token::ERRTOK;
 }
 
 %%

Modified: pure/trunk/parser.yy
===================================================================
--- pure/trunk/parser.yy	2008-04-30 16:23:21 UTC (rev 8)
+++ pure/trunk/parser.yy	2008-04-30 16:24:09 UTC (rev 9)
@@ -1,13 +1,16 @@
 /* The PURE parser.  -*- C++ -*- */
 
 // Tell bison that we want a C++ parser.
+/* NOTE: We require at least bison 2.1a here, since the C++ parser skeleton
+   changed several times, and the newer versions are not compatible with bison
+   2.1 and earlier. :( */
 %skeleton "lalr1.cc"
+%require "2.1a"
 %defines
 
 %{
 #include <iostream>
 #include <string>
-#include "interpreter.hh"
 #include "expr.hh"
 #include "printer.hh"
 #include "util.hh"
@@ -23,6 +26,8 @@
   { error(yylloc, e.what()); x = new expr(interp.symtab.void_sym().f); }
 
 using namespace std;
+
+class interpreter;
 %}
 
 // The parsing context.
@@ -57,6 +62,8 @@
   expr l;
   env e;
 };
+typedef pair<expr,expr> comp_clause;
+typedef list<comp_clause> comp_clause_list;
 %}
 
 %union
@@ -79,6 +86,10 @@
   sym_info *info;
 };
 
+%{
+#include "interpreter.hh"
+%}
+
 %token		NULLARY	"nullary"
 %token <fix>	FIX	"fixity"
 

Modified: pure/trunk/runtime.cc
===================================================================
--- pure/trunk/runtime.cc	2008-04-30 16:23:21 UTC (rev 8)
+++ pure/trunk/runtime.cc	2008-04-30 16:24:09 UTC (rev 9)
@@ -675,7 +675,9 @@
   case EXPR::INT:	return x;
   case EXPR::BIGINT:	return pure_int(mpz_get_ui(x->data.z));
   case EXPR::DBL:	return pure_int((int32_t)x->data.d);
-  case EXPR::PTR:	return pure_int((uint32_t)x->data.p);
+    // Must cast to 64 bit here first, since on 64 bit systems g++ gives an
+    // error when directly casting a 64 bit pointer to a 32 bit integer.
+  case EXPR::PTR:	return pure_int((uint32_t)(uint64_t)x->data.p);
   default:		return 0;
   }
 }
@@ -724,13 +726,14 @@
 #else
   // 4 byte limbs.
   if (sizeof(void*) == 4) {
-    // 4 byte pointers.
-    limb_t u[1] = { (uint32_t)p };
+    // 4 byte pointers. Note that we still cast to 64 bit first, since
+    // otherwise the code will give an error on 64 bit systems.
+    limb_t u[1] = { (uint32_t)(uint64_t)p };
     return pure_bigint(1, u);
   } else {
     // 8 byte pointers, put least significant word in the first limb.
     assert(sizeof(void*) == 8);
-    limb_t u[2] = { (uint32_t)p, (uint32_t)(((uint64_t)p)>>32) };
+    limb_t u[2] = { (uint32_t)(uint64_t)p, (uint32_t)(((uint64_t)p)>>32) };
     return pure_bigint(2, u);
   }
 #endif


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


