This repository has been archived by the owner on Oct 26, 2023. It is now read-only.
forked from iambrj/imin
-
Notifications
You must be signed in to change notification settings - Fork 0
/
type-check-Rwhile.rkt
48 lines (41 loc) · 1.62 KB
/
type-check-Rwhile.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
#lang racket
(require graph)
(require "multigraph.rkt")
(require "utilities.rkt")
(require (only-in "any.rkt" compile-Rany))
(require (only-in "type-check-Rlambda.rkt" typed-vars))
(require "type-check-Rany.rkt")
(require "type-check-Cany.rkt")
(provide type-check-Rwhile type-check-Rwhile-class)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; while, begin, set!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; type-check-Rwhile
(define type-check-Rwhile-class
(class type-check-Rany-class
(super-new)
(inherit check-type-equal?)
(define/override (type-check-exp env)
(lambda (e)
(define recur (type-check-exp env))
(match e
[(SetBang x rhs)
(define-values (rhs^ rhsT) (recur rhs))
(define varT (dict-ref env x))
(check-type-equal? rhsT varT e)
(values (SetBang x rhs^) 'Void)]
[(WhileLoop cnd body)
(define-values (cnd^ Tc) (recur cnd))
(check-type-equal? Tc 'Boolean e)
(define-values (body^ Tbody) ((type-check-exp env) body))
(values (WhileLoop cnd^ body^) 'Void)]
[(Begin es body)
(define-values (es^ ts)
(for/lists (l1 l2) ([e es]) (recur e)))
(define-values (body^ Tbody) (recur body))
(values (Begin es^ body^) Tbody)]
[else ((super type-check-exp env) e)])))
))
(define (type-check-Rwhile p)
(send (new type-check-Rwhile-class) type-check-program p))