add list? to ISL+, Racket; Closes PR14103

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

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]{
+;    @defproc[((advanced-list? list?) [x any]) boolean]{
-    Determines whether some value is a list. 
+;    Determines whether some value is a list. 
-    In ASL, @racket[list?] also deals with cyclic lists. 
+;    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. 

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

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)
+		(raise
-						       (eq? arg y))
+                 (make-exn:fail:contract
-						   (format fmt arg)
+                  (if (or (eq? arg x)
-						   (format "~a (originally comparing ~e and ~e)" (format fmt arg) x y))
+                          (eq? arg y))
-					       (current-continuation-marks))))])
+                      (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)
+		(raise
-						       (eq? arg y))
+                 (make-exn:fail:contract 
-						   (format fmt arg)
+                  (if (or (eq? arg x)
-						   (format "~a (originally comparing ~e and ~e)" (format fmt arg) x y))
+                          (eq? arg y))
-					       (current-continuation-marks))))]
+                      (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")
+       (define a (a-or-an format-msg))
-            snd actual))]))
+       (define f (string-append "expected " a " " format-msg " for the ~a argument, but received ~e"))
+       (err tag f snd actual))]))
 
 ;; -----------------------------------------------------------------------------