From 35aa2c2398f1e66a6fad7fe4d1f5fb25f7d9f1c4 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Fri, 2 Oct 2015 19:50:38 -0400 Subject: [PATCH] first version of read_cdot --- racket/src/racket/include/scheme.h | 1 + racket/src/racket/src/read.c | 79 ++++++++++++++++++++++++++++-- racket/src/racket/src/schminc.h | 2 +- 3 files changed, 76 insertions(+), 6 deletions(-) diff --git a/racket/src/racket/include/scheme.h b/racket/src/racket/include/scheme.h index bfc781f4b0..c9419db4e1 100644 --- a/racket/src/racket/include/scheme.h +++ b/racket/src/racket/include/scheme.h @@ -1348,6 +1348,7 @@ enum { MZCONFIG_CAN_READ_READER, MZCONFIG_CAN_READ_LANG, MZCONFIG_READ_DECIMAL_INEXACT, + MZCONFIG_READ_CDOT, MZCONFIG_PRINT_GRAPH, MZCONFIG_PRINT_STRUCT, diff --git a/racket/src/racket/src/read.c b/racket/src/racket/src/read.c index 64847c9da6..74f0a6355b 100644 --- a/racket/src/racket/src/read.c +++ b/racket/src/racket/src/read.c @@ -84,6 +84,7 @@ ROSYM static Scheme_Object *unsyntax_splicing_symbol; ROSYM static Scheme_Object *quasisyntax_symbol; ROSYM static Scheme_Object *brackets_symbol; ROSYM static Scheme_Object *braces_symbol; +ROSYM static Scheme_Object *dot_symbol; ROSYM static Scheme_Object *terminating_macro_symbol; ROSYM static Scheme_Object *non_terminating_macro_symbol; ROSYM static Scheme_Object *dispatch_macro_symbol; @@ -97,6 +98,7 @@ static Scheme_Object *read_bracket_as_paren(int, Scheme_Object *[]); static Scheme_Object *read_brace_as_paren(int, Scheme_Object *[]); static Scheme_Object *read_bracket_with_tag(int, Scheme_Object *[]); static Scheme_Object *read_brace_with_tag(int, Scheme_Object *[]); +static Scheme_Object *read_cdot(int, Scheme_Object *[]); static Scheme_Object *read_accept_graph(int, Scheme_Object *[]); static Scheme_Object *read_accept_compiled(int, Scheme_Object *[]); static Scheme_Object *read_accept_box(int, Scheme_Object *[]); @@ -177,6 +179,7 @@ typedef struct ReadParams { char curly_braces_are_parens; char square_brackets_are_tagged; char curly_braces_are_tagged; + char read_cdot; char read_decimal_inexact; char can_read_dot; char can_read_infix_dot; @@ -423,6 +426,7 @@ void scheme_init_read(Scheme_Env *env) REGISTER_SO(brackets_symbol); REGISTER_SO(braces_symbol); + REGISTER_SO(dot_symbol); REGISTER_SO(unresolved_uninterned_symbol); REGISTER_SO(tainted_uninterned_symbol); @@ -442,6 +446,7 @@ void scheme_init_read(Scheme_Env *env) brackets_symbol = scheme_intern_symbol("#%brackets"); braces_symbol = scheme_intern_symbol("#%braces"); + dot_symbol = scheme_intern_symbol("#%dot"); unresolved_uninterned_symbol = scheme_make_symbol("unresolved"); tainted_uninterned_symbol = scheme_make_symbol("tainted"); @@ -530,6 +535,7 @@ void scheme_init_read(Scheme_Env *env) GLOBAL_PARAMETER("read-curly-brace-as-paren", read_brace_as_paren, MZCONFIG_CURLY_BRACES_ARE_PARENS, env); GLOBAL_PARAMETER("read-square-bracket-with-tag", read_bracket_with_tag, MZCONFIG_SQUARE_BRACKETS_ARE_TAGGED, env); GLOBAL_PARAMETER("read-curly-brace-with-tag", read_brace_with_tag, MZCONFIG_CURLY_BRACES_ARE_TAGGED, env); + GLOBAL_PARAMETER("read-cdot", read_cdot, MZCONFIG_READ_CDOT, env); GLOBAL_PARAMETER("read-accept-graph", read_accept_graph, MZCONFIG_CAN_READ_GRAPH, env); GLOBAL_PARAMETER("read-accept-compiled", read_accept_compiled, MZCONFIG_CAN_READ_COMPILED, env); GLOBAL_PARAMETER("read-accept-box", read_accept_box, MZCONFIG_CAN_READ_BOX, env); @@ -633,6 +639,12 @@ read_brace_with_tag(int argc, Scheme_Object *argv[]) DO_CHAR_PARAM("read-curly-brace-with-tag", MZCONFIG_CURLY_BRACES_ARE_TAGGED); } +static Scheme_Object * +read_cdot(int argc, Scheme_Object *argv[]) +{ + DO_CHAR_PARAM("read-cdot", MZCONFIG_READ_CDOT); +} + static Scheme_Object * read_accept_graph(int argc, Scheme_Object *argv[]) { @@ -818,6 +830,15 @@ read_delay_load(int argc, Scheme_Object *argv[]) #ifdef DO_STACK_CHECK +static Scheme_Object *read_inner_inner_inner(Scheme_Object *port, + Scheme_Object *stxsrc, + Scheme_Hash_Table **ht, + Scheme_Object *indentation, + ReadParams *params, + int comment_mode, + int pre_char, + Readtable *init_readtable, + int get_info); static Scheme_Object *read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table **ht, @@ -845,7 +866,7 @@ static void set_need_copy(Scheme_Hash_Table **ht) scheme_hash_set(*ht, tainted_uninterned_symbol, scheme_true); } -static Scheme_Object *read_inner_inner_k(void) +static Scheme_Object *read_inner_inner_inner_k(void) { Scheme_Thread *p = scheme_current_thread; Scheme_Object *o = (Scheme_Object *)p->ku.k.p1; @@ -861,7 +882,7 @@ static Scheme_Object *read_inner_inner_k(void) p->ku.k.p4 = NULL; p->ku.k.p5 = NULL; - return read_inner_inner(o, stxsrc, ht, indentation, params, p->ku.k.i1, p->ku.k.i2, + return read_inner_inner_inner(o, stxsrc, ht, indentation, params, p->ku.k.i1, p->ku.k.i2, table, p->ku.k.i3); } #endif @@ -958,7 +979,7 @@ read_plus_minus_period_leading_number(Scheme_Object *port, Scheme_Object *stxsrc static Scheme_Object * -read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table **ht, +read_inner_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table **ht, Scheme_Object *indentation, ReadParams *params, int comment_mode, int pre_char, Readtable *table, int get_info) @@ -994,7 +1015,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table * p->ku.k.i1 = comment_mode; p->ku.k.i2 = pre_char; p->ku.k.i3 = get_info; - return scheme_handle_stack_overflow(read_inner_inner_k); + return scheme_handle_stack_overflow(read_inner_inner_inner_k); } } #endif @@ -1996,6 +2017,50 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table * } } +static Scheme_Object * +read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table **ht, + Scheme_Object *indentation, ReadParams *params, + int comment_mode, int pre_char, Readtable *table, + int get_info) +{ + intptr_t rline = 0, rcol = 0, rpos = 0; + intptr_t dline = 0, dcol = 0, dpos = 0; + Scheme_Object *ret; + int read_cdot, next, found_dot; + + read_cdot = params->read_cdot; + + scheme_tell_all(port, &rline, &rcol, &rpos); + ret = read_inner_inner_inner(port, stxsrc, ht, indentation, params, comment_mode, pre_char, table, get_info); + + if (!read_cdot) { return ret; } + + found_dot = 0; + while ( 1 ) { + next = scheme_peekc_special_ok(port); + if ( next == EOF ) { break; } + if ( scheme_isspace(next) ) { scheme_getc_special_ok(port); continue; } + if ( next == '.' ) { scheme_getc_special_ok(port); found_dot = 1; break; } + break; + } + + if ( found_dot ) { + Scheme_Object *dot, *next; + scheme_tell_all(port, &dline, &dcol, &dpos); + dot = dot_symbol; + if (stxsrc) { + dot = scheme_make_stx_w_offset(dot, dline, dcol, dpos, SPAN(port,dpos), stxsrc, STX_SRCTAG); + } + next = read_inner_inner(port, stxsrc, ht, indentation, params, comment_mode, pre_char, table, get_info); + ret = scheme_make_pair( dot, scheme_make_pair( ret, scheme_make_pair( next, scheme_null ) ) ); + if (stxsrc) { + ret = scheme_make_stx_w_offset(ret, rline, rcol, rpos, SPAN(port,rpos), stxsrc, STX_SRCTAG); + } + } + + return ret; +} + static Scheme_Object * read_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table **ht, Scheme_Object *indentation, ReadParams *params, @@ -2355,6 +2420,8 @@ _internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int cant_fai params.square_brackets_are_tagged = SCHEME_TRUEP(v); v = scheme_get_param(config, MZCONFIG_CURLY_BRACES_ARE_TAGGED); params.curly_braces_are_tagged = SCHEME_TRUEP(v); + v = scheme_get_param(config, MZCONFIG_READ_CDOT); + params.read_cdot = SCHEME_TRUEP(v); v = scheme_get_param(config, MZCONFIG_READ_DECIMAL_INEXACT); params.read_decimal_inexact = SCHEME_TRUEP(v); v = scheme_get_param(config, MZCONFIG_CAN_READ_QUASI); @@ -3580,6 +3647,7 @@ read_number_or_symbol(int init_ch, int skip_rt, Scheme_Object *port, intptr_t rq_pos = 0, rq_col = 0, rq_line = 0; int case_sens = params->case_sensitive; int decimal_inexact = params->read_decimal_inexact; + int read_cdot = params->read_cdot; Scheme_Object *o; int delim_ok; int ungetc_ok; @@ -3628,7 +3696,8 @@ read_number_or_symbol(int init_ch, int skip_rt, Scheme_Object *port, || (!table && !scheme_isspace(ch) && (((ch < 128) && (delim[ch] & delim_ok)) - || ((ch >= 128) && far_char_ok))) + || ((ch >= 128) && far_char_ok)) + && !(!is_float && !is_not_float && !radix_set && read_cdot && ch == '.')) || table)) { if (table) { int v; diff --git a/racket/src/racket/src/schminc.h b/racket/src/racket/src/schminc.h index 85f7fb9a60..5c5853a607 100644 --- a/racket/src/racket/src/schminc.h +++ b/racket/src/racket/src/schminc.h @@ -14,7 +14,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1137 +#define EXPECTED_PRIM_COUNT 1138 #define EXPECTED_UNSAFE_COUNT 106 #define EXPECTED_FLFXNUM_COUNT 69 #define EXPECTED_EXTFL_COUNT 45