From 04c8ab029764418ec687e9e7fd43eaa371cb088c Mon Sep 17 00:00:00 2001 From: Enrico Lumetti Date: Sun, 14 Nov 2021 12:20:08 +0100 Subject: [PATCH] Port uniquify to new structures --- rvar.rkt | 11 ++-- test-uniquify.rkt | 125 ++++++++++++++++++++++++---------------------- uniquify.rkt | 73 ++++++++++++++------------- 3 files changed, 111 insertions(+), 98 deletions(-) diff --git a/rvar.rkt b/rvar.rkt index 5009dc0..20581e1 100644 --- a/rvar.rkt +++ b/rvar.rkt @@ -2,15 +2,16 @@ (require racket/fixnum) (require racket/dict) +(require racket/struct) (provide Int Prim Var Let Program interp-RVar-class interp-RVar) -(struct Int (value)) -(struct Var (var)) -(struct Prim (op args)) -(struct Let (var expr body)) +(struct Int (value) #:transparent) +(struct Var (var) #:transparent) +(struct Prim (op args) #:transparent) +(struct Let (var expr body) #:transparent) -(struct Program (info body)) +(struct Program (info body) #:transparent) (define interp-RVar-class (class object% diff --git a/test-uniquify.rkt b/test-uniquify.rkt index 2680978..53cefb9 100644 --- a/test-uniquify.rkt +++ b/test-uniquify.rkt @@ -1,72 +1,79 @@ #lang racket +(require rackunit) + (require "test-util.rkt") +(require "rvar.rkt") (require "uniquify.rkt") -(require "c2.rkt") +(require/expose "uniquify.rkt" (uniquify-exp)) -(test-eq ((uniquify-exp (make-immutable-hash) (make-immutable-hash)) `(read)) - `(#hash() (read))) -(let ([tbl (hash-set (make-immutable-hash) `x 1)]) - (test-eq ((uniquify-exp tbl tbl) `x) - `(#hash((x . 1)) x.1))) -(let ([tbl (hash-set (make-immutable-hash) `x 1)]) - (test-eq ((uniquify-exp tbl tbl) `(let ([x 2]) 3)) - `(#hash((x . 2)) (let ([x.2 2]) 3)))) -(test-eq ((uniquify-exp (make-immutable-hash) (make-immutable-hash)) `(let ([x 2]) (+ x 3))) - `(#hash((x . 1)) (let ([x.1 2]) (+ x.1 3)))) +(define (list-uniquify-exp symtable) + (lambda (exp) + (call-with-values (lambda () ((uniquify-exp symtable symtable) exp)) list))) + +(test-eq ((list-uniquify-exp (make-immutable-hash)) (Prim 'read (list))) + (list #hash() (Prim 'read '()))) + +(let ([tbl (hash-set (make-immutable-hash) 'x 1)]) + (test-eq ((list-uniquify-exp tbl) (Var 'x)) + (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 - `(program () - (let ([x 32]) - (+ (let ([x 10]) x) x)))) - `(#hash((x . 2)) - (program () - (let ([x.1 32]) - (+ (let ([x.2 10]) x.2) x.1))))) - + (Program '() + (Let 'x (Int 32) + (Prim '+ (list (Let 'x (Int 10) (Var 'x)) + (Let 'x (Int 3) (Var 'x)) + (Var 'x)))))) + (Program '() + (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 - `(program () - (let ([x 32]) - (- x)))) - `(#hash((x . 1)) - (program () - (let ([x.1 32]) - (- x.1))))) - - -(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))))) + (Program '() + (Let 'x (Let 'x (Int 4) + (Prim '+ (list (Var 'x) (Int 1)))) + (Prim '+ (list (Var 'x) (Int 2)))))) + (Program '() + (Let 'x.1 (Let 'x.2 (Int 4) + (Prim '+ (list (Var 'x.2) (Int 1)))) + (Prim '+ (list (Var 'x.1) (Int 2)))))) (define p1 - `(program () - (let ([x 32]) - (+ (+ (let ([x 10]) x) (let ([x 3]) x)) x)))) -(define env1 '()) - + (Program '() + (Let 'x (Int 32) + (Prim '+ (list (Prim '+ (list (Let 'x (Int 10) (Var 'x)) + (Let 'x (Int 3) (Var 'x)))) + (Var 'x)))))) (define p2 - `(program () - (let ([x (let ([y 9]) - y)]) - (+ x y)))) -(define env2 '((y 5))) + (Program '() + (Let 'x (Let 'y (Int 9) + (Var 'y)) + (Prim '+ (list (Var 'x) (Int 5)))))) -(for ([program (list p1 p2)] [env (list env1 env2)]) - (test-eq ((interp-R1 env) program) - ((interp-R1 env) (cadr (uniquify program))))) +(for ([program (list p1 p2)]) + (test-eq (interp-RVar program) + (interp-RVar (uniquify program)))) diff --git a/uniquify.rkt b/uniquify.rkt index f40534f..cdd7f91 100644 --- a/uniquify.rkt +++ b/uniquify.rkt @@ -1,14 +1,21 @@ #lang racket -(provide uniquify uniquify-exp) +(provide uniquify) + +(require "rvar.rkt") (define (uniquify p) + (let-values ([(_ res) (uniquify-ret-symtable p)]) + res)) + +(define (uniquify-ret-symtable p) (match p - [`(program ,data ,exp) - (let ([res ((uniquify-exp (make-immutable-hash) (make-immutable-hash)) exp)]) - `(,(car res) - (program ,data - ,(cadr res))))])) + [(Program info body) + (let-values ([(symtable res) ((uniquify-exp (make-immutable-hash) + (make-immutable-hash)) body)]) + (values symtable + (Program info + res)))])) (define (add-unique-assoc symtable varname) (hash-update symtable varname @@ -20,34 +27,32 @@ (string->symbol (format "~a.~a" varname (hash-ref symtable 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) (match sexp - [(? fixnum?) (list symtable sexp)] - [`(read) (list symtable sexp)] - [(? symbol?) (list symtable (get-unique-assoc ctxtable sexp))] - - [`(let ([,var ,rexp]) ,body) - (begin - (define cur-symtable (add-unique-assoc symtable var)) - (define new-ctxtable (hash-set ctxtable var (hash-ref cur-symtable var))) - (define uniquify-exp-result ((uniquify-exp cur-symtable ctxtable) rexp)) - (define exp-symtable (car uniquify-exp-result)) - (define uniquify-body-result ((uniquify-exp exp-symtable new-ctxtable) body)) - (match uniquify-body-result - [(list new-symtable bodyexp) - (list new-symtable - `(let ([,(get-unique-assoc new-ctxtable var) ,(cadr uniquify-exp-result)]) - ,bodyexp))]))] - - - ; handle (+ e...) and (- e...) - [`(,op ,es ...) + [(Int n) (values symtable (Int n))] + [(Var name) (values symtable (Var (get-unique-assoc evaltable name)))] + [(Let var rexp body) (begin - (define-values (new-symtable res) - (for/fold ([cur-symtable symtable] - [res (list op)]) - ([exp es]) - (let ([uniquify-result ((uniquify-exp cur-symtable ctxtable) exp)]) - (values (car uniquify-result) (append res (list (cadr uniquify-result))))))) - (list new-symtable res))]))) + (define outer-symtable (add-unique-assoc symtable var)) + ; create a new evaltable synced with the outer-symtable + (define outer-evaltable (hash-set evaltable var (hash-ref outer-symtable var))) + (define-values (inner-symtable uniquified-assignment-exp) ((uniquify-exp outer-symtable evaltable) rexp)) + (define-values (res-symtable uniquified-body-exp) ((uniquify-exp inner-symtable outer-evaltable) body)) + (values res-symtable (Let (get-unique-assoc outer-symtable var) + uniquified-assignment-exp + uniquified-body-exp)))] + + [(Prim op args) + (let-values ([(res-symtable res-args) + (for/fold ([cur-symtable symtable] + [cur-args '()]) + ([arg args]) + (let-values ([(new-symtable uniq-exp) + ((uniquify-exp cur-symtable evaltable) arg)]) + (values new-symtable (append cur-args (list uniq-exp)))))]) + (values res-symtable (Prim op res-args)))]))) +