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-Cfun.rkt
53 lines (46 loc) · 1.81 KB
/
type-check-Cfun.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
48
49
50
51
52
53
#lang racket
(require "utilities.rkt")
(require "type-check-Cvar.rkt")
(require "type-check-Cif.rkt")
(require "type-check-Cvec.rkt")
(require "type-check-Rfun.rkt")
(provide type-check-Cfun type-check-Cfun-mixin)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; type-check-Cfun
(define (type-check-Cfun-mixin super-class)
(class super-class
(super-new)
(inherit type-check-exp type-equal? type-check-apply fun-def-type)
(define/override ((type-check-tail env block-env G) t)
(match t
[(TailCall f arg*)
(define-values (f^ arg*^ rt) (type-check-apply env f arg*))
rt]
[else ((super type-check-tail env block-env G) t)]
))
(define/override (type-check-def global-env)
(lambda (d)
(match d
[(Def f (and p:t* (list `[,xs : ,ps] ...)) rt info CFG)
(define new-env (append (map cons xs ps) global-env))
(define env (make-hash new-env))
(define block-env (make-hash))
(define t ((type-check-tail env block-env CFG)
(dict-ref CFG (symbol-append f 'start))))
(unless (type-equal? t rt)
(error 'type-check "mismatch in return type, ~a != ~a" t rt))
(define locals-types
(for/list ([(x t) (in-dict env)]
#:when (not (dict-has-key? global-env x)))
(cons x t)))
(define new-info (dict-set info 'locals-types locals-types))
(Def f p:t* rt new-info CFG)]
)))
))
(define type-check-Cfun-class (type-check-Cfun-mixin
(type-check-Cvec-mixin
(type-check-Cif-mixin
(type-check-Cvar-mixin
type-check-Rfun-class)))))
(define (type-check-Cfun p)
(send (new type-check-Cfun-class) type-check-program p))