disallow #fx()' and #fl()' notation in `read-syntax' mode
Allowing them would require support for immutable fxvectors and flvectors, interning, and more. Since the motivation for reader support is to make marshaling and unmarshaling easier, allow them only in `read' mode. Change printing to make then unquotable.
This commit is contained in:
Matthew Flatt
parent
492167c23f
commit
9cf821b301
|
|
@ -594,22 +594,12 @@
|
|||
(add1 i)))))]
|
||||
[(flvector? obj)
|
||||
(is-compound! obj)
|
||||
(let ([len (flvector-length obj)])
|
||||
(let vloop ([esc? #f][i 0])
|
||||
(if (= i len)
|
||||
(and esc?
|
||||
(escapes! obj))
|
||||
(vloop (or (loop (flvector-ref obj i)) esc?)
|
||||
(add1 i)))))]
|
||||
;; always unquoted:
|
||||
#t]
|
||||
[(fxvector? obj)
|
||||
(is-compound! obj)
|
||||
(let ([len (fxvector-length obj)])
|
||||
(let vloop ([esc? #f][i 0])
|
||||
(if (= i len)
|
||||
(and esc?
|
||||
(escapes! obj))
|
||||
(vloop (or (loop (fxvector-ref obj i)) esc?)
|
||||
(add1 i)))))]
|
||||
;; always unquoted:
|
||||
#t]
|
||||
[(pair? obj)
|
||||
(is-compound! obj)
|
||||
(and (orf (loop (car obj))
|
||||
|
|
@ -873,8 +863,7 @@
|
|||
obj pport #t
|
||||
#f #f
|
||||
(lambda ()
|
||||
(let ([qd (to-quoted out qd obj)]
|
||||
[vecl (flvector->repeatless-list obj)])
|
||||
(let ([vecl (flvector->repeatless-list obj)])
|
||||
(if (and qd (zero? qd))
|
||||
(wr-lst (cons (make-unquoted 'flvector) vecl)
|
||||
#f depth pair? car cdr "(" ")" qd)
|
||||
|
|
@ -888,8 +877,7 @@
|
|||
obj pport #t
|
||||
#f #f
|
||||
(lambda ()
|
||||
(let ([qd (to-quoted out qd obj)]
|
||||
[vecl (fxvector->repeatless-list obj)])
|
||||
(let ([vecl (fxvector->repeatless-list obj)])
|
||||
(if (and qd (zero? qd))
|
||||
(wr-lst (cons (make-unquoted 'fxvector) vecl)
|
||||
#f depth pair? car cdr "(" ")" qd)
|
||||
|
|
@ -1105,8 +1093,7 @@
|
|||
pair? car cdr pair-open pair-close
|
||||
qd))))]
|
||||
[(flvector? obj)
|
||||
(let ([qd (to-quoted out qd obj)]
|
||||
[vecl (flvector->repeatless-list obj)])
|
||||
(let ([vecl (flvector->repeatless-list obj)])
|
||||
(if (and qd (zero? qd))
|
||||
(pp-pair (cons (make-unquoted 'flvector) vecl)
|
||||
pair? car cdr pair-open pair-close
|
||||
|
|
@ -1119,8 +1106,7 @@
|
|||
pair? car cdr pair-open pair-close
|
||||
qd))))]
|
||||
[(fxvector? obj)
|
||||
(let ([qd (to-quoted out qd obj)]
|
||||
[vecl (fxvector->repeatless-list obj)])
|
||||
(let ([vecl (fxvector->repeatless-list obj)])
|
||||
(if (and qd (zero? qd))
|
||||
(pp-pair (cons (make-unquoted 'fxvector) vecl)
|
||||
pair? car cdr pair-open pair-close
|
||||
|
|
|
|||
|
|
@ -275,6 +275,16 @@ all @tech{quotable}, then the vector @racket[print]s as
|
|||
and a closing @litchar{)}. A vector is @tech{quotable} when all of
|
||||
its elements are @tech{quotable}.
|
||||
|
||||
In @racket[write] or @racket[display] mode, an @tech{flvector} prints
|
||||
like a @tech{vector}, but with a @litchar{#fl} prefix instead of
|
||||
@litchar{#}. A @tech{fxvector} similarly prints with a @litchar{#fx}
|
||||
prefix instead of @litchar{#}. The @racket[print-vector-length]
|
||||
parameter affects @tech{flvector} and @tech{fxvector} printing the
|
||||
same as @tech{vector} printing. In @racket[print] mode,
|
||||
@tech{flvectors} and @tech{fxvectors} are not @tech{quotable}, and
|
||||
they print like a @tech{vector} at @tech{quoting depth} 0 using a
|
||||
@litchar["(flvector "] or @litchar["(fxvector "] prefix, respectively.
|
||||
|
||||
|
||||
@section[#:tag "print-structure"]{Printing Structures}
|
||||
|
||||
|
|
|
|||
|
|
@ -113,14 +113,14 @@ on the next character or characters in the input stream as follows:
|
|||
@dispatch[@litchar{#[}]{starts a @tech{vector}; see @secref["parse-vector"]}
|
||||
@dispatch[@litchar["#{"]]{starts a @tech{vector}; see @secref["parse-vector"]}
|
||||
|
||||
@dispatch[@litchar{#fx(}]{starts a @tech{fxvector}; see @secref["parse-vector"]}
|
||||
@dispatch[@litchar{#fx[}]{starts a @tech{fxvector}; see @secref["parse-vector"]}
|
||||
@dispatch[@litchar["#fx{"]]{starts a @tech{fxvector}; see @secref["parse-vector"]}
|
||||
|
||||
@dispatch[@litchar{#fl(}]{starts a @tech{flvector}; see @secref["parse-vector"]}
|
||||
@dispatch[@litchar{#fl[}]{starts a @tech{flvector}; see @secref["parse-vector"]}
|
||||
@dispatch[@litchar["#fl{"]]{starts a @tech{flvector}; see @secref["parse-vector"]}
|
||||
|
||||
@dispatch[@litchar{#fx(}]{starts a @tech{fxvector}; see @secref["parse-vector"]}
|
||||
@dispatch[@litchar{#fx[}]{starts a @tech{fxvector}; see @secref["parse-vector"]}
|
||||
@dispatch[@litchar["#fx{"]]{starts a @tech{fxvector}; see @secref["parse-vector"]}
|
||||
|
||||
@dispatch[@litchar{#s(}]{starts a @tech{structure} literal; see @secref["parse-structure"]}
|
||||
@dispatch[@litchar{#s[}]{starts a @tech{structure} literal; see @secref["parse-structure"]}
|
||||
@dispatch[@litchar["#s{"]]{starts a @tech{structure} literal; see @secref["parse-structure"]}
|
||||
|
|
@ -166,14 +166,13 @@ on the next character or characters in the input stream as follows:
|
|||
@dispatch[@elem{@litchar{#}@kleeneplus{@nonterm{digit@sub{10}}}@litchar{[}}]{starts a vector; see @secref["parse-vector"]}
|
||||
@dispatch[@elem{@litchar{#}@kleeneplus{@nonterm{digit@sub{10}}}@litchar["{"]}]{starts a vector; see @secref["parse-vector"]}
|
||||
|
||||
@dispatch[@elem{@litchar{#fx}@kleeneplus{@nonterm{digit@sub{10}}}@litchar{(}}]{starts a fxvector; see @secref["parse-vector"]}
|
||||
@dispatch[@elem{@litchar{#fx}@kleeneplus{@nonterm{digit@sub{10}}}@litchar{[}}]{starts a fxvector; see @secref["parse-vector"]}
|
||||
@dispatch[@elem{@litchar{#fx}@kleeneplus{@nonterm{digit@sub{10}}}@litchar["{"]}]{starts a fxvector; see @secref["parse-vector"]}
|
||||
|
||||
@dispatch[@elem{@litchar{#fl}@kleeneplus{@nonterm{digit@sub{10}}}@litchar{(}}]{starts a flvector; see @secref["parse-vector"]}
|
||||
@dispatch[@elem{@litchar{#fl}@kleeneplus{@nonterm{digit@sub{10}}}@litchar{[}}]{starts a flvector; see @secref["parse-vector"]}
|
||||
@dispatch[@elem{@litchar{#fl}@kleeneplus{@nonterm{digit@sub{10}}}@litchar["{"]}]{starts a flvector; see @secref["parse-vector"]}
|
||||
|
||||
@dispatch[@elem{@litchar{#fx}@kleeneplus{@nonterm{digit@sub{10}}}@litchar{(}}]{starts a fxvector; see @secref["parse-vector"]}
|
||||
@dispatch[@elem{@litchar{#fx}@kleeneplus{@nonterm{digit@sub{10}}}@litchar{[}}]{starts a fxvector; see @secref["parse-vector"]}
|
||||
@dispatch[@elem{@litchar{#fx}@kleeneplus{@nonterm{digit@sub{10}}}@litchar["{"]}]{starts a fxvector; see @secref["parse-vector"]}
|
||||
|
||||
@dispatch[@graph-defn[]]{binds a graph tag; see @secref["parse-graph"]}
|
||||
@dispatch[@graph-ref[]]{uses a graph tag; see @secref["parse-graph"]}
|
||||
|
|
@ -596,13 +595,12 @@ file.
|
|||
|
||||
When the reader encounters a @litchar{#(}, @litchar{#[}, or
|
||||
@litchar["#{"], it starts parsing a @tech{vector}; see @secref["vectors"] for
|
||||
information on vectors.
|
||||
When the reader encounters a @litchar{#fl(}, @litchar{#fl[}, or
|
||||
@litchar["#fl{"], it starts parsing a @tech{flvector}; see @secref["flvectors"] for
|
||||
information on flvectors.
|
||||
When the reader encounters a @litchar{#fx(}, @litchar{#fx[}, or
|
||||
@litchar["#fx{"], it starts parsing a @tech{fxvector}; see @secref["fxvectors"] for
|
||||
information on flvectors.
|
||||
information on vectors. A @litchar{#fl} in place of @litchar{#}
|
||||
starts an @tech{flvector}, but is not allowed in @racket[read-syntax] mode;
|
||||
see @secref["flvectors"] for information on flvectors.
|
||||
A @litchar{#fx} in place of @litchar{#}
|
||||
starts an @tech{fxvector}, but is not allowed in @racket[read-syntax] mode;
|
||||
see @secref["fxvectors"] for information on fxvectors.
|
||||
The @litchar{#[}, @litchar["#{"], @litchar{#fl[}, @litchar["#fl{"],
|
||||
@litchar{#fx[}, and @litchar["#fx{"] forms can be disabled through
|
||||
the @racket[read-square-bracket-as-paren] and
|
||||
|
|
@ -611,8 +609,11 @@ the @racket[read-square-bracket-as-paren] and
|
|||
The elements of the vector are recursively read until a matching
|
||||
@litchar{)}, @litchar{]}, or @litchar["}"] is found, just as for
|
||||
lists (see @secref["parse-pair"]). A delimited @litchar{.} is not
|
||||
allowed among the vector elements. The @tech{fxvector} and @tech{flvector} forms
|
||||
only accept @tech{flonum}s and @tech{fixnum}s respectively.
|
||||
allowed among the vector elements. In the case of @tech{flvectors},
|
||||
the recursive read for element is implicitly prefixed with @litchar{#i}
|
||||
and must produce a @tech{flonum}. In the case of @tech{flvectors},
|
||||
the recursive read for element is implicitly prefixed with @litchar{#e}
|
||||
and must produce a @tech{fixnum}.
|
||||
|
||||
An optional vector length can be specified between @litchar{#}, @litchar{#fl}, @litchar{#fx} and
|
||||
@litchar{(}, @litchar{[}, or @litchar["{"]. The size is specified
|
||||
|
|
@ -622,7 +623,7 @@ fewer elements are provided, the last provided element is used for the
|
|||
remaining vector slots; if no elements are provided, then @racket[0]
|
||||
is used for all slots.
|
||||
|
||||
In @racket[read-syntax] mode, each recursive read for the vector
|
||||
In @racket[read-syntax] mode, each recursive read for vector
|
||||
elements is also in @racket[read-syntax] mode, so that the wrapped
|
||||
vector's elements are also wrapped as syntax objects, and the vector is
|
||||
immutable.
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
|
|
@ -12,7 +12,9 @@
|
|||
|
||||
(Section 'pretty)
|
||||
|
||||
(require racket/pretty)
|
||||
(require racket/pretty
|
||||
racket/fixnum
|
||||
racket/flonum)
|
||||
|
||||
(print-as-expression #f)
|
||||
|
||||
|
|
@ -68,6 +70,8 @@
|
|||
(test "#<box>" pretty-format (box 10)))
|
||||
(test "#(10)" pretty-format (vector 10))
|
||||
(test "#(10 10)" pretty-format (vector 10 10))
|
||||
(test "#fl(10.0 10.0)" pretty-format (flvector 10.0 10.0))
|
||||
(test "#fx(11 11)" pretty-format (fxvector 11 11))
|
||||
(parameterize ([print-vector-length #t])
|
||||
(test "#1(10)" pretty-format (vector 10))
|
||||
(test "#2(10)" pretty-format (vector 10 10))
|
||||
|
|
@ -111,6 +115,8 @@
|
|||
(test "(1234567890 1 2 3 4)" pretty-format '(1234567890 1 2 3 4))
|
||||
(test "(1234567890xx\n 1\n 2\n 3\n 4)" pretty-format '(1234567890xx 1 2 3 4))
|
||||
(test "#(1234567890xx\n 1\n 2\n 3\n 4)" pretty-format (vector '1234567890xx 1 2 3 4))
|
||||
(test "#fx(1234567890\n 1\n 2\n 3\n 4)" pretty-format (fxvector 1234567890 1 2 3 4))
|
||||
(test "#fl(1234567890.0\n 1.0\n 2.0\n 3.0\n 4.0)" pretty-format (flvector 1234567890.0 1.0 2.0 3.0 4.0))
|
||||
(test "#s(apple\n 1234567890xx\n 1\n 2\n 3\n 4)" pretty-format #s(apple 1234567890xx 1 2 3 4))
|
||||
(test "#(struct:a\n 1234567890xx\n 1)" pretty-format (make-a '1234567890xx 1))
|
||||
(test "#hash((a\n .\n 1234567890xx))" pretty-format #hash((a . 1234567890xx)))
|
||||
|
|
@ -245,6 +251,8 @@
|
|||
(mcons 1 2)
|
||||
(mcons 1 (mcons 2 null))
|
||||
#(1 2 3 4 5)
|
||||
(fxvector 1 2 3)
|
||||
(flvector 1.0 2.0 3.0)
|
||||
(read (open-input-string "(#0=() . #0#)"))
|
||||
(read (open-input-string "#1=(1 . #1#)"))
|
||||
(read (open-input-string "#1={#0={1 2 . #2={#0# . #1#}} . #2#}"))
|
||||
|
|
|
|||
|
|
@ -1125,12 +1125,16 @@
|
|||
racket/fixnum)
|
||||
(test #t flvector? (readstr "#fl(1.5 0.33 0.3)"))
|
||||
(test #t fxvector? (readstr "#fx(1000 76 100000)"))
|
||||
(test #t fxvector? (readstr "#fx(#x10 #X10 #d9 #D9 #b111 #B111 #o77 #O77 #e1 #E1)"))
|
||||
(err/rt-test (readstr "#fx(#i4.2235 #I4.2235)") exn:fail:read?)
|
||||
(test #t fxvector? (readstr "#fx(#x10 #X10 #d9 #D9 #b111 #B111 #o77 #O77)"))
|
||||
(err/rt-test (readstr "#fx(4.2235 4.2235)") exn:fail:read?)
|
||||
(test #t equal? (flvector 1.5 0.33 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3) (readstr "#fl10(1.5 0.33 0.3)"))
|
||||
(test #t equal? (fxvector 1000 76 100000 100000 100000 100000 100000 100000 100000 100000) (readstr "#fx10(1000 76 100000)"))
|
||||
(test #t equal? (flvector 0.0 0.0 0.0) (readstr "#fl3()"))
|
||||
(test #t equal? (fxvector 0 0 0 ) (readstr "#fx3()"))
|
||||
(test #t equal? (flvector 2.0 1.0 1.0) (readstr "#fl3(2 1)"))
|
||||
(test #t equal? (fxvector 0 0 0) (readstr "#fx3()"))
|
||||
(test #t equal? (fxvector 2 1 1) (readstr "#fx3(2 1)"))
|
||||
|
||||
(err/rt-test (readstr "#fl(1.5") exn:fail:read:eof?)
|
||||
(err/rt-test (readstr "#fl(1.5 0.33 0.3 (1 2))") exn:fail:read?)
|
||||
(err/rt-test (readstr "#fx(1000 76 100000 (1 2))") exn:fail:read?)
|
||||
(err/rt-test (readstr "#fl(1.5 0.33 0.3 'a)") exn:fail:read?)
|
||||
|
|
@ -1140,6 +1144,10 @@
|
|||
(err/rt-test (readstr "#fi(1000 76 100000 'a)") exn:fail:read?)
|
||||
(err/rt-test (readstr "#fx(1 . 2)") exn:fail:read?)
|
||||
(err/rt-test (readstr "#fx(1 . 2 . 3)") exn:fail:read?)
|
||||
|
||||
(err/rt-test (read-syntax 'x (open-input-string "#fx()")) exn:fail:read?)
|
||||
(err/rt-test (read-syntax 'x (open-input-string "#fl()")) exn:fail:read?)
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@ Version 5.3.1.9
|
|||
Changed case to use equal? instead of eqv?
|
||||
r5rs, r6rs: fixed case and cond to disallow internal definitions
|
||||
in clauses
|
||||
Add #fx() and #fl() reader forms for flvectors and fxvectors
|
||||
|
||||
Version 5.3.1.8
|
||||
file/untar: added
|
||||
|
|
|
|||
|
|
@ -169,6 +169,8 @@ static Scheme_Object *writable_struct_subs(Scheme_Object *s, int for_write, Prin
|
|||
(SCHEME_PAIRP(obj) \
|
||||
|| SCHEME_MUTABLE_PAIRP(obj) \
|
||||
|| SCHEME_CHAPERONE_VECTORP(obj) \
|
||||
|| SCHEME_FLVECTORP(obj) \
|
||||
|| SCHEME_FXVECTORP(obj) \
|
||||
|| (qk(pp->print_box, 1) && SCHEME_CHAPERONE_BOXP(obj)) \
|
||||
|| (qk(pp->print_struct \
|
||||
&& SCHEME_CHAPERONE_STRUCTP(obj) \
|
||||
|
|
@ -534,6 +536,8 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
|
|||
|| SCHEME_MUTABLE_PAIRP(obj)
|
||||
|| (pp->print_box && SCHEME_CHAPERONE_BOXP(obj))
|
||||
|| SCHEME_CHAPERONE_VECTORP(obj)
|
||||
|| SCHEME_FLVECTORP(obj)
|
||||
|| SCHEME_FXVECTORP(obj)
|
||||
|| (SCHEME_CHAPERONE_STRUCTP(obj)
|
||||
&& ((pp->print_struct
|
||||
&& PRINTABLE_STRUCT(obj, pp))
|
||||
|
|
@ -589,6 +593,8 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
|
|||
if ((for_write < 3) && res)
|
||||
return res;
|
||||
}
|
||||
} else if (SCHEME_FLVECTORP(obj) || SCHEME_FXVECTORP(obj)) {
|
||||
res = 0x1; /* escape for qq printing */
|
||||
} else if (SCHEME_CHAPERONE_STRUCTP(obj)) {
|
||||
if (scheme_is_writable_struct(obj)) {
|
||||
if (pp->print_unreadable) {
|
||||
|
|
@ -797,6 +803,8 @@ static int check_cycles_fast(Scheme_Object *obj, PrintParams *pp, int *fast_chec
|
|||
cycle = -1;
|
||||
} else if (SCHEME_CHAPERONEP(obj))
|
||||
cycle = -1; /* no fast checks for chaperones */
|
||||
else if ((write >= 3) && (SCHEME_FLVECTORP(obj) || SCHEME_FXVECTORP(obj)))
|
||||
cycle = -1; /* needs unquote */
|
||||
else
|
||||
cycle = 0;
|
||||
|
||||
|
|
|
|||
|
|
@ -320,12 +320,12 @@ static Scheme_Object *read_fixnum(Scheme_Object *port,
|
|||
ReadParams *params,
|
||||
int comment_mode);
|
||||
static Scheme_Object *read_number_literal(Scheme_Object *port,
|
||||
Scheme_Object *stxsrc,
|
||||
int is_float, int is_not_float,
|
||||
Scheme_Hash_Table **ht,
|
||||
Scheme_Object *indentation,
|
||||
ReadParams *params,
|
||||
int comment_mode);
|
||||
Scheme_Object *stxsrc,
|
||||
int is_float, int is_not_float,
|
||||
Scheme_Hash_Table **ht,
|
||||
Scheme_Object *indentation,
|
||||
ReadParams *params,
|
||||
int comment_mode);
|
||||
|
||||
#define READTABLE_WHITESPACE 0x1
|
||||
#define READTABLE_CONTINUING 0x2
|
||||
|
|
@ -925,10 +925,10 @@ static int read_vector_length(Scheme_Object *port, Readtable *table, int *ch, mz
|
|||
|
||||
static Scheme_Object *
|
||||
read_plus_minus_period_leading_number(Scheme_Object *port, Scheme_Object *stxsrc,
|
||||
int ch, intptr_t line, intptr_t col, intptr_t pos,
|
||||
int is_float, int is_not_float,
|
||||
Scheme_Hash_Table **ht, Scheme_Object *indentation, ReadParams *params,
|
||||
Readtable *table)
|
||||
int ch, intptr_t line, intptr_t col, intptr_t pos,
|
||||
int is_float, int is_not_float,
|
||||
Scheme_Hash_Table **ht, Scheme_Object *indentation, ReadParams *params,
|
||||
Readtable *table)
|
||||
{
|
||||
int ch2;
|
||||
Scheme_Object *special_value;
|
||||
|
|
@ -936,9 +936,10 @@ read_plus_minus_period_leading_number(Scheme_Object *port, Scheme_Object *stxsrc
|
|||
if ((NOT_EOF_OR_SPECIAL(ch2) && isdigit_ascii(ch2)) || (ch2 == '.')
|
||||
|| ((ch2 == 'i') || (ch2 == 'I') /* Maybe inf */
|
||||
|| (ch2 == 'n') || (ch2 == 'N') /* Maybe nan*/ )) {
|
||||
/* read_number tries to get a number, but produces a symbol if number parsing doesn't work: */
|
||||
/* read_number tries to get a number, but produces a symbol if number parsing doesn't work,
|
||||
unless `is_float' or `is_not_float': */
|
||||
special_value = read_number(ch, port, stxsrc, line, col, pos,
|
||||
is_float, is_not_float, 10, 0, ht, indentation, params, table);
|
||||
is_float, is_not_float, 10, 0, ht, indentation, params, table);
|
||||
} else {
|
||||
special_value = read_symbol(ch, 0, port, stxsrc, line, col, pos, ht, indentation, params, table);
|
||||
}
|
||||
|
|
@ -1260,55 +1261,58 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
|
|||
int overflow = 0, digits = 0, effective_ch;
|
||||
mzchar tagbuf[64], vecbuf[64]; /* just for errors */
|
||||
int ch;
|
||||
|
||||
if (stxsrc) {
|
||||
scheme_read_err(port, stxsrc, line, col, pos, 3, 0, indentation,
|
||||
"read-syntax: literal f%cvectors not allowed", next);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
ch = scheme_getc_special_ok(port);
|
||||
ch = scheme_getc_special_ok(port);
|
||||
if (isdigit_ascii(ch)) {
|
||||
if (isdigit_ascii(ch))
|
||||
effective_ch = read_vector_length(port, table, &ch, tagbuf, vecbuf, &vector_length, &digits, &overflow);
|
||||
}
|
||||
else {
|
||||
else
|
||||
effective_ch = ch;
|
||||
}
|
||||
switch (effective_ch)
|
||||
{
|
||||
case '(':
|
||||
switch (effective_ch) {
|
||||
case '(':
|
||||
if (next == 'l')
|
||||
return read_flvector(port, stxsrc, line, col, pos, ch, ')', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
else
|
||||
return read_fxvector(port, stxsrc, line, col, pos, ch, ')', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
break;
|
||||
case '[':
|
||||
if (!params->square_brackets_are_parens) {
|
||||
scheme_read_err(port, stxsrc, line, col, pos, 2, effective_ch, indentation, "read: bad syntax `#f%c['", next);
|
||||
return NULL;
|
||||
} else
|
||||
if (next == 'l')
|
||||
return read_flvector(port, stxsrc, line, col, pos, ch, ')', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
return read_flvector(port, stxsrc, line, col, pos, ch, ']', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
else
|
||||
return read_fxvector(port, stxsrc, line, col, pos, ch, ')', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
break;
|
||||
case '[':
|
||||
if (!params->square_brackets_are_parens) {
|
||||
scheme_read_err(port, stxsrc, line, col, pos, 2, effective_ch, indentation, "read: bad syntax `#f%c['", next);
|
||||
return NULL;
|
||||
} else
|
||||
if (next == 'l')
|
||||
return read_flvector(port, stxsrc, line, col, pos, ch, ']', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
else
|
||||
return read_fxvector(port, stxsrc, line, col, pos, ch, ']', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
break;
|
||||
case '{':
|
||||
if (!params->curly_braces_are_parens) {
|
||||
scheme_read_err(port, stxsrc, line, col, pos, 2, effective_ch, indentation, "read: bad syntax `#f%c{'", next);
|
||||
return NULL;
|
||||
} else
|
||||
if (next == 'l')
|
||||
return read_flvector(port, stxsrc, line, col, pos, ch, '}', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
else
|
||||
return read_fxvector(port, stxsrc, line, col, pos, ch, '}', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
break;
|
||||
default:
|
||||
scheme_read_err(port, stxsrc, line, col, pos, 2, effective_ch, indentation,
|
||||
"read: expected `(' `[' or `{' after #f%c", next);
|
||||
return read_fxvector(port, stxsrc, line, col, pos, ch, ']', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
break;
|
||||
case '{':
|
||||
if (!params->curly_braces_are_parens) {
|
||||
scheme_read_err(port, stxsrc, line, col, pos, 2, effective_ch, indentation, "read: bad syntax `#f%c{'", next);
|
||||
return NULL;
|
||||
} else
|
||||
if (next == 'l')
|
||||
return read_flvector(port, stxsrc, line, col, pos, ch, '}', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
else
|
||||
return read_fxvector(port, stxsrc, line, col, pos, ch, '}', vector_length, vecbuf, ht, indentation, params, 0);
|
||||
break;
|
||||
default:
|
||||
scheme_read_err(port, stxsrc, line, col, pos, 3, effective_ch, indentation,
|
||||
"read: expected `(' `[' or `{' after #f%c", next);
|
||||
}
|
||||
}
|
||||
default:
|
||||
{
|
||||
GC_CAN_IGNORE const mzchar str[] = { 'f', 'a', 'l', 's', 'e', 0 };
|
||||
default:
|
||||
{
|
||||
GC_CAN_IGNORE const mzchar str[] = { 'f', 'a', 'l', 's', 'e', 0 };
|
||||
return read_delimited_constant(ch, str, scheme_false, port, stxsrc, line, col, pos,
|
||||
indentation, params, table);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
case 'c':
|
||||
case 'C':
|
||||
|
|
@ -2950,7 +2954,6 @@ static Scheme_Object *read_flonum(Scheme_Object *port,
|
|||
return n;
|
||||
else {
|
||||
scheme_tell_all(port, &line2, &col2, &pos2);
|
||||
//printf("%d %d %d %d %d %d\n", line, col, pos, line2, col2, pos2);
|
||||
scheme_read_err(port, stxsrc, line, col, pos, pos2-pos, -1, indentation, "read: expected flonum, got %V", n);
|
||||
}
|
||||
return NULL;
|
||||
|
|
@ -2977,14 +2980,14 @@ static Scheme_Object *read_fixnum(Scheme_Object *port,
|
|||
}
|
||||
|
||||
static Scheme_Object *read_number_literal(Scheme_Object *port,
|
||||
Scheme_Object *stxsrc,
|
||||
int is_float, int is_not_float,
|
||||
Scheme_Hash_Table **ht,
|
||||
Scheme_Object *indentation,
|
||||
ReadParams *params,
|
||||
int comment_mode)
|
||||
Scheme_Object *stxsrc,
|
||||
int is_float, int is_not_float,
|
||||
Scheme_Hash_Table **ht,
|
||||
Scheme_Object *indentation,
|
||||
ReadParams *params,
|
||||
int comment_mode)
|
||||
{
|
||||
int ch, ch2;
|
||||
int ch;
|
||||
intptr_t line = 0, col = 0, pos = 0;
|
||||
Scheme_Object *special_value = NULL;
|
||||
Readtable *table;
|
||||
|
|
@ -3003,43 +3006,28 @@ static Scheme_Object *read_number_literal(Scheme_Object *port,
|
|||
switch (ch ) {
|
||||
case 'X':
|
||||
case 'x':
|
||||
/* 0 0 */
|
||||
return read_number(-1, port, stxsrc, line, col, pos, is_float, is_not_float, 16, 1, ht, indentation, params, table);
|
||||
break;
|
||||
case 'B':
|
||||
case 'b':
|
||||
/* 0 0 */
|
||||
return read_number(-1, port, stxsrc, line, col, pos, is_float, is_not_float, 2, 1, ht, indentation, params, table);
|
||||
break;
|
||||
case 'O':
|
||||
case 'o':
|
||||
/* 0 0 */
|
||||
return read_number(-1, port, stxsrc, line, col, pos, is_float, is_not_float, 8, 1, ht, indentation, params, table);
|
||||
break;
|
||||
case 'D':
|
||||
case 'd':
|
||||
/* 0 0 */
|
||||
return read_number(-1, port, stxsrc, line, col, pos, is_float, is_not_float, 10, 1, ht, indentation, params, table);
|
||||
break;
|
||||
case 'E':
|
||||
case 'e':
|
||||
/* 0 1 */
|
||||
return read_number(-1, port, stxsrc, line, col, pos, is_float, is_not_float, 10, 0, ht, indentation, params, table);
|
||||
break;
|
||||
case 'I':
|
||||
case 'i':
|
||||
/* 1 0 */
|
||||
return read_number(-1, port, stxsrc, line, col, pos, is_float, is_not_float, 10, 0, ht, indentation, params, table);
|
||||
break;
|
||||
default:
|
||||
scheme_read_err(port, stxsrc, line, col, pos, 2, ch, indentation, "read: expected one of [XxBbOoDdEeII]");
|
||||
scheme_read_err(port, stxsrc, line, col, pos, 2, ch, indentation, "read: expected `x', `X', `b', `B', `o', `O', `d', or `D'");
|
||||
}
|
||||
default:
|
||||
if (isdigit_ascii(ch))
|
||||
/* 0 0 */
|
||||
special_value = read_number(ch, port, stxsrc, line, col, pos, is_float, is_not_float, 10, 0, ht, indentation, params, table);
|
||||
else
|
||||
scheme_read_err(port, stxsrc, line, col, pos, 2, ch, indentation, "read: expected digit");
|
||||
scheme_read_err(port, stxsrc, line, col, pos, 2, ch, indentation, "read: expected a digit, `+', `-', `.', or `#'");
|
||||
}
|
||||
return special_value;
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user