Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #lang racket
- (require rackunit
- "4-3-3-exercises-amb-repl-program.rkt")
- ;; The same as 4-3-3-amb-repl-test.rkt except that there are two new test cases, one
- ;; for permanent-set! and one for if-fail.
- ;; default succeed and fail continuations used in calls to ambeval
- (define dsc (lambda (val fail) val))
- (define dfc (lambda () 'failed))
- (test-case "self-evaluating expression"
- (check-equal? (ambeval "x" the-global-environment dsc dfc)
- "x")
- (check-equal? (ambeval 23 the-global-environment dsc dfc)
- 23)
- )
- (test-case "quotation"
- (define quote-expr '(quote ("x" 23 a)))
- (check-equal? (ambeval quote-expr the-global-environment dsc dfc)
- '("x" 23 a))
- )
- (test-case "variable definition"
- (define def-expr '(define a 42))
- (check-equal? (ambeval def-expr the-global-environment dsc dfc)
- 'ok)
- (check-equal? (ambeval 'a the-global-environment dsc dfc)
- 42)
- )
- (test-case "procedure definition"
- (define proc-expr '(define (multiply x y) (* x y)))
- (check-equal? (ambeval proc-expr the-global-environment dsc dfc)
- 'ok)
- )
- (test-case "procedure application"
- (define application-expr '(multiply 3 4))
- (check-equal? (ambeval application-expr the-global-environment dsc dfc)
- 12)
- (check-equal? (ambeval '(car (cons 1 (cons 2 '())))
- the-global-environment
- dsc
- dfc)
- 1)
- )
- (test-case "assignment"
- (define assign-expr '(set! a 23))
- (check-equal? (ambeval assign-expr the-global-environment dsc dfc)
- 'ok)
- (check-equal? (ambeval 'a the-global-environment dsc dfc)
- 23)
- )
- (test-case "predicate"
- (check-true (true? (ambeval 'a the-global-environment dsc dfc)))
- (check-true (true? (ambeval "false" the-global-environment dsc dfc)))
- (check-false (true? (ambeval 'false the-global-environment dsc dfc)))
- (check-true (false? (ambeval 'false the-global-environment dsc dfc)))
- )
- (test-case "if statement"
- (define ie '(if true 1 2))
- (check-equal? (ambeval ie the-global-environment dsc dfc)
- 1)
- (define ie2 '(if false 1 2))
- (check-equal? (ambeval ie2 the-global-environment dsc dfc)
- 2)
- )
- (test-case "cond statement"
- (define ce '(cond ("a" 1 2) ("b" 3)))
- (check-equal? (ambeval ce the-global-environment dsc dfc)
- 2)
- (define alt-ce '(cond ((cons 1 (cons 2 '())) => car) (else 87)))
- (check-equal? (ambeval alt-ce the-global-environment dsc dfc)
- 1)
- )
- (test-case "begin statement"
- (define be '(begin "a" "b" 1 2 (* 3 4)))
- (check-equal? (ambeval be the-global-environment dsc dfc)
- 12)
- )
- (test-case "boolean operator"
- (ambeval '(define c 38) the-global-environment dsc dfc)
- (check-equal? (ambeval '(and 1 "a" c) the-global-environment dsc dfc)
- 38)
- (check-equal? (ambeval '(and 1 1 false) the-global-environment dsc dfc)
- false)
- (check-equal? (ambeval '(or false false 1)
- the-global-environment
- dsc
- dfc)
- 1)
- (check-equal? (ambeval '(or false false false)
- the-global-environment
- dsc
- dfc)
- false)
- )
- (test-case "let"
- (define le '(let ((x 1) (y 2) (z 3)) 'side-effect (+ x y z)))
- (check-equal? (ambeval le the-global-environment dsc dfc)
- 6)
- (define le2 '(let ((x 1) (y 2)) (+ x y)))
- (check-equal? (ambeval le2 the-global-environment dsc dfc)
- 3)
- (define le3 '(let ((x 1)) 'side-effect (+ x 2)))
- (check-equal? (ambeval le3 the-global-environment dsc dfc)
- 3)
- (define le4 '(let () 'side-effect (+ 3 2)))
- (check-equal? (ambeval le4 the-global-environment dsc dfc)
- 5)
- (define le5 '(let () (+ 3 2)))
- (check-equal? (ambeval le5 the-global-environment dsc dfc)
- 5)
- ; let with internal defines
- (define le6 '(let ([x 1])
- (define y 2)
- (+ x y)))
- (check-equal? (ambeval le6 the-global-environment dsc dfc)
- 3)
- (define le7 '(let* ([x 1]
- [y (+ x 1)])
- (define z (+ x y))
- (define w (+ z 1))
- (+ x y z w)))
- (check-equal? (ambeval le7 the-global-environment dsc dfc)
- 10)
- )
- (test-case "named-let"
- (ambeval '(define (fib n)
- (let fib-iter ((a 1)
- (b 0)
- (my-count n))
- (if (= my-count 0)
- b
- (fib-iter (+ a b) a (+ my-count -1)))))
- the-global-environment
- dsc
- dfc)
- (check-equal? (ambeval '(fib 0) the-global-environment dsc dfc)
- 0)
- (check-equal? (ambeval '(fib 1) the-global-environment dsc dfc)
- 1)
- (check-equal? (ambeval '(fib 10) the-global-environment dsc dfc)
- 55)
- )
- (test-case "let*"
- (define lse '(let* ((x 1) (y (+ x 1)) (z (+ y 1))) (+ x y z)))
- (check-equal? (ambeval lse the-global-environment dsc dfc)
- 6)
- (define lse2 '(let* ((a 1) (b 2)) 'side-effect (+ a b)))
- (check-equal? (ambeval lse2 the-global-environment dsc dfc)
- 3)
- (define lse3 '(let* ((a 1)) 'side-effect (+ a 2)))
- (check-equal? (ambeval lse3 the-global-environment dsc dfc)
- 3)
- (define lse4 '(let* ((a 1)) (+ a 2)))
- (check-equal? (ambeval lse4 the-global-environment dsc dfc)
- 3)
- )
- (test-case "letrec"
- (ambeval '(define (my-even? x)
- (letrec ((ev? (lambda (n)
- (if (= n 0)
- true
- (od? (- n 1)))))
- (od? (lambda (n)
- (if (= n 0)
- false
- (ev? (- n 1))))))
- (ev? x)))
- the-global-environment
- dsc
- dfc)
- (check-equal? (ambeval '(my-even? 11) the-global-environment dsc dfc)
- false)
- (check-equal? (ambeval '(my-even? 12) the-global-environment dsc dfc)
- true)
- )
- (test-case "multiple-dwelling"
- (ambeval '(define (multiple-dwelling)
- (let ([baker (an-element-of (list 1 2 3 4 5))])
- (my-require (not (= baker 5)))
- (let ([cooper (amb 1 2 3 4 5)])
- (my-require (not (= cooper 1)))
- (let ([fletcher (amb 1 2 3 4 5)])
- (my-require (not (= fletcher 5)))
- (my-require (not (= fletcher 1)))
- (my-require (not (= (abs (- fletcher cooper)) 1)))
- (let ([miller (amb 1 2 3 4 5)])
- (my-require (> miller cooper))
- (let ([smith (amb 1 2 3 4 5)])
- (my-require (distinct? (list baker
- cooper
- fletcher
- miller
- smith)))
- (my-require (not (= (abs (- smith fletcher)) 1)))
- (list (list 'baker baker)
- (list 'cooper cooper)
- (list 'fletcher fletcher)
- (list 'miller miller)
- (list 'smith smith))))))))
- the-global-environment
- dsc
- dfc)
- (check-equal? (ambeval '(multiple-dwelling)
- the-global-environment
- dsc
- dfc)
- '((baker 3)
- (cooper 2)
- (fletcher 4)
- (miller 5)
- (smith 1)))
- )
- (test-case "fathers-daughters-and-yachts"
- (ambeval '(define (fathers-daughters-and-yachts)
- (define names '(mary-ann gabrielle lorna rosalind melissa))
- (let ([parker-daughter (an-element-of names)]
- [parker-yacht (an-element-of names)]
- [hood-daughter 'melissa]
- [hood-yacht 'gabrielle]
- [moore-daughter (an-element-of names)]
- [moore-yacht 'lorna]
- [downing-daughter (an-element-of names)]
- [downing-yacht 'melissa]
- [hall-daughter (an-element-of names)]
- [hall-yacht 'rosalind])
- (my-require (distinct?
- (list moore-daughter
- downing-daughter
- hall-daughter
- hood-daughter
- parker-daughter)))
- (my-require (distinct?
- (list moore-yacht
- downing-yacht
- hall-yacht
- hood-yacht
- parker-yacht)))
- (my-require (eq? moore-daughter 'mary-ann))
- (my-require (not (eq? moore-daughter moore-yacht)))
- (my-require (not (eq? downing-daughter downing-yacht)))
- (my-require (not (eq? hall-daughter hall-yacht)))
- (my-require (not (eq? hood-daughter hood-yacht)))
- (my-require (not (eq? parker-daughter parker-yacht)))
- (my-require (or (not (eq? moore-daughter 'gabrielle))
- (eq? moore-yacht parker-daughter)))
- (my-require (or (not (eq? downing-daughter 'gabrielle))
- (eq? downing-yacht parker-daughter)))
- (my-require (or (not (eq? hall-daughter 'gabrielle))
- (eq? hall-yacht parker-daughter)))
- (my-require (or (not (eq? hood-daughter 'gabrielle))
- (eq? hood-yacht parker-daughter)))
- (my-require (or (not (eq? parker-daughter 'gabrielle))
- (eq? parker-yacht parker-daughter)))
- (list (list 'moore moore-daughter)
- (list 'downing downing-daughter)
- (list 'hall hall-daughter)
- (list 'hood hood-daughter)
- (list 'parker parker-daughter))))
- the-global-environment
- dsc
- dfc)
- (check-equal? (ambeval '(fathers-daughters-and-yachts)
- the-global-environment
- dsc
- dfc)
- '((moore mary-ann)
- (downing lorna)
- (hall gabrielle)
- (hood melissa)
- (parker rosalind)))
- )
- (test-case "permanent-set!"
- (ambeval '(define count 0) the-global-environment dsc dfc)
- (check-equal? (ambeval '(let ([x (an-element-of '(a b c))]
- [y (an-element-of '(a b c))])
- (permanent-set! count (+ count 1))
- (my-require (not (eq? x y)))
- (list x y count))
- the-global-environment
- dsc
- dfc)
- '(a b 2))
- )
- (test-case "if-fail"
- (check-equal? (ambeval '(if-fail (let ([x (an-element-of '(1 3 5))])
- (my-require (even? x))
- x)
- 'all-odd)
- the-global-environment
- dsc
- dfc)
- 'all-odd)
- (check-equal? (ambeval '(if-fail (let ([x (an-element-of '(1 3 5 8))])
- (my-require (even? x))
- x)
- 'all-odd)
- the-global-environment
- dsc
- dfc)
- 8)
- )
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement