diff --git a/collects/lang/htdp-advanced.ss b/collects/lang/htdp-advanced.ss index 45af174122..1e2bad565f 100644 --- a/collects/lang/htdp-advanced.ss +++ b/collects/lang/htdp-advanced.ss @@ -51,6 +51,9 @@ ;; [advanced-contract contract] ;; [advanced-define-data define-data] ) + check-expect + check-within + check-error #%datum #%top-interaction empty true false) @@ -62,6 +65,4 @@ (all-from-except intermediate: lang/htdp-intermediate-lambda procedures cons list* append) (all-from advanced: lang/private/advanced-funs procedures)) - - (provide (all-from-out test-engine/scheme-tests)) ) diff --git a/collects/lang/htdp-beginner-abbr.ss b/collects/lang/htdp-beginner-abbr.ss index 06f83bc004..0b834dbd66 100644 --- a/collects/lang/htdp-beginner-abbr.ss +++ b/collects/lang/htdp-beginner-abbr.ss @@ -36,6 +36,9 @@ [intermediate-unquote unquote] [intermediate-unquote-splicing unquote-splicing] [beginner-module-begin #%module-begin]) + check-expect + check-within + check-error #%datum #%top-interaction empty true false) @@ -44,6 +47,5 @@ (provide-and-document procedures (all-from beginner: lang/htdp-beginner procedures)) - - (provide (all-from-out test-engine/scheme-tests)) + ) diff --git a/collects/lang/htdp-beginner.ss b/collects/lang/htdp-beginner.ss index 158fb9cbbd..88849a0d42 100644 --- a/collects/lang/htdp-beginner.ss +++ b/collects/lang/htdp-beginner.ss @@ -37,6 +37,9 @@ ;; [beginner-contract contract] ;; [beginner-define-data define-data] ) + check-expect + check-within + check-error #%datum #%top-interaction empty true false) @@ -92,6 +95,4 @@ in-rator-position-only (all-from beginner: lang/private/beginner-funs procedures)) - (provide (all-from-out test-engine/scheme-tests)) - ) diff --git a/collects/lang/htdp-intermediate-lambda.ss b/collects/lang/htdp-intermediate-lambda.ss index 55e0c1d350..b5be5e7a43 100644 --- a/collects/lang/htdp-intermediate-lambda.ss +++ b/collects/lang/htdp-intermediate-lambda.ss @@ -39,6 +39,9 @@ ;; [intermediate-contract contract] ;; [intermediate-define-data define-data] ) + check-expect + check-within + check-error #%datum #%top-interaction empty true false) @@ -47,5 +50,4 @@ (provide-and-document procedures (all-from intermediate: lang/htdp-intermediate procedures)) - (provide (all-from-out test-engine/scheme-tests)) ) diff --git a/collects/lang/htdp-intermediate.ss b/collects/lang/htdp-intermediate.ss index 0f8255e8df..e2360aa7e1 100644 --- a/collects/lang/htdp-intermediate.ss +++ b/collects/lang/htdp-intermediate.ss @@ -40,6 +40,9 @@ ;; [intermediate-contract contract] ;; [intermediate-define-data define-data] ) + check-expect + check-within + check-error #%datum #%top-interaction empty true false) @@ -48,5 +51,4 @@ (provide-and-document procedures (all-from beginner: lang/private/intermediate-funs procedures)) - (provide (all-from-out test-engine/scheme-tests)) ) diff --git a/collects/lang/htdp-lib.scrbl b/collects/lang/htdp-lib.scrbl index 82ec779972..1487aabe65 100644 --- a/collects/lang/htdp-lib.scrbl +++ b/collects/lang/htdp-lib.scrbl @@ -43,9 +43,9 @@ Intermediate Student language for @|htdp|; see @; ------------------------------------------------------------ @section{@italic{HtDP} Intermediate Student with Lambda} -@defmodule[lang/htdp-intermediate-lam] +@defmodule[lang/htdp-intermediate-lambda] -The @schememodname[lang/htdp-intermediate-lam] module provides the +The @schememodname[lang/htdp-intermediate-lambda] module provides the Intermediate Student with Lambda language for @|htdp|; see @htdp-ref["intermediate-lam"]. @@ -138,7 +138,7 @@ they can be syntactically restricted to application positions. ]] } -@defform[(provide-higher-order-procedure id (arg ...))]{ +@defform[(provide-higher-order-primitive id (arg ...))]{ Like @scheme[define-higher-order-primitive], but the function @scheme[id] is exported as the primitive operator named diff --git a/collects/lang/private/teach.ss b/collects/lang/private/teach.ss index 383868fc5f..8719eecb67 100644 --- a/collects/lang/private/teach.ss +++ b/collects/lang/private/teach.ss @@ -604,55 +604,61 @@ (define (intermediate-pre-lambda/proc stx) (beginner-lambda/proc stx)) - (define (check-defined-lambda lam) - (syntax-case lam (intermediate-pre-lambda) - [(intermediate-pre-lambda arg-seq lexpr ...) - (syntax-case (syntax arg-seq) () [(arg ...) #t][_else #f]) - (let ([args (syntax->list (syntax arg-seq))]) - (for-each (lambda (arg) - (unless (identifier/non-kw? arg) - (teach-syntax-error - 'lambda - lam - arg - "expected a name for a function argument, but found ~a" - (something-else/kw arg)))) - args) - (when (null? args) - (teach-syntax-error - 'lambda - lam - (syntax arg-seq) - "expected at least one argument name in the sequence after `lambda', but found none")) - (let ([dup (check-duplicate-identifier args)]) - (when dup - (teach-syntax-error - 'lambda - lam - dup - "found an argument name that was used more than once: ~a" - (syntax-e dup)))) - (check-single-result-expr (syntax->list (syntax (lexpr ...))) - #f - lam - args) - 'ok)] - ;; Bad lambda because bad args: - [(intermediate-pre-lambda args . _) - (teach-syntax-error - 'lambda - lam - (syntax args) - "expected a sequence of function arguments after `lambda', but found ~a" - (something-else (syntax args)))] - ;; Bad lambda, no args: - [(intermediate-pre-lambda) - (teach-syntax-error - 'lambda - lam - (syntax args) - "expected a sequence of function arguments after `lambda', but nothing's there")] - [_else 'ok])) + (define (check-defined-lambda rhs) + (syntax-case rhs () + [(lam . _) + (and (identifier? #'lam) + (or (module-identifier=? #'lam #'beginner-lambda) + (module-identifier=? #'lam #'intermediate-pre-lambda))) + (syntax-case rhs () + [(lam arg-seq lexpr ...) + (syntax-case (syntax arg-seq) () [(arg ...) #t][_else #f]) + (let ([args (syntax->list (syntax arg-seq))]) + (for-each (lambda (arg) + (unless (identifier/non-kw? arg) + (teach-syntax-error + 'lambda + rhs + arg + "expected a name for a function argument, but found ~a" + (something-else/kw arg)))) + args) + (when (null? args) + (teach-syntax-error + 'lambda + rhs + (syntax arg-seq) + "expected at least one argument name in the sequence after `lambda', but found none")) + (let ([dup (check-duplicate-identifier args)]) + (when dup + (teach-syntax-error + 'lambda + rhs + dup + "found an argument name that was used more than once: ~a" + (syntax-e dup)))) + (check-single-result-expr (syntax->list (syntax (lexpr ...))) + #f + rhs + args) + 'ok)] + ;; Bad lambda because bad args: + [(lam args . _) + (teach-syntax-error + 'lambda + rhs + (syntax args) + "expected a sequence of function arguments after `lambda', but found ~a" + (something-else (syntax args)))] + ;; Bad lambda, no args: + [(lam) + (teach-syntax-error + 'lambda + rhs + (syntax args) + "expected a sequence of function arguments after `lambda', but nothing's there")] + [_else 'ok])] + [_else 'ok])) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; define-struct (beginner) diff --git a/collects/lang/run-teaching-program.ss b/collects/lang/run-teaching-program.ss index 1cc3757ff1..5e07f4e2a7 100644 --- a/collects/lang/run-teaching-program.ss +++ b/collects/lang/run-teaching-program.ss @@ -4,7 +4,8 @@ "debugger-language-interface.ss" stepper/private/shared scheme/class - scheme/contract) + scheme/contract + test-engine/scheme-tests) (provide/contract [expand-teaching-program (->* (input-port? @@ -58,7 +59,7 @@ ,@(map (λ (x) `(require ,x)) teachpacks) ,@body-exps ,@(if enable-testing? - (if (null? body-exps) '() '((run-tests) (display-results))) + (if (null? body-exps) '() `((,#'run-tests) (,#'display-results))) '())))) rep)))] [(require) diff --git a/collects/scribblings/start/manuals.ss b/collects/scribblings/start/manuals.ss index 710002c085..276e76b6ad 100644 --- a/collects/scribblings/start/manuals.ss +++ b/collects/scribblings/start/manuals.ss @@ -31,7 +31,7 @@ (make-sec 'net-library "Network Libraries") (make-sec 'parsing-library - "GUI and Graphics Libraries") + "Parsing Libraries") (make-sec 'tool-library "Tool Libraries") (make-sec 'foreign diff --git a/collects/tests/mzscheme/beg-adv.ss b/collects/tests/mzscheme/beg-adv.ss index f4227001e2..517e8aa74d 100644 --- a/collects/tests/mzscheme/beg-adv.ss +++ b/collects/tests/mzscheme/beg-adv.ss @@ -218,7 +218,7 @@ (htdp-teachpack-pop) ;; Check require -(htdp-top (require mzlib/unit)) +(htdp-top (require (lib "unit.ss" "mzlib"))) (htdp-test #f unit? 12) (htdp-top-pop 1) diff --git a/collects/tests/mzscheme/htdp-test.ss b/collects/tests/mzscheme/htdp-test.ss index 8a6477f808..2fb33f8062 100644 --- a/collects/tests/mzscheme/htdp-test.ss +++ b/collects/tests/mzscheme/htdp-test.ss @@ -134,9 +134,13 @@ (define test (namespace-variable-value 'test)) (provide test)) +(define (print-eval stx) + (printf "~s\n" (syntax->datum stx)) + (eval stx)) + (define (do-htdp-test stx stx-err? exn?) (let ([name (gensym 'm)]) - ((if stx-err? syntax-test eval) + ((if stx-err? syntax-test print-eval) #`(module #,name 'helper test #,current-htdp-lang #%module-begin diff --git a/doc/release-notes/mzscheme/MzScheme_4.txt b/doc/release-notes/mzscheme/MzScheme_4.txt index cb464817ad..49ff20e63b 100644 --- a/doc/release-notes/mzscheme/MzScheme_4.txt +++ b/doc/release-notes/mzscheme/MzScheme_4.txt @@ -145,6 +145,11 @@ but we start with an enumeration of changes: - UTF-8 decoding for ports uses #\uFFFD instead of #\? as the replacement character for bad encodings. + - Inside PLT Scheme: the `mzscheme' module is no longer built into + the exectable. When embedding PLT Scheme in a larger application, + use `mzc --c-mods' to convert a set of modules into embeddable C + code (as a static byte array containing bytecode). + ====================================================================== Porting Advice ======================================================================