diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/htdp-intermediate.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/htdp-intermediate.rkt index b488cbfb39..05f3359fc3 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/htdp-intermediate.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/htdp-intermediate.rkt @@ -65,6 +65,7 @@ (begin) (all-from beginner: lang/private/intermediate-funs procedures)) +#; (provide (rename-out [beginner-list? list?])) diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/private/advanced-funs.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/private/advanced-funs.rkt index dbf562e07c..c8a8a50006 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/private/advanced-funs.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/private/advanced-funs.rkt @@ -9,6 +9,8 @@ "../posn.rkt" (for-syntax scheme/base)) +(define advanced-list? list?) + ;; Documents the procedures: (require "provide-and-scribble.rkt") @@ -94,7 +96,8 @@ (display 'hello)] } @defproc[(write [x any]) void]{ - Prints the argument to stdout (in a traditional style that is somewhere between @racket[print] and @racket[display]). + Prints the argument to stdout (in a traditional style that is somewhere + between @racket[print] and @racket[display]). @interaction[#:eval (asl) (write 10) (write "hello") @@ -118,10 +121,10 @@ Reads input from the user.}) ("Lists" - @defproc[(list? [x any]) boolean]{ - Determines whether some value is a list. - In ASL, @racket[list?] also deals with cyclic lists. - } +; @defproc[((advanced-list? list?) [x any]) boolean]{ +; Determines whether some value is a list. +; In ASL, @racket[list?] also deals with cyclic lists. +; } @defproc[((advanced-list* list*) [x any] ... [l (listof any)]) (listof any)]{ Constructs a list by adding multiple items to a list. In ASL, @racket[list*] also deals with cyclic lists. diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/private/intermediate-funs.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/private/intermediate-funs.rkt index 7a7f3e06a4..af6fd756e7 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/private/intermediate-funs.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/private/intermediate-funs.rkt @@ -52,7 +52,13 @@ In ISL and up: @racket[append] also works when applied to one list or none. @interaction[#:eval (isl) (append (cons 1 (cons 2 empty)) (cons "a" (cons "b" empty))) - (append)]}) + (append)]} + @defproc[((beginner-list? list?) [x any]) boolean?]{ + Checks whether the given value is a list. + @interaction[#:eval (isl) + (list? 42) + (list? (cons 1 (cons 2 empty)))]} +) ("Higher-Order Functions" @defproc[(map [f (X ... -> Z)] [l (listof X)] ...) (listof Z)]{ diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/private/teachprims.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/private/teachprims.rkt index ea764692d5..ca1791d978 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/private/teachprims.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/private/teachprims.rkt @@ -265,11 +265,13 @@ namespace. (define (tequal? x y epsilon) (let ([union-equal!? (make-union-equal!?)] [fail (lambda (fmt arg) - (raise (make-exn:fail:contract (if (or (eq? arg x) - (eq? arg y)) - (format fmt arg) - (format "~a (originally comparing ~e and ~e)" (format fmt arg) x y)) - (current-continuation-marks))))]) + (raise + (make-exn:fail:contract + (if (or (eq? arg x) + (eq? arg y)) + (format fmt arg) + (format "~a (originally comparing ~e and ~e)" (format fmt arg) x y)) + (current-continuation-marks))))]) (let ? ([a x][b y]) (cond [(number? a) @@ -285,11 +287,13 @@ namespace. (define (teach-equal? x y) (let ([fail (lambda (fmt arg) - (raise (make-exn:fail:contract (if (or (eq? arg x) - (eq? arg y)) - (format fmt arg) - (format "~a (originally comparing ~e and ~e)" (format fmt arg) x y)) - (current-continuation-marks))))] + (raise + (make-exn:fail:contract + (if (or (eq? arg x) + (eq? arg y)) + (format fmt arg) + (format "~a (originally comparing ~e and ~e)" (format fmt arg) x y)) + (current-continuation-marks))))] [union-equal!? (make-union-equal!?)]) (let recur ([a x] [b y]) @@ -349,7 +353,8 @@ namespace. (define-teach intermediate build-string (lambda (n f) (unless (and (procedure? f) (procedure-arity-includes? f 1)) - (hocheck 'build-string "second argument must be a function that accepts one argument, given ~e" f)) + (hocheck 'build-string + "second argument must be a function that accepts one argument, given ~e" f)) (unless (and (number? n) (integer? n) (>= n 0)) (hocheck 'build-string "first argument must be a natural number, given ~e" n)) (build-string n (lambda (i) @@ -466,7 +471,9 @@ namespace. (unless (list? s) (err tag "expected a ~a, but received: ~e" 1-LETTER* s)) (for-each (lambda (c) - (unless (string? c) (err tag "expected a ~a, but received: ~e\n which contains the non-1-letter string: ~e" 1-LETTER* s c))) + (unless (string? c) + (err tag "expected a ~a, but received: ~e\n which contains the non-1-letter string: ~e" + 1-LETTER* s c))) s) (andmap (compose (curry = 1) string-length) s)) @@ -485,11 +492,13 @@ namespace. [(tag check-result format-msg actual) (unless check-result (displayln `(cerr ,actual)) - (err tag (string-append "expected " (a-or-an format-msg) " " format-msg ", but received ~e") actual))] + (err tag (string-append "expected " (a-or-an format-msg) " " format-msg ", but received ~e") + actual))] [(tag check-result format-msg actual snd) (unless check-result - (err tag (string-append "expected " (a-or-an format-msg) " " format-msg " for the ~a argument, but received ~e") - snd actual))])) + (define a (a-or-an format-msg)) + (define f (string-append "expected " a " " format-msg " for the ~a argument, but received ~e")) + (err tag f snd actual))])) ;; -----------------------------------------------------------------------------