suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add list? to ISL+, Racket; Closes PR14103

Browse Source
This commit is contained in:
Matthias Felleisen 2013-10-18 15:12:09 -04:00
parent 390e052592
commit 63c27e218d
4 changed files with 40 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/htdp-pkgs/htdp-lib/lang/htdp-intermediate.rkt
View File

@ -65,6 +65,7 @@
(begin)
(all-from beginner: lang/private/intermediate-funs procedures))
#;
(provide
(rename-out
[beginner-list? list?]))

13
pkgs/htdp-pkgs/htdp-lib/lang/private/advanced-funs.rkt
View File

@ -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.

8
pkgs/htdp-pkgs/htdp-lib/lang/private/intermediate-funs.rkt
View File

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

39
pkgs/htdp-pkgs/htdp-lib/lang/private/teachprims.rkt
View File

@ -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))]))
;; -----------------------------------------------------------------------------