summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2015-05-28 10:23:43 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2015-05-28 10:23:43 -0400
commiteb9d168a2236eb6c892b11d6d30f065898a89762 (patch)
treeccd452004ad197551a6d7ff3ae9824271dfbd1d1
parentd4d053d05ae3e7d6974f98e28d6f60c837fc687a (diff)
Handling overflow in integer literals (contributed by Gabriel Riba)
-rw-r--r--src/urweb.lex18
1 files changed, 13 insertions, 5 deletions
diff --git a/src/urweb.lex b/src/urweb.lex
index e1ffd1c3..fcf10d94 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -182,7 +182,7 @@ cid = [A-Z][A-Za-z0-9_]*;
ws = [\ \t\012\r];
intconst = [0-9]+;
realconst = [0-9]+\.[0-9]*;
-hexconst = 0x[0-9A-F]{1,8};
+hexconst = 0x[0-9A-F]+;
notags = ([^<{\n(]|(\([^\*<{\n]))+;
xcom = ([^\-]|(-[^\-]))+;
oint = [0-9][0-9][0-9];
@@ -542,17 +542,25 @@ xint = x[0-9a-fA-F][0-9a-fA-F];
<INITIAL> {id} => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));
<INITIAL> {cid} => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
-<INITIAL> {hexconst} => (case StringCvt.scanString (Int64.scan StringCvt.HEX) (String.extract (yytext, 2, NONE)) of
+<INITIAL> {hexconst} => (let val digits = String.extract (yytext, 2, NONE)
+ val v = (StringCvt.scanString (Int64.scan StringCvt.HEX) digits)
+ handle Overflow => NONE
+ in
+ case v of
SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
| NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos)
("Expected hexInt, received: " ^ yytext);
- continue ()));
+ continue ())
+ end);
-<INITIAL> {intconst} => (case Int64.fromString yytext of
+<INITIAL> {intconst} => (let val v = (Int64.fromString yytext) handle Overflow => NONE
+ in
+ case v of
SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
| NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos)
("Expected int, received: " ^ yytext);
- continue ()));
+ continue ())
+ end);
<INITIAL> {realconst} => (case Real64.fromString yytext of
SOME x => Tokens.FLOAT (x, pos yypos, pos yypos + size yytext)
| NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos)