sync HtDP languages and test suite

svn: r9424

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))
   )

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)
@@ -45,5 +48,4 @@
    procedures
    (all-from beginner: lang/htdp-beginner procedures))
 
-  (provide (all-from-out test-engine/scheme-tests))
   )

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))
-  
   )

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))
   )

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))
   )

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

collects/lang/private/teach.ss

@@ -604,55 +604,61 @@
     (define (intermediate-pre-lambda/proc stx)
       (beginner-lambda/proc stx))
 
-    (define (check-defined-lambda lam)
+    (define (check-defined-lambda rhs)
-      (syntax-case lam (intermediate-pre-lambda)
+      (syntax-case rhs ()
-	[(intermediate-pre-lambda arg-seq lexpr ...)
+        [(lam . _)
-	 (syntax-case (syntax arg-seq) () [(arg ...) #t][_else #f])
+         (and (identifier? #'lam)
-	 (let ([args (syntax->list (syntax arg-seq))])
+              (or (module-identifier=? #'lam #'beginner-lambda)
-	   (for-each (lambda (arg)
+                  (module-identifier=? #'lam #'intermediate-pre-lambda)))
-		       (unless (identifier/non-kw? arg)
+         (syntax-case rhs ()
-			 (teach-syntax-error
+           [(lam arg-seq lexpr ...)
-			  'lambda
+            (syntax-case (syntax arg-seq) () [(arg ...) #t][_else #f])
-			  lam
+            (let ([args (syntax->list (syntax arg-seq))])
-			  arg
+              (for-each (lambda (arg)
-			  "expected a name for a function argument, but found ~a"
+                          (unless (identifier/non-kw? arg)
-			  (something-else/kw arg))))
+                            (teach-syntax-error
-		     args)
+                             'lambda
-	   (when (null? args)
+                             rhs
-	     (teach-syntax-error
+                             arg
-	      'lambda
+                             "expected a name for a function argument, but found ~a"
-	      lam
+                             (something-else/kw arg))))
-	      (syntax arg-seq)
+                        args)
-	      "expected at least one argument name in the sequence after `lambda', but found none"))
+              (when (null? args)
-	   (let ([dup (check-duplicate-identifier args)])
+                (teach-syntax-error
-	     (when dup
+                 'lambda
-	       (teach-syntax-error
+                 rhs
-		'lambda
+                 (syntax arg-seq)
-		lam
+                 "expected at least one argument name in the sequence after `lambda', but found none"))
-		dup
+              (let ([dup (check-duplicate-identifier args)])
-		"found an argument name that was used more than once: ~a"
+                (when dup
-		(syntax-e dup))))
+                  (teach-syntax-error
-	   (check-single-result-expr (syntax->list (syntax (lexpr ...)))
+                   'lambda
-				     #f
+                   rhs
-				     lam
+                   dup
-				     args)
+                   "found an argument name that was used more than once: ~a"
-	   'ok)]
+                   (syntax-e dup))))
-	;; Bad lambda because bad args:
+              (check-single-result-expr (syntax->list (syntax (lexpr ...)))
-	[(intermediate-pre-lambda args . _)
+                                        #f
-	 (teach-syntax-error
+                                        rhs
-	  'lambda
+                                        args)
-	  lam
+              'ok)]
-	  (syntax args)
+           ;; Bad lambda because bad args:
-	  "expected a sequence of function arguments after `lambda', but found ~a"
+           [(lam args . _)
-	  (something-else (syntax args)))]
+            (teach-syntax-error
-	;; Bad lambda, no args:
+             'lambda
-	[(intermediate-pre-lambda)
+             rhs
-	 (teach-syntax-error
+             (syntax args)
-	  'lambda
+             "expected a sequence of function arguments after `lambda', but found ~a"
-	  lam
+             (something-else (syntax args)))]
-	  (syntax args)
+           ;; Bad lambda, no args:
-	  "expected a sequence of function arguments after `lambda', but nothing's there")]
+           [(lam)
-	[_else 'ok]))
+            (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)

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)

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

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)
 

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

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
 ======================================================================