Skip to content

Commit 6954516

Browse files
jsiekjsiek
committed
merge
2 parents 3af8777 + 728a04a commit 6954516

File tree

6 files changed

+157
-31
lines changed

6 files changed

+157
-31
lines changed

‎dynamic-interp.rkt

Lines changed: 102 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,102 @@
1+
#lang racket
2+
(require racket/fixnum)
3+
(require "utilities.rkt" (prefix-in runtime-config: "runtime-config.rkt"))
4+
(provide interp-r7)
5+
6+
(define get-injected-type
7+
(lambda (e)
8+
(match e
9+
[`(inject ,v ,ty) ty])))
10+
11+
(define valid-op?
12+
(lambda (op)
13+
(member op '(+ - and or not))))
14+
15+
(define interp-r7-op
16+
(lambda (op es)
17+
(match `(,op ,es)
18+
[`(+ ((inject ,v1 Integer) (inject ,v2 Integer)))
19+
`(inject ,(fx+ v1 v2) Integer)]
20+
[`(- ((inject ,v Integer)))
21+
`(inject ,(fx- 0 v) Integer)]
22+
[`(and (,v1 ,v2))
23+
(match v1
24+
[`(inject #f Boolean) v1]
25+
[else v2])]
26+
[`(or (,v1 ,v2))
27+
(match v1
28+
[`(inject #f Boolean) v2]
29+
[else v1])]
30+
[`(not (,v1))
31+
(match v1
32+
[`(inject #f Boolean) `(inject #t Boolean)]
33+
[else `(inject #f Boolean)])])))
34+
35+
(define (interp-r7 env)
36+
(lambda (ast)
37+
(vomit "interp-r7" ast env)
38+
(match ast
39+
[(? symbol?) (lookup ast env)]
40+
[`(function-ref ,f) (lookup f env)]
41+
[`(function-ref ,f ,n) (lookup f env)] ;; This is to deal with the detail of our translation that it keeps the arity of functions in the funref
42+
[(? integer?) `(inject ,ast Integer)]
43+
[#t `(inject #t Boolean)]
44+
[#f `(inject #f Boolean)]
45+
[`(read) `(inject ,(read-fixnum) Integer)]
46+
[`(lambda (,xs ...) ,body)
47+
`(inject (lambda ,xs ,body ,env) (,@(map (lambda (x) 'Any) xs) -> Any))]
48+
[`(define (,f ,xs ...) ,body)
49+
(mcons f `(lambda ,xs ,body))]
50+
[`(program ,ds ... ,body)
51+
(let ([top-level (map (interp-r7 '()) ds)])
52+
;; Use set-cdr! on define lambda's for mutual recursion
53+
(for/list ([b top-level])
54+
(set-mcdr! b (match (mcdr b)
55+
[`(lambda ,xs ,body)
56+
`(inject (lambda ,xs ,body ,top-level)
57+
(,@(map (lambda (x) 'Any) xs) -> Any))])))
58+
((interp-r7 top-level) body))]
59+
[`(vector ,es ...)
60+
(let* ([elts (map (interp-r7 env) es)]
61+
[tys (map get-injected-type elts)])
62+
`(inject ,(apply vector (map (interp-r7 env) es)) (Vector ,@tys)))]
63+
[`(vector-set! ,e1 ,n ,e2)
64+
(let ([e1^ ((interp-r7 env) e1)]
65+
[e2^ ((interp-r7 env) e2)])
66+
(match e1^
67+
[`(inject ,vec ,ty)
68+
(vector-set! vec n e2^)
69+
`(inject (void) Void)]))]
70+
[`(vector-ref ,e ,n)
71+
(let ([e^ ((interp-r7 env) e)])
72+
(match e^
73+
[`(inject ,vec ,ty)
74+
(vector-ref vec n)]))]
75+
[`(let ([,x ,e]) ,body)
76+
(let ([v ((interp-r7 env) e)])
77+
((interp-r7 (cons (cons x v) env)) body))]
78+
[`(,op ,es ...) #:when (valid-op? op)
79+
(interp-r7-op op (map (interp-r7 env) es))]
80+
[`(eq? ,l ,r)
81+
`(inject ,(equal? ((interp-r7 env) l) ((interp-r7 env) r)) Boolean)]
82+
[`(if ,q ,t ,f)
83+
(match ((interp-r7 env) q)
84+
[`(inject #f Boolean)
85+
((interp-r7 env) f)]
86+
[else ((interp-r7 env) t)])]
87+
[`(app ,f ,es ...)
88+
(define new-args (map (interp-r7 env) es))
89+
(let ([f-val ((interp-r7 env) f)])
90+
(match f-val
91+
[`(inject (lambda (,xs ...) ,body ,lam-env) ,ty)
92+
(define new-env (append (map cons xs new-args) lam-env))
93+
((interp-r7 new-env) body)]
94+
[else (error "interp-r7, expected function, not" f-val)]))]
95+
[`(,f ,es ...)
96+
(define new-args (map (interp-r7 env) es))
97+
(let ([f-val ((interp-r7 env) f)])
98+
(match f-val
99+
[`(inject (lambda (,xs ...) ,body ,lam-env) ,ty)
100+
(define new-env (append (map cons xs new-args) lam-env))
101+
((interp-r7 new-env) body)]
102+
[else (error "interp-r7, expected function, not" f-val)]))])))

‎dynamic-typing.rkt

Lines changed: 18 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
(require racket/set)
33
(require "utilities.rkt")
44
(require "interp.rkt")
5+
(require "dynamic-interp.rkt")
56
(require "lambda.rkt")
67

78
(provide compile-R6 R6-passes R6-typechecker R7-passes)
@@ -440,41 +441,42 @@
440441
)))
441442

442443
(define R7-passes
443-
(let ([compiler (new compile-R7)])
444+
(let ([compiler (new compile-R7)]
445+
[interp (new interp-R6)])
444446
`(
445447
("uniquify" ,(send compiler uniquify '())
446-
#f)
448+
,(interp-r7 '()))
447449
("reveal-functions" ,(send compiler reveal-functions '())
448-
#f)
450+
,(interp-r7 '()))
449451
("translate" ,(send compiler cast-insert)
450-
#f)
452+
,(send interp interp-scheme '()))
451453
("inserthastype" ,(send compiler type-check '())
452-
#f)
454+
,(send interp interp-scheme '()))
453455
("convert-to-closures" ,(send compiler convert-to-closures)
454-
#f)
456+
,(send interp interp-scheme '()))
455457
("flatten" ,(send compiler flatten #f)
456-
#f)
458+
,(send interp interp-C '()))
457459
("expose allocation"
458460
,(send compiler expose-allocation)
459-
#f)
461+
,(send interp interp-C '()))
460462
("uncover call live roots"
461463
,(send compiler uncover-call-live-roots)
462-
#f)
464+
,(send interp interp-C '()))
463465
("instruction selection" ,(send compiler select-instructions)
464-
#f)
466+
,(send interp interp-x86 '()))
465467
("liveness analysis" ,(send compiler uncover-live (void))
466-
#f)
468+
,(send interp interp-x86 '()))
467469
("build interference" ,(send compiler build-interference
468470
(void) (void))
469-
#f)
471+
,(send interp interp-x86 '()))
470472
("build move graph" ,(send compiler
471473
build-move-graph (void))
472-
#f)
474+
,(send interp interp-x86 '()))
473475
("allocate registers" ,(send compiler allocate-registers)
474-
#f)
476+
,(send interp interp-x86 '()))
475477
("lower conditionals" ,(send compiler lower-conditionals)
476-
#f)
478+
,(send interp interp-x86 '()))
477479
("patch instructions" ,(send compiler patch-instructions)
478-
#f)
480+
,(send interp interp-x86 '()))
479481
("print x86" ,(send compiler print-x86) #f)
480482
)))

‎interp.rkt

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -967,6 +967,15 @@
967967
[else (super interp-op op)]
968968
))
969969

970+
(define/public (tyeq? t1 t2)
971+
;; (display t1) (display " ") (display t2) (newline) (flush-output)
972+
(match `(,t1 ,t2)
973+
[`((Vectorof ,t1) (Vector ,t2s ...))
974+
(foldr (lambda (x y) (and x y)) #t (map (lambda (x) (tyeq? t1 x)) t2s))] ;; wtf racket, why cant i just pass and?
975+
[`((Vector ,t1s ...) (Vectorof ,t2))
976+
(foldr (lambda (x y) (and x y)) #t (map (lambda (x) (tyeq? t2 x)) t1s))]
977+
[else (equal? t1 t2)]))
978+
970979
(define/override (interp-scheme env)
971980
(lambda (ast)
972981
(verbose "R6/interp-scheme" ast)
@@ -977,7 +986,7 @@
977986
(define v ((interp-scheme env) e))
978987
(match v
979988
[`(tagged ,v1 ,t1)
980-
(cond [(equal? t1 t2)
989+
(cond [(tyeq? t1 t2)
981990
v1]
982991
[else
983992
(error "in project, type mismatch" t1 t2)])]
@@ -997,7 +1006,7 @@
9971006
(define v ((interp-C env) e))
9981007
(match v
9991008
[`(tagged ,v1 ,t1)
1000-
(cond [(equal? t1 t2)
1009+
(cond [(tyeq? t1 t2)
10011010
v1]
10021011
[else
10031012
(error "in project, type mismatch" t1 t2)])]

‎run-tests.rkt

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@
88
(require "lambda.rkt")
99
(require "dynamic-typing.rkt")
1010
(require "interp.rkt")
11+
(require "dynamic-interp.rkt")
1112
(require "runtime-config.rkt")
1213

1314
;; I have made the original run-tests more programmatic so that we
@@ -20,15 +21,15 @@
2021
;; Table associating names of compilers with the information for
2122
;; running and testing them.
2223
(define compiler-list
23-
;; Name Typechecker Compiler-Passes Use interpreter? Valid suites
24-
`(("int_exp" #f ,int-exp-passes #t (0))
25-
("reg_int_exp" #f ,reg-int-exp-passes #t (0))
26-
("conditionals" ,conditionals-typechecker ,conditionals-passes #t (0 1))
27-
("vectors" ,vectors-typechecker ,vectors-passes #t (0 1 2))
28-
("functions" ,functions-typechecker ,functions-passes #t (0 1 2 3))
29-
("lambda" ,lambda-typechecker ,lambda-passes #t (0 1 2 3 4))
30-
("any" ,R6-typechecker ,R6-passes #t (0 1 2 3 4 6))
31-
("dynamic" #f ,R7-passes #f (7))
24+
;; Name Typechecker Compiler-Passes Initial interpreter Valid suites
25+
`(("int_exp" #f ,int-exp-passes ,interp-scheme (0))
26+
("reg_int_exp" #f ,reg-int-exp-passes ,interp-scheme (0))
27+
("conditionals" ,conditionals-typechecker ,conditionals-passes ,interp-scheme (0 1))
28+
("vectors" ,vectors-typechecker ,vectors-passes ,interp-scheme (0 1 2))
29+
("functions" ,functions-typechecker ,functions-passes ,interp-scheme (0 1 2 3))
30+
("lambda" ,lambda-typechecker ,lambda-passes ,interp-scheme (0 1 2 3 4))
31+
("any" ,R6-typechecker ,R6-passes ,interp-scheme (0 1 2 3 4 6))
32+
("dynamic" #f ,R7-passes ,(interp-r7 '()) (7))
3233
))
3334

3435
(define compiler-table (make-immutable-hash compiler-list))
@@ -56,8 +57,7 @@
5657
(define (test-compiler name typechecker use-interp passes test-suite test-nums)
5758
(display "------------------------------------------------------")(newline)
5859
(display "testing compiler ")(display name)(newline)
59-
(unless (not use-interp)
60-
(interp-tests name typechecker passes interp-scheme test-suite test-nums))
60+
(interp-tests name typechecker passes use-interp test-suite test-nums)
6161
(compiler-tests name typechecker passes test-suite test-nums)
6262
(newline)(display "tests passed")(newline))
6363

‎tests/s6_9.rkt

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,17 +1,30 @@
11
(define (world) : Any (inject 42 Integer))
22

3+
; Allocate a vector of 1 any, initialized with an injected 0, and then inject it
4+
; Project the vector and write the result of the function (world), which returns an injected 42, into the 0th element
5+
; Bind a variable to the projected vector
6+
; Read out the 0th element and project it to integer.
7+
38
(let ((x (inject (vector (inject 0 Integer)) (Vector Any))))
49
(let ([y (vector-set! (project x (Vector Any)) 0 (world))])
510
(let ((a (project x (Vector Any))))
611
(project (vector-ref a 0) Integer))))
712

813
;; ;; Works
14+
15+
; Allocate a vector of 1 any, initialized with an injected 0, and then inject it
16+
; Project the vector and write the result of the function (world), which returns an injected 42, into the 0th element
17+
; Bind a variable to the projected vector
18+
; Read out the 0th element and project it to integer.
19+
20+
921
;; (define (world) : Any (inject 42 Integer))
1022
;; (let ((x (inject (vector (inject 0 Integer)) (Vector Any))))
1123
;; (let ((a (project x (Vector Any))))
1224
;; (let ([y (vector-set! a 0 (world))])
1325
;; (project (vector-ref a 0) Integer))))
1426

27+
1528
;; ;; Works
1629
;; (define (world) : Any (inject 42 Integer))
1730
;; (let ((x (vector (inject 0 Integer))))

‎tests/s7_3.rkt

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
(let ([x (vector 1 2 3 42)])
2-
(let ([y (vector-set! x 0 42)])
3-
(let ([z (vector-set! x 1 42)])
2+
(let ([y (vector-set! x 1 42)])
3+
(let ([z (vector-set! x 0 42)])
44
((lambda (vec) (vector-ref vec 3)) x))))
55

0 commit comments

Comments
 (0)