diff --git a/compiler.rkt b/compiler.rkt index 99e8766..c64629f 100644 --- a/compiler.rkt +++ b/compiler.rkt @@ -1,12 +1,12 @@ #lang racket (require racket/set racket/stream) (require racket/fixnum) -(require "interp-Lint.rkt") -(require "interp-Lvar.rkt") -(require "interp-Cvar.rkt") +(require "interp_Lint.rkt") +(require "interp_Lvar.rkt") +(require "interp_Cvar.rkt") (require "interp.rkt") -(require "type-check-Lvar.rkt") -(require "type-check-Cvar.rkt") +(require "type_check_Lvar.rkt") +(require "type_check_Cvar.rkt") (require "utilities.rkt") (provide (all-defined-out)) @@ -103,9 +103,9 @@ (define compiler-passes `( ;; Uncomment the following passes as you finish them. - ;; ("uniquify" ,uniquify ,interp_Lvar ,type-check-Lvar) - ;; ("remove complex opera*" ,remove-complex-opera* ,interp_Lvar ,type-check-Lvar) - ;; ("explicate control" ,explicate-control ,interp-Cvar ,type-check-Cvar) + ;; ("uniquify" ,uniquify ,interp_Lvar ,type_check_Lvar) + ;; ("remove complex opera*" ,remove-complex-opera* ,interp_Lvar ,type_check_Lvar) + ;; ("explicate control" ,explicate-control ,interp_Cvar ,type_check_Cvar) ;; ("instruction selection" ,select-instructions ,interp-pseudo-x86-0) ;; ("assign homes" ,assign-homes ,interp-x86-0) ;; ("patch instructions" ,patch-instructions ,interp-x86-0) diff --git a/interp-Cany.rkt b/interp-Cany.rkt deleted file mode 100644 index a862b24..0000000 --- a/interp-Cany.rkt +++ /dev/null @@ -1,23 +0,0 @@ -#lang racket -(require "utilities.rkt") -(require "interp-Lany-prime.rkt") -(require "interp-Cvar.rkt") -(require "interp-Cif.rkt") -(require "interp-Cwhile.rkt") -(require "interp-Cvec.rkt") -(require "interp-Cvecof.rkt") -(require "interp-Cfun.rkt") -(require "interp-Clambda.rkt") -(provide interp-Cany) - -(define Cany-class (interp-Clambda-mixin - (interp-Cfun-mixin - (interp-Cvecof-mixin - (interp-Cvec-mixin - (interp-Cwhile-mixin - (interp-Cif-mixin - (interp-Cvar-mixin - interp-Lany-prime-class)))))))) - -(define (interp-Cany p) - (send (new Cany-class) interp-program p)) diff --git a/interp-Clambda.rkt b/interp-Clambda.rkt deleted file mode 100644 index 0f819fd..0000000 --- a/interp-Clambda.rkt +++ /dev/null @@ -1,37 +0,0 @@ -#lang racket -(require "utilities.rkt") -(require "interp-Llambda-prime.rkt") -(require "interp-Cvar.rkt") -(require "interp-Cif.rkt") -(require "interp-Cwhile.rkt") -(require "interp-Cvec.rkt") -(require "interp-Cvecof.rkt") -(require "interp-Cfun.rkt") -(require (prefix-in runtime-config: "runtime-config.rkt")) -(provide interp-Clambda interp-Clambda-mixin) - -(define (interp-Clambda-mixin super-class) - (class super-class - (super-new) - - (define/override (interp-op op) - (verbose "Clambda/interp-op" op) - (match op - ['procedure-arity - (match-lambda - [(vector (CFunction xs info G env) vs ... `(arity ,n)) n] - [v (error 'interp-op "Clambda/expected function, not ~a" v)])] - [else (super interp-op op)])) - )) - -(define Clambda-class (interp-Clambda-mixin - (interp-Cfun-mixin - (interp-Cvecof-mixin - (interp-Cvec-mixin - (interp-Cwhile-mixin - (interp-Cif-mixin - (interp-Cvar-mixin - interp-Llambda-prime-class)))))))) - -(define (interp-Clambda p) - (send (new Clambda-class) interp-program p)) diff --git a/interp-Cvecof.rkt b/interp-Cvecof.rkt deleted file mode 100644 index 01cd239..0000000 --- a/interp-Cvecof.rkt +++ /dev/null @@ -1,36 +0,0 @@ -#lang racket -(require "utilities.rkt") -(require "interp-Cvar.rkt") -(require "interp-Cif.rkt") -(require "interp-Cvec.rkt") -(require "interp-Cwhile.rkt") -(require "interp-Cvec.rkt") -(require "interp-Lvecof-prime.rkt") -(provide interp-Cvecof interp-Cvecof-mixin interp-Cvecof-class) - -(define (interp-Cvecof-mixin super-class) - (class super-class - (super-new) - (inherit interp_exp) - - (define/override ((interp-stmt env) s) - (match s - #;[(Prim 'vectorof-set! (list e-vec i e-arg)) - ((interp_exp env) s) - env] - [else ((super interp-stmt env) s)])) - - )) - -(define interp-Cvecof-class - (interp-Cvecof-mixin - (interp-Cvec-mixin - (interp-Cwhile-mixin - (interp-Cif-mixin - (interp-Cvar-mixin - interp-Lvecof-prime-class)))))) - -(define (interp-Cvecof p) - (send (new interp-Cvecof-class) interp-program p)) - - diff --git a/interp-Cwhile-proxy-closure.rkt b/interp-Cwhile-proxy-closure.rkt deleted file mode 100644 index 41a9960..0000000 --- a/interp-Cwhile-proxy-closure.rkt +++ /dev/null @@ -1,21 +0,0 @@ -#lang racket -(require "utilities.rkt") -(require "interp-Lwhile-proxy-closure.rkt") -(require "interp-Cvar.rkt") -(require "interp-Cif.rkt") -(require "interp-Cvec.rkt") -(require "interp-Cfun.rkt") -(require "interp-Clambda.rkt") -(require "interp-Cwhile.rkt") -(provide interp-Cwhile-proxy-closure) - -(define Cwhile-class (interp-Cwhile-mixin - (interp-Clambda-mixin - (interp-Cfun-mixin - (interp-Cvec-mixin - (interp-Cif-mixin - (interp-Cvar-mixin - interp-Lwhile-proxy-closure-class))))))) - -(define (interp-Cwhile-proxy-closure p) - (send (new Cwhile-class) interp-program p)) diff --git a/interp-Lvecof-proxy-closure.rkt b/interp-Lvecof-proxy-closure.rkt deleted file mode 100644 index 5c41d45..0000000 --- a/interp-Lvecof-proxy-closure.rkt +++ /dev/null @@ -1,11 +0,0 @@ -#lang racket -(require "interp-Lwhile-proxy-closure.rkt") -(require "interp-Lvecof-prime.rkt") -(provide interp-Lvecof-proxy-closure interp-Lvecof-proxy-closure-class) - - -(define interp-Lvecof-proxy-closure-class - (interp-Lwhile-proxy-closure-mixin interp-Lvecof-prime-class)) - -(define (interp-Lvecof-proxy-closure p) - (send (new interp-Lvecof-proxy-closure-class) interp-program p)) diff --git a/interp-Lwhile-prime-old.rkt b/interp-Lwhile-prime-old.rkt deleted file mode 100644 index a61d40f..0000000 --- a/interp-Lwhile-prime-old.rkt +++ /dev/null @@ -1,17 +0,0 @@ -#lang racket -(require "interp-Lvec-prime.rkt") -(require "interp-Lfun-prime.rkt") -(require "interp-Llambda-prime.rkt") -(require "interp-Lany-prime.rkt") -(require "interp-Lwhile.rkt") -(require "utilities.rkt") -(provide interp-Lwhile-prime interp-Lwhile-prime-class) - -(define interp-Lwhile-prime-class - (interp-Lany-prime-mixin - (interp-Llambda-prime-mixin - (interp-Lfun-prime-mixin - (interp-Lvec-prime-mixin interp-Lwhile-class))))) - -(define (interp-Lwhile-prime p) - (send (new interp-Lwhile-prime-class) interp-program p)) diff --git a/interp.rkt b/interp.rkt index ab62c07..858bdec 100644 --- a/interp.rkt +++ b/interp.rkt @@ -183,54 +183,54 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; C0 - (define/public (interp-C-exp env) + (define/public (interp_C_exp env) (lambda (ast) (define result (match ast [(Var x) (lookup x env)] [(Int n) n] [(Prim op args) - (apply (interp-op op) (map (interp-C-exp env) args))] + (apply (interp-op op) (map (interp_C_exp env) args))] [else - (error "C0/interp-C-exp unhandled" ast)] + (error "C0/interp_C_exp unhandled" ast)] )) - (verbose "C0/interp-C-exp" ast result) + (verbose "C0/interp_C_exp" ast result) result)) - (define/public (interp-C-tail env) + (define/public (interp_C_tail env) (lambda (ast) (match ast [(Return e) - ((interp-C-exp env) e)] + ((interp_C_exp env) e)] ;; (return-from-tail v env) hmm -Jeremy [(Seq s t) - (define new-env ((interp-C-stmt env) s)) - ((interp-C-tail new-env) t)] + (define new-env ((interp_C_stmt env) s)) + ((interp_C_tail new-env) t)] [else - (error "interp-C-tail unhandled" ast)] + (error "interp_C_tail unhandled" ast)] ))) - (define/public (interp-C-stmt env) + (define/public (interp_C_stmt env) (lambda (ast) - (verbose "C0/interp-C-stmt" ast) + (verbose "C0/interp_C_stmt" ast) (match ast [(Assign (Var x) e) - (let ([v ((interp-C-exp env) e)]) + (let ([v ((interp_C_exp env) e)]) (cons (cons x v) env))] [(Prim op args) - ((interp-C-exp env) ast) + ((interp_C_exp env) ast) env] [else - (error "interp-C-stmt unhandled" ast)] + (error "interp_C_stmt unhandled" ast)] ))) - (define/public (interp-C ast) - (debug "R1/interp-C" ast) + (define/public (interp_C ast) + (debug "R1/interp_C" ast) (match ast [(CProgram info blocks) (define start (dict-ref blocks 'start)) - ((interp-C-tail '()) start)] - [else (error "no match in interp-C for " ast)])) + ((interp_C_tail '()) start)] + [else (error "no match in interp_C for " ast)])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; psuedo-x86 and x86 @@ -413,37 +413,37 @@ [else ((super interp-scheme-exp env) ast)] ))) - (define/override (interp-C-exp env) + (define/override (interp_C_exp env) (lambda (ast) (define result (match ast - [(HasType e t) ((interp-C-exp env) e)] + [(HasType e t) ((interp_C_exp env) e)] [(Bool b) b] - [else ((super interp-C-exp env) ast)] + [else ((super interp_C_exp env) ast)] )) - (copious "R2/interp-C-exp" ast result) + (copious "R2/interp_C_exp" ast result) result)) - (define/override (interp-C-tail env) + (define/override (interp_C_tail env) (lambda (ast) - (copious "R2/interp-C-tail" ast) + (copious "R2/interp_C_tail" ast) (match ast [(IfStmt cnd thn els) - (if ((interp-C-exp env) cnd) - ((interp-C-tail env) thn) - ((interp-C-tail env) els))] + (if ((interp_C_exp env) cnd) + ((interp_C_tail env) thn) + ((interp_C_tail env) els))] [(Goto label) - ((interp-C-tail env) (goto-label label))] - [else ((super interp-C-tail env) ast)] + ((interp_C_tail env) (goto-label label))] + [else ((super interp_C_tail env) ast)] ))) - (define/override (interp-C ast) - (copious "R2/interp-C" ast) + (define/override (interp_C ast) + (copious "R2/interp_C" ast) (match ast [(CProgram info blocks) (parameterize ([get-basic-blocks blocks]) - (super interp-C (CProgram info blocks)))] - [else (error "R2/interp-C unhandled" ast)] + (super interp_C (CProgram info blocks)))] + [else (error "R2/interp_C unhandled" ast)] )) (define byte2full-reg @@ -757,7 +757,7 @@ [(AllocateProxy ty) (build-vector 3 (lambda a uninitialized))] [(Collect size) (unless (exact-nonnegative-integer? size) - (error 'interp-C "invalid argument to collect in ~a" ast)) + (error 'interp_C "invalid argument to collect in ~a" ast)) (void)] #;[`(vector-ref ,e-vec ,e-i) (define vec (recur e-vec)) @@ -804,7 +804,7 @@ label)) value)) - (define/override (interp-C-exp env) + (define/override (interp_C_exp env) (lambda (ast) (define result (match ast @@ -816,7 +816,7 @@ [(CollectionNeeded? size) (when (or (eq? (unbox free_ptr) uninitialized) (eq? (unbox fromspace_end) uninitialized)) - (error 'interp-C "uninitialized state in ~a" ast)) + (error 'interp_C "uninitialized state in ~a" ast)) #t] ;; allocate a vector of length l and type t that is initialized. [(Allocate l ty) (build-vector l (lambda a uninitialized))] @@ -828,15 +828,15 @@ (build-vector l (lambda a uninitialized))] [(AllocateProxy ty) (build-vector 3 (lambda a uninitialized))] [else - ((super interp-C-exp env) ast)] + ((super interp_C_exp env) ast)] )) - (copious "R3/interp-C-exp" ast result) + (copious "R3/interp_C_exp" ast result) result)) - (define/override (interp-C-stmt env) + (define/override (interp_C_stmt env) (lambda (ast) - (copious "R3/interp-C-stmt" ast) + (copious "R3/interp_C_stmt" ast) (match ast ;; Determine if a collection is needed. ;; Which it isn't because vectors stored in the environment @@ -846,29 +846,29 @@ ;; Collection isn't needed or possible in this representation [(Collect size) (unless (exact-nonnegative-integer? size) - (error 'interp-C "invalid argument to collect in ~a" ast)) + (error 'interp_C "invalid argument to collect in ~a" ast)) env] [else - ((super interp-C-stmt env) ast)] + ((super interp_C_stmt env) ast)] ))) - (define/override (interp-C-tail env) + (define/override (interp_C_tail env) (lambda (ast) - (copious "R3/interp-C-tail" ast) + (copious "R3/interp_C_tail" ast) (match ast [(Seq s t) - (define new-env ((interp-C-stmt env) s)) - ((interp-C-tail new-env) t)] - [else ((super interp-C-tail env) ast)]))) + (define new-env ((interp_C_stmt env) s)) + ((interp_C_tail new-env) t)] + [else ((super interp_C_tail env) ast)]))) - (define/override (interp-C ast) - (copious "R3/interp-C" ast) + (define/override (interp_C ast) + (copious "R3/interp_C" ast) (match ast [(CProgram info blocks) ((initialize!) runtime-config:rootstack-size runtime-config:heap-size) - (super interp-C (CProgram info blocks))] - [else (error "R3/interp-C unhandled" ast)])) + (super interp_C (CProgram info blocks))] + [else (error "R3/interp_C unhandled" ast)])) (define/override (interp-x86-exp env) (lambda (ast) @@ -1146,74 +1146,74 @@ result )) - (define/override (interp-C-exp env) + (define/override (interp_C_exp env) (lambda (ast) (define result (match ast [(FunRef f n) (lookup f env)] [(Call f args) - (define arg-vals (map (interp-C-exp env) args)) - (define f-val ((interp-C-exp env) f)) + (define arg-vals (map (interp_C_exp env) args)) + (define f-val ((interp_C_exp env) f)) (match f-val [(CFunction xs info blocks def-env) (define f (dict-ref info 'name)) (define f-start (symbol-append f '_start)) (define new-env (append (map cons xs arg-vals) def-env)) (parameterize ([get-basic-blocks blocks]) - ((interp-C-tail new-env) (dict-ref blocks f-start)))] - [else (error "interp-C, expected a function, not" f-val)])] + ((interp_C_tail new-env) (dict-ref blocks f-start)))] + [else (error "interp_C, expected a function, not" f-val)])] [else - ((super interp-C-exp env) ast)] + ((super interp_C_exp env) ast)] )) - (verbose "R4/interp-C-exp" ast result) + (verbose "R4/interp_C_exp" ast result) result)) - (define/override (interp-C-tail env) + (define/override (interp_C_tail env) (lambda (ast) (define result (match ast [(TailCall f args) - (define arg-vals (map (interp-C-exp env) args)) - (define f-val ((interp-C-exp env) f)) + (define arg-vals (map (interp_C_exp env) args)) + (define f-val ((interp_C_exp env) f)) (match f-val [(CFunction xs info blocks def-env) (define f (dict-ref info 'name)) (define f-start (symbol-append f '_start)) (define new-env (append (map cons xs arg-vals) def-env)) (parameterize ([get-basic-blocks blocks]) - ((interp-C-tail new-env) (dict-ref blocks f-start)))] - [else (error "interp-C, expected a funnction, not" f-val)])] + ((interp_C_tail new-env) (dict-ref blocks f-start)))] + [else (error "interp_C, expected a funnction, not" f-val)])] [else - ((super interp-C-tail env) ast)] + ((super interp_C_tail env) ast)] )) - (verbose "R4/interp-C-tail" ast result) + (verbose "R4/interp_C_tail" ast result) result)) - (define/public (interp-C-def ast) - (verbose "R4/interp-C-def" ast) + (define/public (interp_C_def ast) + (verbose "R4/interp_C_def" ast) (match ast [(Def f `([,xs : ,ps] ...) rt info blocks) (mcons f (CFunction xs `((name . ,f)) blocks '()))] [else - (error "R4/interp-C-def unhandled" ast)] + (error "R4/interp_C_def unhandled" ast)] )) - (define/override (interp-C ast) - (verbose "R4/interp-C" ast) + (define/override (interp_C ast) + (verbose "R4/interp_C" ast) (match ast [(ProgramDefs info ds) ((initialize!) runtime-config:rootstack-size runtime-config:heap-size) - (define top-level (for/list ([d ds]) (interp-C-def d))) + (define top-level (for/list ([d ds]) (interp_C_def d))) ;; tie the knot (for/list ([b top-level]) (set-mcdr! b (match (mcdr b) [(CFunction xs info blocks '()) (CFunction xs info blocks top-level)]))) - ((interp-C-tail top-level) (TailCall (Var 'main) '()))] + ((interp_C_tail top-level) (TailCall (Var 'main) '()))] [else - (error "R4/interp-C unhandled" ast)] + (error "R4/interp_C unhandled" ast)] )) (define (stack-arg-name n) @@ -1616,14 +1616,14 @@ (verbose "R6/interp-F result of" ast result) result)) - (define/override (interp-C-exp env) + (define/override (interp_C_exp env) (lambda (ast) (define result (match ast #;[(Inject e t) - `(tagged ,((interp-C-exp env) e) ,t)] + `(tagged ,((interp_C_exp env) e) ,t)] #;[(Project e t2) - (define v ((interp-C-exp env) e)) + (define v ((interp_C_exp env) e)) (match v [`(tagged ,v1 ,t1) (cond [(tyeq? t1 t2) @@ -1633,11 +1633,11 @@ [else (error "in project, expected injected value" v)])] [(ValueOf e ty) - ((interp-op 'value-of-any) ((interp-C-exp env) e))] + ((interp-op 'value-of-any) ((interp_C_exp env) e))] [else - ((super interp-C-exp env) ast)] + ((super interp_C_exp env) ast)] )) - (verbose "R6/interp-C-exp ===> " ast result) + (verbose "R6/interp_C_exp ===> " ast result) result)) #;(define/override (display-by-type ty val) @@ -1668,7 +1668,7 @@ (define interp-R8-class (class interp-R6-class-alt (super-new) - (inherit initialize! interp-C-exp) + (inherit initialize! interp_C_exp) (inherit-field result) (define/override (apply-fun interp fun-val arg-vals) @@ -1726,14 +1726,14 @@ (verbose "R8/interp-F result of" ast result) result)) - (define/override (interp-C-stmt env) + (define/override (interp_C_stmt env) (lambda (ast) - (copious "R8/interp-C-stmt" ast) + (copious "R8/interp_C_stmt" ast) (match ast [(Call f args) - ((interp-C-exp env) ast) + ((interp_C_exp env) ast) env] - [else ((super interp-C-stmt env) ast)] + [else ((super interp_C_stmt env) ast)] ))) )) ;; interp-R8-class diff --git a/interp_Cany.rkt b/interp_Cany.rkt new file mode 100644 index 0000000..9269bf2 --- /dev/null +++ b/interp_Cany.rkt @@ -0,0 +1,23 @@ +#lang racket +(require "utilities.rkt") +(require "interp_Lany_prime.rkt") +(require "interp_Cvar.rkt") +(require "interp_Cif.rkt") +(require "interp_Cwhile.rkt") +(require "interp_Cvec.rkt") +(require "interp_Cvecof.rkt") +(require "interp_Cfun.rkt") +(require "interp_Clambda.rkt") +(provide interp_Cany) + +(define Cany-class (interp_Clambda-mixin + (interp_Cfun-mixin + (interp_Cvecof-mixin + (interp_Cvec-mixin + (interp_Cwhile-mixin + (interp_Cif-mixin + (interp_Cvar-mixin + interp_Lany_prime-class)))))))) + +(define (interp_Cany p) + (send (new Cany-class) interp-program p)) diff --git a/interp-Cany-proxy-closure.rkt b/interp_Cany_proxy_closure.rkt similarity index 75% rename from interp-Cany-proxy-closure.rkt rename to interp_Cany_proxy_closure.rkt index fb3a323..2920a00 100644 --- a/interp-Cany-proxy-closure.rkt +++ b/interp_Cany_proxy_closure.rkt @@ -1,16 +1,16 @@ #lang racket (require "utilities.rkt") -(require "interp-Lany-proxy-closure.rkt") -(require "interp-Cvar.rkt") -(require "interp-Cif.rkt") -(require "interp-Cwhile.rkt") -(require "interp-Cvec.rkt") -(require "interp-Cvecof.rkt") -(require "interp-Cfun.rkt") -(require "interp-Clambda.rkt") -(provide interp-Cany-proxy-closure) +(require "interp_Lany_proxy_closure.rkt") +(require "interp_Cvar.rkt") +(require "interp_Cif.rkt") +(require "interp_Cwhile.rkt") +(require "interp_Cvec.rkt") +(require "interp_Cvecof.rkt") +(require "interp_Cfun.rkt") +(require "interp_Clambda.rkt") +(provide interp_Cany_proxy_closure) -(define (interp-Cany-proxy-closure-mixin super-class) +(define (interp_Cany_proxy_closure-mixin super-class) (class super-class (super-new) (inherit call-function) @@ -68,16 +68,16 @@ )) -(define Cany-proxy-closure-class - (interp-Cany-proxy-closure-mixin - (interp-Clambda-mixin - (interp-Cfun-mixin - (interp-Cvecof-mixin - (interp-Cvec-mixin - (interp-Cwhile-mixin - (interp-Cif-mixin - (interp-Cvar-mixin - interp-Lany-proxy-closure-class))))))))) +(define Cany_proxy_closure-class + (interp_Cany_proxy_closure-mixin + (interp_Clambda-mixin + (interp_Cfun-mixin + (interp_Cvecof-mixin + (interp_Cvec-mixin + (interp_Cwhile-mixin + (interp_Cif-mixin + (interp_Cvar-mixin + interp_Lany_proxy_closure-class))))))))) -(define (interp-Cany-proxy-closure p) - (send (new Cany-proxy-closure-class) interp-program p)) +(define (interp_Cany_proxy_closure p) + (send (new Cany_proxy_closure-class) interp-program p)) diff --git a/interp-Cfun.rkt b/interp_Cfun.rkt similarity index 81% rename from interp-Cfun.rkt rename to interp_Cfun.rkt index 2c37044..7d2c634 100644 --- a/interp-Cfun.rkt +++ b/interp_Cfun.rkt @@ -1,15 +1,15 @@ #lang racket (require "utilities.rkt") -(require "interp-Lfun-prime.rkt") -(require "interp-Cvar.rkt") -(require "interp-Cif.rkt") -(require "interp-Cwhile.rkt") -(require "interp-Cvec.rkt") -(require "interp-Cvecof.rkt") +(require "interp_Lfun_prime.rkt") +(require "interp_Cvar.rkt") +(require "interp_Cif.rkt") +(require "interp_Cwhile.rkt") +(require "interp_Cvec.rkt") +(require "interp_Cvecof.rkt") (require (prefix-in runtime-config: "runtime-config.rkt")) -(provide interp-Cfun interp-Cfun-mixin) +(provide interp_Cfun interp_Cfun-mixin) -(define (interp-Cfun-mixin super-class) +(define (interp_Cfun-mixin super-class) (class super-class (super-new) (inherit initialize!) @@ -80,12 +80,12 @@ )) -(define (interp-Cfun p) - (define Cfun-class (interp-Cfun-mixin - (interp-Cvecof-mixin - (interp-Cvec-mixin - (interp-Cwhile-mixin - (interp-Cif-mixin - (interp-Cvar-mixin - interp-Lfun-prime-class))))))) +(define (interp_Cfun p) + (define Cfun-class (interp_Cfun-mixin + (interp_Cvecof-mixin + (interp_Cvec-mixin + (interp_Cwhile-mixin + (interp_Cif-mixin + (interp_Cvar-mixin + interp_Lfun_prime-class))))))) (send (new Cfun-class) interp-program p)) diff --git a/interp-Cif.rkt b/interp_Cif.rkt similarity index 85% rename from interp-Cif.rkt rename to interp_Cif.rkt index 22fd23b..4cdbe71 100644 --- a/interp-Cif.rkt +++ b/interp_Cif.rkt @@ -1,10 +1,10 @@ #lang racket (require "utilities.rkt") -(require "interp-Lif.rkt") -(require "interp-Cvar.rkt") -(provide interp-Cif interp-Cif-mixin) +(require "interp_Lif.rkt") +(require "interp_Cvar.rkt") +(provide interp_Cif interp_Cif-mixin) -(define (interp-Cif-mixin super-class) +(define (interp_Cif-mixin super-class) (class super-class (super-new) (inherit interp_exp) @@ -42,8 +42,8 @@ )) )) -(define (interp-Cif p) - (define Cif-class (interp-Cif-mixin (interp-Cvar-mixin interp-Lif-class))) +(define (interp_Cif p) + (define Cif-class (interp_Cif-mixin (interp_Cvar-mixin interp_Lif-class))) (send (new Cif-class) interp-program p)) diff --git a/interp_Clambda.rkt b/interp_Clambda.rkt new file mode 100644 index 0000000..096fb5f --- /dev/null +++ b/interp_Clambda.rkt @@ -0,0 +1,37 @@ +#lang racket +(require "utilities.rkt") +(require "interp_Llambda_prime.rkt") +(require "interp_Cvar.rkt") +(require "interp_Cif.rkt") +(require "interp_Cwhile.rkt") +(require "interp_Cvec.rkt") +(require "interp_Cvecof.rkt") +(require "interp_Cfun.rkt") +(require (prefix-in runtime-config: "runtime-config.rkt")) +(provide interp_Clambda interp_Clambda-mixin) + +(define (interp_Clambda-mixin super-class) + (class super-class + (super-new) + + (define/override (interp-op op) + (verbose "Clambda/interp-op" op) + (match op + ['procedure-arity + (match-lambda + [(vector (CFunction xs info G env) vs ... `(arity ,n)) n] + [v (error 'interp-op "Clambda/expected function, not ~a" v)])] + [else (super interp-op op)])) + )) + +(define Clambda-class (interp_Clambda-mixin + (interp_Cfun-mixin + (interp_Cvecof-mixin + (interp_Cvec-mixin + (interp_Cwhile-mixin + (interp_Cif-mixin + (interp_Cvar-mixin + interp_Llambda_prime-class)))))))) + +(define (interp_Clambda p) + (send (new Clambda-class) interp-program p)) diff --git a/interp-Cvar.rkt b/interp_Cvar.rkt similarity index 80% rename from interp-Cvar.rkt rename to interp_Cvar.rkt index b7c3458..6295cd7 100644 --- a/interp-Cvar.rkt +++ b/interp_Cvar.rkt @@ -2,10 +2,10 @@ (require racket/fixnum) (require racket/dict) (require "utilities.rkt") -(require "interp-Lvar.rkt") -(provide interp-Cvar interp-Cvar-mixin) +(require "interp_Lvar.rkt") +(provide interp_Cvar interp_Cvar-mixin) -(define (interp-Cvar-mixin super-class) +(define (interp_Cvar-mixin super-class) (class super-class (super-new) (inherit interp_exp) @@ -36,5 +36,5 @@ )) )) -(define (interp-Cvar p) - (send (new (interp-Cvar-mixin interp-Lvar-class)) interp-program p)) +(define (interp_Cvar p) + (send (new (interp_Cvar-mixin interp_Lvar-class)) interp-program p)) diff --git a/interp-Cvec.rkt b/interp_Cvec.rkt similarity index 77% rename from interp-Cvec.rkt rename to interp_Cvec.rkt index ddc60ce..c0625f9 100644 --- a/interp-Cvec.rkt +++ b/interp_Cvec.rkt @@ -1,13 +1,13 @@ #lang racket (require "utilities.rkt") -(require "interp-Lvec-prime.rkt") -(require "interp-Cvar.rkt") -(require "interp-Cif.rkt") -(require "interp-Cwhile.rkt") +(require "interp_Lvec_prime.rkt") +(require "interp_Cvar.rkt") +(require "interp_Cif.rkt") +(require "interp_Cwhile.rkt") (require (prefix-in runtime-config: "runtime-config.rkt")) -(provide interp-Cvec interp-Cvec-mixin) +(provide interp_Cvec interp_Cvec-mixin) -(define (interp-Cvec-mixin super-class) +(define (interp_Cvec-mixin super-class) (class super-class (super-new) (inherit interp_exp initialize!) @@ -31,7 +31,7 @@ ;; Collection isn't needed or possible in this representation [(Collect size) (unless (exact-nonnegative-integer? size) - (error 'interp-C "invalid argument to collect in ~a" ast)) + (error 'interp_C "invalid argument to collect in ~a" ast)) env] [else ((super interp-stmt env) ast)] ))) @@ -56,11 +56,11 @@ [else (error "interp-program unhandled" ast)])) )) -(define (interp-Cvec p) - (define Cvec-class (interp-Cvec-mixin - (interp-Cwhile-mixin - (interp-Cif-mixin - (interp-Cvar-mixin - interp-Lvec-prime-class))))) +(define (interp_Cvec p) + (define Cvec-class (interp_Cvec-mixin + (interp_Cwhile-mixin + (interp_Cif-mixin + (interp_Cvar-mixin + interp_Lvec_prime-class))))) (send (new Cvec-class) interp-program p)) diff --git a/interp_Cvecof.rkt b/interp_Cvecof.rkt new file mode 100644 index 0000000..227137c --- /dev/null +++ b/interp_Cvecof.rkt @@ -0,0 +1,36 @@ +#lang racket +(require "utilities.rkt") +(require "interp_Cvar.rkt") +(require "interp_Cif.rkt") +(require "interp_Cvec.rkt") +(require "interp_Cwhile.rkt") +(require "interp_Cvec.rkt") +(require "interp_Lvecof_prime.rkt") +(provide interp_Cvecof interp_Cvecof-mixin interp_Cvecof-class) + +(define (interp_Cvecof-mixin super-class) + (class super-class + (super-new) + (inherit interp_exp) + + (define/override ((interp-stmt env) s) + (match s + #;[(Prim 'vectorof-set! (list e-vec i e-arg)) + ((interp_exp env) s) + env] + [else ((super interp-stmt env) s)])) + + )) + +(define interp_Cvecof-class + (interp_Cvecof-mixin + (interp_Cvec-mixin + (interp_Cwhile-mixin + (interp_Cif-mixin + (interp_Cvar-mixin + interp_Lvecof_prime-class)))))) + +(define (interp_Cvecof p) + (send (new interp_Cvecof-class) interp-program p)) + + diff --git a/interp-Cwhile.rkt b/interp_Cwhile.rkt similarity index 61% rename from interp-Cwhile.rkt rename to interp_Cwhile.rkt index 55dce15..5842c4c 100644 --- a/interp-Cwhile.rkt +++ b/interp_Cwhile.rkt @@ -1,11 +1,11 @@ #lang racket (require "utilities.rkt") -(require "interp-Lwhile.rkt") -(require "interp-Cvar.rkt") -(require "interp-Cif.rkt") -(provide interp-Cwhile interp-Cwhile-mixin) +(require "interp_Lwhile.rkt") +(require "interp_Cvar.rkt") +(require "interp_Cif.rkt") +(provide interp_Cwhile interp_Cwhile-mixin) -(define (interp-Cwhile-mixin super-class) +(define (interp_Cwhile-mixin super-class) (class super-class (super-new) (inherit interp_exp); call-function @@ -25,10 +25,10 @@ )) -(define Cwhile-class (interp-Cwhile-mixin - (interp-Cif-mixin - (interp-Cvar-mixin - interp-Lwhile-class)))) +(define Cwhile-class (interp_Cwhile-mixin + (interp_Cif-mixin + (interp_Cvar-mixin + interp_Lwhile-class)))) -(define (interp-Cwhile p) +(define (interp_Cwhile p) (send (new Cwhile-class) interp-program p)) diff --git a/interp_Cwhile_proxy_closure.rkt b/interp_Cwhile_proxy_closure.rkt new file mode 100644 index 0000000..39089e2 --- /dev/null +++ b/interp_Cwhile_proxy_closure.rkt @@ -0,0 +1,21 @@ +#lang racket +(require "utilities.rkt") +(require "interp_Lwhile_proxy_closure.rkt") +(require "interp_Cvar.rkt") +(require "interp_Cif.rkt") +(require "interp_Cvec.rkt") +(require "interp_Cfun.rkt") +(require "interp_Clambda.rkt") +(require "interp_Cwhile.rkt") +(provide interp_Cwhile_proxy_closure) + +(define Cwhile-class (interp_Cwhile-mixin + (interp_Clambda-mixin + (interp_Cfun-mixin + (interp_Cvec-mixin + (interp_Cif-mixin + (interp_Cvar-mixin + interp_Lwhile_proxy_closure-class))))))) + +(define (interp_Cwhile_proxy_closure p) + (send (new Cwhile-class) interp-program p)) diff --git a/interp-Lany.rkt b/interp_Lany.rkt similarity index 93% rename from interp-Lany.rkt rename to interp_Lany.rkt index d8c906b..1c2a325 100644 --- a/interp-Lany.rkt +++ b/interp_Lany.rkt @@ -1,15 +1,15 @@ #lang racket (require racket/fixnum) (require "utilities.rkt") -(require "interp-Llambda.rkt") -(provide interp-Lany interp-Lany-class) +(require "interp_Llambda.rkt") +(provide interp_Lany interp_Lany-class) ;; Note to maintainers of this code: ;; A copy of this interpreter is in the book and should be ;; kept in sync with this code. -(define interp-Lany-class - (class interp-Llambda-class +(define interp_Lany-class + (class interp_Llambda-class (super-new) (define/override (interp-op op) @@ -76,5 +76,5 @@ [else ((super interp_exp env) e)])) )) -(define (interp-Lany p) - (send (new interp-Lany-class) interp-program p)) +(define (interp_Lany p) + (send (new interp_Lany-class) interp-program p)) diff --git a/interp-Lany-prime.rkt b/interp_Lany_prime.rkt similarity index 52% rename from interp-Lany-prime.rkt rename to interp_Lany_prime.rkt index d761c39..eff52be 100644 --- a/interp-Lany-prime.rkt +++ b/interp_Lany_prime.rkt @@ -1,19 +1,19 @@ #lang racket -(require "interp-Lvec-prime.rkt") -(require "interp-Lvecof-prime.rkt") -(require "interp-Lfun-prime.rkt") -(require "interp-Llambda-prime.rkt") -(require "interp-Lany.rkt") +(require "interp_Lvec_prime.rkt") +(require "interp_Lvecof_prime.rkt") +(require "interp_Lfun_prime.rkt") +(require "interp_Llambda_prime.rkt") +(require "interp_Lany.rkt") (require "utilities.rkt") (require (prefix-in runtime-config: "runtime-config.rkt")) -(provide interp-Lany-prime interp-Lany-prime-class interp-Lany-prime-mixin) +(provide interp_Lany_prime interp_Lany_prime-class interp_Lany_prime-mixin) -(define (interp-Lany-prime-mixin super-class) +(define (interp_Lany_prime-mixin super-class) (class super-class (super-new) (define/override (interp-op op) - (verbose "Lany-prime/interp-op" op) + (verbose "Lany_prime/interp-op" op) (match op ['make-any (lambda (v tg) (Tagged v tg))] ['tag-of-any @@ -24,7 +24,7 @@ (define/override ((interp_exp env) e) (define recur (interp_exp env)) - (verbose "Lany-prime/interp_exp" e) + (verbose "Lany_prime/interp_exp" e) (match e [(ValueOf e ty) (match (recur e) @@ -33,13 +33,13 @@ [else ((super interp_exp env) e)])) )) -(define interp-Lany-prime-class - (interp-Lany-prime-mixin - (interp-Llambda-prime-mixin - (interp-Lfun-prime-mixin - (interp-Lvecof-prime-mixin - (interp-Lvec-prime-mixin - interp-Lany-class)))))) +(define interp_Lany_prime-class + (interp_Lany_prime-mixin + (interp_Llambda_prime-mixin + (interp_Lfun_prime-mixin + (interp_Lvecof_prime-mixin + (interp_Lvec_prime-mixin + interp_Lany-class)))))) -(define (interp-Lany-prime p) - (send (new interp-Lany-prime-class) interp-program p)) +(define (interp_Lany_prime p) + (send (new interp_Lany_prime-class) interp-program p)) diff --git a/interp-Lany-proxy.rkt b/interp_Lany_proxy.rkt similarity index 94% rename from interp-Lany-proxy.rkt rename to interp_Lany_proxy.rkt index 6a74d0d..6a9d1ec 100644 --- a/interp-Lany-proxy.rkt +++ b/interp_Lany_proxy.rkt @@ -1,12 +1,12 @@ #lang racket (require racket/fixnum) (require "utilities.rkt") -(require "interp-Lany-prime.rkt") +(require "interp_Lany_prime.rkt") (require (prefix-in runtime-config: "runtime-config.rkt")) -(provide interp-Lany-proxy interp-Lany-proxy-class) +(provide interp_Lany_proxy interp_Lany_proxy-class) -(define interp-Lany-proxy-class - (class interp-Lany-prime-class +(define interp_Lany_proxy-class + (class interp_Lany_prime-class (super-new) (inherit apply-fun initialize! interp-def interp_exp) @@ -96,6 +96,6 @@ )) -(define (interp-Lany-proxy p) - (send (new interp-Lany-proxy-class) interp-program p)) +(define (interp_Lany_proxy p) + (send (new interp_Lany_proxy-class) interp-program p)) diff --git a/interp-Lany-proxy-closure.rkt b/interp_Lany_proxy_closure.rkt similarity index 87% rename from interp-Lany-proxy-closure.rkt rename to interp_Lany_proxy_closure.rkt index 04d8d65..145b834 100644 --- a/interp-Lany-proxy-closure.rkt +++ b/interp_Lany_proxy_closure.rkt @@ -1,11 +1,11 @@ #lang racket (require "utilities.rkt") -(require "interp-Lany-prime.rkt") -(provide interp-Lany-proxy-closure - interp-Lany-proxy-closure-mixin - interp-Lany-proxy-closure-class) +(require "interp_Lany_prime.rkt") +(provide interp_Lany_proxy_closure + interp_Lany_proxy_closure-mixin + interp_Lany_proxy_closure-class) -(define (interp-Lany-proxy-closure-mixin super-class) +(define (interp_Lany_proxy_closure-mixin super-class) (class super-class (super-new) (inherit apply-fun interp-def) @@ -79,9 +79,9 @@ )) -(define interp-Lany-proxy-closure-class - (interp-Lany-proxy-closure-mixin interp-Lany-prime-class)) +(define interp_Lany_proxy_closure-class + (interp_Lany_proxy_closure-mixin interp_Lany_prime-class)) -(define (interp-Lany-proxy-closure p) - (send (new interp-Lany-proxy-closure-class) interp-program p)) +(define (interp_Lany_proxy_closure p) + (send (new interp_Lany_proxy_closure-class) interp-program p)) diff --git a/interp-Lcast.rkt b/interp_Lcast.rkt similarity index 95% rename from interp-Lcast.rkt rename to interp_Lcast.rkt index 0edb916..3ae4faf 100644 --- a/interp-Lcast.rkt +++ b/interp_Lcast.rkt @@ -1,11 +1,11 @@ #lang racket ;(require racket/fixnum) (require "utilities.rkt") -(require "interp-Lany.rkt") -(provide interp-Lcast interp-Lcast-class) +(require "interp_Lany.rkt") +(provide interp_Lcast interp_Lcast-class) -(define interp-Lcast-class - (class interp-Lany-class +(define interp_Lcast-class + (class interp_Lany-class (super-new) (inherit apply-fun apply-inject apply-project) @@ -107,6 +107,6 @@ )) -(define (interp-Lcast p) - (send (new interp-Lcast-class) interp-program p)) +(define (interp_Lcast p) + (send (new interp_Lcast-class) interp-program p)) diff --git a/interp-Ldyn.rkt b/interp_Ldyn.rkt similarity index 88% rename from interp-Ldyn.rkt rename to interp_Ldyn.rkt index 03418fe..9063926 100644 --- a/interp-Ldyn.rkt +++ b/interp_Ldyn.rkt @@ -1,7 +1,7 @@ #lang racket (require racket/fixnum) (require "utilities.rkt" (prefix-in runtime-config: "runtime-config.rkt")) -(provide interp-Ldyn interp-Ldyn-prog) +(provide interp_Ldyn interp_Ldyn_prog) ;; Note to maintainers of this code: ;; A copy of this interpreter is in the book and should be @@ -68,9 +68,9 @@ (unless (eq? tag expected) (error 'trapped-error "expected ~a tag, not ~a\nin ~v" expected tag ast))) -(define ((interp-Ldyn-exp env) ast) - (verbose 'interp-Ldyn "start" ast) - (define recur (interp-Ldyn-exp env)) +(define ((interp_Ldyn_exp env) ast) + (verbose 'interp_Ldyn "start" ast) + (define recur (interp_Ldyn_exp env)) (define result (match ast [(Var x) (unbox (lookup x env))] @@ -95,7 +95,7 @@ (vector-set! (Tagged-value vec) (Tagged-value i) arg) (Tagged (void) 'Void)] [(Let x e body) - ((interp-Ldyn-exp (cons (cons x (box (recur e))) env)) body)] + ((interp_Ldyn_exp (cons (cons x (box (recur e))) env)) body)] [(Prim 'and (list e1 e2)) (recur (If e1 e2 (Bool #f)))] [(Prim 'or (list e1 e2)) (define v1 (recur e1)) @@ -143,38 +143,38 @@ (error 'trapped-error "number of arguments ~a != arity ~a\nin ~v" (length args) (length xs) ast)) (define new-env (append (map cons xs args) lam-env)) - ((interp-Ldyn-exp new-env) body)] - [else (error "interp-Ldyn-exp, expected function, not" f-val)])])) - (verbose 'interp-Ldyn ast result) + ((interp_Ldyn_exp new-env) body)] + [else (error "interp_Ldyn_exp, expected function, not" f-val)])])) + (verbose 'interp_Ldyn ast result) result) -(define (interp-Ldyn-def ast) +(define (interp_Ldyn-def ast) (match ast [(Def f xs rt info body) (mcons f (Function xs body '()))])) ;; This version is for source code in Ldyn. -(define (interp-Ldyn ast) +(define (interp_Ldyn ast) (match ast [(ProgramDefsExp info ds body) - (define top-level (map (lambda (d) (interp-Ldyn-def d)) ds)) + (define top-level (map (lambda (d) (interp_Ldyn-def d)) ds)) (for/list ([b top-level]) (set-mcdr! b (match (mcdr b) [(Function xs body '()) (box (Tagged (Function xs body top-level) 'Procedure))]))) - (define result ((interp-Ldyn-exp top-level) body)) + (define result ((interp_Ldyn_exp top-level) body)) (check-tag result 'Integer ast) (Tagged-value result)] - [(Program info body) (interp-Ldyn (ProgramDefsExp info '() body))])) + [(Program info body) (interp_Ldyn (ProgramDefsExp info '() body))])) ;; This version is for after shrink. -(define (interp-Ldyn-prog ast) +(define (interp_Ldyn_prog ast) (match ast [(ProgramDefs info ds) - (define top-level (map (lambda (d) (interp-Ldyn-def d)) ds)) + (define top-level (map (lambda (d) (interp_Ldyn-def d)) ds)) (for/list ([b top-level]) (set-mcdr! b (match (mcdr b) [(Function xs body '()) (box (Tagged (Function xs body top-level) 'Procedure))]))) - (define result ((interp-Ldyn-exp top-level) (Apply (Var 'main) '()))) + (define result ((interp_Ldyn_exp top-level) (Apply (Var 'main) '()))) (check-tag result 'Integer ast) (Tagged-value result)])) diff --git a/interp-Lfun.rkt b/interp_Lfun.rkt similarity index 89% rename from interp-Lfun.rkt rename to interp_Lfun.rkt index fa64ac4..02347cb 100644 --- a/interp-Lfun.rkt +++ b/interp_Lfun.rkt @@ -1,15 +1,15 @@ #lang racket (require racket/fixnum) (require "utilities.rkt") -(require "interp-Lvecof.rkt") -(provide interp-Lfun interp-Lfun-class) +(require "interp_Lvecof.rkt") +(provide interp_Lfun interp_Lfun-class) ;; Note to maintainers of this code: ;; A copy of this interpreter is in the book and should be ;; kept in sync with this code. -(define interp-Lfun-class - (class interp-Lvecof-class +(define interp_Lfun-class + (class interp_Lvecof-class (super-new) (define/public (apply-fun fun-val arg-vals e) @@ -39,7 +39,7 @@ )) (define/override (interp-program p) - (verbose "interp-Lfun" p) + (verbose "interp_Lfun" p) (match p [(ProgramDefsExp info ds body) (let ([top-level (for/list ([d ds]) (interp-def d))]) @@ -61,5 +61,5 @@ )) )) -(define (interp-Lfun p) - (send (new interp-Lfun-class) interp-program p)) +(define (interp_Lfun p) + (send (new interp_Lfun-class) interp-program p)) diff --git a/interp-Lfun-prime.rkt b/interp_Lfun_prime.rkt similarity index 68% rename from interp-Lfun-prime.rkt rename to interp_Lfun_prime.rkt index 6a30e55..fc22540 100644 --- a/interp-Lfun-prime.rkt +++ b/interp_Lfun_prime.rkt @@ -1,12 +1,12 @@ #lang racket -(require "interp-Lvecof-prime.rkt") -(require "interp-Lvec-prime.rkt") -(require "interp-Lfun.rkt") +(require "interp_Lvecof_prime.rkt") +(require "interp_Lvec_prime.rkt") +(require "interp_Lfun.rkt") (require "utilities.rkt") (require (prefix-in runtime-config: "runtime-config.rkt")) -(provide interp-Lfun-prime interp-Lfun-prime-mixin interp-Lfun-prime-class) +(provide interp_Lfun_prime interp_Lfun_prime-mixin interp_Lfun_prime-class) -(define (interp-Lfun-prime-mixin super-class) +(define (interp_Lfun_prime-mixin super-class) (class super-class (super-new) (inherit initialize! interp-def) @@ -34,11 +34,11 @@ )) -(define interp-Lfun-prime-class - (interp-Lfun-prime-mixin - (interp-Lvecof-prime-mixin - (interp-Lvec-prime-mixin - interp-Lfun-class)))) +(define interp_Lfun_prime-class + (interp_Lfun_prime-mixin + (interp_Lvecof_prime-mixin + (interp_Lvec_prime-mixin + interp_Lfun-class)))) -(define (interp-Lfun-prime p) - (send (new interp-Lfun-prime-class) interp-program p)) +(define (interp_Lfun_prime p) + (send (new interp_Lfun_prime-class) interp-program p)) diff --git a/interp-Lif.rkt b/interp_Lif.rkt similarity index 89% rename from interp-Lif.rkt rename to interp_Lif.rkt index f519fde..1d87ce0 100644 --- a/interp-Lif.rkt +++ b/interp_Lif.rkt @@ -1,15 +1,15 @@ #lang racket (require racket/fixnum) (require "utilities.rkt") -(require "interp-Lvar.rkt") -(provide interp-Lif interp-Lif-class) +(require "interp_Lvar.rkt") +(provide interp_Lif interp_Lif-class) ;; Note to maintainers of this code: ;; A copy of this interpreter is in the book and should be ;; kept in sync with this code. -(define interp-Lif-class - (class interp-Lvar-class +(define interp_Lif-class + (class interp_Lvar-class (super-new) (define/public (interp-op op) @@ -64,8 +64,8 @@ )) )) -(define (interp-Lif p) - (send (new interp-Lif-class) interp-program p)) +(define (interp_Lif p) + (send (new interp_Lif-class) interp-program p)) #;(define (interp_exp env) - (send (new interp-Lif-class) interp_exp env)) + (send (new interp_Lif-class) interp_exp env)) diff --git a/interp-Lint.rkt b/interp_Lint.rkt similarity index 96% rename from interp-Lint.rkt rename to interp_Lint.rkt index f3a9fa0..f4c7d88 100644 --- a/interp-Lint.rkt +++ b/interp_Lint.rkt @@ -1,7 +1,7 @@ #lang racket (require racket/fixnum) (require "utilities.rkt") -(provide interp_Lint interp-Lint-class) +(provide interp_Lint interp_Lint-class) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Interpreter for Lint: integer arithmetic @@ -41,7 +41,7 @@ ;; This version of the interpreter for Lint is the base class ;; for interp-Rvar-class in interp-Rvar.rkt. -(define interp-Lint-class +(define interp_Lint-class (class object% (super-new) diff --git a/interp-Llambda.rkt b/interp_Llambda.rkt similarity index 79% rename from interp-Llambda.rkt rename to interp_Llambda.rkt index ab297cb..079152f 100644 --- a/interp-Llambda.rkt +++ b/interp_Llambda.rkt @@ -1,15 +1,15 @@ #lang racket (require racket/fixnum) (require "utilities.rkt") -(require "interp-Lfun.rkt") -(provide interp-Llambda interp-Llambda-class) +(require "interp_Lfun.rkt") +(provide interp_Llambda interp_Llambda-class) ;; Note to maintainers of this code: ;; A copy of this interpreter is in the book and should be ;; kept in sync with this code. -(define interp-Llambda-class - (class interp-Lfun-class +(define interp_Llambda-class + (class interp_Lfun-class (super-new) (define/override (interp-op op) @@ -32,6 +32,6 @@ [else ((super interp_exp env) e)])) )) -(define (interp-Llambda p) - (send (new interp-Llambda-class) interp-program p)) +(define (interp_Llambda p) + (send (new interp_Llambda-class) interp-program p)) diff --git a/interp-Llambda-prime.rkt b/interp_Llambda_prime.rkt similarity index 59% rename from interp-Llambda-prime.rkt rename to interp_Llambda_prime.rkt index a83ccf8..b878b28 100644 --- a/interp-Llambda-prime.rkt +++ b/interp_Llambda_prime.rkt @@ -1,13 +1,13 @@ #lang racket -(require "interp-Lvec-prime.rkt") -(require "interp-Lvecof-prime.rkt") -(require "interp-Lfun-prime.rkt") -(require "interp-Llambda.rkt") +(require "interp_Lvec_prime.rkt") +(require "interp_Lvecof_prime.rkt") +(require "interp_Lfun_prime.rkt") +(require "interp_Llambda.rkt") (require "utilities.rkt") (require (prefix-in runtime-config: "runtime-config.rkt")) -(provide interp-Llambda-prime interp-Llambda-prime-mixin interp-Llambda-prime-class) +(provide interp_Llambda_prime interp_Llambda_prime-mixin interp_Llambda_prime-class) -(define (interp-Llambda-prime-mixin super-class) +(define (interp_Llambda_prime-mixin super-class) (class super-class (super-new) @@ -30,12 +30,12 @@ [else ((super interp_exp env) e)])) )) -(define interp-Llambda-prime-class - (interp-Llambda-prime-mixin - (interp-Lfun-prime-mixin - (interp-Lvecof-prime-mixin - (interp-Lvec-prime-mixin - interp-Llambda-class))))) +(define interp_Llambda_prime-class + (interp_Llambda_prime-mixin + (interp_Lfun_prime-mixin + (interp_Lvecof_prime-mixin + (interp_Lvec_prime-mixin + interp_Llambda-class))))) -(define (interp-Llambda-prime p) - (send (new interp-Llambda-prime-class) interp-program p)) +(define (interp_Llambda_prime p) + (send (new interp_Llambda_prime-class) interp-program p)) diff --git a/interp-Lvar.rkt b/interp_Lvar.rkt similarity index 76% rename from interp-Lvar.rkt rename to interp_Lvar.rkt index e1a34da..ecc7597 100644 --- a/interp-Lvar.rkt +++ b/interp_Lvar.rkt @@ -2,15 +2,15 @@ (require racket/fixnum) (require racket/dict) (require "utilities.rkt") -(require "interp-Lint.rkt") -(provide interp_Lvar interp-Lvar-class) +(require "interp_Lint.rkt") +(provide interp_Lvar interp_Lvar-class) ;; Note to maintainers of this code: ;; A copy of this interpreter is in the book and should be ;; kept in sync with this code. -(define interp-Lvar-class - (class interp-Lint-class +(define interp_Lvar-class + (class interp_Lint-class (super-new) (define/override ((interp_exp env) e) @@ -25,5 +25,5 @@ )) (define (interp_Lvar p) - (send (new interp-Lvar-class) interp-program p)) + (send (new interp_Lvar-class) interp-program p)) diff --git a/interp-Lvec.rkt b/interp_Lvec.rkt similarity index 83% rename from interp-Lvec.rkt rename to interp_Lvec.rkt index 801426d..1c0dbd6 100644 --- a/interp-Lvec.rkt +++ b/interp_Lvec.rkt @@ -1,15 +1,15 @@ #lang racket (require racket/fixnum) (require "utilities.rkt") -(require "interp-Lwhile.rkt") -(provide interp-Lvec interp-Lvec-class) +(require "interp_Lwhile.rkt") +(provide interp_Lvec interp_Lvec-class) ;; Note to maintainers of this code: ;; A copy of this interpreter is in the book and should be ;; kept in sync with this code. -(define interp-Lvec-class - (class interp-Lwhile-class +(define interp_Lvec-class + (class interp_Lwhile-class (super-new) (define/override (interp-op op) @@ -37,5 +37,5 @@ )) )) -(define (interp-Lvec p) - (send (new interp-Lvec-class) interp-program p)) +(define (interp_Lvec p) + (send (new interp_Lvec-class) interp-program p)) diff --git a/interp-Lvec-prime.rkt b/interp_Lvec_prime.rkt similarity index 94% rename from interp-Lvec-prime.rkt rename to interp_Lvec_prime.rkt index 34af7a6..687b403 100644 --- a/interp-Lvec-prime.rkt +++ b/interp_Lvec_prime.rkt @@ -1,10 +1,10 @@ #lang racket -(require "interp-Lvec.rkt") +(require "interp_Lvec.rkt") (require "utilities.rkt") (require (prefix-in runtime-config: "runtime-config.rkt")) -(provide interp-Lvec-prime interp-Lvec-prime-mixin interp-Lvec-prime-class) +(provide interp_Lvec_prime interp_Lvec_prime-mixin interp_Lvec_prime-class) -(define (interp-Lvec-prime-mixin super-class) +(define (interp_Lvec_prime-mixin super-class) (class super-class (super-new) @@ -33,7 +33,7 @@ (let-values ([(start stop name vect) (fetch-page addr)]) (let ([value (vector-ref vect (arithmetic-shift (- addr start) -3))]) (when (equal? value uninitialized) - (error 'interp-Lvec-class/memory-read + (error 'interp_Lvec-class/memory-read "read uninitialized memory at address ~s" addr)) value)))) @@ -164,7 +164,7 @@ )) )) -(define interp-Lvec-prime-class (interp-Lvec-prime-mixin interp-Lvec-class)) +(define interp_Lvec_prime-class (interp_Lvec_prime-mixin interp_Lvec-class)) -(define (interp-Lvec-prime p) - (send (new interp-Lvec-prime-class) interp-program p)) +(define (interp_Lvec_prime p) + (send (new interp_Lvec_prime-class) interp-program p)) diff --git a/interp-Lvecof.rkt b/interp_Lvecof.rkt similarity index 81% rename from interp-Lvecof.rkt rename to interp_Lvecof.rkt index 80d3493..e7e954f 100644 --- a/interp-Lvecof.rkt +++ b/interp_Lvecof.rkt @@ -1,15 +1,15 @@ #lang racket (require racket/fixnum) (require "utilities.rkt") -(require "interp-Lvec.rkt") -(provide interp-Lvecof interp-Lvecof-class) +(require "interp_Lvec.rkt") +(provide interp_Lvecof interp_Lvecof-class) ;; Note to maintainers of this code: ;; A copy of this interpreter is in the book and should be ;; kept in sync with this code. -(define interp-Lvecof-class - (class interp-Lvec-class +(define interp_Lvecof-class + (class interp_Lvec-class (super-new) (define/override (interp-op op) @@ -32,5 +32,5 @@ [else (super interp-op op)])) )) -(define (interp-Lvecof p) - (send (new interp-Lvecof-class) interp-program p)) +(define (interp_Lvecof p) + (send (new interp_Lvecof-class) interp-program p)) diff --git a/interp-Lvecof-prime.rkt b/interp_Lvecof_prime.rkt similarity index 51% rename from interp-Lvecof-prime.rkt rename to interp_Lvecof_prime.rkt index 26437d7..cac9aa2 100644 --- a/interp-Lvecof-prime.rkt +++ b/interp_Lvecof_prime.rkt @@ -1,10 +1,10 @@ #lang racket -(require "interp-Lvec-prime.rkt") -(require "interp-Lvecof.rkt") +(require "interp_Lvec_prime.rkt") +(require "interp_Lvecof.rkt") (require "utilities.rkt") -(provide interp-Lvecof-prime interp-Lvecof-prime-mixin interp-Lvecof-prime-class) +(provide interp_Lvecof_prime interp_Lvecof_prime-mixin interp_Lvecof_prime-class) -(define (interp-Lvecof-prime-mixin super-class) +(define (interp_Lvecof_prime-mixin super-class) (class super-class (super-new) (inherit-field uninitialized) @@ -21,9 +21,9 @@ )) -(define interp-Lvecof-prime-class - (interp-Lvecof-prime-mixin - (interp-Lvec-prime-mixin interp-Lvecof-class))) +(define interp_Lvecof_prime-class + (interp_Lvecof_prime-mixin + (interp_Lvec_prime-mixin interp_Lvecof-class))) -(define (interp-Lvecof-prime p) - (send (new interp-Lvecof-prime-class) interp-program p)) +(define (interp_Lvecof_prime p) + (send (new interp_Lvecof_prime-class) interp-program p)) diff --git a/interp_Lvecof_proxy_closure.rkt b/interp_Lvecof_proxy_closure.rkt new file mode 100644 index 0000000..455d2fa --- /dev/null +++ b/interp_Lvecof_proxy_closure.rkt @@ -0,0 +1,11 @@ +#lang racket +(require "interp_Lwhile_proxy_closure.rkt") +(require "interp_Lvecof_prime.rkt") +(provide interp_Lvecof_proxy_closure interp_Lvecof_proxy_closure-class) + + +(define interp_Lvecof_proxy_closure-class + (interp_Lwhile_proxy_closure-mixin interp_Lvecof_prime-class)) + +(define (interp_Lvecof_proxy_closure p) + (send (new interp_Lvecof_proxy_closure-class) interp-program p)) diff --git a/interp-Lwhile.rkt b/interp_Lwhile.rkt similarity index 83% rename from interp-Lwhile.rkt rename to interp_Lwhile.rkt index 4706274..39efab8 100644 --- a/interp-Lwhile.rkt +++ b/interp_Lwhile.rkt @@ -1,15 +1,15 @@ #lang racket (require racket/fixnum) (require "utilities.rkt") -(require "interp-Lif.rkt") -(provide interp-Lwhile interp-Lwhile-class) +(require "interp_Lif.rkt") +(provide interp_Lwhile interp_Lwhile-class) ;; Note to maintainers of this code: ;; A copy of this interpreter is in the book and should be ;; kept in sync with this code. -(define interp-Lwhile-class - (class interp-Lif-class +(define interp_Lwhile-class + (class interp_Lif-class (super-new) (define/override ((interp_exp env) e) @@ -38,6 +38,6 @@ result) )) -(define (interp-Lwhile p) - (send (new interp-Lwhile-class) interp-program p)) +(define (interp_Lwhile p) + (send (new interp_Lwhile-class) interp-program p)) diff --git a/interp_Lwhile_prime_old.rkt b/interp_Lwhile_prime_old.rkt new file mode 100644 index 0000000..05ecf38 --- /dev/null +++ b/interp_Lwhile_prime_old.rkt @@ -0,0 +1,17 @@ +#lang racket +(require "interp_Lvec_prime.rkt") +(require "interp_Lfun_prime.rkt") +(require "interp_Llambda_prime.rkt") +(require "interp_Lany_prime.rkt") +(require "interp_Lwhile.rkt") +(require "utilities.rkt") +(provide interp_Lwhile_prime interp_Lwhile_prime-class) + +(define interp_Lwhile_prime-class + (interp_Lany_prime-mixin + (interp_Llambda_prime-mixin + (interp_Lfun_prime-mixin + (interp_Lvec_prime-mixin interp_Lwhile-class))))) + +(define (interp_Lwhile_prime p) + (send (new interp_Lwhile_prime-class) interp-program p)) diff --git a/interp-Lwhile-proxy-closure-old.rkt b/interp_Lwhile_proxy_closure_old.rkt similarity index 84% rename from interp-Lwhile-proxy-closure-old.rkt rename to interp_Lwhile_proxy_closure_old.rkt index 448e376..93f21b0 100644 --- a/interp-Lwhile-proxy-closure-old.rkt +++ b/interp_Lwhile_proxy_closure_old.rkt @@ -1,11 +1,11 @@ #lang racket (require "utilities.rkt") -(require "interp-Lwhile-prime.rkt") -(provide interp-Lwhile-proxy-closure - interp-Lwhile-proxy-closure-mixin - interp-Lwhile-proxy-closure-class) +(require "interp_Lwhile_prime.rkt") +(provide interp_Lwhile_proxy_closure + interp_Lwhile_proxy_closure-mixin + interp_Lwhile_proxy_closure-class) -(define (interp-Lwhile-proxy-closure-mixin super-class) +(define (interp_Lwhile_proxy_closure-mixin super-class) (class super-class (super-new) (inherit apply-fun interp-def) @@ -70,9 +70,9 @@ )) -(define interp-Lwhile-proxy-closure-class - (interp-Lwhile-proxy-closure-mixin interp-Lwhile-prime-class)) +(define interp_Lwhile_proxy_closure-class + (interp_Lwhile_proxy_closure-mixin interp_Lwhile_prime-class)) -(define (interp-Lwhile-proxy-closure p) - (send (new interp-Lwhile-proxy-closure-class) interp-program p)) +(define (interp_Lwhile_proxy_closure p) + (send (new interp_Lwhile_proxy_closure-class) interp-program p)) diff --git a/interp-Lwhile-proxy-old.rkt b/interp_Lwhile_proxy_old.rkt similarity index 92% rename from interp-Lwhile-proxy-old.rkt rename to interp_Lwhile_proxy_old.rkt index a5fc3cf..900c651 100644 --- a/interp-Lwhile-proxy-old.rkt +++ b/interp_Lwhile_proxy_old.rkt @@ -1,12 +1,12 @@ #lang racket (require racket/fixnum) (require "utilities.rkt") -(require "interp-Lwhile-prime.rkt") +(require "interp_Lwhile_prime.rkt") (require (prefix-in runtime-config: "runtime-config.rkt")) -(provide interp-Lwhile-proxy interp-Lwhile-proxy-class) +(provide interp_Lwhile_proxy interp_Lwhile_proxy-class) -(define interp-Lwhile-proxy-class - (class interp-Lwhile-prime-class +(define interp_Lwhile_proxy-class + (class interp_Lwhile_prime-class (super-new) (inherit apply-fun initialize! interp-def interp_exp) @@ -87,6 +87,6 @@ )) -(define (interp-Lwhile-proxy p) - (send (new interp-Lwhile-proxy-class) interp-program p)) +(define (interp_Lwhile_proxy p) + (send (new interp_Lwhile_proxy-class) interp-program p)) diff --git a/interp-poly.rkt b/interp_poly.rkt similarity index 70% rename from interp-poly.rkt rename to interp_poly.rkt index 9f1e940..9da1e9a 100644 --- a/interp-poly.rkt +++ b/interp_poly.rkt @@ -1,10 +1,10 @@ #lang racket (require "utilities.rkt") -(require "interp-Lwhile.rkt") -(provide interp-poly interp-poly-class) +(require "interp_Lwhile.rkt") +(provide interp_poly interp_poly-class) -(define interp-poly-class - (class interp-Lwhile-class +(define interp_poly-class + (class interp_Lwhile-class (super-new) (define/override ((interp_exp env) e) @@ -22,5 +22,5 @@ )) -(define (interp-poly p) - (send (new interp-poly-class) interp-program p)) +(define (interp_poly p) + (send (new interp_poly-class) interp-program p)) diff --git a/run-tests.rkt b/run-tests.rkt index 4755aca..b9935e6 100755 --- a/run-tests.rkt +++ b/run-tests.rkt @@ -2,8 +2,8 @@ #lang racket (require "utilities.rkt") -(require "interp-Lvar.rkt") -(require "interp-Cvar.rkt") +(require "interp_Lvar.rkt") +(require "interp_Cvar.rkt") (require "interp.rkt") (require "compiler.rkt") ;; (debug-level 1) diff --git a/type-check-Cany.rkt b/type-check-Cany.rkt deleted file mode 100644 index 970c830..0000000 --- a/type-check-Cany.rkt +++ /dev/null @@ -1,37 +0,0 @@ -#lang racket -(require "utilities.rkt") -(require "type-check-Clambda.rkt") -(require "type-check-Lany.rkt") -(provide type-check-Cany type-check-Cany-class) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Cany - -(define type-check-Cany-class - (class (type-check-any-mixin type-check-Clambda-class) - (super-new) - (inherit type-check-exp check-type-equal? join-types exp-ready?) - - (define/override (free-vars-exp e) - (define (recur e) (send this free-vars-exp e)) - (match e - [(ValueOf e ty) (recur e)] - [else (super free-vars-exp e)])) - - (define/override ((type-check-tail env block-env blocks) t) - (debug 'type-check-tail "Cany" t) - (match t - [(IfStmt cnd tail1 tail2) - (cond [(exp-ready? cnd env) - (define-values (c Tc) ((type-check-exp env) cnd)) - (check-type-equal? Tc 'Boolean t) - ]) - (define T1 ((type-check-tail env block-env blocks) tail1)) - (define T2 ((type-check-tail env block-env blocks) tail2)) - (check-type-equal? T1 T2 t) - (join-types T1 T2)] - [else ((super type-check-tail env block-env blocks) t)])) - )) - -(define (type-check-Cany p) - (send (new type-check-Cany-class) type-check-program p)) diff --git a/type-check-Cvar.rkt b/type-check-Cvar.rkt deleted file mode 100644 index e632556..0000000 --- a/type-check-Cvar.rkt +++ /dev/null @@ -1,57 +0,0 @@ -#lang racket -(require "utilities.rkt" "type-check-Lvar.rkt") -(provide type-check-Cvar type-check-Cvar-class) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Cvar - -(define type-check-Cvar-class - (class (type-check-var-mixin object%) - (super-new) - (inherit type-check-op type-equal? check-type-equal? type-check-exp) - - (define/public ((type-check-atm env) e) - (match e - [(Var x) (values (Var x) (dict-ref env x))] - [(Int n) (values (Int n) 'Integer)] - [else (error 'type-check-atm "expected a Cvar atm, not ~a" e)])) - - (define/public ((type-check-stmt env) s) - (debug 'type-check-stmt "Cvar ~a" s) - (match s - [(Assign (Var x) e) - (define-values (e^ t) ((type-check-exp env) e)) - (cond [(dict-has-key? env x) - (check-type-equal? t (dict-ref env x) s)] - [else (dict-set! env x t)])] - [else (error 'type-check-stmt "expected a Cvar stmt, not ~a" s)])) - - (define/public ((type-check-tail env block-env blocks) t) - (debug 'type-check-tail "Cvar ~a ~a" t env) - (match t - [(Return e) - (define-values (e^ t) ((type-check-exp env) e)) - t] - [(Seq s t) - ((type-check-stmt env) s) - ((type-check-tail env block-env blocks) t)] - [else (error 'type-check-tail "expected a Cvar tail, not ~a" t)])) - - (define/public (type-check-program p) - (match p - [(CProgram info blocks) - (define env (make-hash)) - (define block-env (make-hash)) - (define t ((type-check-tail env block-env blocks) - (dict-ref blocks 'start))) - (unless (type-equal? t 'Integer) - (error "return type of program must be Integer, not" t)) - (define locals-types (for/list ([(x t) (in-dict env)]) - (cons x t))) - (define new-info (dict-set info 'locals-types locals-types)) - (CProgram new-info blocks)] - [else (error 'type-check-program "expected a C program, not ~a" p)])) - )) - -(define (type-check-Cvar p) - (send (new type-check-Cvar-class) type-check-program p)) diff --git a/type-check-Cvecof.rkt b/type-check-Cvecof.rkt deleted file mode 100644 index 33daf2c..0000000 --- a/type-check-Cvecof.rkt +++ /dev/null @@ -1,30 +0,0 @@ -#lang racket -(require "utilities.rkt") -(require "type-check-Cvec.rkt") -(require "type-check-Lvecof.rkt") -(provide type-check-Cvecof type-check-Cvecof-class) - -(define type-check-Cvecof-class - (class (type-check-vecof-mixin type-check-Cvec-class) - (super-new) - (inherit check-type-equal?) - - (define/override (free-vars-exp e) - (define (recur e) (send this free-vars-exp e)) - (match e - [(AllocateArray e-len ty) (recur e-len)] - [else (super free-vars-exp e)])) - - (define/override ((type-check-tail env block-env blocks) t) - (debug 'type-check-tail "Cif" t) - (match t - [(Prim 'exit '()) - '_] - [else ((super type-check-tail env block-env blocks) t)])) - - )) - -(define (type-check-Cvecof p) - (send (new type-check-Cvecof-class) type-check-program p)) - - diff --git a/type_check_Cany.rkt b/type_check_Cany.rkt new file mode 100644 index 0000000..60cd14c --- /dev/null +++ b/type_check_Cany.rkt @@ -0,0 +1,37 @@ +#lang racket +(require "utilities.rkt") +(require "type_check_Clambda.rkt") +(require "type_check_Lany.rkt") +(provide type_check_Cany type_check_Cany-class) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; type_check_Cany + +(define type_check_Cany-class + (class (type_check_any-mixin type_check_Clambda-class) + (super-new) + (inherit type_check_exp check-type-equal? join-types exp-ready?) + + (define/override (free-vars-exp e) + (define (recur e) (send this free-vars-exp e)) + (match e + [(ValueOf e ty) (recur e)] + [else (super free-vars-exp e)])) + + (define/override ((type_check_tail env block-env blocks) t) + (debug 'type_check_tail "Cany" t) + (match t + [(IfStmt cnd tail1 tail2) + (cond [(exp-ready? cnd env) + (define-values (c Tc) ((type_check_exp env) cnd)) + (check-type-equal? Tc 'Boolean t) + ]) + (define T1 ((type_check_tail env block-env blocks) tail1)) + (define T2 ((type_check_tail env block-env blocks) tail2)) + (check-type-equal? T1 T2 t) + (join-types T1 T2)] + [else ((super type_check_tail env block-env blocks) t)])) + )) + +(define (type_check_Cany p) + (send (new type_check_Cany-class) type_check_program p)) diff --git a/type-check-Cfun.rkt b/type_check_Cfun.rkt similarity index 61% rename from type-check-Cfun.rkt rename to type_check_Cfun.rkt index 7b0b00e..bc2d2df 100644 --- a/type-check-Cfun.rkt +++ b/type_check_Cfun.rkt @@ -1,16 +1,16 @@ #lang racket (require "utilities.rkt") -(require "type-check-Cvecof.rkt") -(require "type-check-Lfun.rkt") -(provide type-check-Cfun type-check-Cfun-class) +(require "type_check_Cvecof.rkt") +(require "type_check_Lfun.rkt") +(provide type_check_Cfun type_check_Cfun-class) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Cfun +;; type_check_Cfun -(define type-check-Cfun-class - (class (type-check-fun-mixin type-check-Cvecof-class) +(define type_check_Cfun-class + (class (type_check_fun-mixin type_check_Cvecof-class) (super-new) - (inherit type-equal? type-check-apply type-check-blocks fun-def-type + (inherit type-equal? type_check_apply type_check_blocks fun-def-type exp-ready?) (define/override (free-vars-exp e) @@ -22,37 +22,37 @@ [(Call f arg*) (apply set-union (cons (recur f) (map recur arg*)))] [else (super free-vars-exp e)])) - (define/override ((type-check-tail env block-env G) t) - (debug 'type-check-tail "Cfun" t) + (define/override ((type_check_tail env block-env G) t) + (debug 'type_check_tail "Cfun" t) (match t [(TailCall f arg*) #:when (and (exp-ready? f env) (for/and ([arg arg*]) (exp-ready? arg env))) - (define-values (f^ arg*^ rt) (type-check-apply env f arg*)) + (define-values (f^ arg*^ rt) (type_check_apply env f arg*)) rt] [(TailCall f arg*) '_] - [else ((super type-check-tail env block-env G) t)] + [else ((super type_check_tail env block-env G) t)] )) - (define/override ((type-check-stmt env) s) + (define/override ((type_check_stmt env) s) (match s [(Call e es) #:when (and (exp-ready? e env) (for/and ([arg es]) (exp-ready? arg env))) - (define-values (e^ es^ rt) (type-check-apply env e es)) + (define-values (e^ es^ rt) (type_check_apply env e es)) (void)] - [else ((super type-check-stmt env) s)])) + [else ((super type_check_stmt env) s)])) - (define/public (type-check-def global-env) + (define/public (type_check_def global-env) (lambda (d) (match d [(Def f (and p:t* (list `[,xs : ,ps] ...)) rt info blocks) (define new-env (append (map cons xs ps) global-env)) (define env^ (make-hash new-env)) (define-values (env t) - (type-check-blocks info blocks env^ (symbol-append f '_start))) + (type_check_blocks info blocks env^ (symbol-append f '_start))) (unless (type-equal? t rt) - (error 'type-check "mismatch in return type, ~a != ~a" 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))) @@ -61,17 +61,17 @@ (Def f p:t* rt new-info blocks)] ))) - (define/override (type-check-program p) + (define/override (type_check_program p) (match p [(ProgramDefs info ds) (define new-env (for/list ([d ds]) (cons (Def-name d) (fun-def-type d)))) (define ds^ (for/list ([d ds]) - ((type-check-def new-env) d))) + ((type_check_def new-env) d))) (ProgramDefs info ds^)] - [else (error 'type-check-program "expected a C program, not ~a" p)] + [else (error 'type_check_program "expected a C program, not ~a" p)] )) )) -(define (type-check-Cfun p) - (send (new type-check-Cfun-class) type-check-program p)) +(define (type_check_Cfun p) + (send (new type_check_Cfun-class) type_check_program p)) diff --git a/type-check-Cif.rkt b/type_check_Cif.rkt similarity index 72% rename from type-check-Cif.rkt rename to type_check_Cif.rkt index 140db21..4ef7de1 100644 --- a/type-check-Cif.rkt +++ b/type_check_Cif.rkt @@ -2,17 +2,17 @@ (require graph) (require "multigraph.rkt") (require "utilities.rkt") -(require "type-check-Cvar.rkt") -(require "type-check-Lif.rkt") -(provide type-check-Cif type-check-Cif-class) +(require "type_check_Cvar.rkt") +(require "type_check_Lif.rkt") +(provide type_check_Cif type_check_Cif-class) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Cif +;; type_check_Cif -(define type-check-Cif-class - (class (type-check-if-mixin type-check-Cvar-class) +(define type_check_Cif-class + (class (type_check_if-mixin type_check_Cvar-class) (super-new) - (inherit type-check-exp type-equal? check-type-equal? combine-types) + (inherit type_check_exp type-equal? check-type-equal? combine-types) ;; TODO: move some things from here to later type checkers (define/public (free-vars-exp e) @@ -52,56 +52,56 @@ (set! type-changed #t) (dict-set! env x t)])) - (define/override ((type-check-atm env) e) + (define/override ((type_check_atm env) e) (match e [(Bool b) (values (Bool b) 'Boolean)] [else - ((super type-check-atm env) e)] + ((super type_check_atm env) e)] )) - (define/override (type-check-stmt env) + (define/override (type_check_stmt env) (lambda (s) - (debug 'type-check-stmt "Cwhile" s env) + (debug 'type_check_stmt "Cwhile" s env) (match s [(Assign (Var x) e) #:when (exp-ready? e env) - (define-values (e^ t) ((type-check-exp env) e)) + (define-values (e^ t) ((type_check_exp env) e)) (update-type x t env)] [(Assign (Var x) e) - (debug 'type-check-stmt "RHS not ready" e) + (debug 'type_check_stmt "RHS not ready" e) (void)] [(Prim 'read '()) (void)] [else (void)] ))) - (define/override ((type-check-tail env block-env blocks) t) - (debug 'type-check-tail "Cif" t) + (define/override ((type_check_tail env block-env blocks) t) + (debug 'type_check_tail "Cif" t) (match t [(Return e) #:when (exp-ready? e env) - (define-values (e^ t) ((type-check-exp env) e)) + (define-values (e^ t) ((type_check_exp env) e)) t] [(Return e) '_] [(Seq s t) - ((type-check-stmt env) s) - ((type-check-tail env block-env blocks) t)] + ((type_check_stmt env) s) + ((type_check_tail env block-env blocks) t)] [(Goto label) (cond [(dict-has-key? block-env label) (dict-ref block-env label)] [else '_])] [(IfStmt cnd tail1 tail2) (cond [(exp-ready? cnd env) - (define-values (c Tc) ((type-check-exp env) cnd)) + (define-values (c Tc) ((type_check_exp env) cnd)) (unless (type-equal? Tc 'Boolean) (error "type error: condition should be Boolean, not" Tc)) ]) - (define T1 ((type-check-tail env block-env blocks) tail1)) - (define T2 ((type-check-tail env block-env blocks) tail2)) + (define T1 ((type_check_tail env block-env blocks) tail1)) + (define T2 ((type_check_tail env block-env blocks) tail2)) (unless (type-equal? T1 T2) (error "type error: branches of if should have same type, not" T1 T2)) (combine-types T1 T2)] - [else ((super type-check-tail env block-env blocks) t)])) + [else ((super type_check_tail env block-env blocks) t)])) (define/public (adjacent-tail t) (match t @@ -121,31 +121,31 @@ ;; Do the iterative dataflow analysis because of deadcode ;; in the un-optimized version of the compiler. -Jeremy - (define/public (type-check-blocks info blocks env start) + (define/public (type_check_blocks info blocks env start) (define block-env (make-hash)) (set! type-changed #t) (define (iterate) (cond [type-changed (set! type-changed #f) (for ([(label tail) (in-dict blocks)]) - (define t ((type-check-tail env block-env blocks) tail)) + (define t ((type_check_tail env block-env blocks) tail)) (update-type label t block-env) ) - (verbose "type-check-blocks" env block-env) + (verbose "type_check_blocks" env block-env) (iterate)] [else (void)])) (iterate) (unless (dict-has-key? block-env start) - (error 'type-check-blocks "failed to infer type for ~a" start)) + (error 'type_check_blocks "failed to infer type for ~a" start)) (define t (dict-ref block-env start)) (values env t)) - (define/override (type-check-program p) + (define/override (type_check_program p) (match p [(CProgram info blocks) (define empty-env (make-hash)) (define-values (env t) - (type-check-blocks info blocks empty-env 'start)) + (type_check_blocks info blocks empty-env 'start)) (unless (type-equal? t 'Integer) (error "return type of program must be Integer, not" t)) (define locals-types @@ -153,10 +153,10 @@ (cons x t))) (define new-info (dict-set info 'locals-types locals-types)) (CProgram new-info blocks)] - [else (super type-check-program p)])) + [else (super type_check_program p)])) )) -(define (type-check-Cif p) - (send (new type-check-Cif-class) type-check-program p)) +(define (type_check_Cif p) + (send (new type_check_Cif-class) type_check_program p)) diff --git a/type-check-Clambda.rkt b/type_check_Clambda.rkt similarity index 59% rename from type-check-Clambda.rkt rename to type_check_Clambda.rkt index 641e1a0..5a9bb93 100644 --- a/type-check-Clambda.rkt +++ b/type_check_Clambda.rkt @@ -1,26 +1,26 @@ #lang racket (require "utilities.rkt") -(require "type-check-Cfun.rkt") -(require "type-check-Llambda.rkt") -(provide type-check-Clambda type-check-Clambda-class) +(require "type_check_Cfun.rkt") +(require "type_check_Llambda.rkt") +(provide type_check_Clambda type_check_Clambda-class) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Clambda +;; type_check_Clambda -(define type-check-Clambda-class - (class (type-check-lambda-mixin type-check-Cfun-class) +(define type_check_Clambda-class + (class (type_check_lambda-mixin type_check_Cfun-class) (super-new) (inherit type-equal? exp-ready?) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (debug 'type-check-exp "Clambda" e) - (define recur (type-check-exp env)) + (debug 'type_check_exp "Clambda" e) + (define recur (type_check_exp env)) (match e [(UncheckedCast e t) (define-values (new-e new-t) (recur e)) (values (UncheckedCast new-e t) t)] - [else ((super type-check-exp env) e)]))) + [else ((super type_check_exp env) e)]))) (define/override (free-vars-exp e) (define (recur e) (send this free-vars-exp e)) @@ -35,8 +35,8 @@ )) -(define (type-check-Clambda p) - (send (new type-check-Clambda-class) type-check-program p)) +(define (type_check_Clambda p) + (send (new type_check_Clambda-class) type_check_program p)) diff --git a/type_check_Cvar.rkt b/type_check_Cvar.rkt new file mode 100644 index 0000000..808e23d --- /dev/null +++ b/type_check_Cvar.rkt @@ -0,0 +1,57 @@ +#lang racket +(require "utilities.rkt" "type_check_Lvar.rkt") +(provide type_check_Cvar type_check_Cvar-class) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; type_check_Cvar + +(define type_check_Cvar-class + (class (type_check_var-mixin object%) + (super-new) + (inherit type_check_op type-equal? check-type-equal? type_check_exp) + + (define/public ((type_check_atm env) e) + (match e + [(Var x) (values (Var x) (dict-ref env x))] + [(Int n) (values (Int n) 'Integer)] + [else (error 'type_check_atm "expected a Cvar atm, not ~a" e)])) + + (define/public ((type_check_stmt env) s) + (debug 'type_check_stmt "Cvar ~a" s) + (match s + [(Assign (Var x) e) + (define-values (e^ t) ((type_check_exp env) e)) + (cond [(dict-has-key? env x) + (check-type-equal? t (dict-ref env x) s)] + [else (dict-set! env x t)])] + [else (error 'type_check_stmt "expected a Cvar stmt, not ~a" s)])) + + (define/public ((type_check_tail env block-env blocks) t) + (debug 'type_check_tail "Cvar ~a ~a" t env) + (match t + [(Return e) + (define-values (e^ t) ((type_check_exp env) e)) + t] + [(Seq s t) + ((type_check_stmt env) s) + ((type_check_tail env block-env blocks) t)] + [else (error 'type_check_tail "expected a Cvar tail, not ~a" t)])) + + (define/public (type_check_program p) + (match p + [(CProgram info blocks) + (define env (make-hash)) + (define block-env (make-hash)) + (define t ((type_check_tail env block-env blocks) + (dict-ref blocks 'start))) + (unless (type-equal? t 'Integer) + (error "return type of program must be Integer, not" t)) + (define locals-types (for/list ([(x t) (in-dict env)]) + (cons x t))) + (define new-info (dict-set info 'locals-types locals-types)) + (CProgram new-info blocks)] + [else (error 'type_check_program "expected a C program, not ~a" p)])) + )) + +(define (type_check_Cvar p) + (send (new type_check_Cvar-class) type_check_program p)) diff --git a/type-check-Cvec.rkt b/type_check_Cvec.rkt similarity index 55% rename from type-check-Cvec.rkt rename to type_check_Cvec.rkt index d45d92e..f694b75 100644 --- a/type-check-Cvec.rkt +++ b/type_check_Cvec.rkt @@ -1,16 +1,16 @@ #lang racket (require "utilities.rkt") -(require "type-check-Cwhile.rkt") -(require "type-check-Lvec.rkt") -(provide type-check-Cvec type-check-Cvec-class) +(require "type_check_Cwhile.rkt") +(require "type_check_Lvec.rkt") +(provide type_check_Cvec type_check_Cvec-class) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Cvec +;; type_check_Cvec -(define type-check-Cvec-class - (class (type-check-vec-mixin type-check-Cwhile-class) +(define type_check_Cvec-class + (class (type_check_vec-mixin type_check_Cwhile-class) (super-new) - (inherit check-type-equal? exp-ready? type-check-exp) + (inherit check-type-equal? exp-ready? type_check_exp) (define/override (free-vars-exp e) (define (recur e) (send this free-vars-exp e)) @@ -20,19 +20,19 @@ [(GlobalValue name) (set)] [else (super free-vars-exp e)])) - (define/override ((type-check-stmt env) s) + (define/override ((type_check_stmt env) s) (match s [(Collect size) (void)] [(Prim 'vector-set! (list vec index rhs)) #:when (and (exp-ready? vec env) (exp-ready? index env) (exp-ready? rhs env)) - ((type-check-exp env) s)] - [else ((super type-check-stmt env) s)])) + ((type_check_exp env) s)] + [else ((super type_check_stmt env) s)])) )) -(define (type-check-Cvec p) - (send (new type-check-Cvec-class) type-check-program p)) +(define (type_check_Cvec p) + (send (new type_check_Cvec-class) type_check_program p)) diff --git a/type_check_Cvecof.rkt b/type_check_Cvecof.rkt new file mode 100644 index 0000000..3cf3136 --- /dev/null +++ b/type_check_Cvecof.rkt @@ -0,0 +1,30 @@ +#lang racket +(require "utilities.rkt") +(require "type_check_Cvec.rkt") +(require "type_check_Lvecof.rkt") +(provide type_check_Cvecof type_check_Cvecof-class) + +(define type_check_Cvecof-class + (class (type_check_vecof-mixin type_check_Cvec-class) + (super-new) + (inherit check-type-equal?) + + (define/override (free-vars-exp e) + (define (recur e) (send this free-vars-exp e)) + (match e + [(AllocateArray e-len ty) (recur e-len)] + [else (super free-vars-exp e)])) + + (define/override ((type_check_tail env block-env blocks) t) + (debug 'type_check_tail "Cif" t) + (match t + [(Prim 'exit '()) + '_] + [else ((super type_check_tail env block-env blocks) t)])) + + )) + +(define (type_check_Cvecof p) + (send (new type_check_Cvecof-class) type_check_program p)) + + diff --git a/type-check-Cwhile.rkt b/type_check_Cwhile.rkt similarity index 74% rename from type-check-Cwhile.rkt rename to type_check_Cwhile.rkt index 41ceae2..7447832 100644 --- a/type-check-Cwhile.rkt +++ b/type_check_Cwhile.rkt @@ -1,13 +1,13 @@ #lang racket (require "utilities.rkt") -(require "type-check-Cif.rkt") -(provide type-check-Cwhile type-check-Cwhile-class) +(require "type_check_Cif.rkt") +(provide type_check_Cwhile type_check_Cwhile-class) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Cwhile +;; type_check_Cwhile -(define type-check-Cwhile-class - (class type-check-Cif-class +(define type_check_Cwhile-class + (class type_check_Cif-class (super-new) (inherit check-type-equal?) @@ -48,23 +48,23 @@ (set! type-changed #t) (dict-set! env x t)])) - (define/override ((type-check-atm env) e) + (define/override ((type_check_atm env) e) (match e [(Void) (values (Void) 'Void)] [else - ((super type-check-atm env) e)] + ((super type_check_atm env) e)] )) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (debug 'type-check-exp "Cwhile" e) - (define recur (type-check-exp env)) + (debug 'type_check_exp "Cwhile" e) + (define recur (type_check_exp env)) (match e [(Void) (values (Void) 'Void)] - [else ((super type-check-exp env) e)]))) + [else ((super type_check_exp env) e)]))) )) -(define (type-check-Cwhile p) - (send (new type-check-Cwhile-class) type-check-program p)) +(define (type_check_Cwhile p) + (send (new type_check_Cwhile-class) type_check_program p)) diff --git a/type-check-Lany.rkt b/type_check_Lany.rkt similarity index 84% rename from type-check-Lany.rkt rename to type_check_Lany.rkt index 1ddb379..405ef41 100644 --- a/type-check-Lany.rkt +++ b/type_check_Lany.rkt @@ -1,16 +1,16 @@ #lang racket (require "utilities.rkt") -(require "type-check-Lvec.rkt") -(require "type-check-Lvecof.rkt") -(require "type-check-Llambda.rkt") -(provide type-check-Lany type-check-Lany-has-type - type-check-Lany-class type-check-any-mixin) +(require "type_check_Lvec.rkt") +(require "type_check_Lvecof.rkt") +(require "type_check_Llambda.rkt") +(provide type_check_Lany type_check_Lany_has_type + type_check_Lany-class type_check_any-mixin) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Type Checker for the Any type and inject, project, etc. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (type-check-any-mixin super-class) +(define (type_check_any-mixin super-class) (class super-class (super-new) (inherit check-type-equal?) @@ -60,10 +60,10 @@ #f] )) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (debug 'type-check-exp "any" e) - (define recur (type-check-exp env)) + (debug 'type_check_exp "any" e) + (define recur (type_check_exp env)) (match e [(Prim 'any-vector-length (list e1)) (define-values (e1^ t1) (recur e1)) @@ -104,25 +104,25 @@ [(ValueOf e ty) (define-values (new-e e-ty) (recur e)) (values (ValueOf new-e ty) ty)] - [else ((super type-check-exp env) e)]))) + [else ((super type_check_exp env) e)]))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Lany +;; type_check_Lany -(define type-check-Lany-class - (class (type-check-any-mixin type-check-Llambda-class) +(define type_check_Lany-class + (class (type_check_any-mixin type_check_Llambda-class) (super-new) (inherit check-type-equal? join-types operator-types flat-ty?) (define/public (type-predicates) (set 'boolean? 'integer? 'vector? 'procedure? 'void?)) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (debug 'type-check-exp "Lany" e) - (define recur (type-check-exp env)) + (debug 'type_check_exp "Lany" e) + (define recur (type_check_exp env)) (match e ;; Change If to use join-types [(If cnd thn els) @@ -134,13 +134,13 @@ (values (If cnd^ thn^ els^) (join-types Tt Te))] [(Inject e1 ty) (unless (flat-ty? ty) - (error 'type-check "may only inject from flat type, not ~a" ty)) + (error 'type_check "may only inject from flat type, not ~a" ty)) (define-values (new-e1 e-ty) (recur e1)) (check-type-equal? e-ty ty e) (values (Inject new-e1 ty) 'Any)] [(Project e1 ty) (unless (flat-ty? ty) - (error 'type-check "may only project to flat type, not ~a" ty)) + (error 'type_check "may only project to flat type, not ~a" ty)) (define-values (new-e1 e-ty) (recur e1)) (check-type-equal? e-ty 'Any e) (values (Project new-e1 ty) ty)] @@ -158,18 +158,18 @@ [(`(Vectorof ,t1) `(Vectorof ,t2)) (void)] [(other wise) (check-type-equal? t1 t2 e)]) (values (Prim 'eq? (list e1 e2)) 'Boolean)] - [else ((super type-check-exp env) e)]))) + [else ((super type_check_exp env) e)]))) )) -(define (type-check-Lany p) - (send (new type-check-Lany-class) type-check-program p)) +(define (type_check_Lany p) + (send (new type_check_Lany-class) type_check_program p)) -(define (type-check-Lany-has-type p) +(define (type_check_Lany_has_type p) (begin (typed-vec #t) (typed-vecof #t) - (define t (send (new type-check-Lany-class) type-check-program p)) + (define t (send (new type_check_Lany-class) type_check_program p)) (typed-vec #f) (typed-vecof #f) t)) diff --git a/type-check-Lfun.rkt b/type_check_Lfun.rkt similarity index 60% rename from type-check-Lfun.rkt rename to type_check_Lfun.rkt index a458f04..7776723 100644 --- a/type-check-Lfun.rkt +++ b/type_check_Lfun.rkt @@ -1,18 +1,18 @@ #lang racket (require "utilities.rkt") -(require "type-check-Lvec.rkt") -(require "type-check-Lvecof.rkt") -(provide type-check-Lfun type-check-Lfun-has-type - type-check-Lfun-class type-check-fun-mixin) +(require "type_check_Lvec.rkt") +(require "type_check_Lvecof.rkt") +(provide type_check_Lfun type_check_Lfun_has_type + type_check_Lfun-class type_check_fun-mixin) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-fun-mixin (for use in Lfun and Cfun) +;; type_check_fun-mixin (for use in Lfun and Cfun) -(define (type-check-fun-mixin super-class) +(define (type_check_fun-mixin super-class) (class super-class (super-new) (inherit check-type-equal?) @@ -25,98 +25,98 @@ (type-equal? rt1 rt2))] [(other wise) (super type-equal? t1 t2)])) - (define/public (type-check-apply env e es) - (define-values (e^ ty) ((type-check-exp env) e)) + (define/public (type_check_apply env e es) + (define-values (e^ ty) ((type_check_exp env) e)) (define-values (e* ty*) (for/lists (e* ty*) ([e (in-list es)]) - ((type-check-exp env) e))) + ((type_check_exp env) e))) (match ty [`(,ty^* ... -> ,rt) (for ([arg-ty ty*] [param-ty ty^*]) (check-type-equal? arg-ty param-ty (Apply e es))) (values e^ e* rt)] - [else (error 'type-check "expected a function, not ~a" ty)])) + [else (error 'type_check "expected a function, not ~a" ty)])) (define/public (fun-def-type d) (match d [(Def f (list `[,xs : ,ps] ...) rt info body) `(,@ps -> ,rt)] - [else (error 'type-check "ill-formed function definition in ~a" d)])) + [else (error 'type_check "ill-formed function definition in ~a" d)])) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) (match e [(FunRef f n) (values (FunRef f n) (dict-ref env f))] [(Call e es) - (define-values (e^ es^ rt) (type-check-apply env e es)) + (define-values (e^ es^ rt) (type_check_apply env e es)) (values (Call e^ es^) rt)] - [else ((super type-check-exp env) e)] + [else ((super type_check_exp env) e)] ))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Lfun +;; type_check_Lfun ;; TODO: Don't allow eq? on function types. -Jeremy -(define type-check-Lfun-class - (class (type-check-fun-mixin type-check-Lvecof-class) +(define type_check_Lfun-class + (class (type_check_fun-mixin type_check_Lvecof-class) (super-new) - (inherit check-type-equal? type-check-apply fun-def-type) + (inherit check-type-equal? type_check_apply fun-def-type) (field [max-parameters 32]) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) (match e [(Apply e es) - (define-values (e^ es^ rt) (type-check-apply env e es)) + (define-values (e^ es^ rt) (type_check_apply env e es)) (values (Apply e^ es^) rt)] - [else ((super type-check-exp env) e)] + [else ((super type_check_exp env) e)] ))) - (define/public (type-check-def env) + (define/public (type_check_def env) (lambda (e) (match e [(Def f (and p:t* (list `[,xs : ,ps] ...)) rt info body) (unless (< (length xs) max-parameters) - (error 'type-check "~a has too many parameters, max is ~a" + (error 'type_check "~a has too many parameters, max is ~a" f max-parameters)) (define new-env (append (map cons xs ps) env)) - (define-values (body^ ty^) ((type-check-exp new-env) body)) + (define-values (body^ ty^) ((type_check_exp new-env) body)) (check-type-equal? ty^ rt body) (Def f p:t* rt info body^)] - [else (error 'type-check "ill-formed function definition ~a" e)] + [else (error 'type_check "ill-formed function definition ~a" e)] ))) - (define/override (type-check-program e) + (define/override (type_check_program e) (match e [(ProgramDefsExp info ds body) (define new-env (for/list ([d ds]) (cons (Def-name d) (fun-def-type d)))) - (define ds^ (for/list ([d ds]) ((type-check-def new-env) d))) - (define-values (body^ ty) ((type-check-exp new-env) body)) + (define ds^ (for/list ([d ds]) ((type_check_def new-env) d))) + (define-values (body^ ty) ((type_check_exp new-env) body)) (check-type-equal? ty 'Integer body) (ProgramDefsExp info ds^ body^)] [(ProgramDefs info ds) (define new-env (for/list ([d ds]) (cons (Def-name d) (fun-def-type d)))) - (define ds^ (for/list ([d ds]) ((type-check-def new-env) d))) + (define ds^ (for/list ([d ds]) ((type_check_def new-env) d))) ;; TODO: check that main has Integer return type. (ProgramDefs info ds^)] [(Program info body) - (define-values (body^ ty) ((type-check-exp '()) body)) + (define-values (body^ ty) ((type_check_exp '()) body)) (check-type-equal? ty 'Integer body) (ProgramDefsExp info '() body^)] - [else (error 'type-check "unrecognized ~a" e)])) + [else (error 'type_check "unrecognized ~a" e)])) )) -(define (type-check-Lfun p) - (send (new type-check-Lfun-class) type-check-program p)) +(define (type_check_Lfun p) + (send (new type_check_Lfun-class) type_check_program p)) -(define (type-check-Lfun-has-type p) +(define (type_check_Lfun_has_type p) (begin (typed-vec #t) (typed-vecof #t) - (define t (type-check-Lfun p)) + (define t (type_check_Lfun p)) (typed-vec #f) (typed-vecof #f) t)) diff --git a/type-check-Lif.rkt b/type_check_Lif.rkt similarity index 66% rename from type-check-Lif.rkt rename to type_check_Lif.rkt index bb99e9a..1e6051f 100644 --- a/type-check-Lif.rkt +++ b/type_check_Lif.rkt @@ -1,16 +1,16 @@ #lang racket (require "utilities.rkt") -(require "type-check-Lvar.rkt") -(provide type-check-Lif type-check-Lif-class type-check-if-mixin) +(require "type_check_Lvar.rkt") +(provide type_check_Lif type_check_Lif-class type_check_if-mixin) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Booleans and Control Flow ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-if-mixin (reusable for Lif and Cif) +;; type_check_if-mixin (reusable for Lif and Cif) -(define (type-check-if-mixin super-class) +(define (type_check_if-mixin super-class) (class super-class (super-new) (inherit check-type-equal?) @@ -40,40 +40,40 @@ ) (super operator-types))) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (debug 'type-check-exp "Lif" e) + (debug 'type_check_exp "Lif" e) (match e [(Bool b) (values (Bool b) 'Boolean)] [(Prim 'eq? (list e1 e2)) - (define-values (e1^ T1) ((type-check-exp env) e1)) - (define-values (e2^ T2) ((type-check-exp env) e2)) + (define-values (e1^ T1) ((type_check_exp env) e1)) + (define-values (e2^ T2) ((type_check_exp env) e2)) (check-type-equal? T1 T2 e) (values (Prim 'eq? (list e1^ e2^)) 'Boolean)] - [else ((super type-check-exp env) e)]))) + [else ((super type_check_exp env) e)]))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Lif +;; type_check_Lif -(define type-check-Lif-class - (class (type-check-if-mixin type-check-Lvar-class) +(define type_check_Lif-class + (class (type_check_if-mixin type_check_Lvar-class) (super-new) (inherit check-type-equal? combine-types) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) (match e [(If cnd thn els) - (define-values (cnd^ Tc) ((type-check-exp env) cnd)) - (define-values (thn^ Tt) ((type-check-exp env) thn)) - (define-values (els^ Te) ((type-check-exp env) els)) + (define-values (cnd^ Tc) ((type_check_exp env) cnd)) + (define-values (thn^ Tt) ((type_check_exp env) thn)) + (define-values (els^ Te) ((type_check_exp env) els)) (check-type-equal? Tc 'Boolean e) (check-type-equal? Tt Te e) (values (If cnd^ thn^ els^) (combine-types Tt Te))] - [else ((super type-check-exp env) e)]))) + [else ((super type_check_exp env) e)]))) )) -(define (type-check-Lif p) - (send (new type-check-Lif-class) type-check-program p)) +(define (type_check_Lif p) + (send (new type_check_Lif-class) type_check_program p)) diff --git a/type-check-Llambda.rkt b/type_check_Llambda.rkt similarity index 69% rename from type-check-Llambda.rkt rename to type_check_Llambda.rkt index 8ba73b6..b748768 100644 --- a/type-check-Llambda.rkt +++ b/type_check_Llambda.rkt @@ -1,27 +1,27 @@ #lang racket (require "utilities.rkt") -(require "type-check-Lvec.rkt") -(require "type-check-Lvecof.rkt") -(require "type-check-Lfun.rkt") -(provide type-check-Llambda type-check-Llambda-has-type - type-check-Llambda-class type-check-lambda-mixin typed-vars) +(require "type_check_Lvec.rkt") +(require "type_check_Lvecof.rkt") +(require "type_check_Lfun.rkt") +(provide type_check_Llambda type_check_Llambda_has_type + type_check_Llambda-class type_check_lambda-mixin typed-vars) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Lambda ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-lambda-mixin (for use in Llambda and Clambda) +;; type_check_lambda-mixin (for use in Llambda and Clambda) -(define (type-check-lambda-mixin super-class) +(define (type_check_lambda-mixin super-class) (class super-class (super-new) (inherit check-type-equal?) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (debug 'type-check-exp "Llambda" e) - (define recur (type-check-exp env)) + (debug 'type_check_exp "Llambda" e) + (define recur (type_check_exp env)) (match e [(AllocateClosure size t arity) (values (AllocateClosure size t arity) t)] @@ -31,19 +31,19 @@ ;; after closure conversion [`(Vector (,clos ,ts ... -> ,rt) ,ts2 ...) (values (Prim 'procedure-arity (list e1^)) 'Integer)] - [else (error 'type-check + [else (error 'type_check "expected a function not ~a\nin ~v" t e)])] - [else ((super type-check-exp env) e)] + [else ((super type_check_exp env) e)] ))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Llambda +;; type_check_Llambda (define typed-vars (make-parameter #f)) -(define type-check-Llambda-class - (class (type-check-lambda-mixin type-check-Lfun-class) +(define type_check_Llambda-class + (class (type_check_lambda-mixin type_check_Lfun-class) (super-new) (inherit check-type-equal?) (inherit-field max-parameters) @@ -54,13 +54,13 @@ `(Vector ((Vector _) ,@ps -> ,rt))] [else (error "closure-type, expected function type")])) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (debug 'type-check-exp "Llambda" e) - (define recur (type-check-exp env)) + (debug 'type_check_exp "Llambda" e) + (define recur (type_check_exp env)) (match e [(HasType (Var x) t) - ((type-check-exp env) (Var x))] + ((type_check_exp env) (Var x))] [(Var x) (define t (dict-ref env x)) (define var (cond [(typed-vars) (HasType (Var x) t)] @@ -79,9 +79,9 @@ ;; before closure conversion [`(,ts ... -> ,rt) (values (Prim 'procedure-arity (list e1^)) 'Integer)] - [else ((super type-check-exp env) e)])] + [else ((super type_check_exp env) e)])] [(HasType (Closure arity es) t) - ((type-check-exp env) (Closure arity es))] + ((type_check_exp env) (Closure arity es))] [(UncheckedCast e t) (define-values (new-e new-t) (recur e)) (values (UncheckedCast new-e t) t)] @@ -90,26 +90,26 @@ (values (FunRef f n) t))] [(Lambda (and params `([,xs : ,Ts] ...)) rT body) (unless (< (length xs) max-parameters) - (error 'type-check "lambda has too many parameters, max is ~a" + (error 'type_check "lambda has too many parameters, max is ~a" max-parameters)) (define-values (new-body bodyT) - ((type-check-exp (append (map cons xs Ts) env)) body)) + ((type_check_exp (append (map cons xs Ts) env)) body)) (define ty `(,@Ts -> ,rT)) (check-type-equal? rT bodyT e) (values (Lambda params rT new-body) ty)] - [else ((super type-check-exp env) e)] + [else ((super type_check_exp env) e)] ))) )) -(define (type-check-Llambda p) - (send (new type-check-Llambda-class) type-check-program p)) +(define (type_check_Llambda p) + (send (new type_check_Llambda-class) type_check_program p)) -(define (type-check-Llambda-has-type p) +(define (type_check_Llambda_has_type p) (begin (typed-vec #t) (typed-vecof #t) - (define t (type-check-Llambda p)) + (define t (type_check_Llambda p)) (typed-vec #f) (typed-vecof #f) t)) diff --git a/type-check-Lvar.rkt b/type_check_Lvar.rkt similarity index 55% rename from type-check-Lvar.rkt rename to type_check_Lvar.rkt index e237496..9b3bbda 100644 --- a/type-check-Lvar.rkt +++ b/type_check_Lvar.rkt @@ -1,15 +1,15 @@ #lang racket (require "utilities.rkt") -(provide type-check-Lvar type-check-Lvar-class type-check-var-mixin) +(provide type_check_Lvar type_check_Lvar-class type_check_var-mixin) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Integers and Variables ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-var-mixin (the parts reusable for Lvar and Cvar) +;; type_check_var-mixin (the parts reusable for Lvar and Cvar) -(define (type-check-var-mixin super-class) +(define (type_check_var-mixin super-class) (class super-class (super-new) @@ -22,58 +22,58 @@ (define/public (check-type-equal? t1 t2 e) (unless (type-equal? t1 t2) - (error 'type-check "~a != ~a\nin ~v" t1 t2 e))) + (error 'type_check "~a != ~a\nin ~v" t1 t2 e))) - (define/public (type-check-op op arg-types e) + (define/public (type_check_op op arg-types e) (match (dict-ref (operator-types) op) [`(,param-types . ,return-type) (for ([at arg-types] [pt param-types]) (check-type-equal? at pt e)) return-type] - [else (error 'type-check-op "unrecognized ~a" op)])) + [else (error 'type_check_op "unrecognized ~a" op)])) - (define/public (type-check-exp env) + (define/public (type_check_exp env) (lambda (e) - (debug 'type-check-exp "Lvar ~a" e) + (debug 'type_check_exp "Lvar ~a" e) (match e [(Var x) (values (Var x) (dict-ref env x))] [(Int n) (values (Int n) 'Integer)] [(Prim op es) (define-values (new-es ts) - (for/lists (exprs types) ([e es]) ((type-check-exp env) e))) - (values (Prim op new-es) (type-check-op op ts e))] - [else (error 'type-check-exp "couldn't match ~a" e)]))) + (for/lists (exprs types) ([e es]) ((type_check_exp env) e))) + (values (Prim op new-es) (type_check_op op ts e))] + [else (error 'type_check_exp "couldn't match ~a" e)]))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Lvar +;; type_check_Lvar -(define type-check-Lvar-class - (class (type-check-var-mixin object%) +(define type_check_Lvar-class + (class (type_check_var-mixin object%) (super-new) (inherit check-type-equal?) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (debug 'type-check-exp "Lvar ~a" e) + (debug 'type_check_exp "Lvar ~a" e) (match e [(Let x e body) - (define-values (e^ Te) ((type-check-exp env) e)) - (define-values (b Tb) ((type-check-exp (dict-set env x Te)) body)) + (define-values (e^ Te) ((type_check_exp env) e)) + (define-values (b Tb) ((type_check_exp (dict-set env x Te)) body)) (values (Let x e^ b) Tb)] - [else ((super type-check-exp env) e)]))) + [else ((super type_check_exp env) e)]))) - (define/public (type-check-program e) + (define/public (type_check_program e) (match e [(Program info body) - (define-values (body^ Tb) ((type-check-exp '()) body)) + (define-values (body^ Tb) ((type_check_exp '()) body)) (check-type-equal? Tb 'Integer body) (Program info body^)] - [else (error 'type-check-Lvar "couldn't match ~a" e)])) + [else (error 'type_check_Lvar "couldn't match ~a" e)])) )) -(define (type-check-Lvar p) - (send (new type-check-Lvar-class) type-check-program p)) +(define (type_check_Lvar p) + (send (new type_check_Lvar-class) type_check_program p)) diff --git a/type-check-Lvec.rkt b/type_check_Lvec.rkt similarity index 76% rename from type-check-Lvec.rkt rename to type_check_Lvec.rkt index bb6de7f..b870c7b 100644 --- a/type-check-Lvec.rkt +++ b/type_check_Lvec.rkt @@ -1,8 +1,8 @@ #lang racket (require "utilities.rkt") -(require "type-check-Lwhile.rkt") -(provide type-check-Lvec type-check-Lvec-has-type type-check-Lvec-class - type-check-vec-mixin +(require "type_check_Lwhile.rkt") +(provide type_check_Lvec type_check_Lvec_has_type type_check_Lvec-class + type_check_vec-mixin typed-vec) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -10,11 +10,11 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-vec-mixin +;; type_check_vec-mixin (define typed-vec (make-parameter #f)) -(define (type-check-vec-mixin super-class) +(define (type_check_vec-mixin super-class) (class super-class (super-new) @@ -33,13 +33,13 @@ (type-equal? t1 t2)))] [(other wise) (super type-equal? t1 t2)])) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (define recur (type-check-exp env)) + (define recur (type_check_exp env)) (match e [(Prim 'vector es) (unless (<= (length es) 50) - (error 'type-check "vector too large ~a, max is 50" (length es))) + (error 'type_check "vector too large ~a, max is 50" (length es))) (define-values (e* t*) (for/lists (e* t*) ([e es]) (recur e))) (define t `(Vector ,@t*)) (values (cond [(typed-vec) (HasType (Prim 'vector e*) t)] @@ -52,13 +52,13 @@ (match e2 [(Int i) (unless (and (0 . <= . i) (i . < . (length ts))) - (error 'type-check "index ~a out of bounds\nin ~v" i e)) + (error 'type_check "index ~a out of bounds\nin ~v" i e)) (values (Prim 'vector-ref (list e1^ (Int i))) (list-ref ts i))] [else - (error 'type-check + (error 'type_check "expected constant index, not ~a" e2)])] - [else (error 'type-check "expect Vector, not ~a\nin ~v" t e)])] + [else (error 'type_check "expect Vector, not ~a\nin ~v" t e)])] [(Prim 'vector-set! (list e1 e2 arg) ) (define-values (e-vec t-vec) (recur e1)) (define-values (e-arg^ t-arg) (recur arg)) @@ -67,20 +67,20 @@ (match e2 [(Int i) (unless (and (0 . <= . i) (i . < . (length ts))) - (error 'type-check "index ~a out of bounds\nin ~v" i e)) + (error 'type_check "index ~a out of bounds\nin ~v" i e)) (check-type-equal? (list-ref ts i) t-arg e) (values (Prim 'vector-set! (list e-vec (Int i) e-arg^)) 'Void)] [else - (error 'type-check + (error 'type_check "expected constant index, not ~a" e2)])] - [else (error 'type-check "expect Vector, not ~a\nin ~v" t-vec e)])] + [else (error 'type_check "expect Vector, not ~a\nin ~v" t-vec e)])] [(Prim 'vector-length (list e)) (define-values (e^ t) (recur e)) (match t [`(Vector ,ts ...) (values (Prim 'vector-length (list e^)) 'Integer)] - [else (error 'type-check "expect Vector, not ~a\nin ~v" t e)])] + [else (error 'type_check "expect Vector, not ~a\nin ~v" t e)])] [(Prim 'eq? (list arg1 arg2)) (define-values (e1 t1) (recur arg1)) (define-values (e2 t2) (recur arg2)) @@ -94,21 +94,21 @@ (values (Allocate size t) t)] [(Collect size) (values (Collect size) 'Void)] - [else ((super type-check-exp env) e)] + [else ((super type_check_exp env) e)] ))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Lvec +;; type_check_Lvec -(define type-check-Lvec-class (type-check-vec-mixin type-check-Lwhile-class)) +(define type_check_Lvec-class (type_check_vec-mixin type_check_Lwhile-class)) -(define (type-check-Lvec p) - (send (new type-check-Lvec-class) type-check-program p)) +(define (type_check_Lvec p) + (send (new type_check_Lvec-class) type_check_program p)) -(define (type-check-Lvec-has-type p) +(define (type_check_Lvec_has_type p) (typed-vec #t) - (define result (send (new type-check-Lvec-class) type-check-program p)) + (define result (send (new type_check_Lvec-class) type_check_program p)) (typed-vec #f) result) diff --git a/type-check-Lvecof.rkt b/type_check_Lvecof.rkt similarity index 75% rename from type-check-Lvecof.rkt rename to type_check_Lvecof.rkt index 36a7a26..1cf6a15 100644 --- a/type-check-Lvecof.rkt +++ b/type_check_Lvecof.rkt @@ -1,19 +1,19 @@ #lang racket (require "utilities.rkt") -(require "type-check-Lvec.rkt") -(provide type-check-Lvecof type-check-Lvecof-has-type - type-check-Lvecof-class type-check-vecof-mixin typed-vecof) +(require "type_check_Lvec.rkt") +(provide type_check_Lvecof type_check_Lvecof_has_type + type_check_Lvecof-class type_check_vecof-mixin typed-vecof) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Homogeneous Vectors ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Lvecof +;; type_check_Lvecof (define typed-vecof (make-parameter #f)) -(define (type-check-vecof-mixin super-class) +(define (type_check_vecof-mixin super-class) (class super-class (super-new) (inherit check-type-equal?) @@ -23,10 +23,10 @@ (exit . (() . _))) (super operator-types))) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (debug 'type-check-exp "vecof" e) - (define recur (type-check-exp env)) + (debug 'type_check_exp "vecof" e) + (define recur (type_check_exp env)) (match e [(Prim 'make-vector (list e1 e2)) (define-values (e1^ t1) (recur e1)) @@ -44,7 +44,7 @@ [`(Vectorof ,elt-type) (values (Prim 'vectorof-ref (list e1^ e2^)) elt-type)] [else - (error 'type-check + (error 'type_check "expected a vectorof in vectorof-ref, not " t1)])] [(Prim 'vectorof-set! (list e1 e2 e3) ) (define-values (e-vec t-vec) (recur e1)) @@ -55,16 +55,16 @@ [`(Vectorof ,elt-type) (check-type-equal? elt-type t-arg e) (values (Prim 'vectorof-set! (list e-vec e2^ e-arg^)) 'Void)] - [else ((super type-check-exp env) e)])] + [else ((super type_check_exp env) e)])] [(Prim 'vectorof-length (list e1)) (define-values (e1^ t1) (recur e1)) - (debug 'type-check-exp "vectorof-length type: " t1) + (debug 'type_check_exp "vectorof-length type: " t1) (match t1 [`(Vectorof ,t) (values (Prim 'vectorof-length (list e1^)) 'Integer)] [else ;; error here instead? -Jeremy - ((super type-check-exp env) e)])] + ((super type_check_exp env) e)])] [(AllocateArray e1 t) (define-values (e1^ t1) (recur e1)) @@ -72,16 +72,16 @@ (values (AllocateArray e1^ t) t)] [(HasType e t) - ((type-check-exp env) e)] + ((type_check_exp env) e)] - [else ((super type-check-exp env) e)]))) + [else ((super type_check_exp env) e)]))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Lvecof +;; type_check_Lvecof -(define type-check-Lvecof-class - (class (type-check-vecof-mixin type-check-Lvec-class) +(define type_check_Lvecof-class + (class (type_check_vecof-mixin type_check_Lvec-class) (super-new) (inherit check-type-equal?) @@ -90,10 +90,10 @@ (exit . (() . _))) (super operator-types))) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (debug 'type-check-exp "vecof" e) - (define recur (type-check-exp env)) + (debug 'type_check_exp "vecof" e) + (define recur (type_check_exp env)) (match e [(Prim 'vector-ref (list e1 e2)) (define-values (e1^ t1) (recur e1)) @@ -105,7 +105,7 @@ (check-type-equal? t2 'Integer e2) (values (Prim 'vector-ref (list e1^^ e2^)) elt-type)] - [else ((super type-check-exp env) e)])] + [else ((super type_check_exp env) e)])] [(Prim 'vector-set! (list e1 e2 e3) ) (define-values (e-vec t-vec) (recur e1)) (match t-vec @@ -115,24 +115,24 @@ (check-type-equal? t2 'Integer e2) (check-type-equal? elt-type t-arg e) (values (Prim 'vectorof-set! (list e-vec e2^ e-arg^)) 'Void)] - [else ((super type-check-exp env) e)])] + [else ((super type_check_exp env) e)])] [(Prim 'vector-length (list e1)) (define-values (e1^ t1) (recur e1)) (match t1 [`(Vectorof ,t) (values (Prim 'vectorof-length (list e1^)) 'Integer)] - [else ((super type-check-exp env) e)])] - [else ((super type-check-exp env) e)]))) + [else ((super type_check_exp env) e)])] + [else ((super type_check_exp env) e)]))) )) -(define (type-check-Lvecof p) - (send (new type-check-Lvecof-class) type-check-program p)) +(define (type_check_Lvecof p) + (send (new type_check_Lvecof-class) type_check_program p)) -(define (type-check-Lvecof-has-type p) +(define (type_check_Lvecof_has_type p) (typed-vecof #t) (typed-vec #t) - (define result (send (new type-check-Lvecof-class) type-check-program p)) + (define result (send (new type_check_Lvecof-class) type_check_program p)) (typed-vecof #f) (typed-vec #f) result) diff --git a/type-check-Lwhile.rkt b/type_check_Lwhile.rkt similarity index 73% rename from type-check-Lwhile.rkt rename to type_check_Lwhile.rkt index c6d2f79..36841ef 100644 --- a/type-check-Lwhile.rkt +++ b/type_check_Lwhile.rkt @@ -2,15 +2,15 @@ ;(require graph) ;(require "multigraph.rkt") (require "utilities.rkt") -(require "type-check-Lif.rkt") -(provide type-check-Lwhile type-check-Lwhile-class) +(require "type_check_Lif.rkt") +(provide type_check_Lwhile type_check_Lwhile-class) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; while, begin, set! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define type-check-Lwhile-class - (class type-check-Lif-class +(define type_check_Lwhile-class + (class type_check_Lif-class (super-new) (inherit check-type-equal?) @@ -22,10 +22,10 @@ [(t1 '_) #t] [(other wise) (equal? t1 t2)])) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (debug 'type-check-exp "Lwhile" e) - (define recur (type-check-exp env)) + (debug 'type_check_exp "Lwhile" e) + (define recur (type_check_exp env)) (match e [(SetBang x rhs) (define-values (rhs^ rhsT) (recur rhs)) @@ -37,7 +37,7 @@ [(WhileLoop cnd body) (define-values (cnd^ Tc) (recur cnd)) (check-type-equal? Tc 'Boolean e) - (define-values (body^ Tbody) ((type-check-exp env) body)) + (define-values (body^ Tbody) ((type_check_exp env) body)) (values (WhileLoop cnd^ body^) 'Void)] [(Begin es body) (define-values (es^ ts) @@ -45,12 +45,12 @@ (define-values (body^ Tbody) (recur body)) (values (Begin es^ body^) Tbody)] [(Void) (values (Void) 'Void)] - [else ((super type-check-exp env) e)]))) + [else ((super type_check_exp env) e)]))) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Lwhile +;; type_check_Lwhile -(define (type-check-Lwhile p) - (send (new type-check-Lwhile-class) type-check-program p)) +(define (type_check_Lwhile p) + (send (new type_check_Lwhile-class) type_check_program p)) diff --git a/type-check-gradual.rkt b/type_check_gradual.rkt similarity index 80% rename from type-check-gradual.rkt rename to type_check_gradual.rkt index c2aa328..de8aa8f 100644 --- a/type-check-gradual.rkt +++ b/type_check_gradual.rkt @@ -1,16 +1,16 @@ #lang racket (require "utilities.rkt") -(require "type-check-Lany.rkt") -(require "type-check-Cany.rkt") +(require "type_check_Lany.rkt") +(require "type_check_Cany.rkt") -(provide type-check-gradual type-check-gradual-class type-check-gradual-mixin - type-check-Lany-proxy type-check-Lany-proxy-class - type-check-Cany-proxy type-check-Cany-proxy-class +(provide type_check_gradual type_check_gradual-class type_check_gradual-mixin + type_check_Lany_proxy type_check_Lany_proxy-class + type_check_Cany_proxy type_check_Cany_proxy-class ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (type-check-gradual-mixin super-class) +(define (type_check_gradual-mixin super-class) (class super-class (super-new) @@ -50,8 +50,8 @@ )) -(define type-check-gradual-class - (class (type-check-gradual-mixin type-check-Lany-class) +(define type_check_gradual-class + (class (type_check_gradual-mixin type_check_Lany-class) (super-new) (inherit operator-types type-predicates join meet) @@ -87,19 +87,19 @@ (define/public (check-consistent? t1 t2 e) (unless (consistent? t1 t2) - (error 'type-check "~a is inconsistent with ~a\nin ~v" t1 t2 e))) + (error 'type_check "~a is inconsistent with ~a\nin ~v" t1 t2 e))) - ;; Override type-check-op to check for consistency instead of equality. - (define/override (type-check-op op arg-types e) + ;; Override type_check_op to check for consistency instead of equality. + (define/override (type_check_op op arg-types e) (match (dict-ref (operator-types) op) [`(,param-types . ,return-type) (for ([at arg-types] [pt param-types]) (check-consistent? at pt e)) return-type] - [else (error 'type-check-op "unrecognized ~a" op)])) + [else (error 'type_check_op "unrecognized ~a" op)])) ;; These primitive operators are handled explicitly in the - ;; type checkers, so don't use type-check-op on them. + ;; type checkers, so don't use type_check_op on them. (define explicit-prim-ops (set-union (type-predicates) @@ -108,10 +108,10 @@ 'make-vector 'any-vector-length 'any-vector-ref 'any-vector-set!))) - (define/override (type-check-exp env) + (define/override (type_check_exp env) (lambda (e) - (verbose "gradual/type-check-exp" e) - (define recur (type-check-exp env)) + (verbose "gradual/type_check_exp" e) + (define recur (type_check_exp env)) (match e ;; Lvar [(Prim op es) @@ -119,7 +119,7 @@ (define-values (new-es ts) (for/lists (exprs types) ([e es]) (recur e))) - (define t-ret (type-check-op op ts e)) + (define t-ret (type_check_op op ts e)) (values (Prim op new-es) t-ret)] ;; Lif [(Prim 'eq? (list e1 e2)) @@ -150,7 +150,7 @@ [(WhileLoop e1 e2) (define-values (e1^ T1) (recur e1)) (check-consistent? T1 'Boolean e) - (define-values (e2^ T2) ((type-check-exp env) e2)) + (define-values (e2^ T2) ((type_check_exp env) e2)) (values (WhileLoop e1^ e2^) 'Void)] ;; Lvec [(Prim 'vector-length (list e1)) @@ -160,7 +160,7 @@ (values (Prim 'vector-length (list e1^)) 'Integer)] ['Any (values (Prim 'vector-length (list e1^)) 'Integer)] [`(Vectorof ,elt-type) - ;;(error 'type-check "unhandled Vectorof in vector-length") + ;;(error 'type_check "unhandled Vectorof in vector-length") (values (Prim 'vector-length (list e1^)) 'Integer)] )] [(Prim 'vector-ref (list e1 e2)) @@ -172,14 +172,14 @@ (match e2^ [(Int i) (unless (and (0 . <= . i) (i . < . (length ts))) - (error 'type-check "invalid index ~a in ~a" i e)) + (error 'type_check "invalid index ~a in ~a" i e)) (values (Prim 'vector-ref (list e1^ (Int i))) (list-ref ts i))] [else (values (Prim 'vector-ref (list e1^ e2^)) 'Any)])] [`(Vectorof ,elt-type) (values (Prim 'vector-ref (list e1^ e2^)) elt-type)] ['Any (values (Prim 'vector-ref (list e1^ e2^)) 'Any)] - [else (error 'type-check "expected vector not ~a\nin ~v" t1 e)])] + [else (error 'type_check "expected vector not ~a\nin ~v" t1 e)])] [(Prim 'vector-set! (list e1 e2 e3) ) (define-values (e1^ t1) (recur e1)) (define-values (e2^ t2) (recur e2)) @@ -190,7 +190,7 @@ (match e2^ [(Int i) (unless (and (0 . <= . i) (i . < . (length ts))) - (error 'type-check "invalid index ~a in ~a" i e)) + (error 'type_check "invalid index ~a in ~a" i e)) (check-consistent? (list-ref ts i) t3 e) (values (Prim 'vector-set! (list e1^ (Int i) e3^)) 'Void)] [else @@ -199,7 +199,7 @@ (values (Prim 'vector-set! (list e1^ e2^ e3^)) 'Void)] ['Any (values (Prim 'vector-set! (list e1^ e2^ e3^)) 'Void)] - [else (error 'type-check "expected vector not ~a\nin ~v" t1 e)])] + [else (error 'type_check "expected vector not ~a\nin ~v" t1 e)])] ;; Llambda [(Apply e1 e2s) (define-values (e1^ T1) (recur e1)) @@ -211,21 +211,21 @@ (values (Apply e1^ e2s^) T1rt)] [`Any (values (Apply e1^ e2s^) 'Any)] - [else (error 'type-check "expected function not ~a\nin ~v" T1 e)])] + [else (error 'type_check "expected function not ~a\nin ~v" T1 e)])] [(Lambda params Tr e1) (define-values (xs Ts) (for/lists (l1 l2) ([p params]) (match p [`[,x : ,T] (values x T)] [(? symbol? x) (values x 'Any)]))) (define-values (e1^ T1) - ((type-check-exp (append (map cons xs Ts) env)) e1)) + ((type_check_exp (append (map cons xs Ts) env)) e1)) (check-consistent? Tr T1 e) (values (Lambda (for/list ([x xs] [T Ts]) `[,x : ,T]) Tr e1^) `(,@Ts -> ,Tr))] - [else ((super type-check-exp env) e)] + [else ((super type_check_exp env) e)] ))) - (define/override (type-check-def env) + (define/override (type_check_def env) (lambda (e) (match e [(Def f params rt info body) @@ -234,37 +234,37 @@ [`[,x : ,T] (values x T)] [(? symbol? x) (values x 'Any)]))) (define new-env (append (map cons xs ps) env)) - (define-values (body^ ty^) ((type-check-exp new-env) body)) + (define-values (body^ ty^) ((type_check_exp new-env) body)) (check-consistent? ty^ rt e) (Def f (for/list ([x xs] [T ps]) `[,x : ,T]) rt info body^)] - [else (error 'type-check "ill-formed function definition ~a" e)] + [else (error 'type_check "ill-formed function definition ~a" e)] ))) - (define/override (type-check-program e) + (define/override (type_check_program e) (match e [(Program info body) - (define-values (body^ ty) ((type-check-exp '()) body)) + (define-values (body^ ty) ((type_check_exp '()) body)) (check-consistent? ty 'Integer e) (ProgramDefsExp info '() body^)] [(ProgramDefsExp info ds body) (define new-env (for/list ([d ds]) (cons (Def-name d) (fun-def-type d)))) (define ds^ (for/list ([d ds]) - ((type-check-def new-env) d))) - (define-values (body^ ty) ((type-check-exp new-env) body)) + ((type_check_def new-env) d))) + (define-values (body^ ty) ((type_check_exp new-env) body)) (check-consistent? ty 'Integer e) (ProgramDefsExp info ds^ body^)] - [else (super type-check-program e)])) + [else (super type_check_program e)])) )) -(define (type-check-gradual p) - (send (new type-check-gradual-class) type-check-program p)) +(define (type_check_gradual p) + (send (new type_check_gradual-class) type_check_program p)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Lany-proxy +;; type_check_Lany_proxy -(define (type-check-Lany-proxy-mixin super-class) +(define (type_check_Lany_proxy-mixin super-class) (class super-class (super-new) (inherit check-type-equal?) @@ -282,8 +282,8 @@ (type-equal? t1 t2))] [else (super type-equal? t1 t2)])) - (define/override ((type-check-exp env) e) - (define recur (type-check-exp env)) + (define/override ((type_check_exp env) e) + (define recur (type_check_exp env)) (match e [(Prim 'inject-vector (list e1)) (define-values (e1^ T1) (recur e1)) @@ -324,7 +324,7 @@ (match (list T1 e2^) [(list `(PVector ,ts ...) (Int i)) (unless (and (0 . <= . i) (i . < . (length ts))) - (error 'type-check "invalid index ~a in ~a" i e)) + (error 'type_check "invalid index ~a in ~a" i e)) (values (Prim 'proxy-vector-ref (list e1^ e2^)) (list-ref ts i))])] [(Prim 'proxy-vector-set! (list e1 e2 e3)) @@ -334,26 +334,26 @@ (match (list T1 e2^) [(list `(PVector ,ts ...) (Int i)) (unless (and (0 . <= . i) (i . < . (length ts))) - (error 'type-check "invalid index ~a in ~a" i e)) + (error 'type_check "invalid index ~a in ~a" i e)) (check-type-equal? (list-ref ts i) T3 e) (values (Prim 'proxy-vector-set! (list e1^ e2^ e3^)) 'Void)])] - [else ((super type-check-exp env) e)])) + [else ((super type_check_exp env) e)])) )) -(define type-check-Lany-proxy-class - (type-check-Lany-proxy-mixin type-check-Lany-class)) +(define type_check_Lany_proxy-class + (type_check_Lany_proxy-mixin type_check_Lany-class)) -(define (type-check-Lany-proxy p) - (send (new type-check-Lany-proxy-class) type-check-program p)) +(define (type_check_Lany_proxy p) + (send (new type_check_Lany_proxy-class) type_check_program p)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; type-check-Cany-proxy +;; type_check_Cany_proxy -(define type-check-Cany-proxy-class - (type-check-Lany-proxy-mixin type-check-Cany-class)) +(define type_check_Cany_proxy-class + (type_check_Lany_proxy-mixin type_check_Cany-class)) -(define (type-check-Cany-proxy p) - (send (new type-check-Cany-proxy-class) type-check-program p)) +(define (type_check_Cany_proxy p) + (send (new type_check_Cany_proxy-class) type_check_program p)) diff --git a/type-check-poly.rkt b/type_check_poly.rkt similarity index 74% rename from type-check-poly.rkt rename to type_check_poly.rkt index f4aba94..70dd649 100644 --- a/type-check-poly.rkt +++ b/type_check_poly.rkt @@ -1,11 +1,11 @@ #lang racket (require "utilities.rkt") -(require "type-check-Llambda.rkt") +(require "type_check_Llambda.rkt") -(provide type-check-poly type-check-poly-class) +(provide type_check_poly type_check_poly-class) -(define type-check-poly-class - (class type-check-Llambda-class +(define type_check_poly-class + (class type_check_Llambda-class (super-new) (inherit check-type-equal?) @@ -20,7 +20,7 @@ (super type-equal? t1 t2)])) (define/public (match-types env param_ty arg_ty) - (verbose 'type-check "match-types" env param_ty arg_ty) + (verbose 'type_check "match-types" env param_ty arg_ty) (define result (match* (param_ty arg_ty) [('Integer 'Integer) env] @@ -39,15 +39,15 @@ (match-types env^ t1 t2)] [((? symbol? x) t) (match (dict-ref env x (lambda () #f)) - [#f (error 'type-check "undefined type variable ~a" x)] + [#f (error 'type_check "undefined type variable ~a" x)] ['Type (cons (cons x t) env)] [t^ (check-type-equal? t t^ 'matching) env])] - [(other wise) (error 'type-check "mismatch ~a != a" param_ty arg_ty)])) + [(other wise) (error 'type_check "mismatch ~a != a" param_ty arg_ty)])) (copious 'match-types "done" param_ty arg_ty result) result) (define/public (subst-type env pat1) - (verbose 'type-check "subst" env pat1) + (verbose 'type_check "subst" env pat1) (match pat1 ['Integer 'Integer] ['Boolean 'Boolean] @@ -60,7 +60,7 @@ [`(All ,xs ,t) `(All ,xs ,(subst-type (append (map cons xs xs) env) t))] [(? symbol? x) (dict-ref env x)] - [else (error 'type-check "expected a type not ~a" pat1)])) + [else (error 'type_check "expected a type not ~a" pat1)])) (define/override (fun-def-type d) (match d @@ -83,7 +83,7 @@ [(? symbol? a) (match (dict-ref env a (lambda () #f)) ['Type (void)] - [else (error 'type-check "undefined type variable ~a" a)])] + [else (error 'type_check "undefined type variable ~a" a)])] [`(Vector ,ts ...) (for ([t ts]) ((check-well-formed env) t))] [`(,ts ... -> ,t) @@ -92,14 +92,14 @@ [`(All ,xs ,t) (define env^ (append (for/list ([x xs]) (cons x 'Type)) env)) ((check-well-formed env^) t)] - [else (error 'type-check "unrecognized type ~a" ty)])) + [else (error 'type_check "unrecognized type ~a" ty)])) (define/public (combine-decls-defs ds) (match ds ['() '()] [`(,(Decl name type) . (,(Def f params _ info body) . ,ds^)) (unless (equal? name f) - (error 'type-check "name mismatch, ~a != ~a" name f)) + (error 'type_check "name mismatch, ~a != ~a" name f)) (match type [`(All ,xs (,ps ... -> ,rt)) (define params^ (for/list ([x params] [T ps]) `[,x : ,T])) @@ -108,14 +108,14 @@ [`(,ps ... -> ,rt) (define params^ (for/list ([x params] [T ps]) `[,x : ,T])) (cons (Def name params^ rt info body) (combine-decls-defs ds^))] - [else (error 'type-check "expected a function type, not ~a" type) ])] + [else (error 'type_check "expected a function type, not ~a" type) ])] [`(,(Def f params rt info body) . ,ds^) (cons (Def f params rt info body) (combine-decls-defs ds^))])) - (define/override (type-check-apply env e1 es) - (define-values (e^ ty) ((type-check-exp env) e1)) + (define/override (type_check_apply env e1 es) + (define-values (e^ ty) ((type_check_exp env) e1)) (define-values (es^ ty*) (for/lists (es^ ty*) ([e (in-list es)]) - ((type-check-exp env) e))) + ((type_check_exp env) e))) (match ty [`(,ty^* ... -> ,rt) (for ([arg-ty ty*] [param-ty ty^*]) @@ -125,59 +125,59 @@ (define env^ (append (for/list ([x xs]) (cons x 'Type)) env)) (define env^^ (for/fold ([env^^ env^]) ([arg-ty ty*] [param-ty tys]) (match-types env^^ param-ty arg-ty))) - (debug 'type-check "match result" env^^) + (debug 'type_check "match result" env^^) (define targs (for/list ([x xs]) (match (dict-ref env^^ x (lambda () #f)) - [#f (error 'type-check "type variable ~a not deduced\nin ~v" + [#f (error 'type_check "type variable ~a not deduced\nin ~v" x (Apply e1 es))] [ty ty]))) (values (Inst e^ ty targs) es^ (subst-type env^^ rt))] - [else (error 'type-check "expected a function, not ~a" ty)])) + [else (error 'type_check "expected a function, not ~a" ty)])) - (define/override ((type-check-exp env) e) - (verbose 'type-check "poly/exp begin" e env) + (define/override ((type_check_exp env) e) + (verbose 'type_check "poly/exp begin" e env) (define-values (e^ ty) (match e [(Lambda `([,xs : ,Ts] ...) rT body) (for ([T Ts]) ((check-well-formed env) T)) ((check-well-formed env) rT) - ((super type-check-exp env) e)] + ((super type_check_exp env) e)] [(HasType e1 ty) ((check-well-formed env) ty) - ((super type-check-exp env) e)] - [else ((super type-check-exp env) e)])) - (verbose 'type-check "poly/exp end" e e^ ty) + ((super type_check_exp env) e)] + [else ((super type_check_exp env) e)])) + (verbose 'type_check "poly/exp end" e e^ ty) (values e^ ty)) - (define/override ((type-check-def env) d) - (verbose 'type-check "poly/def" d) + (define/override ((type_check_def env) d) + (verbose 'type_check "poly/def" d) (match d [(Poly ts (Def f (and p:t* (list `[,xs : ,ps] ...)) rt info body)) (define ts-env (for/list ([t ts]) (cons t 'Type))) (for ([p ps]) ((check-well-formed ts-env) p)) ((check-well-formed ts-env) rt) (define new-env (append ts-env (map cons xs ps) env)) - (define-values (body^ ty^) ((type-check-exp new-env) body)) + (define-values (body^ ty^) ((type_check_exp new-env) body)) (check-type-equal? ty^ rt body) (Poly ts (Def f p:t* rt info body^))] - [else ((super type-check-def env) d)])) + [else ((super type_check_def env) d)])) - (define/override (type-check-program p) - (verbose 'type-check "poly/program" p) + (define/override (type_check_program p) + (verbose 'type_check "poly/program" p) (match p [(Program info body) - (type-check-program (ProgramDefsExp info '() body))] + (type_check_program (ProgramDefsExp info '() body))] [(ProgramDefsExp info ds body) (define ds^ (combine-decls-defs ds)) (define new-env (for/list ([d ds^]) (cons (def-name d) (fun-def-type d)))) - (define ds^^ (for/list ([d ds^]) ((type-check-def new-env) d))) - (define-values (body^ ty) ((type-check-exp new-env) body)) + (define ds^^ (for/list ([d ds^]) ((type_check_def new-env) d))) + (define-values (body^ ty) ((type_check_exp new-env) body)) (check-type-equal? ty 'Integer body) (ProgramDefsExp info ds^^ body^)])) )) -(define (type-check-poly p) - (send (new type-check-poly-class) type-check-program p)) +(define (type_check_poly p) + (send (new type_check_poly-class) type_check_program p)) diff --git a/utilities.rkt b/utilities.rkt index 4745aca..da65b47 100644 --- a/utilities.rkt +++ b/utilities.rkt @@ -2077,7 +2077,7 @@ Changelog: (define pass-name (list-ref pass-info 0)) (define pass (list-ref pass-info 1)) (define interp (list-ref pass-info 2)) - (define type-checker + (define type_checker (cond [(>= (length pass-info) 4) (list-ref pass-info 3)] [else #f])) @@ -2085,11 +2085,11 @@ Changelog: (define input p) (define new-p^ ((check-exception name test-name #f) (thunk (pass p)))) (trace "pass output: " (strip-has-type new-p^)) - (define new-p (cond [type-checker + (define new-p (cond [type_checker (trace "type checking...") - (type-checker new-p^)] + (type_checker new-p^)] [else new-p^])) - (trace "type-check output: " (strip-has-type new-p)) + (trace "type_check output: " (strip-has-type new-p)) (cond [interp (define result (if (file-exists? input-file-name) @@ -2147,7 +2147,7 @@ Changelog: (define name (list-ref pass-info 0)) (define pass (list-ref pass-info 1)) (define interp (list-ref pass-info 2)) - (define type-checker + (define type_checker (cond [(>= (length pass-info) 4) (list-ref pass-info 3)] [else #f])) @@ -2156,9 +2156,9 @@ Changelog: ((check-exception name file-base #f) (thunk (pass p)))) (trace (string-append name " output: ") (strip-has-type new-p^)) - (define new-p (cond [type-checker + (define new-p (cond [type_checker (trace "type checking...") - (type-checker new-p^)] + (type_checker new-p^)] [else new-p^])) (loop (cdr passes) new-p) ]))])