suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

read and write support for fxvectors and flvectors

Browse Source
This commit is contained in:
Kevin Tew 2012-11-29 05:27:19 -07:00 committed by Matthew Flatt
parent 280d924349
commit 492167c23f
11 changed files with 792 additions and 224 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
collects/racket/pretty.rkt
View File

@ -10,7 +10,9 @@
;; (current-print pretty-print-handler)
(module pretty racket/base
(require racket/private/port)
(require racket/private/port
racket/flonum
racket/fixnum)
(provide pretty-print
pretty-write
@ -429,24 +431,31 @@
(define long-bools? (print-boolean-long-form))
(define vector->repeatless-list
(if print-vec-length?
(lambda (v)
(let ([len (vector-length v)])
(if (zero? len)
null
(let ([last (vector-ref v (sub1 len))])
(let loop ([i (- len 2)])
(if (i . < . 0)
(list last)
(let ([e (vector-ref v i)])
(if (eq? e last)
(loop (sub1 i))
(let loop ([i (sub1 i)][r (list e last)])
(if (i . < . 0)
r
(loop (sub1 i) (cons (vector-ref v i) r))))))))))))
vector->list))
(define-syntax-rule (mkvector->repeatless-list name v-length v-ref equal-op? ->list)
(define name
(if print-vec-length?
(lambda (v)
(let ([len (v-length v)])
(if (zero? len)
null
(let ([last (v-ref v (sub1 len))])
(let loop ([i (- len 2)])
(if (i . < . 0)
(list last)
(let ([e (v-ref v i)])
(if (equal-op? e last)
(loop (sub1 i))
(let loop ([i (sub1 i)][r (list e last)])
(if (i . < . 0)
r
(loop (sub1 i) (cons (v-ref v i) r))))))))))))
->list)))
(mkvector->repeatless-list vector->repeatless-list vector-length vector-ref eq? vector->list)
(mkvector->repeatless-list flvector->repeatless-list flvector-length flvector-ref equal?
(lambda (v) (for/list ([x (in-flvector v)]) x)))
(mkvector->repeatless-list fxvector->repeatless-list fxvector-length fxvector-ref eq?
(lambda (v) (for/list ([x (in-fxvector v)]) x)))
(define (extract-sub-objects obj pport)
(let ([p (open-output-nowhere 'null (port-writes-special? pport))]
@ -583,6 +592,24 @@
(escapes! obj))
(vloop (or (loop (vector-ref obj i)) esc?)
(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)))))]
[(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)))))]
[(pair? obj)
(is-compound! obj)
(and (orf (loop (car obj))
@ -841,6 +868,36 @@
(when print-vec-length?
(out (number->string (vector-length obj))))
(wr-lst vecl #f depth pair? car cdr "(" ")" qd))))))]
[(flvector? obj)
(check-expr-found
obj pport #t
#f #f
(lambda ()
(let ([qd (to-quoted out qd obj)]
[vecl (flvector->repeatless-list obj)])
(if (and qd (zero? qd))
(wr-lst (cons (make-unquoted 'flvector) vecl)
#f depth pair? car cdr "(" ")" qd)
(begin
(out "#fl")
(when print-vec-length?
(out (number->string (flvector-length obj))))
(wr-lst vecl #f depth pair? car cdr "(" ")" qd))))))]
[(fxvector? obj)
(check-expr-found
obj pport #t
#f #f
(lambda ()
(let ([qd (to-quoted out qd obj)]
[vecl (fxvector->repeatless-list obj)])
(if (and qd (zero? qd))
(wr-lst (cons (make-unquoted 'fxvector) vecl)
#f depth pair? car cdr "(" ")" qd)
(begin
(out "#fx")
(when print-vec-length?
(out (number->string (fxvector-length obj))))
(wr-lst vecl #f depth pair? car cdr "(" ")" qd))))))]
[(and (box? obj)
print-box?)
(check-expr-found
@ -976,6 +1033,8 @@
(or (pair? obj)
(mpair? obj)
(vector? obj)
(flvector? obj)
(fxvector? obj)
(and (box? obj) print-box?)
(and (custom-write? obj)
(not (struct-type? obj)))
@ -1045,6 +1104,34 @@
(pp-list vecl extra pp-expr #f depth
pair? car cdr pair-open pair-close
qd))))]
[(flvector? obj)
(let ([qd (to-quoted out qd obj)]
[vecl (flvector->repeatless-list obj)])
(if (and qd (zero? qd))
(pp-pair (cons (make-unquoted 'flvector) vecl)
pair? car cdr pair-open pair-close
qd)
(begin
(out "#fl")
(when print-vec-length?
(out (number->string (flvector-length obj))))
(pp-list vecl extra pp-expr #f depth
pair? car cdr pair-open pair-close
qd))))]
[(fxvector? obj)
(let ([qd (to-quoted out qd obj)]
[vecl (fxvector->repeatless-list obj)])
(if (and qd (zero? qd))
(pp-pair (cons (make-unquoted 'fxvector) vecl)
pair? car cdr pair-open pair-close
qd)
(begin
(out "#fx")
(when print-vec-length?
(out (number->string (fxvector-length obj))))
(pp-list vecl extra pp-expr #f depth
pair? car cdr pair-open pair-close
qd))))]
[(and (custom-write? obj)
(not (struct-type? obj)))
(let ([qd (let ([kind (if (custom-print-quotable? obj)

35
collects/scribblings/reference/reader.scrbl
View File

@ -113,6 +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{#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"]}
@ -157,6 +165,16 @@ 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{#}@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[@graph-defn[]]{binds a graph tag; see @secref["parse-graph"]}
@dispatch[@graph-ref[]]{uses a graph tag; see @secref["parse-graph"]}
@ -578,16 +596,25 @@ file.
When the reader encounters a @litchar{#(}, @litchar{#[}, or
@litchar["#{"], it starts parsing a @tech{vector}; see @secref["vectors"] for
information on vectors. The @litchar{#[} and @litchar["#{"] forms can
be disabled through the @racket[read-square-bracket-as-paren] and
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.
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
@racket[read-curly-brace-as-paren] @tech{parameters}.
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.
allowed among the vector elements. The @tech{fxvector} and @tech{flvector} forms
only accept @tech{flonum}s and @tech{fixnum}s respectively.
An optional vector length can be specified between the @litchar{#} and
An optional vector length can be specified between @litchar{#}, @litchar{#fl}, @litchar{#fx} and
@litchar{(}, @litchar{[}, or @litchar["{"]. The size is specified
using a sequence of decimal digits, and the number of elements
provided for the vector must be no more than the specified size. If

7
collects/tests/racket/print.rktl
View File

@ -5,6 +5,9 @@
(Section 'printing)
(require racket/flonum
racket/fixnum)
(let ([ptest (lambda (s v)
(define (to-string v)
(format "~v" v))
@ -190,6 +193,9 @@
(ptest "'`,#,#`a" '`,#,#`a)
(ptest "'`,#,#`,@#,@a" '`,#,#`,@#,@a)
(ptest "'#fx(1 10000 3)" (fxvector 1 10000 3))
(ptest "'#fl(1.1 10000.1 3.1)" (flvector 1.1 10000.1 3.1))
(void))
(let ([in-string (lambda (f v)
@ -250,4 +256,5 @@
;; ----------------------------------------
(report-errs)

19
collects/tests/racket/read.rktl
View File

@ -1121,6 +1121,25 @@
(err/rt-test (read-language p)
(lambda (exn) (regexp-match? #rx"read-language" (exn-message exn)))))
(require racket/flonum
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 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()"))
(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?)
(err/rt-test (readstr "#fx(1000 76 100000 'a)") exn:fail:read?)
(err/rt-test (readstr "#fli(1.5 0.33 0.3 'a)") exn:fail:read?)
(err/rt-test (readstr "#fxi(1000 76 100000 'a)") exn:fail:read?)
(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?)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

6
src/racket/src/Makefile.in
View File

@ -378,14 +378,16 @@ port.@LTO@: $(COMMON_HEADERS) \
portfun.@LTO@: $(COMMON_HEADERS) $(srcdir)/schvers.h \
$(srcdir)/../src/stypes.h $(srcdir)/schfd.h $(srcdir)/mzmark_portfun.inc
print.@LTO@: $(COMMON_HEADERS) $(srcdir)/../src/stypes.h $(srcdir)/../src/schcpt.h \
$(srcdir)/schvers.h $(SCONFIG) $(srcdir)/mzmark_print.inc
$(srcdir)/schvers.h $(SCONFIG) $(srcdir)/mzmark_print.inc \
$(srcdir)/print_vector.inc
thread.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/schfd.h $(srcdir)/mzmark_thread.inc
rational.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h
read.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/schcpt.h $(srcdir)/schvers.h $(srcdir)/schminc.h \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark_read.inc
$(srcdir)/../src/stypes.h $(srcdir)/mzmark_read.inc \
$(srcdir)/read_vector.inc
regexp.@LTO@: $(COMMON_HEADERS) \
$(srcdir)/../src/stypes.h $(srcdir)/mzmark_regexp.inc $(srcdir)/schrx.h
resolve.@LTO@: $(COMMON_HEADERS) \

26
src/racket/src/numstr.c
View File

@ -1531,12 +1531,8 @@ string_to_number (int argc, Scheme_Object *argv[])
return v;
}
static char *double_to_string (double d, int alloc, int was_single)
char *scheme_double_to_string (double d, char* s, int slen, int was_single, int *used_buffer)
{
char buffer[100], *s;
int l, i, digits;
if (MZ_IS_NAN(d))
#ifdef MZ_USE_SINGLE_FLOATS
if (was_single)
@ -1581,13 +1577,15 @@ static char *double_to_string (double d, int alloc, int was_single)
(single). That's big enough to get most right, small enough to
avoid nonsense digits. But we'll loop in case it's not precise
enough to get read-write invariance: */
int i, l, digits;
GC_CAN_IGNORE char *loc;
char *buffer = s;
if (was_single)
digits = 6;
else
digits = 14;
loc = scheme_push_c_numeric_locale();
while (digits < 30) {
while (digits < 30 && digits < slen) {
double check;
GC_CAN_IGNORE char *ptr;
@ -1637,7 +1635,20 @@ static char *double_to_string (double d, int alloc, int was_single)
}
}
#endif
*used_buffer = 1;
}
return s;
}
static char *double_to_string (double d, int alloc, int was_single)
{
char buffer[100];
char *s;
int used_buffer = 0;
s = scheme_double_to_string(d, buffer, 100, was_single, &used_buffer);
if (used_buffer) {
s = (char *)scheme_malloc_atomic(strlen(buffer) + 1);
strcpy(s, buffer);
alloc = 0;
@ -1645,6 +1656,7 @@ static char *double_to_string (double d, int alloc, int was_single)
if (alloc) {
char *s2;
int l;
l = strlen(s) + 1;
s2 = (char *)scheme_malloc_atomic(l);
memcpy(s2, s, l);

168
src/racket/src/print.c
View File

@ -64,6 +64,20 @@ ROSYM Scheme_Object *qq_ellipses;
#define REASONABLE_QQ_DEPTH (1 << 29)
/* notdisplay
enum NOTDISPLAY {
NOTDISPLAY_DISPLAY = 0,
NOTDISPLAY_WRITE = 1,
NOTDISPLAY_PRINT = 2,
NOTDISPLAY_AS_EXPRESSION = 3,
};
*/
/* locals */
#define MAX_PRINT_BUFFER 500
@ -121,6 +135,16 @@ static void print_vector(Scheme_Object *vec, int notdisplay, int compact,
Scheme_Marshal_Tables *mt,
PrintParams *pp,
int as_prefab);
static void print_flvector(Scheme_Object *vec, int notdisplay, int compact,
Scheme_Hash_Table *ht,
Scheme_Marshal_Tables *mt,
PrintParams *pp,
int as_prefab);
static void print_fxvector(Scheme_Object *vec, int notdisplay, int compact,
Scheme_Hash_Table *ht,
Scheme_Marshal_Tables *mt,
PrintParams *pp,
int as_prefab);
static void print_char(Scheme_Object *chobj, int notdisplay, PrintParams *pp);
static char *print_to_string(Scheme_Object *obj, intptr_t * volatile len, int write,
Scheme_Object *port, intptr_t maxl,
@ -2225,6 +2249,18 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
print_vector(obj, notdisplay, compact, ht, mt, pp, 0);
closed = 1;
}
else if (SCHEME_FLVECTORP(obj))
{
notdisplay = to_quoted(obj, pp, notdisplay);
print_flvector(obj, notdisplay, compact, ht, mt, pp, 0);
closed = 1;
}
else if (SCHEME_FXVECTORP(obj))
{
notdisplay = to_quoted(obj, pp, notdisplay);
print_fxvector(obj, notdisplay, compact, ht, mt, pp, 0);
closed = 1;
}
else if ((compact || pp->print_box) && SCHEME_CHAPERONE_BOXP(obj))
{
if (compact && !pp->print_box) {
@ -3713,67 +3749,81 @@ print_pair(Scheme_Object *pair, int notdisplay, int compact,
}
}
static void
print_vector(Scheme_Object *vec, int notdisplay, int compact,
Scheme_Hash_Table *ht,
Scheme_Marshal_Tables *mt,
PrintParams *pp,
int as_prefab)
{
int i, size, common = 0;
Scheme_Object **elems, *elem;
#define FUNC_NAME print_vector
#define DEFINEEXTRA
#define ELMS_TYPE Scheme_Object **
#define ELM_TYPE Scheme_Object *
#define DO_COMPACT() do { \
print_compact(pp, CPT_VECTOR); \
print_compact_number(pp, size); \
} while(0);
#define DO_VEC_SIZE() do { \
if (SCHEME_VECTORP(vec)) \
size = SCHEME_VEC_SIZE(vec); \
else \
size = SCHEME_VEC_SIZE(SCHEME_CHAPERONE_VAL(vec)); \
} while(0);
#define DO_ELMS_SELECTOR() do { \
if (SCHEME_VECTORP(vec)) \
elems = SCHEME_VEC_ELS(vec); \
else \
elems = SCHEME_VEC_ELS(SCHEME_CHAPERONE_VAL(vec)); \
} while(0);
#define DO_ELM_SELECTOR() do { \
if (SCHEME_VECTORP(vec)) \
elem = SCHEME_VEC_ELS(vec)[i]; \
else \
elem = scheme_chaperone_vector_ref(vec, i); \
} while(0);
#define F_0 print_utf8_string(pp, "#0(", 0, 3)
#define F_D sprintf(buffer, "#%d(", size)
#define F_VECTOR print_utf8_string(pp, "(vector ", 0, 8)
#define F_ print_utf8_string(pp, "#(", 0, 2)
#define PRINT_ELM() do {\
print(elem, notdisplay, compact, ht, mt, pp); \
} while(0);
#include "print_vector.inc"
if (SCHEME_VECTORP(vec))
size = SCHEME_VEC_SIZE(vec);
else
size = SCHEME_VEC_SIZE(SCHEME_CHAPERONE_VAL(vec));
#define FUNC_NAME print_flvector
#define DEFINEEXTRA int used_buffer = 0; char buffer[100];
#define ELMS_TYPE double *
#define ELM_TYPE double
#define DO_COMPACT() do { \
print_escaped(pp, notdisplay, vec, ht, mt, 1); \
return; \
} while(0);
#define DO_VEC_SIZE() size = SCHEME_FLVEC_SIZE(vec);
#define DO_ELMS_SELECTOR() elems = SCHEME_FLVEC_ELS(vec);
#define DO_ELM_SELECTOR() elem = SCHEME_FLVEC_ELS(vec)[i];
#define F_0 print_utf8_string(pp, "#fl0(", 0, 5)
#define F_D sprintf(buffer, "#fl%d(", size)
#define F_VECTOR print_utf8_string(pp, "(flvector ", 0, 10)
#define F_ print_utf8_string(pp, "#fl(", 0, 4)
#define PRINT_ELM() do {\
scheme_double_to_string(elem, buffer, 100, 0, &used_buffer); \
print_utf8_string(pp, buffer, 0, -1); \
} while(0);
#include "print_vector.inc"
if (compact) {
print_compact(pp, CPT_VECTOR);
print_compact_number(pp, size);
} else {
if (SCHEME_VECTORP(vec))
elems = SCHEME_VEC_ELS(vec);
else
elems = SCHEME_VEC_ELS(SCHEME_CHAPERONE_VAL(vec));
for (i = size; i--; common++) {
if (!i || (elems[i] != elems[i - 1]))
break;
}
elems = NULL; /* Precise GC: because VEC_ELS is not aligned */
if (as_prefab) {
print_utf8_string(pp, "#s(", 0, 3);
} else if (notdisplay && pp->print_vec_shorthand && (notdisplay != 3)) {
if (size == 0) {
print_utf8_string(pp, "#0(", 0, 3);
} else {
char buffer[100];
sprintf(buffer, "#%d(", size);
print_utf8_string(pp, buffer, 0, -1);
size -= common;
}
} else if (notdisplay == 3)
print_utf8_string(pp, "(vector ", 0, 8);
else
print_utf8_string(pp, "#(", 0, 2);
}
for (i = 0; i < size; i++) {
if (SCHEME_VECTORP(vec))
elem = SCHEME_VEC_ELS(vec)[i];
else
elem = scheme_chaperone_vector_ref(vec, i);
print(elem, notdisplay, compact, ht, mt, pp);
if (i < (size - 1)) {
if (!compact)
print_utf8_string(pp, " ", 0, 1);
}
}
if (!compact)
print_utf8_string(pp, ")", 0, 1);
}
#define FUNC_NAME print_fxvector
#define DEFINEEXTRA
#define ELMS_TYPE Scheme_Object **
#define ELM_TYPE Scheme_Object *
#define DO_COMPACT() do { \
print_escaped(pp, notdisplay, vec, ht, mt, 1); \
return; \
} while(0);
#define DO_VEC_SIZE() size = SCHEME_FXVEC_SIZE(vec);
#define DO_ELMS_SELECTOR() elems = SCHEME_FXVEC_ELS(vec);
#define DO_ELM_SELECTOR() elem = SCHEME_FXVEC_ELS(vec)[i];
#define F_0 print_utf8_string(pp, "#fx0(", 0, 5)
#define F_D sprintf(buffer, "#fx%d(", size)
#define F_VECTOR print_utf8_string(pp, "(fxvector ", 0, 10)
#define F_ print_utf8_string(pp, "#fx(", 0, 4)
#define PRINT_ELM() do {\
print(elem, notdisplay, compact, ht, mt, pp); \
} while(0);
#include "print_vector.inc"
static void
print_char(Scheme_Object *charobj, int notdisplay, PrintParams *pp)

69
src/racket/src/print_vector.inc Normal file
View File

@ -0,0 +1,69 @@
static void
FUNC_NAME (Scheme_Object *vec, int notdisplay, int compact,
Scheme_Hash_Table *ht,
Scheme_Marshal_Tables *mt,
PrintParams *pp,
int as_prefab)
{
int i, size, common = 0;
ELMS_TYPE elems;
ELM_TYPE elem;
DEFINEEXTRA
DO_VEC_SIZE()
if (compact) {
DO_COMPACT()
} else {
DO_ELMS_SELECTOR()
for (i = size; i--; common++) {
if (!i || (elems[i] != elems[i - 1]))
break;
}
elems = NULL; /* Precise GC: because VEC_ELS is not aligned */
if (as_prefab) {
print_utf8_string(pp, "#s(", 0, 3);
} else if (notdisplay && pp->print_vec_shorthand && (notdisplay != 3)) {
if (size == 0) {
F_0;
} else {
char buffer[100];
F_D;
print_utf8_string(pp, buffer, 0, -1);
size -= common;
}
} else if (notdisplay == 3)
F_VECTOR;
else
F_;
}
for (i = 0; i < size; i++) {
DO_ELM_SELECTOR()
PRINT_ELM()
if (i < (size - 1)) {
if (!compact)
print_utf8_string(pp, " ", 0, 1);
}
}
if (!compact)
print_utf8_string(pp, ")", 0, 1);
}
#undef FUNC_NAME
#undef DEFINEEXTRA
#undef ELMS_TYPE
#undef ELM_TYPE
#undef DO_COMPACT
#undef DO_VEC_SIZE
#undef DO_ELMS_SELECTOR
#undef DO_ELM_SELECTOR
#undef F_0
#undef F_D
#undef F_VECTOR
#undef F_
#undef PRINT_ELM
/* vim: ft=c
*/

466
src/racket/src/read.c
View File

@ -142,6 +142,8 @@ static MZ_INLINE intptr_t SPAN(Scheme_Object *port, intptr_t pos) {
#define mz_shape_hash_list 2
#define mz_shape_hash_elem 3
#define mz_shape_vec_plus_infix 4
#define mz_shape_fl_vec 5
#define mz_shape_fx_vec 6
typedef struct Readtable {
Scheme_Object so;
@ -207,6 +209,20 @@ static Scheme_Object *read_vector(Scheme_Object *port, Scheme_Object *stxsrc,
Scheme_Hash_Table **ht,
Scheme_Object *indentation,
ReadParams *params, int allow_infix);
static Scheme_Object *read_flvector (Scheme_Object *port, Scheme_Object *stxsrc,
intptr_t line, intptr_t col, intptr_t pos,
int opener, char closer,
intptr_t requestLength, const mzchar *reqBuffer,
Scheme_Hash_Table **ht,
Scheme_Object *indentation,
ReadParams *params, int allow_infix);
static Scheme_Object *read_fxvector (Scheme_Object *port, Scheme_Object *stxsrc,
intptr_t line, intptr_t col, intptr_t pos,
int opener, char closer,
intptr_t requestLength, const mzchar *reqBuffer,
Scheme_Hash_Table **ht,
Scheme_Object *indentation,
ReadParams *params, int allow_infix);
static Scheme_Object *read_number(int init_ch,
Scheme_Object *port, Scheme_Object *stxsrc,
intptr_t line, intptr_t col, intptr_t pos,
@ -291,6 +307,25 @@ static Scheme_Object *readtable_call(int w_char, int ch, Scheme_Object *proc, Re
Scheme_Object *port, Scheme_Object *src, intptr_t line, intptr_t col, intptr_t pos,
int get_info,
Scheme_Hash_Table **ht, Scheme_Object *modpath_stx);
static Scheme_Object *read_flonum(Scheme_Object *port,
Scheme_Object *stxsrc,
Scheme_Hash_Table **ht,
Scheme_Object *indentation,
ReadParams *params,
int comment_mode);
static Scheme_Object *read_fixnum(Scheme_Object *port,
Scheme_Object *stxsrc,
Scheme_Hash_Table **ht,
Scheme_Object *indentation,
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);
#define READTABLE_WHITESPACE 0x1
#define READTABLE_CONTINUING 0x2
@ -831,6 +866,86 @@ static Scheme_Object *read_inner_inner_k(void)
#define MAX_GRAPH_ID_DIGITS 8
static int read_vector_length(Scheme_Object *port, Readtable *table, int *ch, mzchar *tagbuf, mzchar *vecbuf, int *vector_length, int *digits, int *overflow)
{
int i = 0, j = 0, nch;
*vector_length = -1;
*overflow = 0;
*digits = 0;
while (NOT_EOF_OR_SPECIAL((*ch)) && isdigit_ascii((*ch))) {
if (*digits <= MAX_GRAPH_ID_DIGITS)
(*digits)++;
/* For vector error msgs, want to drop leading zeros: */
if (j || ((*ch) != '0')) {
if (j < 60) {
vecbuf[j++] = (*ch);
} else if (j == 60) {
vecbuf[j++] = '.';
vecbuf[j++] = '.';
vecbuf[j++] = '.';
vecbuf[j] = 0;
}
}
/* For tag error msgs, want to keep zeros: */
if (i < 60) {
tagbuf[i++] = (*ch);
} else if (i == 60) {
tagbuf[i++] = '.';
tagbuf[i++] = '.';
tagbuf[i++] = '.';
tagbuf[i] = 0;
}
if (!(*overflow)) {
intptr_t old_len;
if (*vector_length < 0)
*vector_length = 0;
old_len = *vector_length;
*vector_length = ((*vector_length) * 10) + ((*ch) - 48);
if ((*vector_length < 0)|| ((*vector_length / 10) != old_len)) {
*overflow = 1;
}
}
nch = scheme_getc_special_ok(port);
(*ch) = nch;
}
if (*overflow)
*vector_length = -2;
vecbuf[j] = 0;
tagbuf[i] = 0;
return readtable_effective_char(table, (*ch));
}
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 ch2;
Scheme_Object *special_value;
ch2 = scheme_peekc_special_ok(port);
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: */
special_value = read_number(ch, port, stxsrc, line, col, pos,
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);
}
return special_value;
}
static Scheme_Object *
read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table **ht,
Scheme_Object *indentation, ReadParams *params,
@ -1027,15 +1142,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
case '+':
case '-':
case '.': /* ^^^ fallthrough ^^^ */
ch2 = scheme_peekc_special_ok(port);
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: */
special_value = read_number(ch, port, stxsrc, line, col, pos, 0, 0, 10, 0, ht, indentation, params, table);
} else {
special_value = read_symbol(ch, 0, port, stxsrc, line, col, pos, ht, indentation, params, table);
}
special_value = read_plus_minus_period_leading_number(port, stxsrc, ch, line, col, pos, 0, 0, ht, indentation, params, table);
break;
case '#':
ch = scheme_getc_special_ok(port);
@ -1143,9 +1250,65 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
? scheme_make_stx_w_offset(scheme_false, line, col, pos, 2, stxsrc, STX_SRCTAG)
: scheme_false);
} else {
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);
int next;
next = scheme_peekc_special_ok(port);
switch (next) {
case 'l':
case 'x':
{
int vector_length = -1;
int overflow = 0, digits = 0, effective_ch;
mzchar tagbuf[64], vecbuf[64]; /* just for errors */
int ch;
ch = scheme_getc_special_ok(port);
ch = scheme_getc_special_ok(port);
if (isdigit_ascii(ch)) {
effective_ch = read_vector_length(port, table, &ch, tagbuf, vecbuf, &vector_length, &digits, &overflow);
}
else {
effective_ch = ch;
}
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);
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);
}
}
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':
@ -1671,56 +1834,9 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
default:
{
int vector_length = -1;
int i = 0, j = 0, overflow = 0, digits = 0, effective_ch;
int overflow = 0, digits = 0, effective_ch;
mzchar tagbuf[64], vecbuf[64]; /* just for errors */
while (NOT_EOF_OR_SPECIAL(ch) && isdigit_ascii(ch)) {
if (digits <= MAX_GRAPH_ID_DIGITS)
digits++;
/* For vector error msgs, want to drop leading zeros: */
if (j || (ch != '0')) {
if (j < 60) {
vecbuf[j++] = ch;
} else if (j == 60) {
vecbuf[j++] = '.';
vecbuf[j++] = '.';
vecbuf[j++] = '.';
vecbuf[j] = 0;
}
}
/* For tag error msgs, want to keep zeros: */
if (i < 60) {
tagbuf[i++] = ch;
} else if (i == 60) {
tagbuf[i++] = '.';
tagbuf[i++] = '.';
tagbuf[i++] = '.';
tagbuf[i] = 0;
}
if (!overflow) {
intptr_t old_len;
if (vector_length < 0)
vector_length = 0;
old_len = vector_length;
vector_length = (vector_length * 10) + (ch - 48);
if ((vector_length < 0)|| ((vector_length / 10) != old_len)) {
overflow = 1;
}
}
ch = scheme_getc_special_ok(port);
}
if (overflow)
vector_length = -2;
vecbuf[j] = 0;
tagbuf[i] = 0;
effective_ch = readtable_effective_char(table, ch);
effective_ch = read_vector_length(port, table, &ch, tagbuf, vecbuf, &vector_length, &digits, &overflow);
if (effective_ch == '(')
return read_vector(port, stxsrc, line, col, pos, ch, ')', vector_length, vecbuf, ht, indentation, params, 0);
@ -2646,8 +2762,16 @@ read_list(Scheme_Object *port,
prefetched = NULL;
} else {
scheme_ungetc(ch, port);
car = read_inner(port, stxsrc, ht, indentation, params,
RETURN_FOR_SPECIAL_COMMENT);
switch (shape) {
case mz_shape_fl_vec:
car = read_flonum(port, NULL, ht, indentation, params, RETURN_FOR_SPECIAL_COMMENT);
break;
case mz_shape_fx_vec:
car = read_fixnum(port, NULL, ht, indentation, params, RETURN_FOR_SPECIAL_COMMENT);
break;
default:
car = read_inner(port, stxsrc, ht, indentation, params, RETURN_FOR_SPECIAL_COMMENT);
}
if (!car) continue; /* special was a comment */
}
/* can't be eof, due to check above */
@ -2810,6 +2934,116 @@ static Scheme_Object *attach_shape_property(Scheme_Object *list,
return list;
}
static Scheme_Object *read_flonum(Scheme_Object *port,
Scheme_Object *stxsrc,
Scheme_Hash_Table **ht,
Scheme_Object *indentation,
ReadParams *params,
int comment_mode)
{
intptr_t line = 0, col = 0, pos = 0;
intptr_t line2 = 0, col2 = 0, pos2 = 0;
Scheme_Object *n;
scheme_tell_all(port, &line, &col, &pos);
n = read_number_literal(port, stxsrc, 1, 0, ht, indentation, params, comment_mode);
if (SCHEME_DBLP(n))
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;
}
static Scheme_Object *read_fixnum(Scheme_Object *port,
Scheme_Object *stxsrc,
Scheme_Hash_Table **ht,
Scheme_Object *indentation,
ReadParams *params,
int comment_mode)
{
intptr_t line = 0, col = 0, pos = 0;
intptr_t line2 = 0, col2 = 0, pos2 = 0;
Scheme_Object *n;
scheme_tell_all(port, &line, &col, &pos);
n = read_number_literal(port, stxsrc, 0, 1, ht, indentation, params, comment_mode);
if (SCHEME_INTP(n))
return n;
else
scheme_tell_all(port, &line2, &col2, &pos2);
scheme_read_err(port, stxsrc, line, col, pos, pos2-pos, -1, indentation, "read: expected fixnum, got %V", n);
return NULL;
}
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)
{
int ch, ch2;
intptr_t line = 0, col = 0, pos = 0;
Scheme_Object *special_value = NULL;
Readtable *table;
table = params->table;
scheme_tell_all(port, &line, &col, &pos);
ch = scheme_getc_special_ok(port);
switch (ch) {
case '+':
case '-':
case '.': /* ^^^ fallthrough ^^^ */
special_value = read_plus_minus_period_leading_number(port, stxsrc, ch, line, col, pos, is_float, is_not_float, ht, indentation, params, table);
break;
case '#':
ch = scheme_getc_special_ok(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]");
}
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");
}
return special_value;
}
/*========================================================================*/
/* string reader */
/*========================================================================*/
@ -3205,78 +3439,44 @@ char *scheme_extract_indentation_suggestions(Scheme_Object *indentation)
/*========================================================================*/
/* vector reader */
/*========================================================================*/
#define FUNC_NAME read_vector
#define VTYPE_STR "vector"
#define VEC_TYPE Scheme_Object
#define ELMS_TYPE Scheme_Object **
#define ELM_TYPE Scheme_Object *
#define MZ_SHAPE allow_infix ? mz_shape_vec_plus_infix : mz_shape_vec
#define MK_VEC() (Scheme_Object *) scheme_make_vector(requestLength, NULL)
#define ELMS_SELECTOR SCHEME_VEC_ELS
#define ELM_SELECTOR
#define ELM_MAKE_ZERO scheme_make_integer(0)
#define VEC_SIZE SCHEME_VEC_SIZE
#include "read_vector.inc"
/* "#(" has been read */
static Scheme_Object *
read_vector (Scheme_Object *port,
Scheme_Object *stxsrc, intptr_t line, intptr_t col, intptr_t pos,
int opener, char closer,
intptr_t requestLength, const mzchar *reqBuffer,
Scheme_Hash_Table **ht,
Scheme_Object *indentation, ReadParams *params, int allow_infix)
/* requestLength == -1 => no request
requestLength == -2 => overflow */
{
Scheme_Object *lresult, *obj, *vec, **els;
int len, i;
#define FUNC_NAME read_fxvector
#define VTYPE_STR "fxvector"
#define VEC_TYPE Scheme_Object
#define ELMS_TYPE Scheme_Object **
#define ELM_TYPE Scheme_Object *
#define MZ_SHAPE mz_shape_fx_vec
#define MK_VEC() (Scheme_Object *) scheme_alloc_fxvector(requestLength)
#define ELMS_SELECTOR SCHEME_FXVEC_ELS
#define ELM_SELECTOR
#define ELM_MAKE_ZERO scheme_make_integer(0)
#define VEC_SIZE SCHEME_FXVEC_SIZE
#include "read_vector.inc"
lresult = read_list(port, stxsrc, line, col, pos, opener, closer,
allow_infix ? mz_shape_vec_plus_infix : mz_shape_vec,
1, ht, indentation, params);
if (requestLength == -2) {
scheme_raise_out_of_memory("read", "making vector of size %5", reqBuffer);
return NULL;
}
if (stxsrc)
obj = ((Scheme_Stx *)lresult)->val;
else
obj = lresult;
len = scheme_list_length(obj);
if (requestLength >= 0 && len > requestLength) {
char buffer[20];
sprintf(buffer, "%" PRIdPTR, requestLength);
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), 0, indentation,
"read: vector length %ld is too small, "
"%d values provided",
requestLength, len);
return NULL;
}
if (requestLength < 0)
requestLength = len;
vec = scheme_make_vector(requestLength, NULL);
els = SCHEME_VEC_ELS(vec);
for (i = 0; i < len ; i++) {
els[i] = SCHEME_CAR(obj);
obj = SCHEME_CDR(obj);
}
els = NULL;
if (i < requestLength) {
if (len)
obj = SCHEME_VEC_ELS(vec)[len - 1];
else {
obj = scheme_make_integer(0);
if (stxsrc)
obj = scheme_make_stx_w_offset(obj, line, col, pos, SPAN(port, pos), stxsrc, STX_SRCTAG);
}
els = SCHEME_VEC_ELS(vec);
for (; i < requestLength; i++) {
els[i] = obj;
}
els = NULL;
}
if (stxsrc) {
if (SCHEME_VEC_SIZE(vec) > 0)
SCHEME_SET_VECTOR_IMMUTABLE(vec);
((Scheme_Stx *)lresult)->val = vec;
return lresult;
} else
return vec;
}
#define FUNC_NAME read_flvector
#define VTYPE_STR "flvector"
#define VEC_TYPE Scheme_Double_Vector
#define ELMS_TYPE double *
#define ELM_TYPE double
#define MZ_SHAPE mz_shape_fl_vec
#define MK_VEC() scheme_alloc_flvector(requestLength)
#define ELMS_SELECTOR SCHEME_FLVEC_ELS
#define ELM_SELECTOR SCHEME_DBL_VAL
#define ELM_MAKE_ZERO 0.0
#define VEC_SIZE SCHEME_FLVEC_SIZE
#include "read_vector.inc"
/*========================================================================*/
/* symbol reader */

94
src/racket/src/read_vector.inc Normal file
View File

@ -0,0 +1,94 @@
/* "#(" has been read */
/* or "#fl(" has been read */
/* or "#fx(" has been read */
static Scheme_Object *
FUNC_NAME (Scheme_Object *port,
Scheme_Object *stxsrc, intptr_t line, intptr_t col, intptr_t pos,
int opener, char closer,
intptr_t requestLength, const mzchar *reqBuffer,
Scheme_Hash_Table **ht,
Scheme_Object *indentation, ReadParams *params, int allow_infix)
/* requestLength == -1 => no request
requestLength == -2 => overflow */
{
Scheme_Object *lresult, *obj;
VEC_TYPE *vec;
ELMS_TYPE els;
ELM_TYPE elm;
int len, i;
char *vtype_str;
vtype_str = VTYPE_STR;
lresult = read_list(port, stxsrc, line, col, pos, opener, closer,
MZ_SHAPE,
1, ht, indentation, params);
if (requestLength == -2) {
scheme_raise_out_of_memory("read", "making %s of size %5", vtype_str, reqBuffer);
return NULL;
}
if (stxsrc)
obj = ((Scheme_Stx *)lresult)->val;
else
obj = lresult;
len = scheme_list_length(obj);
if (requestLength >= 0 && len > requestLength) {
char buffer[20];
sprintf(buffer, "%" PRIdPTR, requestLength);
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), 0, indentation,
"read: %s length %ld is too small, "
"%d values provided",
vtype_str, requestLength, len);
return NULL;
}
if (requestLength < 0)
requestLength = len;
vec = MK_VEC();
els = ELMS_SELECTOR(vec);
for (i = 0; i < len ; i++) {
els[i] = ELM_SELECTOR(SCHEME_CAR(obj));
obj = SCHEME_CDR(obj);
}
els = NULL;
if (i < requestLength) {
if (len)
elm = ELMS_SELECTOR(vec)[len - 1];
else {
elm = ELM_MAKE_ZERO;
if (stxsrc)
obj = scheme_make_stx_w_offset(obj, line, col, pos, SPAN(port, pos), stxsrc, STX_SRCTAG);
}
els = ELMS_SELECTOR(vec);
for (; i < requestLength; i++) {
els[i] = elm;
}
els = NULL;
}
if (stxsrc) {
if (VEC_SIZE(vec) > 0)
SCHEME_SET_VECTOR_IMMUTABLE(vec);
((Scheme_Stx *)lresult)->val = (Scheme_Object *) vec;
return lresult;
} else
return (Scheme_Object *) vec;
}
#undef FUNC_NAME
#undef VTYPE_STR
#undef VEC_TYPE
#undef ELMS_TYPE
#undef ELM_TYPE
#undef MZ_SHAPE
#undef MK_VEC
#undef ELMS_SELECTOR
#undef ELM_SELECTOR
#undef ELM_MAKE_ZERO
#undef VEC_SIZE
/* vim: ft=c
*/

1
src/racket/src/schpriv.h
View File

@ -1878,6 +1878,7 @@ typedef struct {
XFORM_NONGCING Scheme_Object *scheme_make_small_bignum(intptr_t v, Small_Bignum *s);
char *scheme_number_to_string(int radix, Scheme_Object *obj);
char *scheme_double_to_string (double d, char* s, int slen, int was_single, int *used_buffer);
Scheme_Object *scheme_bignum_copy(const Scheme_Object *n);