diff --git a/collects/htdp/world.ss b/collects/htdp/world.ss index e777792e44..2335509770 100644 --- a/collects/htdp/world.ss +++ b/collects/htdp/world.ss @@ -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 diff --git a/collects/mrlib/gif.ss b/collects/mrlib/gif.ss index 6a05e77d2c..12a080413a 100644 --- a/collects/mrlib/gif.ss +++ b/collects/mrlib/gif.ss @@ -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?)) ) diff --git a/collects/scribblings/inside/values.scrbl b/collects/scribblings/inside/values.scrbl index 86fce543cd..637fb8c89b 100644 --- a/collects/scribblings/inside/values.scrbl +++ b/collects/scribblings/inside/values.scrbl @@ -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, diff --git a/src/mzscheme/include/scheme.h b/src/mzscheme/include/scheme.h index b09e9b42bc..8cfb3be923 100644 --- a/src/mzscheme/include/scheme.h +++ b/src/mzscheme/include/scheme.h @@ -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) diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index ddb9758d61..a601e61edf 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -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 */ diff --git a/src/mzscheme/src/list.c b/src/mzscheme/src/list.c index 452bd28875..162cdf7532 100644 --- a/src/mzscheme/src/list.c +++ b/src/mzscheme/src/list.c @@ -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; }