improve macros and docs for mpairs inside; change mrlib/gif to use scheme/base keywords
svn: r10781
This commit is contained in:
parent
e4a66b0d11
commit
447698bce1
|
@ -1,4 +1,4 @@
|
|||
#lang mzscheme
|
||||
#lang scheme/base
|
||||
|
||||
#|
|
||||
workshop experience:
|
||||
|
@ -61,15 +61,16 @@ Matthew
|
|||
;; Fri Dec 9 21:39:03 EST 2005: remoevd (update ... produce ...); added on-redraw
|
||||
;; Thu Dec 1 17:03:03 EST 2005: fixed place-image; all coordinates okay now
|
||||
|
||||
(require mzlib/class
|
||||
mzlib/kw
|
||||
mzlib/etc
|
||||
(require scheme/class
|
||||
scheme/local
|
||||
scheme/bool
|
||||
mred
|
||||
htdp/error
|
||||
htdp/image
|
||||
(only lang/htdp-beginner image?)
|
||||
(only-in lang/htdp-beginner image?)
|
||||
mrlib/cache-image-snip
|
||||
lang/prim)
|
||||
lang/prim
|
||||
(for-syntax scheme/base))
|
||||
|
||||
(require mrlib/gif)
|
||||
(require mzlib/runtime-path)
|
||||
|
@ -98,7 +99,7 @@ Matthew
|
|||
|
||||
;; image manipulation functions:
|
||||
;; =============================
|
||||
(provide (all-from htdp/image))
|
||||
(provide (all-from-out htdp/image))
|
||||
|
||||
(provide
|
||||
;; Scene is Image with pinhole in origin
|
||||
|
@ -811,9 +812,9 @@ Matthew
|
|||
[callback (lambda (before after)
|
||||
(string->symbol
|
||||
(string-append before n:str "-callback" after)))]
|
||||
[name (datum->syntax-object stx (callback "" ""))]
|
||||
[name0 (datum->syntax-object stx (callback "" "0"))]
|
||||
[set-name (datum->syntax-object stx (callback "set-" ""))])
|
||||
[name (datum->syntax stx (callback "" ""))]
|
||||
[name0 (datum->syntax stx (callback "" "0"))]
|
||||
[set-name (datum->syntax stx (callback "set-" ""))])
|
||||
#`(define-values (#,name #,name0 #,set-name)
|
||||
(values
|
||||
void void
|
||||
|
|
|
@ -1,12 +1,9 @@
|
|||
|
||||
(module gif mzscheme
|
||||
(require mzlib/class
|
||||
mzlib/file
|
||||
mred
|
||||
(module gif scheme/base
|
||||
(require scheme/gui/base
|
||||
scheme/class
|
||||
net/gifwrite
|
||||
mzlib/contract
|
||||
mzlib/kw
|
||||
mzlib/etc)
|
||||
scheme/contract)
|
||||
|
||||
(provide write-gif
|
||||
write-animated-gif)
|
||||
|
@ -69,7 +66,7 @@
|
|||
(define (write-gif bm filename)
|
||||
(write-gifs (list bm) #f filename #f))
|
||||
|
||||
(define/kw (write-animated-gif bms delay filename #:key [one-at-a-time? #f])
|
||||
(define (write-animated-gif bms delay filename #:one-at-a-time? [one-at-a-time? #f])
|
||||
(write-gifs bms delay filename one-at-a-time?))
|
||||
|
||||
)
|
||||
|
|
|
@ -28,7 +28,7 @@ of the type. For example, @cpp{scheme_make_pair} takes two
|
|||
@cpp{Scheme_Object*} values and returns the @scheme[cons] of the
|
||||
values.
|
||||
|
||||
The macro @cppi{SCHEME_TYPE} takes a @cpp{Scheme_Object *} and returns
|
||||
The macro @cppdef{SCHEME_TYPE} takes a @cpp{Scheme_Object *} and returns
|
||||
the type of the object. This macro performs the tag-bit check, and
|
||||
returns @cppi{scheme_integer_type} when the value is an immediate
|
||||
integer; otherwise, @cpp{SCHEME_TYPE} follows the pointer to get the
|
||||
|
@ -73,136 +73,140 @@ types:
|
|||
@cpp{scheme_true} and @cpp{scheme_false} are the only values of this
|
||||
type; use @cpp{SCHEME_FALSEP} to recognize @cpp{scheme_false} and use
|
||||
@cpp{SCHEME_TRUEP} to recognize anything except @cpp{scheme_false};
|
||||
test for this type with @cppi{SCHEME_BOOLP}}
|
||||
test for this type with @cppdef{SCHEME_BOOLP}}
|
||||
|
||||
@item{@cppdef{scheme_char_type} --- @cppi{SCHEME_CHAR_VAL}
|
||||
@item{@cppdef{scheme_char_type} --- @cppdef{SCHEME_CHAR_VAL}
|
||||
extracts the character (of type @cppi{mzchar}); test for this type
|
||||
with @cppi{SCHEME_CHARP}}
|
||||
with @cppdef{SCHEME_CHARP}}
|
||||
|
||||
@item{@cppdef{scheme_integer_type} --- fixnum integers, which are
|
||||
identified via the tag bit rather than following a pointer to this
|
||||
@cpp{Scheme_Type} value; @cppi{SCHEME_INT_VAL} extracts the integer;
|
||||
test for this type with @cppi{SCHEME_INTP}}
|
||||
@cpp{Scheme_Type} value; @cppdef{SCHEME_INT_VAL} extracts the integer;
|
||||
test for this type with @cppdef{SCHEME_INTP}}
|
||||
|
||||
@item{@cppdef{scheme_double_type} --- flonum inexact numbers;
|
||||
@cppi{SCHEME_FLOAT_VAL} or @cppi{SCHEME_DBL_VAL} extracts the
|
||||
floating-point value; test for this type with @cppi{SCHEME_DBLP}}
|
||||
@cppdef{SCHEME_FLOAT_VAL} or @cppdef{SCHEME_DBL_VAL} extracts the
|
||||
floating-point value; test for this type with @cppdef{SCHEME_DBLP}}
|
||||
|
||||
@item{@cppdef{scheme_float_type} --- single-precision flonum
|
||||
inexact numbers, when specifically enabled when compiling PLT Scheme;
|
||||
@cppi{SCHEME_FLOAT_VAL} or @cppi{SCHEME_FLT_VAL} extracts the
|
||||
floating-point value; test for this type with @cppi{SCHEME_FLTP}}
|
||||
@cppi{SCHEME_FLOAT_VAL} or @cppdef{SCHEME_FLT_VAL} extracts the
|
||||
floating-point value; test for this type with @cppdef{SCHEME_FLTP}}
|
||||
|
||||
@item{@cppdef{scheme_bignum_type} --- test for this type with
|
||||
@cppi{SCHEME_BIGNUMP}}
|
||||
@cppdef{SCHEME_BIGNUMP}}
|
||||
|
||||
@item{@cppdef{scheme_rational_type} --- test for this type with
|
||||
@cppi{SCHEME_RATIONALP}}
|
||||
@cppdef{SCHEME_RATIONALP}}
|
||||
|
||||
@item{@cppdef{scheme_complex_type} --- test for this type or
|
||||
@cpp{scheme_complex_izi_type} with @cppi{SCHEME_COMPLEXP}}
|
||||
@cpp{scheme_complex_izi_type} with @cppdef{SCHEME_COMPLEXP}}
|
||||
|
||||
@item{@cppdef{scheme_complex_izi_type} --- complex number with an inexact
|
||||
zero imaginary part (so it counts as a real number); test for this
|
||||
type specifically with @cppi{SCHEME_COMPLEX_IZIP}}
|
||||
type specifically with @cppdef{SCHEME_COMPLEX_IZIP}}
|
||||
|
||||
@item{@cppdef{scheme_char_string_type} --- @index['("strings"
|
||||
"conversion to C")]{@cppi{SCHEME_CHAR_STR_VAL}} extracts the string
|
||||
"conversion to C")]{@cppdef{SCHEME_CHAR_STR_VAL}} extracts the string
|
||||
as a @cpp{mzchar*}; the string is always nul-terminated, but may also
|
||||
contain embedded nul characters, and the Scheme string is modified if
|
||||
this string is modified; @cppi{SCHEME_CHAR_STRLEN_VAL} extracts the
|
||||
this string is modified; @cppdef{SCHEME_CHAR_STRLEN_VAL} extracts the
|
||||
string length (in characters, not counting the nul terminator); test
|
||||
for this type with @cppi{SCHEME_CHAR_STRINGP}}
|
||||
for this type with @cppdef{SCHEME_CHAR_STRINGP}}
|
||||
|
||||
@item{@cppdef{scheme_byte_string_type} ---
|
||||
@cppi{SCHEME_BYTE_STR_VAL} extracts the string as a @cpp{char*}; the
|
||||
@cppdef{SCHEME_BYTE_STR_VAL} extracts the string as a @cpp{char*}; the
|
||||
string is always nul-terminated, but may also contain embedded nul
|
||||
characters, and the Scheme string is modified if this string is
|
||||
modified; @cppi{SCHEME_BYTE_STRLEN_VAL} extracts the string length
|
||||
modified; @cppdef{SCHEME_BYTE_STRLEN_VAL} extracts the string length
|
||||
(in bytes, not counting the nul terminator); test for this type with
|
||||
@cppi{SCHEME_BYTE_STRINGP}}
|
||||
@cppdef{SCHEME_BYTE_STRINGP}}
|
||||
|
||||
@item{@cppdef{scheme_path_type} ---
|
||||
@index['("strings" "conversion to C")] @cppi{SCHEME_PATH_VAL}
|
||||
@index['("strings" "conversion to C")] @cppdef{SCHEME_PATH_VAL}
|
||||
extracts the path as a @cpp{char*}; the string is always
|
||||
nul-terminated; @cppi{SCHEME_PATH_LEN} extracts the path length (in
|
||||
nul-terminated; @cppdef{SCHEME_PATH_LEN} extracts the path length (in
|
||||
bytes, not counting the nul terminator); test for this type with
|
||||
@cppi{SCHEME_PATHP}}
|
||||
@cppdef{SCHEME_PATHP}}
|
||||
|
||||
@item{@cppdef{scheme_symbol_type} --- @cppi{SCHEME_SYM_VAL}
|
||||
@item{@cppdef{scheme_symbol_type} --- @cppdef{SCHEME_SYM_VAL}
|
||||
extracts the symbol's string as a @cpp{char*} UTF-8 encoding (do not
|
||||
modify this string); @cppi{SCHEME_SYM_LEN} extracts the number of
|
||||
modify this string); @cppdef{SCHEME_SYM_LEN} extracts the number of
|
||||
bytes in the symbol name (not counting the nul terminator); test for
|
||||
this type with @cppi{SCHEME_SYMBOLP}; 3m: see @secref["im:3m"] for
|
||||
this type with @cppdef{SCHEME_SYMBOLP}; 3m: see @secref["im:3m"] for
|
||||
a caution about @cppi{SCHEME_SYM_VAL}}
|
||||
|
||||
@item{@cppdef{scheme_keyword_type} --- @cppi{SCHEME_KEYWORD_VAL}
|
||||
@item{@cppdef{scheme_keyword_type} --- @cppdef{SCHEME_KEYWORD_VAL}
|
||||
extracts the keywors's string (without the leading hash colon) as a
|
||||
@cpp{char*} UTF-8 encoding (do not modify this string);
|
||||
@cppi{SCHEME_KEYWORD_LEN} extracts the number of bytes in the keyword
|
||||
@cppdef{SCHEME_KEYWORD_LEN} extracts the number of bytes in the keyword
|
||||
name (not counting the nul terminator); test for this type with
|
||||
@cppi{SCHEME_KEYWORDP}; 3m: see @secref["im:3m"] for a caution
|
||||
@cppdef{SCHEME_KEYWORDP}; 3m: see @secref["im:3m"] for a caution
|
||||
about @cppi{SCHEME_KEYWORD_VAL}}
|
||||
|
||||
@item{@cppdef{scheme_box_type} --- @cppi{SCHEME_BOX_VAL}
|
||||
@item{@cppdef{scheme_box_type} --- @cppdef{SCHEME_BOX_VAL}
|
||||
extracts/sets the boxed value; test for this type with
|
||||
@cppi{SCHEME_BOXP}}
|
||||
@cppdef{SCHEME_BOXP}}
|
||||
|
||||
@item{@cppdef{scheme_pair_type} --- @cppi{SCHEME_CAR} extracts/sets
|
||||
the @scheme{car} and @cppi{SCHEME_CDR} extracts/sets the
|
||||
@scheme{cdr}; test for this type with @cppi{SCHEME_PAIRP}}
|
||||
@item{@cppdef{scheme_pair_type} --- @cppdef{SCHEME_CAR} extracts/sets
|
||||
the @scheme[car] and @cppdef{SCHEME_CDR} extracts/sets the
|
||||
@scheme[cdr]; test for this type with @cppdef{SCHEME_PAIRP}}
|
||||
|
||||
@item{@cppdef{scheme_vector_type} --- @cppi{SCHEME_VEC_SIZE}
|
||||
extracts the length and @cppi{SCHEME_VEC_ELS} extracts the array of
|
||||
@item{@cppdef{scheme_mutable_pair_type} --- @cppdef{SCHEME_MCAR} extracts/sets
|
||||
the @scheme[mcar] and @cppdef{SCHEME_MCDR} extracts/sets the
|
||||
@scheme[mcdr]; test for this type with @cppdef{SCHEME_MPAIRP}}
|
||||
|
||||
@item{@cppdef{scheme_vector_type} --- @cppdef{SCHEME_VEC_SIZE}
|
||||
extracts the length and @cppdef{SCHEME_VEC_ELS} extracts the array of
|
||||
Scheme values (the Scheme vector is modified when this array is
|
||||
modified); test for this type with @cppi{SCHEME_VECTORP}; 3m: see
|
||||
modified); test for this type with @cppdef{SCHEME_VECTORP}; 3m: see
|
||||
@secref["im:3m"] for a caution about @cppi{SCHEME_VEC_ELS}}
|
||||
|
||||
@item{@cppdef{scheme_structure_type} --- structure instances; test
|
||||
for this type with @cppi{SCHEME_STRUCTP}}
|
||||
for this type with @cppdef{SCHEME_STRUCTP}}
|
||||
|
||||
@item{@cppdef{scheme_struct_type_type} --- structure types; test for
|
||||
this type with @cppi{SCHEME_STRUCT_TYPEP}}
|
||||
this type with @cppdef{SCHEME_STRUCT_TYPEP}}
|
||||
|
||||
@item{@cppdef{scheme_struct_property_type} --- structure type
|
||||
properties}
|
||||
|
||||
@item{@cppdef{scheme_input_port_type} --- @cppi{SCHEME_INPORT_VAL}
|
||||
@item{@cppdef{scheme_input_port_type} --- @cppdef{SCHEME_INPORT_VAL}
|
||||
extracts/sets the user data pointer; test for just this type with
|
||||
@cppi{SCHEME_INPORTP}, but use @cppi{SCHEME_INPUT_PORTP} to recognize
|
||||
@cppdef{SCHEME_INPORTP}, but use @cppdef{SCHEME_INPUT_PORTP} to recognize
|
||||
all input ports (including structures with the
|
||||
@scheme[prop:input-port] property)}
|
||||
|
||||
@item{@cppdef{scheme_output_port_type} --- @cppi{SCHEME_OUTPORT_VAL}
|
||||
@item{@cppdef{scheme_output_port_type} --- @cppdef{SCHEME_OUTPORT_VAL}
|
||||
extracts/sets the user data pointer; test for just this type with
|
||||
@cppi{SCHEME_OUTPORTP}, but use @cppi{SCHEME_OUTPUT_PORTP} to
|
||||
@cppdef{SCHEME_OUTPORTP}, but use @cppdef{SCHEME_OUTPUT_PORTP} to
|
||||
recognize all output ports (including structures with the
|
||||
@scheme[prop:output-port] property)}
|
||||
|
||||
@item{@cppdef{scheme_thread_type} --- thread descriptors; test for
|
||||
this type with @cppi{SCHEME_THREADP}}
|
||||
this type with @cppdef{SCHEME_THREADP}}
|
||||
|
||||
@item{@cppdef{scheme_sema_type} --- semaphores; test for this type
|
||||
with @cppi{SCHEME_SEMAP}}
|
||||
with @cppdef{SCHEME_SEMAP}}
|
||||
|
||||
@item{@cppdef{scheme_hash_table_type} --- test for this type with
|
||||
@cppi{SCHEME_HASHTP}}
|
||||
@cppdef{SCHEME_HASHTP}}
|
||||
|
||||
@item{@cppdef{scheme_bucket_table_type} --- test for this type with
|
||||
@cppi{SCHEME_BUCKTP}}
|
||||
@cppdef{SCHEME_BUCKTP}}
|
||||
|
||||
@item{@cppdef{scheme_weak_box_type} --- test for this type with
|
||||
@cppi{SCHEME_WEAKP}; @cppi{SCHEME_WEAK_PTR} extracts the contained
|
||||
@cppdef{SCHEME_WEAKP}; @cppdef{SCHEME_WEAK_PTR} extracts the contained
|
||||
object, or @cpp{NULL} after the content is collected; do not set the
|
||||
content of a weak box}
|
||||
|
||||
@item{@cppdef{scheme_namespace_type} --- namespaces; test for this
|
||||
type with @cppi{SCHEME_NAMESPACEP}}
|
||||
type with @cppdef{SCHEME_NAMESPACEP}}
|
||||
|
||||
@item{@cppdef{scheme_cpointer_type} --- @|void-const| pointer with a
|
||||
type-describing @cpp{Scheme_Object}; @cppi{SCHEME_CPTR_VAL} extracts
|
||||
the pointer and @cppi{SCHEME_CPTR_TYPE} extracts the type tag object;
|
||||
test for this type with @cppi{SCHEME_CPTRP}. The tag is used when
|
||||
type-describing @cpp{Scheme_Object}; @cppdef{SCHEME_CPTR_VAL} extracts
|
||||
the pointer and @cppdef{SCHEME_CPTR_TYPE} extracts the type tag object;
|
||||
test for this type with @cppdef{SCHEME_CPTRP}. The tag is used when
|
||||
printing such objects when it's a symbol, a byte string, a string, or
|
||||
a pair holding one of these in its car.}
|
||||
|
||||
|
@ -229,11 +233,11 @@ The following are the procedure types:
|
|||
procedure}
|
||||
|
||||
@item{@cppdef{scheme_native_closure_type} --- a procedure with
|
||||
native code generated by the just-in-time compiler}}
|
||||
native code generated by the just-in-time compiler}
|
||||
|
||||
}
|
||||
|
||||
The predicate @cppi{SCHEME_PROCP} returns 1 for all procedure types
|
||||
The predicate @cppdef{SCHEME_PROCP} returns 1 for all procedure types
|
||||
and 0 for anything else.
|
||||
|
||||
The following are additional number predicates:
|
||||
|
@ -263,19 +267,19 @@ There are six global constants:
|
|||
@itemize{
|
||||
|
||||
@item{@cppdef{scheme_null} --- test for this value with
|
||||
@cppi{SCHEME_NULLP}}
|
||||
@cppdef{SCHEME_NULLP}}
|
||||
|
||||
@item{@cppdef{scheme_eof} --- test for this value with
|
||||
@cppi{SCHEME_EOFP}}
|
||||
@cppdef{SCHEME_EOFP}}
|
||||
|
||||
@item{@cppdef{scheme_true}}
|
||||
|
||||
@item{@cppdef{scheme_false} --- test for this value with
|
||||
@cppi{SCHEME_FALSEP}; test @italic{against} it with
|
||||
@cppi{SCHEME_TRUEP}}
|
||||
@cppdef{SCHEME_FALSEP}; test @italic{against} it with
|
||||
@cppdef{SCHEME_TRUEP}}
|
||||
|
||||
@item{@cppdef{scheme_void} --- test for this value with
|
||||
@cppi{SCHEME_VOIDP}}
|
||||
@cppdef{SCHEME_VOIDP}}
|
||||
|
||||
@item{@cppdef{scheme_undefined}}
|
||||
|
||||
|
@ -290,11 +294,11 @@ As noted in @secref["im:unicode"], a Scheme character is a Unicode
|
|||
are @cpp{mzchar} arrays. PLT Scheme also supplies byte strings, which
|
||||
are @cpp{char} arrays.
|
||||
|
||||
For a character string @var{s}, @cpp{SCHEME_CHAR_STR_VAL(@var{s})}
|
||||
For a character string @var{s}, @cpp{@cpp{SCHEME_CHAR_STR_VAL}(@var{s})}
|
||||
produces a pointer to @cpp{mzchar}s, not @cpp{char}s. Convert a
|
||||
character string to its UTF-8 encoding as byte string with
|
||||
@cpp{scheme_char_string_to_byte_string}. For a byte string
|
||||
@var{bs}, @cpp{SCHEME_BYTE_STR_VAL(@var{bs})} produces a pointer
|
||||
@var{bs}, @cpp{@cpp{SCHEME_BYTE_STR_VAL}(@var{bs})} produces a pointer
|
||||
to @cpp{char}s. The function
|
||||
@cpp{scheme_byte_string_to_char_string} decodes a byte string as
|
||||
UTF-8 and produces a character string. The functions
|
||||
|
@ -682,7 +686,7 @@ Creates a C-pointer object that encapsulates both @var{ptr} and @var{offset}.
|
|||
Installs a printer to be used for printing (or writing or displaying)
|
||||
values that have the type tag @var{type}.
|
||||
|
||||
The type of @var{printer} is defined as follows:\cppIndex{scheme_Type_Printer}
|
||||
The type of @var{printer} is defined as follows:
|
||||
|
||||
@verbatim[#:indent 2]{
|
||||
typedef void (*Scheme_Type_Printer)(Scheme_Object *v, int dis,
|
||||
|
|
|
@ -415,7 +415,8 @@ typedef long (*Scheme_Secondary_Hash_Proc)(Scheme_Object *obj, void *cycle_data)
|
|||
|
||||
#define SCHEME_NULLP(obj) SAME_OBJ(obj, scheme_null)
|
||||
#define SCHEME_PAIRP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_pair_type)
|
||||
#define SCHEME_MUTABLE_PAIRP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_mutable_pair_type)
|
||||
#define SCHEME_MPAIRP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_mutable_pair_type)
|
||||
#define SCHEME_MUTABLE_PAIRP(obj) SCHEME_MPAIRP(obj)
|
||||
#define SCHEME_LISTP(obj) (SCHEME_NULLP(obj) || SCHEME_PAIRP(obj))
|
||||
|
||||
#define SCHEME_RPAIRP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_raw_pair_type)
|
||||
|
@ -529,6 +530,9 @@ typedef long (*Scheme_Secondary_Hash_Proc)(Scheme_Object *obj, void *cycle_data)
|
|||
#define SCHEME_CAAR(obj) (SCHEME_CAR (SCHEME_CAR (obj)))
|
||||
#define SCHEME_CDDR(obj) (SCHEME_CDR (SCHEME_CDR (obj)))
|
||||
|
||||
#define SCHEME_MCAR(obj) (((Scheme_Simple_Object *)(obj))->u.pair_val.car)
|
||||
#define SCHEME_MCDR(obj) (((Scheme_Simple_Object *)(obj))->u.pair_val.cdr)
|
||||
|
||||
#define SCHEME_VEC_SIZE(obj) (((Scheme_Vector *)(obj))->size)
|
||||
#define SCHEME_VEC_ELS(obj) (((Scheme_Vector *)(obj))->els)
|
||||
#define SCHEME_VEC_BASE(obj) SCHEME_VEC_ELS(obj)
|
||||
|
|
|
@ -4187,8 +4187,8 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
|
|||
inline_alloc(jitter, sizeof(Scheme_Simple_Object), scheme_mutable_pair_type, 1, 0);
|
||||
CHECK_LIMIT();
|
||||
|
||||
jit_stxi_p((long)&SCHEME_CAR(0x0) + sizeof(long), JIT_V1, JIT_R0);
|
||||
jit_stxi_p((long)&SCHEME_CDR(0x0) + sizeof(long), JIT_V1, JIT_R1);
|
||||
jit_stxi_p((long)&SCHEME_MCAR(0x0) + sizeof(long), JIT_V1, JIT_R0);
|
||||
jit_stxi_p((long)&SCHEME_MCDR(0x0) + sizeof(long), JIT_V1, JIT_R1);
|
||||
jit_addi_p(JIT_R0, JIT_V1, sizeof(long));
|
||||
#else
|
||||
/* Non-inlined alloc */
|
||||
|
|
|
@ -859,9 +859,9 @@ scheme_checked_cdr (int argc, Scheme_Object *argv[])
|
|||
Scheme_Object *
|
||||
scheme_checked_mcar (int argc, Scheme_Object *argv[])
|
||||
{
|
||||
if (!SCHEME_MUTABLE_PAIRP(argv[0]))
|
||||
if (!SCHEME_MPAIRP(argv[0]))
|
||||
scheme_wrong_type("mcar", "mutable-pair", 0, argc, argv);
|
||||
return (SCHEME_CAR (argv[0]));
|
||||
return (SCHEME_MCAR (argv[0]));
|
||||
}
|
||||
|
||||
Scheme_Object *
|
||||
|
@ -870,26 +870,26 @@ scheme_checked_mcdr (int argc, Scheme_Object *argv[])
|
|||
if (!SCHEME_MUTABLE_PAIRP(argv[0]))
|
||||
scheme_wrong_type("mcdr", "mutable-pair", 0, argc, argv);
|
||||
|
||||
return (SCHEME_CDR (argv[0]));
|
||||
return (SCHEME_MCDR (argv[0]));
|
||||
}
|
||||
|
||||
Scheme_Object *
|
||||
scheme_checked_set_mcar (int argc, Scheme_Object *argv[])
|
||||
{
|
||||
if (!SCHEME_MUTABLE_PAIRP(argv[0]))
|
||||
if (!SCHEME_MPAIRP(argv[0]))
|
||||
scheme_wrong_type("set-mcar!", "mutable-pair", 0, argc, argv);
|
||||
|
||||
SCHEME_CAR(argv[0]) = argv[1];
|
||||
SCHEME_MCAR(argv[0]) = argv[1];
|
||||
return scheme_void;
|
||||
}
|
||||
|
||||
Scheme_Object *
|
||||
scheme_checked_set_mcdr (int argc, Scheme_Object *argv[])
|
||||
{
|
||||
if (!SCHEME_MUTABLE_PAIRP(argv[0]))
|
||||
if (!SCHEME_MPAIRP(argv[0]))
|
||||
scheme_wrong_type("set-mcdr!", "mutable-pair", 0, argc, argv);
|
||||
|
||||
SCHEME_CDR(argv[0]) = argv[1];
|
||||
SCHEME_MCDR(argv[0]) = argv[1];
|
||||
return scheme_void;
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user