json: new *read-json-int* variable.

* parser.h (struct parser): New member, read_json_int.

* parser.c (read_json_int_s): New symbol variable
for *read-json-int* symbol.
(parser_common_init): Look up value of *read-json-int*
and store in read_json_int struct member.
(parse_init): Initialize read_json_int_s with interned
symbol and also register the dynamic variable.

* parser.l (grammar): Extend the {JNUM} rule to check
the read_json_int flag and produce an integer value if
the lexeme does not contain a decimal point, e or E.

* tests/010/json.tl: New tests.

* txr.1: Documented.

* lex.yy.c.shipped: Regenerated.

6 files changed, 74 insertions, 18 deletions

diff --git a/lex.yy.c.shipped b/lex.yy.c.shipped
index 040f9c81..2d1041c1 100644
--- a/lex.yy.c.shipped
+++ b/lex.yy.c.shipped
@@ -6395,8 +6395,13 @@ case 156:
 YY_RULE_SETUP
 #line 1251 "parser.l"
 {
-  if ((yylval->val = flo_str_utf8(yytext)) == nil)
+  if (yyextra->read_json_int && !strpbrk(yytext, ".eE")) {
+    wchar_t *wtxt = utf8_dup_from(yytext);
+    yylval->val = int_str_wc(wtxt, num(10));
+    free(wtxt);
+  } else if ((yylval->val = flo_str_utf8(yytext)) == nil) {
     out_of_range_float(yyg, yytext);
+  }
   return NUMBER;
 }
 	YY_BREAK
@@ -6407,7 +6412,7 @@ YY_LINENO_REWIND_TO(yy_bp + 4);
 yyg->yy_c_buf_p = yy_cp = yy_bp + 4;
 YY_DO_BEFORE_ACTION; /* set up yytext again */
 YY_RULE_SETUP
-#line 1257 "parser.l"
+#line 1262 "parser.l"
 {
   yylval->val = t;
   return JSKW;
@@ -6420,7 +6425,7 @@ YY_LINENO_REWIND_TO(yy_bp + 5);
 yyg->yy_c_buf_p = yy_cp = yy_bp + 5;
 YY_DO_BEFORE_ACTION; /* set up yytext again */
 YY_RULE_SETUP
-#line 1262 "parser.l"
+#line 1267 "parser.l"
 {
   yylval->val = nil;
   return JSKW;
@@ -6433,7 +6438,7 @@ YY_LINENO_REWIND_TO(yy_bp + 4);
 yyg->yy_c_buf_p = yy_cp = yy_bp + 4;
 YY_DO_BEFORE_ACTION; /* set up yytext again */
 YY_RULE_SETUP
-#line 1267 "parser.l"
+#line 1272 "parser.l"
 {
   yylval->val = null_s;
   return JSKW;
@@ -6441,7 +6446,7 @@ YY_RULE_SETUP
 	YY_BREAK
 case 160:
 YY_RULE_SETUP
-#line 1272 "parser.l"
+#line 1277 "parser.l"
 {
   if (strcmp("true", yytext) == 0) {
     yylval->val = t;
@@ -6466,7 +6471,7 @@ YY_RULE_SETUP
 	YY_BREAK
 case 161:
 YY_RULE_SETUP
-#line 1294 "parser.l"
+#line 1299 "parser.l"
 {
   yy_push_state(JLIT, yyscanner);
   return yytext[0];
@@ -6474,7 +6479,7 @@ YY_RULE_SETUP
 	YY_BREAK
 case 162:
 YY_RULE_SETUP
-#line 1299 "parser.l"
+#line 1304 "parser.l"
 {
   yy_push_state(JMARKER, yyscanner);
   yy_push_state(NESTED, yyscanner);
@@ -6483,7 +6488,7 @@ YY_RULE_SETUP
 	YY_BREAK
 case 163:
 YY_RULE_SETUP
-#line 1305 "parser.l"
+#line 1310 "parser.l"
 {
   yy_push_state(JMARKER, yyscanner);
   yy_push_state(NESTED, yyscanner);
@@ -6492,7 +6497,7 @@ YY_RULE_SETUP
 	YY_BREAK
 case 164:
 YY_RULE_SETUP
-#line 1311 "parser.l"
+#line 1316 "parser.l"
 {
   return yytext[0];
 }
@@ -6500,20 +6505,20 @@ YY_RULE_SETUP
 case 165:
 /* rule 165 can match eol */
 YY_RULE_SETUP
-#line 1315 "parser.l"
+#line 1320 "parser.l"
 {
   yyextra->lineno++;
 }
 	YY_BREAK
 case 166:
 YY_RULE_SETUP
-#line 1319 "parser.l"
+#line 1324 "parser.l"
 {
 }
 	YY_BREAK
 case 167:
 YY_RULE_SETUP
-#line 1322 "parser.l"
+#line 1327 "parser.l"
 {
   yyerrorf(yyg, lit("bad character ~s in JSON literal"),
            chr(yytext[0]), nao);
@@ -6521,17 +6526,17 @@ YY_RULE_SETUP
 	YY_BREAK
 case 168:
 YY_RULE_SETUP
-#line 1327 "parser.l"
+#line 1332 "parser.l"
 {
   internal_error("scanner processed input JMARKER state");
 }
 	YY_BREAK
 case 169:
 YY_RULE_SETUP
-#line 1331 "parser.l"
+#line 1336 "parser.l"
 ECHO;
 	YY_BREAK
-#line 6535 "lex.yy.c"
+#line 6540 "lex.yy.c"
 			case YY_STATE_EOF(INITIAL):
 			case YY_STATE_EOF(SPECIAL):
 			case YY_STATE_EOF(BRACED):
@@ -7744,7 +7749,7 @@ void yyfree (void * ptr , yyscan_t yyscanner)
 
 #define YYTABLES_NAME "yytables"
 
-#line 1331 "parser.l"
+#line 1336 "parser.l"
 
 
 static int directive_tok(scanner_t *yyscanner, int tok, int state)
diff --git a/parser.c b/parser.c
index 037a77c2..8b17cba7 100644
--- a/parser.c
+++ b/parser.c
@@ -77,7 +77,7 @@
 val parser_s, unique_s, circref_s;
 val listener_hist_len_s, listener_multi_line_p_s, listener_sel_inclusive_p_s;
 val listener_pprint_s, listener_greedy_eval_s, listener_auto_compound_s;
-val rec_source_loc_s, read_unknown_structs_s, read_bad_json_s;
+val rec_source_loc_s, read_unknown_structs_s, read_bad_json_s, read_json_int_s;
 val json_s;
 val intr_s;
 
@@ -131,6 +131,7 @@ void parser_common_init(parser_t *p)
   val rec_source_loc_var = lookup_var(nil, rec_source_loc_s);
   val read_unknown_structs_var = lookup_var(nil, read_unknown_structs_s);
   val read_bad_json_var = lookup_var(nil, read_bad_json_s);
+  val read_json_int = lookup_var(nil, read_json_int_s);
 
   p->parser = nil;
   p->lineno = 1;
@@ -159,6 +160,7 @@ void parser_common_init(parser_t *p)
   p->rec_source_loc = !nilp(cdr(rec_source_loc_var));
   p->read_unknown_structs = !nilp(cdr(read_unknown_structs_var));
   p->read_bad_json = !nilp(cdr(read_bad_json_var));
+  p->read_json_int = !nilp(cdr(read_json_int));
 }
 
 void parser_cleanup(parser_t *p)
@@ -2068,6 +2070,7 @@ void parse_init(void)
   rec_source_loc_s = intern(lit("*rec-source-loc*"), user_package);
   read_unknown_structs_s = intern(lit("*read-unknown-structs*"), user_package);
   read_bad_json_s = intern(lit("*read-bad-json*"), user_package);
+  read_json_int_s = intern(lit("*read-json-int*"), user_package);
   json_s = intern(lit("json"), user_package);
   unique_s = gensym(nil);
 
@@ -2092,6 +2095,7 @@ void parse_init(void)
   reg_var(rec_source_loc_s, nil);
   reg_var(read_unknown_structs_s, nil);
   reg_var(read_bad_json_s, nil);
+  reg_var(read_json_int_s, nil);
   reg_fun(circref_s, func_n1(circref));
   reg_fun(intern(lit("parse-errors"), user_package), func_n1(parse_errors));
   reg_fun(intern(lit("repl"), system_package), func_n4(repl));
diff --git a/parser.h b/parser.h
index abf9c4ef..f39c19f8 100644
--- a/parser.h
+++ b/parser.h
@@ -68,6 +68,7 @@ struct parser {
   int rec_source_loc;
   int read_unknown_structs;
   int read_bad_json;
+  int read_json_int;
 };
 #endif
 
diff --git a/parser.l b/parser.l
index 7f143515..74594c8f 100644
--- a/parser.l
+++ b/parser.l
@@ -1249,8 +1249,13 @@ NJPUNC  [^(){},:\[\]"~*^ \t\r\n]
 }
 
 <JSON>{JNUM} {
-  if ((yylval->val = flo_str_utf8(yytext)) == nil)
+  if (yyextra->read_json_int && !strpbrk(yytext, ".eE")) {
+    wchar_t *wtxt = utf8_dup_from(yytext);
+    yylval->val = int_str_wc(wtxt, num(10));
+    free(wtxt);
+  } else if ((yylval->val = flo_str_utf8(yytext)) == nil) {
     out_of_range_float(yyg, yytext);
+  }
   return NUMBER;
 }
 
diff --git a/tests/010/json.tl b/tests/010/json.tl
index d419295f..b7117d8a 100644
--- a/tests/010/json.tl
+++ b/tests/010/json.tl
@@ -192,3 +192,18 @@
 
 (test
   (get-json "[1, 2, ; foo\n 3]") #(1.0 2.0 3.0))
+
+(let ((*read-json-int* t))
+  (mtest
+    (get-json "1") 1
+    (get-json "-1") -1
+    (get-json "0") 0
+    (get-json "12345") 12345
+    (get-json "12345678900000000000000000") 12345678900000000000000000))
+
+(mtest
+  (get-json "1") 1.0
+  (get-json "-1") -1.0
+  (get-json "0") 0.0
+  (get-json "12345") 12345.0
+  (get-json "12345678900000000000000000") 1.23456789E25)
diff --git a/txr.1 b/txr.1
index 5fef5db8..bbd25f6a 100644
--- a/txr.1
+++ b/txr.1
@@ -84788,6 +84788,32 @@ tolerance in the area of JSON parsing.
   --> #H(() (3.0 4.0))
 .brev
 
+.coNP Variable @ *read-json-int*
+.desc
+This dynamic variable, initialized to a value of
+.codn nil ,
+controls whether the parser reads some JSON numbers as integer objects.
+
+If the value of the variable is true, then whenever a JSON number is
+scanned which does not contain a
+.code .
+(decimal point) character or the letters
+.code e
+or
+.code E
+indicating an exponent field, it is converted to an integer object
+rather than a floating-point value. It is unspecified whether the number
+is converted to integer or floating-point if the exponent
+.code e
+or
+.code E
+is present, with a positive exponent value.
+
+If this variable is
+.codn nil ,
+then JSON numbers are all converted to floating point.
+
+
 .SH* FOREIGN FUNCTION INTERFACE
 
 On platforms where it is supported, \*(TX provides a feature called the