7.7.1A Customer-Manager Component🔗 i

This first module contains some struct definitions in a separate module in order to better track bugs.

#lang racket

;data definitions

(define id?symbol? )

(define id-equal?eq? )

(define-struct basic-customer(idnameaddress)#:mutable)

;interface

(provide

(contract-out

[id?(-> any/c boolean? )]

[id-equal?(-> id?id?boolean? )]

[struct basic-customer((idid?)

(namestring? )

(addressstring? ))]))

;end of interface

This module contains the program that uses the above.

#lang racket

(require "1.rkt");the module just above

;implementation

;[listof (list basic-customer? secret-info)]

(define all'())

(define (findc)

(define (has-c-as-keyp)

(id-equal?(basic-customer-id(car p))c))

(define x(filter has-c-as-keyall))

(if (pair? x)(car x)x))

(define (active?c)

(pair? (findc)))

(define not-active?(compose not active?basic-customer-id))

(define count 0)

(define (get-count)count )

(define (addc)

(set! all(cons (list c'secret)all))

(set! count (+ count 1)))

(define (nameid)

(define bc-with-id(findid))

(basic-customer-name(car bc-with-id)))

(define (set-nameidname)

(define bc-with-id(findid))

(set-basic-customer-name!(car bc-with-id)name))

(define c00)

;end of implementation

(provide

(contract-out

;how many customers are in the db?

[get-count(-> natural-number/c )]

;is the customer with this id active?

[active?(-> id?boolean? )]

;what is the name of the customer with this id?

[name(-> (and/c id?active?)string? )]

;change the name of the customer with this id

[set-name(->i ([idid?][nnstring? ])

[resultany/c ];result contract

#:post(idnn)(string=? (nameid)nn))]

[add(->i ([bc(and/c basic-customer?not-active?)])

;A pre-post condition contract must use

;a side-effect to express this contract

;via post-conditions

#:pre()(set! c0count )

[resultany/c ];result contract

#:post()(> count c0))]))

The tests:

#lang racket

(require rackunitrackunit/text-ui"1.rkt""1b.rkt")

(add(make-basic-customer'mf"matthias""brookstone"))

(add(make-basic-customer'rf"robby""beverly hills park"))

(add(make-basic-customer'fl"matthew""pepper clouds town"))

(add(make-basic-customer'sk"shriram""i city"))

(run-tests

(test-suite

"manager"

(test-equal? "id lookup""matthias"(name'mf))

(test-equal? "count"4(get-count))

(test-true "active?"(active?'mf))

(test-false "active? 2"(active?'kk))

(test-true "set name"(void? (set-name'mf"matt")))))

7.7.2A Parameteric (Simple) Stack🔗 i

#lang racket

;a contract utility

(define (eq/cx)(lambda (y)(eq? xy)))

(define-struct stack(list p?eq))

(define (initializep?eq)(make-stack'()p?eq))

(define (pushsx)

(make-stack(cons x(stack-lists))(stack-p?s)(stack-eqs)))

(define (item-atsi)(list-ref (reverse (stack-lists))(- i1)))

(define (count s)(length (stack-lists)))

(define (is-empty?s)(null? (stack-lists)))

(define not-empty?(compose not is-empty?))

(define (pops)(make-stack(cdr (stack-lists))

(stack-p?s)

(stack-eqs)))

(define (tops)(car (stack-lists)))

(provide

(contract-out

;predicate

[stack?(-> any/c boolean? )]

;primitive queries

;how many items are on the stack?

[count (-> stack?natural-number/c )]

;which item is at the given position?

[item-at

(->d ([sstack?][i(and/c positive? (<=/c (count s)))])

()

[result(stack-p?s)])]

;derived queries

;is the stack empty?

[is-empty?

(->d ([sstack?])

()

[result(eq/c(= (count s)0))])]

;which item is at the top of the stack

[top

(->d ([s(and/c stack?not-empty?)])

()

[t(stack-p?s)];a stack item, t is its name

#:post-cond

([stack-eqs]t(item-ats(count s))))]

;creation

[initialize

(->d ([pcontract? ][s(pp. -> .boolean? )])

()

;Mitchell and McKim use (= (count s) 0) here to express

;the post-condition in terms of a primitive query

[result(and/c stack?is-empty?)])]

;commands

;add an item to the top of the stack

[push

(->d ([sstack?][x(stack-p?s)])

()

[snstack?];result kind

#:post-cond

(and (= (+ (count s)1)(count sn))

([stack-eqs]x(topsn))))]

;remove the item at the top of the stack

[pop

(->d ([s(and/c stack?not-empty?)])

()

[snstack?];result kind

#:post-cond

(= (- (count s)1)(count sn)))]))

The tests:

#lang racket

(require rackunitrackunit/text-ui"2.rkt")

(define s0(initialize(flat-contract integer? )= ))

(define s2(push(pushs02)1))

(run-tests

(test-suite

"stack"

(test-true

"empty"

(is-empty?(initialize(flat-contract integer? )= )))

(test-true "push"(stack?s2))

(test-true

"push exn"

(with-handlers ([exn:fail:contract? (lambda _ #t)])

(push(initialize(flat-contract integer? ))'a)

#f))

(test-true "pop"(stack?(pops2)))

(test-equal? "top"(tops2)1)

(test-equal? "toppop"(top(pops2))2)))

7.7.3A Dictionary🔗 i

#lang racket

;a shorthand for use below

(define-syntax ⇒

(syntax-rules ()

[(⇒antecedentconsequent)(if antecedentconsequent#t)]))

;implementation

(define-struct dictionary(lvalue?eq? ))

;the keys should probably be another parameter (exercise)

(define (initializepeq)(make-dictionary'()peq))

(define (putdkv)

(make-dictionary(cons (cons kv)(dictionary-ld))

(dictionary-value?d)

(dictionary-eq?d)))

(define (remdk)

(make-dictionary

(let loop([l(dictionary-ld)])

(cond

[(null? l)l]

[(eq? (caar l)k)(loop(cdr l))]

[else (cons (car l)(loop(cdr l)))]))

(dictionary-value?d)

(dictionary-eq?d)))

(define (count d)(length (dictionary-ld)))

(define (value-fordk)(cdr (assq k(dictionary-ld))))

(define (has?dk)(pair? (assq k(dictionary-ld))))

(define (not-has?d)(lambda (k)(not (has?dk))))

;end of implementation

;interface

(provide

(contract-out

;predicates

[dictionary?(-> any/c boolean? )]

;basic queries

;how many items are in the dictionary?

[count (-> dictionary?natural-number/c )]

;does the dictionary define key k?

[has?(->d ([ddictionary?][ksymbol? ])

()

[resultboolean? ]

#:post-cond

((zero? (count d)). ⇒ .(not result)))]

;what is the value of key k in this dictionary?

[value-for(->d ([ddictionary?]

[k(and/c symbol? (lambda (k)(has?dk)))])

()

[result(dictionary-value?d)])]

;initialization

;post condition: for all k in symbol, (has? d k) is false.

[initialize(->d ([pcontract? ][eq(pp. -> .boolean? )])

()

[result(and/c dictionary?(compose zero? count ))])]

;commands

;Mitchell and McKim say that put shouldn't consume Void (null ptr)

;for v. We allow the client to specify a contract for all values

;via initialize. We could do the same via a key? parameter

;(exercise). add key k with value v to this dictionary

[put(->d ([ddictionary?]

[k(and/c symbol? (not-has?d))]

[v(dictionary-value?d)])

()

[resultdictionary?]

#:post-cond

(and (has?resultk)

(= (count d)(- (count result)1))

([dictionary-eq?d](value-forresultk)v)))]

;remove key k from this dictionary

[rem(->d ([ddictionary?]

[k(and/c symbol? (lambda (k)(has?dk)))])

()

[result(and/c dictionary?(lambda (d)((not-has?d)k)))]

#:post-cond

(= (count d)(+ (count result)1)))]))

;end of interface

The tests:

#lang racket

(require rackunitrackunit/text-ui"3.rkt")

(define d0(initialize(flat-contract integer? )= ))

(define d(put(put(putd0'a2)'b2)'c1))

(run-tests

(test-suite

"dictionaries"

(test-equal? "value for"2(value-ford'b))

(test-false "has?"(has?(remd'b)'b))

(test-equal? "count"3(count d))

(test-case "contract check for put: symbol?"

(define d0(initialize(flat-contract integer? )= ))

(check-exn exn:fail:contract? (lambda ()(putd0"a"2))))))

7.7.4A Queue🔗 i

#lang racket

;Note: this queue doesn't implement the capacity restriction

;of Mitchell and McKim's queue but this is easy to add.

;a contract utility

(define (all-but-lastl)(reverse (cdr (reverse l))))

(define (eq/cx)(lambda (y)(eq? xy)))

;implementation

(define-struct queue(list p?eq))

(define (initializep?eq)(make-queue'()p?eq))

(define itemsqueue-list)

(define (putqx)

(make-queue(append (queue-listq)(list x))

(queue-p?q)

(queue-eqq)))

(define (count s)(length (queue-lists)))

(define (is-empty?s)(null? (queue-lists)))

(define not-empty?(compose not is-empty?))

(define (rems)

(make-queue(cdr (queue-lists))

(queue-p?s)

(queue-eqs)))

(define (heads)(car (queue-lists)))

;interface

(provide

(contract-out

;predicate

[queue?(-> any/c boolean? )]

;primitive queries

;Imagine providing this 'query' for the interface of the module

;only. Then in Racket there is no reason to have count or is-empty?

;around (other than providing it to clients). After all items is

;exactly as cheap as count.

[items(->d ([qqueue?])()[result(listof (queue-p?q))])]

;derived queries

[count (->d ([qqueue?])

;We could express this second part of the post

;condition even if count were a module "attribute"

;in the language of Eiffel; indeed it would use the

;exact same syntax (minus the arrow and domain).

()

[result(and/c natural-number/c

(=/c (length (itemsq))))])]

[is-empty?(->d ([qqueue?])

()

[result(and/c boolean?

(eq/c(null? (itemsq))))])]

[head(->d ([q(and/c queue?(compose not is-empty?))])

()

[result(and/c (queue-p?q)

(eq/c(car (itemsq))))])]

;creation

[initialize(-> contract?

(contract? contract? . -> .boolean? )

(and/c queue?(compose null? items)))]

;commands

[put(->d ([oldqqueue?][i(queue-p?oldq)])

()

[result

(and/c

queue?

(lambda (q)

(define old-items(itemsoldq))

(equal? (itemsq)(append old-items(list i)))))])]

[rem(->d ([oldq(and/c queue?(compose not is-empty?))])

()

[result

(and/c queue?

(lambda (q)

(equal? (cdr (itemsoldq))(itemsq))))])]))

;end of interface

The tests:

#lang racket

(require rackunitrackunit/text-ui"5.rkt")

(define s(put(put(initialize(flat-contract integer? )= )2)1))

(run-tests

(test-suite

"queue"

(test-true

"empty"

(is-empty?(initialize(flat-contract integer? )= )))

(test-true "put"(queue?s))

(test-equal? "count"2(count s))

(test-true "put exn"

(with-handlers ([exn:fail:contract? (lambda _ #t)])

(put(initialize(flat-contract integer? ))'a)

#f))

(test-true "remove"(queue?(rems)))

(test-equal? "head"2(heads))))