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

fixed higher-order function contracts in intermediate

Browse Source 
svn: r1489
This commit is contained in:
Matthias Felleisen 2005-12-02 15:11:23 +00:00
parent 55037c44cf
commit 2526db5610
3 changed files with 173 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/lang/htdp-intermediate.ss
View File

@ -46,13 +46,13 @@
"to apply a function to each item on one or more lists for effect only")
(filter ((X -> boolean) (listof X) -> (listof X))
"to construct a list from all those items on a list for which the predicate holds")
(foldr ((X Y -> Y) Y (listof X) -> Y)
((intermediate-foldr foldr) ((X Y -> Y) Y (listof X) -> Y)
"(foldr f base (list x-1 ... x-n)) = (f x-1 ... (f x-n base))")
(foldl ((X Y -> Y) Y (listof X) -> Y)
((intermediate-foldl foldl) ((X Y -> Y) Y (listof X) -> Y)
"(foldl f base (list x-1 ... x-n)) = (f x-n ... (f x-1 base))")
(build-list (nat (nat -> X) -> (listof X))
"(build-list n f) = (list (f 0) ... (f (- n 1)))")
(build-string (nat (nat -> char) -> string)
((intermediate-build-string build-string) (nat (nat -> char) -> string)
"(build-string n f) = (string (f 0) ... (f (- n 1)))")
((intermediate-quicksort quicksort) ((listof X) (X X -> boolean) -> (listof X))
"to construct a list from all items on a list in an order according to a predicate")
@ -63,9 +63,6 @@
(memf ((X -> boolean) (listof X) -> (union false (listof X)))
"to determine whether the first argument produces true for some value in the second argument")
(assf ((X -> boolean) (listof (cons X Y)) -> (union false (cons X Y)))
"to determine whether the first argument produces true for some value in the second argument")
(apply ((X-1 ... X-N -> Y) X-1 ... X-i (list X-i+1 ... X-N) -> Y)
"to apply a function using items from a list as the arguments")
(compose ((Y-1 -> Z) ... (Y-N -> Y-N-1) (X-1 ... X-N -> Y-N) -> (X-1 ... X-N -> Z))

2
collects/lang/private/beginner-funs.ss
View File

@ -365,6 +365,8 @@
"to determine whether a value is a string")
(string-length (string -> nat)
"to determine the length of a string")
(string (char ... -> string)
"(string c1 c2 ...) builds a string")
(make-string (nat char -> string)
"to produce a string of given length"
"from a single given character")

45
collects/lang/private/teachprims.ss
View File

@ -2,7 +2,8 @@
(module teachprims mzscheme
(require "../imageeq.ss"
(lib "list.ss"))
(lib "list.ss")
(lib "etc.ss"))
(define-syntax (define-teach stx)
(syntax-case stx ()
@ -248,24 +249,53 @@
(check-three a b c 'equal~? values 'any values 'any positive-real? 'non-negative-real)
(tequal? a b c)))
(define (qcheck fmt-str x)
(define (qcheck quicksort fmt-str . x)
(raise
(make-exn:fail:contract
(string->immutable-string
(string-append "quicksort: " (format fmt-str x)))
(string-append (format "~a : " quicksort) (apply format fmt-str x)))
(current-continuation-marks))))
(define-teach intermediate quicksort
(lambda (l cmp?)
(unless (beginner-list? l)
(qcheck "first argument must be of type <list>, given ~e" l))
(qcheck 'quicksort "first argument must be of type <list>, given ~e" l))
(unless (and (procedure? cmp?) (procedure-arity-includes? cmp? 2))
(qcheck "second argument must be a <procedure> that accepts two arguments, given ~e" cmp?))
(qcheck 'quicksort "second argument must be a <procedure> that accepts two arguments, given ~e" cmp?))
(quicksort l (lambda (x y)
(define r (cmp? x y))
(unless (boolean? r)
(qcheck "the results of the procedure argument must be of type <boolean>, produced ~e" r))
(qcheck 'quicksort "the results of the procedure argument must be of type <boolean>, produced ~e" r))
r))))
(define-teach intermediate foldr
(lambda (f e l)
(unless (and (procedure? f) (procedure-arity-includes? f 2))
(qcheck 'foldr "first argument must be a <procedure> that accepts two arguments, given ~e" f))
(unless (beginner-list? l)
(qcheck 'foldr "third argument must be of type <list>, given ~e" l))
(foldr f e l)))
(define-teach intermediate foldl
(lambda (f e l)
(unless (and (procedure? f) (procedure-arity-includes? f 2))
(qcheck 'foldl "first argument must be a <procedure> that accepts two arguments, given ~e" f))
(unless (beginner-list? l)
(qcheck 'foldl "third argument must be of type <list>, given ~e" l))
(foldl f e l)))
(define-teach intermediate build-string
(lambda (n f)
(unless (and (procedure? f) (procedure-arity-includes? f 1))
(qcheck 'build-string "second argument must be a <procedure> that accepts one argument, given ~e" f))
(unless (and (number? n) (integer? n) (>= n 0))
(qcheck 'build-string "first argument must be of type <natural number>, given ~e" n))
(build-string n (lambda (i)
(define r (f i))
(unless (char? r)
(qcheck 'build-string "second argument must be a <procedure> that produces a <char>, given ~e which produced ~e for ~e" f r i))
r))))
(define-teach advanced cons
(lambda (a b)
@ -313,6 +343,9 @@
beginner-equal~?
beginner-=~
intermediate-quicksort
intermediate-foldr
intermediate-foldl
intermediate-build-string
advanced-cons
advanced-set-cdr!
advanced-set-rest!