Compare commits
2 Commits
f68e628804
...
31b6f1a494
Author | SHA1 | Date | |
---|---|---|---|
31b6f1a494 | |||
64281e9a42 |
2
.gitignore
vendored
2
.gitignore
vendored
@ -1,2 +1,2 @@
|
|||||||
# Ignore raket temp files
|
# Ignore raket temp files
|
||||||
*.rkt*
|
*.rkt~
|
||||||
|
49
Labs/07.rkt
Normal file
49
Labs/07.rkt
Normal file
@ -0,0 +1,49 @@
|
|||||||
|
#lang typed/racket
|
||||||
|
(require (rename-in typed/rackunit [check-equal? test])
|
||||||
|
(only-in typed/rackunit check-exn))
|
||||||
|
(define-syntax-rule (test/exn expr msg)
|
||||||
|
(check-exn exn:fail? (lambda () expr) msg))
|
||||||
|
|
||||||
|
(define (msg0 [obj : Node] [selector : Symbol]) (obj selector))
|
||||||
|
|
||||||
|
(define (node [v : Number] [l : Node] [r : Node]) : Node
|
||||||
|
(lambda (m)
|
||||||
|
(case m
|
||||||
|
[(value) v]
|
||||||
|
[(left) l]
|
||||||
|
[(right) r]
|
||||||
|
[(sum) (+ v (+ (msg-num l 'sum) (msg-num r 'sum)))]
|
||||||
|
[else (error 'node (symbol->string m))])))
|
||||||
|
|
||||||
|
(define (mt)
|
||||||
|
(lambda ([m : Symbol])
|
||||||
|
(case m
|
||||||
|
[(sum) 0]
|
||||||
|
[else (error 'mt (symbol->string m))])))
|
||||||
|
|
||||||
|
(define-type Node (Symbol -> (U (U Number Node) Zero)))
|
||||||
|
|
||||||
|
(define (msg-num [obj : Node] [selector : Symbol]) : Number
|
||||||
|
(define result (msg0 obj selector))
|
||||||
|
(cond
|
||||||
|
[(number? result) result]
|
||||||
|
[else (error 'msg-num "Expected a number message")]))
|
||||||
|
|
||||||
|
(define (msg-node [obj : Node] [selector : Symbol]) : Node
|
||||||
|
(define result (msg0 obj selector))
|
||||||
|
(cond
|
||||||
|
[(not (number? result)) result]
|
||||||
|
[else (error 'msg-node "Expected a node message")]))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(define tree1 (node 1 (mt) (mt)))
|
||||||
|
(test (msg0 tree1 'sum) 1)
|
||||||
|
(test (msg0 tree1 'value) 1)
|
||||||
|
(define tree2 (node 1 (node 2 (mt) (mt)) (mt)))
|
||||||
|
(test (msg0 tree2 'value) 1)
|
||||||
|
(test (msg0 (msg-node tree2 'left) 'value) 2)
|
||||||
|
(test (msg0 (msg-node tree2 'right) 'sum) 0)
|
||||||
|
(test/exn (msg0 (mt) 'left) "left")
|
||||||
|
(test/exn (msg0 tree2 'wrong) "wrong")
|
||||||
|
(test/exn (msg-num tree2 'left) "number")
|
||||||
|
(test/exn (msg-node tree2 'value) "node"))
|
Loading…
x
Reference in New Issue
Block a user