Port uniquify to new structures
This commit is contained in:
parent
7b8ea0b6f4
commit
04c8ab0297
11
rvar.rkt
11
rvar.rkt
|
|
@ -2,15 +2,16 @@
|
||||||
|
|
||||||
(require racket/fixnum)
|
(require racket/fixnum)
|
||||||
(require racket/dict)
|
(require racket/dict)
|
||||||
|
(require racket/struct)
|
||||||
|
|
||||||
(provide Int Prim Var Let Program interp-RVar-class interp-RVar)
|
(provide Int Prim Var Let Program interp-RVar-class interp-RVar)
|
||||||
|
|
||||||
(struct Int (value))
|
(struct Int (value) #:transparent)
|
||||||
(struct Var (var))
|
(struct Var (var) #:transparent)
|
||||||
(struct Prim (op args))
|
(struct Prim (op args) #:transparent)
|
||||||
(struct Let (var expr body))
|
(struct Let (var expr body) #:transparent)
|
||||||
|
|
||||||
(struct Program (info body))
|
(struct Program (info body) #:transparent)
|
||||||
|
|
||||||
(define interp-RVar-class
|
(define interp-RVar-class
|
||||||
(class object%
|
(class object%
|
||||||
|
|
|
||||||
|
|
@ -1,72 +1,79 @@
|
||||||
#lang racket
|
#lang racket
|
||||||
|
|
||||||
|
(require rackunit)
|
||||||
|
|
||||||
(require "test-util.rkt")
|
(require "test-util.rkt")
|
||||||
|
(require "rvar.rkt")
|
||||||
(require "uniquify.rkt")
|
(require "uniquify.rkt")
|
||||||
(require "c2.rkt")
|
(require/expose "uniquify.rkt" (uniquify-exp))
|
||||||
|
|
||||||
(test-eq ((uniquify-exp (make-immutable-hash) (make-immutable-hash)) `(read))
|
(define (list-uniquify-exp symtable)
|
||||||
`(#hash() (read)))
|
(lambda (exp)
|
||||||
(let ([tbl (hash-set (make-immutable-hash) `x 1)])
|
(call-with-values (lambda () ((uniquify-exp symtable symtable) exp)) list)))
|
||||||
(test-eq ((uniquify-exp tbl tbl) `x)
|
|
||||||
`(#hash((x . 1)) x.1)))
|
(test-eq ((list-uniquify-exp (make-immutable-hash)) (Prim 'read (list)))
|
||||||
(let ([tbl (hash-set (make-immutable-hash) `x 1)])
|
(list #hash() (Prim 'read '())))
|
||||||
(test-eq ((uniquify-exp tbl tbl) `(let ([x 2]) 3))
|
|
||||||
`(#hash((x . 2)) (let ([x.2 2]) 3))))
|
(let ([tbl (hash-set (make-immutable-hash) 'x 1)])
|
||||||
(test-eq ((uniquify-exp (make-immutable-hash) (make-immutable-hash)) `(let ([x 2]) (+ x 3)))
|
(test-eq ((list-uniquify-exp tbl) (Var 'x))
|
||||||
`(#hash((x . 1)) (let ([x.1 2]) (+ x.1 3))))
|
(list #hash((x . 1)) (Var 'x.1))))
|
||||||
|
|
||||||
|
(test-eq ((list-uniquify-exp (make-immutable-hash)) (Let 'x (Int 2) (Int 3)))
|
||||||
|
(list #hash((x . 1)) (Let 'x.1 (Int 2) (Int 3))))
|
||||||
|
|
||||||
|
(test-eq ((list-uniquify-exp (make-immutable-hash)) (Let 'x (Int 2) (Prim '+ (list (Var 'x) (Int 3)))))
|
||||||
|
(list #hash((x . 1)) (Let 'x.1 (Int 2) (Prim '+ (list (Var 'x.1) (Int 3))))))
|
||||||
|
|
||||||
|
(test-eq (uniquify
|
||||||
|
(Program '()
|
||||||
|
(Let 'x (Int 32)
|
||||||
|
(Prim '+ (list (Let 'x (Int 10) (Var 'x)) (Var 'x))))))
|
||||||
|
(Program '()
|
||||||
|
(Let 'x.1 (Int 32)
|
||||||
|
(Prim '+ (list (Let 'x.2 (Int 10) (Var 'x.2)) (Var 'x.1))))))
|
||||||
|
|
||||||
|
(test-eq (uniquify
|
||||||
|
(Program '()
|
||||||
|
(Let 'x (Int 32)
|
||||||
|
(Prim '- (list (Var 'x))))))
|
||||||
|
(Program '()
|
||||||
|
(Let 'x.1 (Int 32)
|
||||||
|
(Prim '- (list (Var 'x.1))))))
|
||||||
|
|
||||||
|
|
||||||
(test-eq (uniquify
|
(test-eq (uniquify
|
||||||
`(program ()
|
(Program '()
|
||||||
(let ([x 32])
|
(Let 'x (Int 32)
|
||||||
(+ (let ([x 10]) x) x))))
|
(Prim '+ (list (Let 'x (Int 10) (Var 'x))
|
||||||
`(#hash((x . 2))
|
(Let 'x (Int 3) (Var 'x))
|
||||||
(program ()
|
(Var 'x))))))
|
||||||
(let ([x.1 32])
|
(Program '()
|
||||||
(+ (let ([x.2 10]) x.2) x.1)))))
|
(Let 'x.1 (Int 32)
|
||||||
|
(Prim '+ (list (Let 'x.2 (Int 10) (Var 'x.2))
|
||||||
|
(Let 'x.3 (Int 3) (Var 'x.3))
|
||||||
|
(Var 'x.1))))))
|
||||||
(test-eq (uniquify
|
(test-eq (uniquify
|
||||||
`(program ()
|
(Program '()
|
||||||
(let ([x 32])
|
(Let 'x (Let 'x (Int 4)
|
||||||
(- x))))
|
(Prim '+ (list (Var 'x) (Int 1))))
|
||||||
`(#hash((x . 1))
|
(Prim '+ (list (Var 'x) (Int 2))))))
|
||||||
(program ()
|
(Program '()
|
||||||
(let ([x.1 32])
|
(Let 'x.1 (Let 'x.2 (Int 4)
|
||||||
(- x.1)))))
|
(Prim '+ (list (Var 'x.2) (Int 1))))
|
||||||
|
(Prim '+ (list (Var 'x.1) (Int 2))))))
|
||||||
|
|
||||||
(test-eq (uniquify
|
|
||||||
`(program ()
|
|
||||||
(let ([x 32])
|
|
||||||
(+ (let ([x 10]) x) (let ([x 3]) x) x))))
|
|
||||||
`(#hash((x . 3))
|
|
||||||
(program ()
|
|
||||||
(let ([x.1 32])
|
|
||||||
(+ (let ([x.2 10]) x.2) (let ([x.3 3]) x.3) x.1)))))
|
|
||||||
(test-eq (uniquify
|
|
||||||
`(program ()
|
|
||||||
(let ([x (let ([x 4])
|
|
||||||
(+ x 1))])
|
|
||||||
(+ x 2))))
|
|
||||||
`(#hash((x . 2))
|
|
||||||
(program ()
|
|
||||||
(let ([x.1 (let ([x.2 4])
|
|
||||||
(+ x.2 1))])
|
|
||||||
(+ x.1 2)))))
|
|
||||||
|
|
||||||
(define p1
|
(define p1
|
||||||
`(program ()
|
(Program '()
|
||||||
(let ([x 32])
|
(Let 'x (Int 32)
|
||||||
(+ (+ (let ([x 10]) x) (let ([x 3]) x)) x))))
|
(Prim '+ (list (Prim '+ (list (Let 'x (Int 10) (Var 'x))
|
||||||
(define env1 '())
|
(Let 'x (Int 3) (Var 'x))))
|
||||||
|
(Var 'x))))))
|
||||||
(define p2
|
(define p2
|
||||||
`(program ()
|
(Program '()
|
||||||
(let ([x (let ([y 9])
|
(Let 'x (Let 'y (Int 9)
|
||||||
y)])
|
(Var 'y))
|
||||||
(+ x y))))
|
(Prim '+ (list (Var 'x) (Int 5))))))
|
||||||
(define env2 '((y 5)))
|
|
||||||
|
|
||||||
(for ([program (list p1 p2)] [env (list env1 env2)])
|
(for ([program (list p1 p2)])
|
||||||
(test-eq ((interp-R1 env) program)
|
(test-eq (interp-RVar program)
|
||||||
((interp-R1 env) (cadr (uniquify program)))))
|
(interp-RVar (uniquify program))))
|
||||||
|
|
|
||||||
69
uniquify.rkt
69
uniquify.rkt
|
|
@ -1,14 +1,21 @@
|
||||||
#lang racket
|
#lang racket
|
||||||
|
|
||||||
(provide uniquify uniquify-exp)
|
(provide uniquify)
|
||||||
|
|
||||||
|
(require "rvar.rkt")
|
||||||
|
|
||||||
(define (uniquify p)
|
(define (uniquify p)
|
||||||
|
(let-values ([(_ res) (uniquify-ret-symtable p)])
|
||||||
|
res))
|
||||||
|
|
||||||
|
(define (uniquify-ret-symtable p)
|
||||||
(match p
|
(match p
|
||||||
[`(program ,data ,exp)
|
[(Program info body)
|
||||||
(let ([res ((uniquify-exp (make-immutable-hash) (make-immutable-hash)) exp)])
|
(let-values ([(symtable res) ((uniquify-exp (make-immutable-hash)
|
||||||
`(,(car res)
|
(make-immutable-hash)) body)])
|
||||||
(program ,data
|
(values symtable
|
||||||
,(cadr res))))]))
|
(Program info
|
||||||
|
res)))]))
|
||||||
|
|
||||||
(define (add-unique-assoc symtable varname)
|
(define (add-unique-assoc symtable varname)
|
||||||
(hash-update symtable varname
|
(hash-update symtable varname
|
||||||
|
|
@ -20,34 +27,32 @@
|
||||||
(string->symbol (format "~a.~a" varname (hash-ref symtable varname)))
|
(string->symbol (format "~a.~a" varname (hash-ref symtable varname)))
|
||||||
varname))
|
varname))
|
||||||
|
|
||||||
(define (uniquify-exp symtable ctxtable)
|
; symtable is a global table that keeps track of all the variables and what unique
|
||||||
|
; counter they have reached
|
||||||
|
; evaltable is the table used for the evaluation context
|
||||||
|
(define (uniquify-exp symtable evaltable)
|
||||||
(lambda (sexp)
|
(lambda (sexp)
|
||||||
(match sexp
|
(match sexp
|
||||||
[(? fixnum?) (list symtable sexp)]
|
[(Int n) (values symtable (Int n))]
|
||||||
[`(read) (list symtable sexp)]
|
[(Var name) (values symtable (Var (get-unique-assoc evaltable name)))]
|
||||||
[(? symbol?) (list symtable (get-unique-assoc ctxtable sexp))]
|
[(Let var rexp body)
|
||||||
|
|
||||||
[`(let ([,var ,rexp]) ,body)
|
|
||||||
(begin
|
(begin
|
||||||
(define cur-symtable (add-unique-assoc symtable var))
|
(define outer-symtable (add-unique-assoc symtable var))
|
||||||
(define new-ctxtable (hash-set ctxtable var (hash-ref cur-symtable var)))
|
; create a new evaltable synced with the outer-symtable
|
||||||
(define uniquify-exp-result ((uniquify-exp cur-symtable ctxtable) rexp))
|
(define outer-evaltable (hash-set evaltable var (hash-ref outer-symtable var)))
|
||||||
(define exp-symtable (car uniquify-exp-result))
|
(define-values (inner-symtable uniquified-assignment-exp) ((uniquify-exp outer-symtable evaltable) rexp))
|
||||||
(define uniquify-body-result ((uniquify-exp exp-symtable new-ctxtable) body))
|
(define-values (res-symtable uniquified-body-exp) ((uniquify-exp inner-symtable outer-evaltable) body))
|
||||||
(match uniquify-body-result
|
(values res-symtable (Let (get-unique-assoc outer-symtable var)
|
||||||
[(list new-symtable bodyexp)
|
uniquified-assignment-exp
|
||||||
(list new-symtable
|
uniquified-body-exp)))]
|
||||||
`(let ([,(get-unique-assoc new-ctxtable var) ,(cadr uniquify-exp-result)])
|
|
||||||
,bodyexp))]))]
|
|
||||||
|
|
||||||
|
[(Prim op args)
|
||||||
; handle (+ e...) and (- e...)
|
(let-values ([(res-symtable res-args)
|
||||||
[`(,op ,es ...)
|
|
||||||
(begin
|
|
||||||
(define-values (new-symtable res)
|
|
||||||
(for/fold ([cur-symtable symtable]
|
(for/fold ([cur-symtable symtable]
|
||||||
[res (list op)])
|
[cur-args '()])
|
||||||
([exp es])
|
([arg args])
|
||||||
(let ([uniquify-result ((uniquify-exp cur-symtable ctxtable) exp)])
|
(let-values ([(new-symtable uniq-exp)
|
||||||
(values (car uniquify-result) (append res (list (cadr uniquify-result)))))))
|
((uniquify-exp cur-symtable evaltable) arg)])
|
||||||
(list new-symtable res))])))
|
(values new-symtable (append cur-args (list uniq-exp)))))])
|
||||||
|
(values res-symtable (Prim op res-args)))])))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue