[pure-lang-svn] SF.net SVN: pure-lang: [9] pure/trunk
Status: Beta
Brought to you by:
agraef
|
From: <ag...@us...> - 2008-04-30 16:24:07
|
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.
|