remove built-in reader and printing support for Honu
This is a backward-incompatible change, but I think it's unlikely that any code depends on the removed bindings or reader syntax.
This commit is contained in:
Matthew Flatt
parent
fe1909581b
commit
ec380e34ed
|
|
@ -54,6 +54,8 @@ can be nested.
|
|||
|
||||
@subsection{Structure}
|
||||
|
||||
@defmodule[honu/core/read]
|
||||
|
||||
After tokenization a Honu program will be converted into a tree with minimal
|
||||
structure. Enclosing tokens will be grouped into a single object represented as
|
||||
an s-expression. Enclosing tokens are pairs of (), {}, and [].
|
||||
|
|
|
|||
|
|
@ -28,8 +28,7 @@
|
|||
[print-struct #t]
|
||||
[print-box #t]
|
||||
[print-vector-length #f]
|
||||
[print-hash-table #t]
|
||||
[print-honu #f])
|
||||
[print-hash-table #t])
|
||||
(pretty-write datum port)))
|
||||
|
||||
(define-struct syntax-dummy (val))
|
||||
|
|
|
|||
|
|
@ -316,8 +316,7 @@ The arguments implement the port as follows:
|
|||
This procedure is called to implement @racket[port-next-location],
|
||||
but only if line counting is enabled for the port via
|
||||
@racket[port-count-lines!] (in which case @racket[count-lines!] is
|
||||
called). The @racket[read], @racket[read-syntax],
|
||||
@racket[read-honu], and @racket[read-honu-syntax] procedures
|
||||
called). The @racket[read] and @racket[read-syntax] procedures
|
||||
assume that reading a non-whitespace character increments the
|
||||
column and position by one.}
|
||||
|
||||
|
|
@ -354,13 +353,13 @@ The arguments implement the port as follows:
|
|||
|
||||
@itemize[
|
||||
|
||||
@item{When the special read is triggered by @racket[read-syntax],
|
||||
@racket[read-honu-syntax], or @racket[read-syntax/recursive], the
|
||||
@item{When the special read is triggered by @racket[read-syntax]
|
||||
or @racket[read-syntax/recursive], the
|
||||
procedure is passed four arguments that represent a source
|
||||
location.}
|
||||
|
||||
@item{When the special read is triggered by @racket[read],
|
||||
@racket[read-honu], @racket[read-byte-or-special],
|
||||
@racket[read-byte-or-special],
|
||||
@racket[read-char-or-special], @racket[peek-byte-or-special], or
|
||||
@racket[peek-char-or-special], the procedure is passed no arguments
|
||||
if it accepts zero arguments, otherwise it is passed four arguments
|
||||
|
|
@ -375,8 +374,7 @@ The arguments implement the port as follows:
|
|||
|
||||
If @racket[read-in] or @racket[peek] returns a special
|
||||
procedure when called by any reading procedure other than
|
||||
@racket[read], @racket[read-syntax], @racket[read-honu],
|
||||
@racket[read-honu-syntax], @racket[read-char-or-special],
|
||||
@racket[read], @racket[read-syntax], @racket[read-char-or-special],
|
||||
@racket[peek-char-or-special], @racket[read-byte-or-special], or
|
||||
@racket[peek-byte-or-special], then the @exnraise[exn:fail:contract].}
|
||||
|
||||
|
|
|
|||
|
|
@ -91,7 +91,6 @@
|
|||
|
||||
(provide margin-note/ref
|
||||
refalso moreref Guide guideintro guidealso guidesecref
|
||||
HonuManual
|
||||
raco-doc)
|
||||
|
||||
(define (margin-note/ref . s)
|
||||
|
|
@ -125,9 +124,6 @@
|
|||
|
||||
(define Guide
|
||||
(other-manual '(lib "scribblings/guide/guide.scrbl")))
|
||||
|
||||
(define HonuManual
|
||||
(other-manual '(lib "scribblings/honu/honu.scrbl")))
|
||||
|
||||
(define raco-doc
|
||||
'(lib "scribblings/raco/raco.scrbl"))
|
||||
|
|
|
|||
|
|
@ -16,8 +16,8 @@ bytes, and it can track @deftech{line locations} and @deftech{column
|
|||
locations}; this optional tracking must be specifically enabled for a
|
||||
port via @racket[port-count-lines!] or the
|
||||
@racket[port-count-lines-enabled] parameter. Position, line, and
|
||||
column locations for a port are used by @racket[read-syntax] and
|
||||
@racket[read-honu-syntax]. Position and line locations are numbered
|
||||
column locations for a port are used by @racket[read-syntax].
|
||||
Position and line locations are numbered
|
||||
from @math{1}; column locations are numbered from @math{0}.
|
||||
|
||||
When counting lines, Racket treats linefeed, return, and
|
||||
|
|
|
|||
|
|
@ -324,34 +324,3 @@ except that special-comment values (see
|
|||
|
||||
The default port read handler itself can be customized through a
|
||||
readtable; see @secref["readtables"] for more information.}
|
||||
|
||||
|
||||
@defproc[(read-honu [in input-port? (current-input-port)]) any]{
|
||||
|
||||
Like @racket[read], but for Honu mode (see @secref["parse-honu"]).}
|
||||
|
||||
@defproc[(read-honu-syntax [source-name any/c (object-name in)]
|
||||
[in input-port? (current-input-port)])
|
||||
(or/c syntax? eof-object?)]{
|
||||
|
||||
Like @racket[read-syntax], but for Honu mode (see
|
||||
@secref["parse-honu"]).}
|
||||
|
||||
@defproc[(read-honu/recursive [in input-port? (current-input-port)]
|
||||
[start (or/c char? #f) #f]
|
||||
[readtable (or/c readtable? #f) (current-readtable)]
|
||||
[graph? any/c #t])
|
||||
any]{
|
||||
|
||||
Like @racket[read/recursive], but for Honu mode (see
|
||||
@secref["parse-honu"]).}
|
||||
|
||||
@defproc[(read-honu-syntax/recursive [source-name any/c (object-name in)]
|
||||
[in input-port? (current-input-port)]
|
||||
[start (or/c char? #f) #f]
|
||||
[readtable (or/c readtable? #f) (current-readtable)]
|
||||
[graph? any/c #f])
|
||||
any]{
|
||||
|
||||
Like @racket[read-syntax/recursive], but for Honu mode (see
|
||||
@secref["parse-honu"]).}
|
||||
|
|
|
|||
|
|
@ -137,10 +137,6 @@ on the next character or characters in the input stream as follows:
|
|||
@dispatch[@cilitchar{#ci}]{switches case sensitivity; see @secref["parse-symbol"]}
|
||||
@dispatch[@cilitchar{#cs}]{switches case sensitivity; see @secref["parse-symbol"]}
|
||||
|
||||
@dispatch[@cilitchar["#sx"]]{starts a Racket expression; see @secref["parse-honu"]}
|
||||
|
||||
@dispatch[@litchar{#hx}]{starts a Honu expression; see @secref["parse-honu"]}
|
||||
|
||||
@dispatch[@litchar{#hash}]{starts a @tech{hash table}; see @secref["parse-hashtable"]}
|
||||
|
||||
@dispatch[@litchar{#reader}]{starts a reader extension use; see @secref["parse-reader"]}
|
||||
|
|
@ -879,9 +875,3 @@ effectively takes the place of @racketmodname[reader]. In other words,
|
|||
the @racketmodname[reader] meta-language generalizes the syntax of the
|
||||
module specified after @hash-lang[] to be a module path, and without
|
||||
the implicit addition of @litchar{/lang/reader} to the path.
|
||||
|
||||
|
||||
@section[#:tag "parse-honu"]{Honu Parsing}
|
||||
|
||||
See @|HonuManual| for information on @litchar{#hx} and
|
||||
@litchar{#sx}.
|
||||
|
|
|
|||
|
|
@ -326,11 +326,9 @@ character and the @racket[#f] readtable.}
|
|||
@section[#:tag "reader-procs"]{Reader-Extension Procedures}
|
||||
|
||||
Calls to @techlink{reader extension procedures} can be triggered
|
||||
through @racket[read], @racket[read/recursive], @racket[read-syntax],
|
||||
or @racket[read-honu-syntax]. In addition, a special-read procedure
|
||||
can be triggered by calls to @racket[read-honu],
|
||||
@racket[read-honu/recursive], @racket[read-honu-syntax],
|
||||
@racket[read-honu-syntax/recursive], @racket[read-char-or-special], or
|
||||
through @racket[read], @racket[read/recursive], or @racket[read-syntax].
|
||||
In addition, a special-read procedure
|
||||
can be triggered by calls to @racket[read-char-or-special], or
|
||||
by the context of @racket[read-bytes-avail!],
|
||||
@racket[peek-bytes-avail!*], @racket[read-bytes-avail!], and
|
||||
@racket[peek-bytes-avail!*].
|
||||
|
|
|
|||
|
|
@ -70,7 +70,7 @@ marshaling compiled @tech{syntax object}s.}
|
|||
@defproc[(syntax-original? [stx syntax?]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[stx] has the property that
|
||||
@racket[read-syntax] and @racket[read-honu-syntax] attach to the
|
||||
@racket[read-syntax] attaches to the
|
||||
@tech{syntax object}s that they generate (see @secref["stxprops"]), and if
|
||||
@racket[stx]'s @tech{lexical information} does not indicate that the
|
||||
object was introduced by a syntax transformer (see
|
||||
|
|
|
|||
|
|
@ -80,7 +80,7 @@ Racket adds properties to expanded syntax (often using
|
|||
a module is discovered, the @indexed-racket['protected] property is
|
||||
added to the identifier with a @racket[#t] value.}
|
||||
|
||||
@item{When @racket[read-syntax] or @racket[read-honu-syntax]
|
||||
@item{When @racket[read-syntax]
|
||||
generates a syntax object, it attaches a property to the object
|
||||
(using a private key) to mark the object as originating from a
|
||||
read. The @racket[syntax-original?] predicate looks for the property
|
||||
|
|
|
|||
|
|
@ -241,11 +241,6 @@ A parameter that controls printing in @racket[print] mode (as opposed
|
|||
to @racket[write] or @racket[display]); defaults to @racket[#t]. See
|
||||
@secref["printing"] for more information.}
|
||||
|
||||
@defboolparam[print-honu on?]{
|
||||
|
||||
A parameter that controls printing values in an alternate syntax. See
|
||||
@|HonuManual| for more information. The default is @racket[#f].}
|
||||
|
||||
|
||||
@defparam[print-syntax-width width (or/c +inf.0 0 (and/c exact-integer? (>/c 3)))]{
|
||||
|
||||
|
|
|
|||
|
|
@ -93,17 +93,6 @@ identifiers used by the @racket[reader-option]s.
|
|||
repeatedly to the module source until @racket[eof] is produced,
|
||||
but see also @racket[#:whole-body-readers?].
|
||||
|
||||
For example, a language built on the @secref[#:doc '(lib
|
||||
"scribblings/honu/honu.scrbl")]{Honu} reader could be
|
||||
implemented with:
|
||||
|
||||
@racketblock[
|
||||
(module reader syntax/module-reader
|
||||
module-path
|
||||
#:read read-honu
|
||||
#:read-syntax read-honu-syntax)
|
||||
]
|
||||
|
||||
See also @racket[#:wrapper1] and @racket[#:wrapper2], which
|
||||
support simple parameterization of readers rather than
|
||||
wholesale replacement.}
|
||||
|
|
|
|||
|
|
@ -2385,11 +2385,6 @@
|
|||
(cl->* (-> -Input-Port (->opt -Input-Port [Univ] Univ))
|
||||
(-> -Input-Port (->opt -Input-Port [Univ] Univ) -Void))]
|
||||
|
||||
[read-honu (->opt [-Input-Port] Univ)]
|
||||
[read-honu-syntax (->opt [Univ -Input-Port] (Un (-Syntax Univ) (-val eof)))]
|
||||
[read-honu/recursive (->opt [-Input-Port (-opt -Char) (-opt -Read-Table) Univ] Univ)]
|
||||
[read-honu-syntax/recursive (->opt [Univ -Input-Port (-opt -Char) (-opt -Read-Table) Univ] Univ)]
|
||||
|
||||
; Section 12.5
|
||||
; Writing
|
||||
[write (Univ [-Output-Port] . ->opt . -Void)]
|
||||
|
|
@ -2412,7 +2407,6 @@
|
|||
[print-boolean-long-form (-Param Univ B)]
|
||||
[print-reader-abbreviations (-Param Univ B)]
|
||||
[print-as-expression (-Param Univ B)]
|
||||
[print-honu (-Param Univ B)]
|
||||
[print-syntax-width (-Param (Un (-val +inf.0) -Nat) (Un (-val +inf.0) -Nat))]
|
||||
|
||||
[current-write-relative-directory (-Param (-opt -Path) (-opt -Path))]
|
||||
|
|
|
|||
|
|
@ -1,3 +1,6 @@
|
|||
Version 5.1.3.12
|
||||
Removed built-in support for Honu reading and printing
|
||||
|
||||
Version 5.1.3.11
|
||||
Added exn:fail:syntax:unbound
|
||||
Added date*, which extends date to include nanoseconds and a
|
||||
|
|
|
|||
|
|
@ -1237,8 +1237,6 @@ enum {
|
|||
MZCONFIG_SQUARE_BRACKETS_ARE_PARENS,
|
||||
MZCONFIG_CURLY_BRACES_ARE_PARENS,
|
||||
|
||||
MZCONFIG_HONU_MODE,
|
||||
|
||||
MZCONFIG_ERROR_PRINT_WIDTH,
|
||||
MZCONFIG_ERROR_PRINT_CONTEXT_LENGTH,
|
||||
|
||||
|
|
|
|||
|
|
@ -47,7 +47,7 @@ Scheme_Object *scheme_eval_compiled_sized_string_with_magic(const char *str, int
|
|||
if (!env)
|
||||
env = scheme_get_env(NULL);
|
||||
|
||||
expr = scheme_internal_read(port, NULL, 1, 1, 0, 0, 0, -1, NULL,
|
||||
expr = scheme_internal_read(port, NULL, 1, 1, 0, 0, -1, NULL,
|
||||
magic_sym, magic_val,
|
||||
NULL);
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -4156,7 +4156,7 @@ Scheme_Object *scheme_load_compiled_stx_string(const char *str, intptr_t len)
|
|||
|
||||
port = scheme_make_sized_byte_string_input_port(str, -len);
|
||||
|
||||
expr = scheme_internal_read(port, NULL, 1, 0, 0, 0, 0, -1, NULL, NULL, NULL, NULL);
|
||||
expr = scheme_internal_read(port, NULL, 1, 0, 0, 0, -1, NULL, NULL, NULL, NULL);
|
||||
|
||||
expr = _scheme_eval_compiled(expr, scheme_get_env(NULL));
|
||||
|
||||
|
|
|
|||
|
|
@ -48,12 +48,8 @@ static Scheme_Object *with_input_from_file (int, Scheme_Object *[]);
|
|||
static Scheme_Object *with_output_to_file (int, Scheme_Object *[]);
|
||||
static Scheme_Object *read_f (int, Scheme_Object *[]);
|
||||
static Scheme_Object *read_recur_f (int, Scheme_Object *[]);
|
||||
static Scheme_Object *read_honu_f (int, Scheme_Object *[]);
|
||||
static Scheme_Object *read_honu_recur_f (int, Scheme_Object *[]);
|
||||
static Scheme_Object *read_syntax_f (int, Scheme_Object *[]);
|
||||
static Scheme_Object *read_syntax_recur_f (int, Scheme_Object *[]);
|
||||
static Scheme_Object *read_honu_syntax_f (int, Scheme_Object *[]);
|
||||
static Scheme_Object *read_honu_syntax_recur_f (int, Scheme_Object *[]);
|
||||
static Scheme_Object *read_language (int, Scheme_Object *[]);
|
||||
static Scheme_Object *read_char (int, Scheme_Object *[]);
|
||||
static Scheme_Object *read_char_spec (int, Scheme_Object *[]);
|
||||
|
|
@ -261,10 +257,6 @@ scheme_init_port_fun(Scheme_Env *env)
|
|||
GLOBAL_NONCM_PRIM("read/recursive", read_recur_f, 0, 4, env);
|
||||
GLOBAL_NONCM_PRIM("read-syntax", read_syntax_f, 0, 2, env);
|
||||
GLOBAL_NONCM_PRIM("read-syntax/recursive", read_syntax_recur_f, 0, 5, env);
|
||||
GLOBAL_NONCM_PRIM("read-honu", read_honu_f, 0, 1, env);
|
||||
GLOBAL_NONCM_PRIM("read-honu/recursive", read_honu_recur_f, 0, 1, env);
|
||||
GLOBAL_NONCM_PRIM("read-honu-syntax", read_honu_syntax_f, 0, 2, env);
|
||||
GLOBAL_NONCM_PRIM("read-honu-syntax/recursive", read_honu_syntax_recur_f, 0, 2, env);
|
||||
GLOBAL_PRIM_W_ARITY2("read-language", read_language, 0, 2, 0, -1, env);
|
||||
GLOBAL_NONCM_PRIM("read-char", read_char, 0, 1, env);
|
||||
GLOBAL_NONCM_PRIM("read-char-or-special", read_char_spec, 0, 1, env);
|
||||
|
|
@ -2734,7 +2726,7 @@ static Scheme_Object *sch_default_read_handler(void *ignore, int argc, Scheme_Ob
|
|||
else
|
||||
src = NULL;
|
||||
|
||||
return scheme_internal_read(argv[0], src, -1, 0, 0, 0, 0, -1, NULL, NULL, NULL, NULL);
|
||||
return scheme_internal_read(argv[0], src, -1, 0, 0, 0, -1, NULL, NULL, NULL, NULL);
|
||||
}
|
||||
|
||||
static int extract_recur_args(const char *who, int argc, Scheme_Object **argv, int delta,
|
||||
|
|
@ -2764,7 +2756,7 @@ static int extract_recur_args(const char *who, int argc, Scheme_Object **argv, i
|
|||
return pre_char;
|
||||
}
|
||||
|
||||
static Scheme_Object *do_read_f(const char *who, int argc, Scheme_Object *argv[], int honu_mode, int recur)
|
||||
static Scheme_Object *do_read_f(const char *who, int argc, Scheme_Object *argv[], int recur)
|
||||
{
|
||||
Scheme_Object *port, *readtable = NULL;
|
||||
int pre_char = -1, recur_graph = recur;
|
||||
|
|
@ -2778,13 +2770,13 @@ static Scheme_Object *do_read_f(const char *who, int argc, Scheme_Object *argv[]
|
|||
else
|
||||
port = CURRENT_INPUT_PORT(scheme_current_config());
|
||||
|
||||
if (recur && !honu_mode) {
|
||||
if (recur) {
|
||||
pre_char = extract_recur_args(who, argc, argv, 0, &readtable, &recur_graph);
|
||||
}
|
||||
|
||||
ip = scheme_input_port_record(port);
|
||||
|
||||
if (ip->read_handler && !honu_mode && !recur) {
|
||||
if (ip->read_handler && !recur) {
|
||||
Scheme_Object *o[1];
|
||||
o[0] = port;
|
||||
return _scheme_apply(ip->read_handler, 1, o);
|
||||
|
|
@ -2792,7 +2784,7 @@ static Scheme_Object *do_read_f(const char *who, int argc, Scheme_Object *argv[]
|
|||
if (port == scheme_orig_stdin_port)
|
||||
scheme_flush_orig_outputs();
|
||||
|
||||
return scheme_internal_read(port, NULL, -1, 0, honu_mode,
|
||||
return scheme_internal_read(port, NULL, -1, 0,
|
||||
recur_graph, recur,
|
||||
pre_char, readtable,
|
||||
NULL, NULL, NULL);
|
||||
|
|
@ -2801,25 +2793,15 @@ static Scheme_Object *do_read_f(const char *who, int argc, Scheme_Object *argv[]
|
|||
|
||||
static Scheme_Object *read_f(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
return do_read_f("read", argc, argv, 0, 0);
|
||||
return do_read_f("read", argc, argv, 0);
|
||||
}
|
||||
|
||||
static Scheme_Object *read_recur_f(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
return do_read_f("read/recursive", argc, argv, 0, 1);
|
||||
return do_read_f("read/recursive", argc, argv, 1);
|
||||
}
|
||||
|
||||
static Scheme_Object *read_honu_f(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
return do_read_f("read-honu", argc, argv, 1, 0);
|
||||
}
|
||||
|
||||
static Scheme_Object *read_honu_recur_f(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
return do_read_f("read-honu/recursive", argc, argv, 1, 1);
|
||||
}
|
||||
|
||||
static Scheme_Object *do_read_syntax_f(const char *who, int argc, Scheme_Object *argv[], int honu_mode, int recur)
|
||||
static Scheme_Object *do_read_syntax_f(const char *who, int argc, Scheme_Object *argv[], int recur)
|
||||
{
|
||||
Scheme_Object *port, *readtable = NULL;
|
||||
int pre_char = -1, recur_graph = recur;
|
||||
|
|
@ -2833,13 +2815,13 @@ static Scheme_Object *do_read_syntax_f(const char *who, int argc, Scheme_Object
|
|||
else
|
||||
port = CURRENT_INPUT_PORT(scheme_current_config());
|
||||
|
||||
if (recur && !honu_mode) {
|
||||
if (recur) {
|
||||
pre_char = extract_recur_args(who, argc, argv, 1, &readtable, &recur_graph);
|
||||
}
|
||||
|
||||
ip = scheme_input_port_record(port);
|
||||
|
||||
if (ip->read_handler && !honu_mode && !recur) {
|
||||
if (ip->read_handler && !recur) {
|
||||
Scheme_Object *o[2], *result;
|
||||
o[0] = port;
|
||||
o[1] = (argc ? argv[0] : ip->name);
|
||||
|
|
@ -2861,7 +2843,7 @@ static Scheme_Object *do_read_syntax_f(const char *who, int argc, Scheme_Object
|
|||
if (port == scheme_orig_stdin_port)
|
||||
scheme_flush_orig_outputs();
|
||||
|
||||
return scheme_internal_read(port, src, -1, 0, honu_mode,
|
||||
return scheme_internal_read(port, src, -1, 0,
|
||||
recur, recur_graph,
|
||||
pre_char, readtable,
|
||||
NULL, NULL, NULL);
|
||||
|
|
@ -2870,22 +2852,12 @@ static Scheme_Object *do_read_syntax_f(const char *who, int argc, Scheme_Object
|
|||
|
||||
static Scheme_Object *read_syntax_f(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
return do_read_syntax_f("read-syntax", argc, argv, 0, 0);
|
||||
return do_read_syntax_f("read-syntax", argc, argv, 0);
|
||||
}
|
||||
|
||||
static Scheme_Object *read_syntax_recur_f(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
return do_read_syntax_f("read-syntax/recursive", argc, argv, 0, 1);
|
||||
}
|
||||
|
||||
static Scheme_Object *read_honu_syntax_f(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
return do_read_syntax_f("read-honu-syntax", argc, argv, 1, 0);
|
||||
}
|
||||
|
||||
static Scheme_Object *read_honu_syntax_recur_f(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
return do_read_syntax_f("read-honu-syntax/recursive", argc, argv, 1, 1);
|
||||
return do_read_syntax_f("read-syntax/recursive", argc, argv, 1);
|
||||
}
|
||||
|
||||
static Scheme_Object *read_language(int argc, Scheme_Object **argv)
|
||||
|
|
@ -4192,7 +4164,7 @@ static Scheme_Object *do_load_handler(void *data)
|
|||
}
|
||||
}
|
||||
|
||||
while ((obj = scheme_internal_read(port, lhd->stxsrc, 1, 0, 0, 0, 0, -1, NULL,
|
||||
while ((obj = scheme_internal_read(port, lhd->stxsrc, 1, 0, 0, 0, -1, NULL,
|
||||
NULL, NULL, lhd->delay_load_info))
|
||||
&& !SCHEME_EOFP(obj)) {
|
||||
save_array = NULL;
|
||||
|
|
@ -4278,7 +4250,7 @@ static Scheme_Object *do_load_handler(void *data)
|
|||
}
|
||||
|
||||
/* Check no more expressions: */
|
||||
d = scheme_internal_read(port, lhd->stxsrc, 1, 0, 0, 0, 0, -1, NULL, NULL, NULL, NULL);
|
||||
d = scheme_internal_read(port, lhd->stxsrc, 1, 0, 0, 0, -1, NULL, NULL, NULL, NULL);
|
||||
if (!SCHEME_EOFP(d)) {
|
||||
Scheme_Input_Port *ip;
|
||||
ip = scheme_input_port_record(port);
|
||||
|
|
|
|||
|
|
@ -83,7 +83,6 @@ typedef struct Scheme_Print_Params {
|
|||
char print_long_bools;
|
||||
char can_read_pipe_quote;
|
||||
char case_sens;
|
||||
char honu_mode;
|
||||
Scheme_Object *inspector;
|
||||
|
||||
char printing_quoted;
|
||||
|
|
@ -106,13 +105,13 @@ static void register_traversers(void);
|
|||
#endif
|
||||
|
||||
static void print_to_port(char *name, Scheme_Object *obj, Scheme_Object *port,
|
||||
int notdisplay, intptr_t maxl, int check_honu, Scheme_Object *qq_depth);
|
||||
int notdisplay, intptr_t maxl, Scheme_Object *qq_depth);
|
||||
static int print(Scheme_Object *obj, int notdisplay, int compact,
|
||||
Scheme_Hash_Table *ht,
|
||||
Scheme_Marshal_Tables *mt,
|
||||
PrintParams *p);
|
||||
static void print_char_string(const char *s, int l, const mzchar *us, int delta, int ul,
|
||||
int notdisplay, int honu_char, PrintParams *pp);
|
||||
int notdisplay, PrintParams *pp);
|
||||
static void print_byte_string(const char *s, int delta, int l, int notdisplay, PrintParams *pp);
|
||||
static void print_pair(Scheme_Object *pair, int notdisplay, int compact,
|
||||
Scheme_Hash_Table *ht,
|
||||
|
|
@ -126,7 +125,7 @@ static void print_vector(Scheme_Object *vec, int notdisplay, int compact,
|
|||
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, int check_honu,
|
||||
Scheme_Object *port, intptr_t maxl,
|
||||
Scheme_Object *qq_depth);
|
||||
|
||||
static void custom_write_struct(Scheme_Object *s, Scheme_Hash_Table *ht,
|
||||
|
|
@ -262,7 +261,7 @@ static void *print_to_port_k(void)
|
|||
: "write")
|
||||
: "display"),
|
||||
obj, port,
|
||||
p->ku.k.i2, p->ku.k.i1, p->ku.k.i3,
|
||||
p->ku.k.i2, p->ku.k.i1,
|
||||
depth);
|
||||
|
||||
return NULL;
|
||||
|
|
@ -305,7 +304,6 @@ void scheme_write_w_max(Scheme_Object *obj, Scheme_Object *port, intptr_t maxl)
|
|||
p->ku.k.p2 = obj;
|
||||
p->ku.k.i1 = maxl;
|
||||
p->ku.k.i2 = 1;
|
||||
p->ku.k.i3 = 0;
|
||||
p->ku.k.p3 = NULL;
|
||||
|
||||
(void)scheme_top_level_do(print_to_port_k, 0);
|
||||
|
|
@ -328,7 +326,6 @@ void scheme_display_w_max(Scheme_Object *obj, Scheme_Object *port, intptr_t maxl
|
|||
p->ku.k.p2 = obj;
|
||||
p->ku.k.i1 = maxl;
|
||||
p->ku.k.i2 = 0;
|
||||
p->ku.k.i3 = 0;
|
||||
p->ku.k.p3 = NULL;
|
||||
|
||||
(void)scheme_top_level_do(print_to_port_k, 0);
|
||||
|
|
@ -351,7 +348,6 @@ void scheme_print_w_max(Scheme_Object *obj, Scheme_Object *port, intptr_t maxl)
|
|||
p->ku.k.p2 = obj;
|
||||
p->ku.k.i1 = maxl;
|
||||
p->ku.k.i2 = 2;
|
||||
p->ku.k.i3 = 1;
|
||||
p->ku.k.p3 = NULL;
|
||||
|
||||
(void)scheme_top_level_do(print_to_port_k, 0);
|
||||
|
|
@ -368,20 +364,19 @@ static void *print_to_string_k(void)
|
|||
Scheme_Thread *p = scheme_current_thread;
|
||||
Scheme_Object *obj, *qq_depth;
|
||||
intptr_t *len, maxl;
|
||||
int iswrite, check_honu;
|
||||
int iswrite;
|
||||
|
||||
obj = (Scheme_Object *)p->ku.k.p1;
|
||||
len = (intptr_t *) mzALIAS p->ku.k.p2;
|
||||
maxl = p->ku.k.i1;
|
||||
iswrite = p->ku.k.i2;
|
||||
check_honu = p->ku.k.i3;
|
||||
qq_depth = (Scheme_Object *)p->ku.k.p3;
|
||||
|
||||
p->ku.k.p1 = NULL;
|
||||
p->ku.k.p2 = NULL;
|
||||
p->ku.k.p3 = NULL;
|
||||
|
||||
return (void *)print_to_string(obj, len, iswrite, NULL, maxl, check_honu, qq_depth);
|
||||
return (void *)print_to_string(obj, len, iswrite, NULL, maxl, qq_depth);
|
||||
}
|
||||
|
||||
char *scheme_write_to_string_w_max(Scheme_Object *obj, intptr_t *len, intptr_t maxl)
|
||||
|
|
@ -444,19 +439,19 @@ char *scheme_print_to_string(Scheme_Object *obj, intptr_t *len)
|
|||
void
|
||||
scheme_internal_write(Scheme_Object *obj, Scheme_Object *port)
|
||||
{
|
||||
print_to_port("write", obj, port, 1, -1, 0, NULL);
|
||||
print_to_port("write", obj, port, 1, -1, NULL);
|
||||
}
|
||||
|
||||
void
|
||||
scheme_internal_display(Scheme_Object *obj, Scheme_Object *port)
|
||||
{
|
||||
print_to_port("display", obj, port, 0, -1, 0, NULL);
|
||||
print_to_port("display", obj, port, 0, -1, NULL);
|
||||
}
|
||||
|
||||
void
|
||||
scheme_internal_print(Scheme_Object *obj, Scheme_Object *port, Scheme_Object *depth)
|
||||
{
|
||||
print_to_port("print", obj, port, 2, -1, 1, depth);
|
||||
print_to_port("print", obj, port, 2, -1, depth);
|
||||
}
|
||||
|
||||
#ifdef DO_STACK_CHECK
|
||||
|
|
@ -953,7 +948,6 @@ static char *
|
|||
print_to_string(Scheme_Object *obj,
|
||||
intptr_t * volatile len, int write,
|
||||
Scheme_Object *port, intptr_t maxl,
|
||||
int check_honu,
|
||||
Scheme_Object *qq_depth)
|
||||
{
|
||||
Scheme_Hash_Table * volatile ht;
|
||||
|
|
@ -995,7 +989,6 @@ print_to_string(Scheme_Object *obj,
|
|||
params.print_mpair_curly = 1;
|
||||
params.can_read_pipe_quote = 1;
|
||||
params.case_sens = 1;
|
||||
params.honu_mode = 0;
|
||||
params.inspector = scheme_false;
|
||||
params.print_syntax = -1;
|
||||
} else {
|
||||
|
|
@ -1057,11 +1050,6 @@ print_to_string(Scheme_Object *obj,
|
|||
params.case_sens = SCHEME_TRUEP(v);
|
||||
v = scheme_get_param(config, MZCONFIG_PRINT_LONG_BOOLEAN);
|
||||
params.print_long_bools = SCHEME_TRUEP(v);
|
||||
if (check_honu) {
|
||||
v = scheme_get_param(config, MZCONFIG_HONU_MODE);
|
||||
params.honu_mode = SCHEME_TRUEP(v);
|
||||
} else
|
||||
params.honu_mode = 0;
|
||||
v = scheme_get_param(config, MZCONFIG_INSPECTOR);
|
||||
params.inspector = v;
|
||||
}
|
||||
|
|
@ -1112,7 +1100,7 @@ print_to_string(Scheme_Object *obj,
|
|||
|
||||
static void
|
||||
print_to_port(char *name, Scheme_Object *obj, Scheme_Object *port, int notdisplay,
|
||||
intptr_t maxl, int check_honu, Scheme_Object *qq_depth)
|
||||
intptr_t maxl, Scheme_Object *qq_depth)
|
||||
{
|
||||
Scheme_Output_Port *op;
|
||||
char *str;
|
||||
|
|
@ -1122,7 +1110,7 @@ print_to_port(char *name, Scheme_Object *obj, Scheme_Object *port, int notdispla
|
|||
if (op->closed)
|
||||
scheme_raise_exn(MZEXN_FAIL, "%s: output port is closed", name);
|
||||
|
||||
str = print_to_string(obj, &len, notdisplay, port, maxl, check_honu, qq_depth);
|
||||
str = print_to_string(obj, &len, notdisplay, port, maxl, qq_depth);
|
||||
|
||||
scheme_write_byte_string(str, len, port);
|
||||
}
|
||||
|
|
@ -1301,7 +1289,7 @@ static void do_print_string(int compact, int notdisplay,
|
|||
print_compact_number(pp, l);
|
||||
print_this_string(pp, buf, 0, el);
|
||||
} else {
|
||||
print_char_string(buf, el, s, offset, l, notdisplay, 0, pp);
|
||||
print_char_string(buf, el, s, offset, l, notdisplay, pp);
|
||||
}
|
||||
|
||||
if (reset)
|
||||
|
|
@ -1722,15 +1710,6 @@ static void print_named(Scheme_Object *obj, const char *kind,
|
|||
print_utf8_string(pp, ">", 0, 1);
|
||||
}
|
||||
|
||||
static void always_scheme(PrintParams *pp, int reset)
|
||||
{
|
||||
if (pp->honu_mode) {
|
||||
print_utf8_string(pp, "#sx", 0, 3);
|
||||
if (reset)
|
||||
pp->honu_mode = 0;
|
||||
}
|
||||
}
|
||||
|
||||
static int to_quoted(Scheme_Object *obj, PrintParams *pp, int notdisplay)
|
||||
{
|
||||
if (notdisplay == 3) {
|
||||
|
|
@ -1768,7 +1747,6 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
/* notdisplay >= 3 => print at qq depth notdisplay - 3 */
|
||||
{
|
||||
int closed = 0;
|
||||
int save_honu_mode;
|
||||
|
||||
#if NO_COMPACT
|
||||
compact = 0;
|
||||
|
|
@ -1823,8 +1801,6 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
}
|
||||
}
|
||||
|
||||
save_honu_mode = pp->honu_mode;
|
||||
|
||||
if (ht && HAS_SUBSTRUCT(obj, ssQUICK)) {
|
||||
intptr_t val;
|
||||
|
||||
|
|
@ -1837,12 +1813,10 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
return 1;
|
||||
} else {
|
||||
if (val > 0) {
|
||||
always_scheme(pp, 1);
|
||||
sprintf(quick_buffer, "#%" PRIdPTR "=", (val - 3) >> 1);
|
||||
print_utf8_string(pp, quick_buffer, 0, -1);
|
||||
scheme_hash_set(ht, obj, (Scheme_Object *)(-val));
|
||||
} else {
|
||||
always_scheme(pp, 0);
|
||||
sprintf(quick_buffer, "#%" PRIdPTR "#", ((-val) - 3) >> 1);
|
||||
print_utf8_string(pp, quick_buffer, 0, -1);
|
||||
return 0;
|
||||
|
|
@ -1899,57 +1873,28 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
|
||||
symtab_set(pp, mt, obj);
|
||||
} else if (notdisplay) {
|
||||
if (pp->honu_mode) {
|
||||
/* Honu symbol... */
|
||||
if (is_kw)
|
||||
print_utf8_string(pp, "key(", 0, 4);
|
||||
else
|
||||
print_utf8_string(pp, "sym(", 0, 4);
|
||||
{
|
||||
int i;
|
||||
/* Check for fast case: */
|
||||
for (i = SCHEME_SYM_LEN(obj); i--; ) {
|
||||
if (((unsigned char *)SCHEME_SYM_VAL(obj))[i] > 127)
|
||||
break;
|
||||
}
|
||||
if (i < 0) {
|
||||
/* Fits as byte string (fast case) */
|
||||
print_byte_string((char *)obj, SCHEME_SYMSTR_OFFSET(obj), SCHEME_SYM_LEN(obj),
|
||||
notdisplay, pp);
|
||||
} else {
|
||||
/* Coerce to string (slower) */
|
||||
Scheme_Object *s;
|
||||
s = scheme_make_sized_offset_utf8_string((char *)obj,
|
||||
SCHEME_SYMSTR_OFFSET(obj),
|
||||
SCHEME_SYM_LEN(obj));
|
||||
do_print_string(0, notdisplay, pp, SCHEME_CHAR_STR_VAL(s), 0, SCHEME_CHAR_STRLEN_VAL(s));
|
||||
}
|
||||
}
|
||||
print_utf8_string(pp, ")", 0, 1);
|
||||
} else {
|
||||
const char *s;
|
||||
const char *s;
|
||||
|
||||
if (notdisplay >= 3) {
|
||||
if (SAME_OBJ(qq_ellipses, obj)) {
|
||||
/* no quoting */
|
||||
} else
|
||||
notdisplay = to_quoted(NULL, pp, notdisplay);
|
||||
}
|
||||
if (notdisplay >= 3) {
|
||||
if (SAME_OBJ(qq_ellipses, obj)) {
|
||||
/* no quoting */
|
||||
} else
|
||||
notdisplay = to_quoted(NULL, pp, notdisplay);
|
||||
}
|
||||
|
||||
if (is_kw)
|
||||
print_utf8_string(pp, "#:", 0, 2);
|
||||
s = scheme_symbol_name_and_size(obj, (uintptr_t *)&l,
|
||||
((pp->can_read_pipe_quote
|
||||
? SCHEME_SNF_PIPE_QUOTE
|
||||
: SCHEME_SNF_NO_PIPE_QUOTE)
|
||||
| (pp->case_sens
|
||||
? 0
|
||||
: SCHEME_SNF_NEED_CASE)
|
||||
| (is_kw
|
||||
? SCHEME_SNF_KEYWORD
|
||||
: 0)));
|
||||
print_utf8_string(pp, s, 0, l);
|
||||
}
|
||||
if (is_kw)
|
||||
print_utf8_string(pp, "#:", 0, 2);
|
||||
s = scheme_symbol_name_and_size(obj, (uintptr_t *)&l,
|
||||
((pp->can_read_pipe_quote
|
||||
? SCHEME_SNF_PIPE_QUOTE
|
||||
: SCHEME_SNF_NO_PIPE_QUOTE)
|
||||
| (pp->case_sens
|
||||
? 0
|
||||
: SCHEME_SNF_NEED_CASE)
|
||||
| (is_kw
|
||||
? SCHEME_SNF_KEYWORD
|
||||
: 0)));
|
||||
print_utf8_string(pp, s, 0, l);
|
||||
} else {
|
||||
if (is_kw)
|
||||
print_utf8_string(pp, "#:", 0, 2);
|
||||
|
|
@ -1976,7 +1921,6 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
}
|
||||
} else {
|
||||
if (notdisplay) {
|
||||
always_scheme(pp, 0);
|
||||
print_utf8_string(pp, "#", 0, 1);
|
||||
}
|
||||
print_byte_string(SCHEME_BYTE_STR_VAL(obj),
|
||||
|
|
@ -2012,14 +1956,6 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
print_compact(pp, CPT_CHAR);
|
||||
cv = SCHEME_CHAR_VAL(obj);
|
||||
print_compact_number(pp, cv);
|
||||
} else if (notdisplay && pp->honu_mode) {
|
||||
/* Honu char */
|
||||
char s[MAX_UTF8_CHAR_BYTES];
|
||||
mzchar us[1];
|
||||
int l;
|
||||
us[0] = SCHEME_CHAR_VAL(obj);
|
||||
l = scheme_utf8_encode(us, 0, 1, (unsigned char *)s, 0, 0);
|
||||
print_char_string(s, l, us, 0, 1, notdisplay, 1, pp);
|
||||
} else
|
||||
print_char(obj, notdisplay, pp);
|
||||
}
|
||||
|
|
@ -2051,8 +1987,6 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
print_escaped(pp, notdisplay, obj, ht, mt, 1);
|
||||
closed = 1;
|
||||
} else {
|
||||
if (SCHEME_COMPLEXP(obj))
|
||||
always_scheme(pp, 0);
|
||||
print_utf8_string(pp, scheme_number_to_string(10, obj), 0, -1);
|
||||
}
|
||||
}
|
||||
|
|
@ -2062,10 +1996,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
print_compact(pp, CPT_NULL);
|
||||
} else {
|
||||
notdisplay = to_quoted(NULL, pp, notdisplay);
|
||||
if (pp->honu_mode)
|
||||
print_utf8_string(pp, "null", 0, 4);
|
||||
else
|
||||
print_utf8_string(pp, "()", 0, 2);
|
||||
print_utf8_string(pp, "()", 0, 2);
|
||||
closed = 1;
|
||||
}
|
||||
}
|
||||
|
|
@ -2097,7 +2028,6 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
if (compact)
|
||||
print_compact(pp, CPT_BOX);
|
||||
else {
|
||||
always_scheme(pp, 1);
|
||||
notdisplay = to_quoted(obj, pp, notdisplay);
|
||||
if (notdisplay == 3)
|
||||
print_utf8_string(pp, "(box ", 0, 5);
|
||||
|
|
@ -2136,7 +2066,6 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
else
|
||||
print_compact_number(pp, 0);
|
||||
} else {
|
||||
always_scheme(pp, 1);
|
||||
notdisplay = to_quoted(obj, pp, notdisplay);
|
||||
if (notdisplay == 3)
|
||||
print_utf8_string(pp, "(hash ", 0, 6);
|
||||
|
|
@ -2236,8 +2165,6 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
{
|
||||
if (compact)
|
||||
print_compact(pp, CPT_TRUE);
|
||||
else if (pp->honu_mode)
|
||||
print_utf8_string(pp, "true", 0, 4);
|
||||
else if (pp->print_long_bools)
|
||||
print_utf8_string(pp, "#true", 0, 5);
|
||||
else
|
||||
|
|
@ -2247,8 +2174,6 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
{
|
||||
if (compact)
|
||||
print_compact(pp, CPT_FALSE);
|
||||
else if (pp->honu_mode)
|
||||
print_utf8_string(pp, "false", 0, 5);
|
||||
else if (pp->print_long_bools)
|
||||
print_utf8_string(pp, "#false", 0, 6);
|
||||
else
|
||||
|
|
@ -2716,7 +2641,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
char *str;
|
||||
print_utf8_string(pp, " ", 0, 1);
|
||||
str = print_to_string(scheme_syntax_to_datum((Scheme_Object *)stx, 0, NULL),
|
||||
&slen, 1, NULL, pp->print_syntax, 0, NULL);
|
||||
&slen, 1, NULL, pp->print_syntax, NULL);
|
||||
print_utf8_string(pp, str, 0, slen);
|
||||
}
|
||||
print_utf8_string(pp, ">", 0, 1);
|
||||
|
|
@ -3189,22 +3114,19 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
|||
closed = 1;
|
||||
}
|
||||
|
||||
if (save_honu_mode != pp->honu_mode)
|
||||
pp->honu_mode = save_honu_mode;
|
||||
|
||||
return (closed || compact);
|
||||
}
|
||||
|
||||
static void
|
||||
print_char_string(const char *str, int len,
|
||||
const mzchar *ustr, int delta, int ulen,
|
||||
int notdisplay, int honu_char, PrintParams *pp)
|
||||
int notdisplay, PrintParams *pp)
|
||||
{
|
||||
char minibuf[12], *esc;
|
||||
int a, i, v, ui, cont_utf8 = 0, isize;
|
||||
|
||||
if (notdisplay) {
|
||||
print_utf8_string(pp, honu_char ? "'" : "\"", 0, 1);
|
||||
print_utf8_string(pp, "\"", 0, 1);
|
||||
|
||||
for (a = i = ui = 0; i < len; i += isize, ui++) {
|
||||
v = ((unsigned char *)str)[i];
|
||||
|
|
@ -3212,16 +3134,7 @@ print_char_string(const char *str, int len,
|
|||
|
||||
switch (v) {
|
||||
case '\"':
|
||||
if (honu_char)
|
||||
esc = NULL;
|
||||
else
|
||||
esc = "\\\"";
|
||||
break;
|
||||
case '\'':
|
||||
if (honu_char)
|
||||
esc = "\\'";
|
||||
else
|
||||
esc = NULL;
|
||||
esc = "\\\"";
|
||||
break;
|
||||
case '\\': esc = "\\\\"; break;
|
||||
case '\a': esc = "\\a"; break;
|
||||
|
|
@ -3276,7 +3189,7 @@ print_char_string(const char *str, int len,
|
|||
if (a < i)
|
||||
print_utf8_string(pp, str, a, i-a);
|
||||
|
||||
print_utf8_string(pp, honu_char ? "'" : "\"", 0, 1);
|
||||
print_utf8_string(pp, "\"", 0, 1);
|
||||
} else if (len) {
|
||||
print_utf8_string(pp, str, 0, len);
|
||||
}
|
||||
|
|
@ -3440,57 +3353,6 @@ print_pair(Scheme_Object *pair, int notdisplay, int compact,
|
|||
super_compact = -1;
|
||||
}
|
||||
}
|
||||
} else if (pp->honu_mode) {
|
||||
/* Honu list printing */
|
||||
cdr = SCHEME_CDR(pair);
|
||||
while (SAME_TYPE(SCHEME_TYPE(cdr), pair_type)) {
|
||||
if (ht) {
|
||||
if (is_graph_point(ht, cdr)) {
|
||||
/* This needs a tag */
|
||||
break;
|
||||
}
|
||||
}
|
||||
cdr = SCHEME_CDR(cdr);
|
||||
}
|
||||
if (SCHEME_NULLP(cdr)) {
|
||||
/* Proper list without sharing. */
|
||||
print_utf8_string(pp, "list(", 0, 5);
|
||||
(void)print(SCHEME_CAR(pair), notdisplay, compact, ht, mt, pp);
|
||||
cdr = SCHEME_CDR(pair);
|
||||
while (SAME_TYPE(SCHEME_TYPE(cdr), pair_type)) {
|
||||
print_utf8_string(pp, ", ", 0, 2);
|
||||
(void)print(SCHEME_CAR(cdr), notdisplay, compact, ht, mt, pp);
|
||||
cdr = SCHEME_CDR(cdr);
|
||||
}
|
||||
print_utf8_string(pp, ")", 0, 1);
|
||||
} else {
|
||||
/* Use cons cells. */
|
||||
int cnt = 1;
|
||||
print_utf8_string(pp, "cons(", 0, 5);
|
||||
(void)print(SCHEME_CAR(pair), notdisplay, compact, ht, mt, pp);
|
||||
cdr = SCHEME_CDR(pair);
|
||||
while (SAME_TYPE(SCHEME_TYPE(cdr), pair_type)) {
|
||||
print_utf8_string(pp, ", ", 0, 2);
|
||||
if (ht) {
|
||||
if (is_graph_point(ht, cdr)) {
|
||||
/* This needs a tag */
|
||||
(void)print(cdr, notdisplay, compact, ht, mt, pp);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
print_utf8_string(pp, "cons(", 0, 5);
|
||||
(void)print(SCHEME_CAR(cdr), notdisplay, compact, ht, mt, pp);
|
||||
cnt++;
|
||||
cdr = SCHEME_CDR(cdr);
|
||||
}
|
||||
print_utf8_string(pp, ", ", 0, 2);
|
||||
(void)print(cdr, notdisplay, compact, ht, mt, pp);
|
||||
while (cnt--) {
|
||||
print_utf8_string(pp, ")", 0, 1);
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
if (compact) {
|
||||
|
|
@ -3607,19 +3469,14 @@ print_vector(Scheme_Object *vec, int notdisplay, int compact,
|
|||
print_utf8_string(pp, "#s(", 0, 3);
|
||||
} else if (notdisplay && pp->print_vec_shorthand && (notdisplay != 3)) {
|
||||
if (size == 0) {
|
||||
if (pp->honu_mode)
|
||||
print_utf8_string(pp, "vectorN(0", 0, 7);
|
||||
else
|
||||
print_utf8_string(pp, "#0(", 0, 3);
|
||||
print_utf8_string(pp, "#0(", 0, 3);
|
||||
} else {
|
||||
char buffer[100];
|
||||
sprintf(buffer, pp->honu_mode ? "vectorN(%d, " : "#%d(", size);
|
||||
sprintf(buffer, "#%d(", size);
|
||||
print_utf8_string(pp, buffer, 0, -1);
|
||||
size -= common;
|
||||
}
|
||||
} else if (pp->honu_mode)
|
||||
print_utf8_string(pp, "vector(", 0, 7);
|
||||
else if (notdisplay == 3)
|
||||
} else if (notdisplay == 3)
|
||||
print_utf8_string(pp, "(vector ", 0, 8);
|
||||
else
|
||||
print_utf8_string(pp, "#(", 0, 2);
|
||||
|
|
@ -3632,12 +3489,8 @@ print_vector(Scheme_Object *vec, int notdisplay, int compact,
|
|||
elem = scheme_chaperone_vector_ref(vec, i);
|
||||
print(elem, notdisplay, compact, ht, mt, pp);
|
||||
if (i < (size - 1)) {
|
||||
if (!compact) {
|
||||
if (pp->honu_mode)
|
||||
print_utf8_string(pp, ", ", 0, 2);
|
||||
else
|
||||
print_utf8_string(pp, " ", 0, 1);
|
||||
}
|
||||
if (!compact)
|
||||
print_utf8_string(pp, " ", 0, 1);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -13,7 +13,7 @@
|
|||
|
||||
#define USE_COMPILED_STARTUP 1
|
||||
|
||||
#define EXPECTED_PRIM_COUNT 1043
|
||||
#define EXPECTED_PRIM_COUNT 1038
|
||||
#define EXPECTED_UNSAFE_COUNT 78
|
||||
#define EXPECTED_FLFXNUM_COUNT 68
|
||||
#define EXPECTED_FUTURES_COUNT 11
|
||||
|
|
|
|||
|
|
@ -2082,7 +2082,7 @@ Scheme_Object *_scheme_apply_to_list (Scheme_Object *rator, Scheme_Object *rands
|
|||
Scheme_Object *_scheme_tail_apply_to_list (Scheme_Object *rator, Scheme_Object *rands);
|
||||
|
||||
Scheme_Object *scheme_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int cantfail,
|
||||
int honu_mode, int recur, int expose_comment, int pre_char, Scheme_Object *readtable,
|
||||
int recur, int expose_comment, int pre_char, Scheme_Object *readtable,
|
||||
Scheme_Object *magic_sym, Scheme_Object *magic_val,
|
||||
Scheme_Object *delay_load_info);
|
||||
void scheme_internal_display(Scheme_Object *obj, Scheme_Object *port);
|
||||
|
|
|
|||
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "5.1.3.11"
|
||||
#define MZSCHEME_VERSION "5.1.3.12"
|
||||
|
||||
#define MZSCHEME_VERSION_X 5
|
||||
#define MZSCHEME_VERSION_Y 1
|
||||
#define MZSCHEME_VERSION_Z 3
|
||||
#define MZSCHEME_VERSION_W 11
|
||||
#define MZSCHEME_VERSION_W 12
|
||||
|
||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
|
|||
|
|
@ -6651,8 +6651,6 @@ static void make_initial_config(Scheme_Thread *p)
|
|||
init_param(cells, paramz, MZCONFIG_PRINT_AS_QQ, scheme_true);
|
||||
init_param(cells, paramz, MZCONFIG_PRINT_SYNTAX_WIDTH, scheme_make_integer(32));
|
||||
|
||||
init_param(cells, paramz, MZCONFIG_HONU_MODE, scheme_false);
|
||||
|
||||
init_param(cells, paramz, MZCONFIG_COMPILE_MODULE_CONSTS, scheme_true);
|
||||
init_param(cells, paramz, MZCONFIG_USE_JIT, scheme_startup_use_jit ? scheme_true : scheme_false);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user