Port uniquify to new structures

This commit is contained in:
Enrico Lumetti 2021-11-14 12:20:08 +01:00
parent 7b8ea0b6f4
commit 04c8ab0297
3 changed files with 111 additions and 98 deletions

View File

@ -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%

View File

@ -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))))

View File

@ -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)))])))