Add uniquify implementation

This commit is contained in:
Enrico Lumetti 2021-04-26 19:04:50 +02:00
parent e6c4b50adf
commit 95cec82371
3 changed files with 120 additions and 0 deletions

3
.editorconfig Normal file
View File

@ -0,0 +1,3 @@
[*.scm]
indent_style = space
indent_size = 2

64
test-uniquify.scm Normal file
View File

@ -0,0 +1,64 @@
#lang racket
(require "test-util.scm")
(require "uniquify.scm")
(require "c2.scm")
(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))))
(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)))))
(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
`(program ()
(let ([x 32])
(+ (+ (let ([x 10]) x) (let ([x 3]) x)) x))))
(define env1 '())
(define p2
`(program ()
(let ([x (let ([y 9])
y)])
(+ x y))))
(define env2 '((y 5)))
(for/list ([program (list p1 p2)] [env (list env1 env2)])
(test-eq ((interp-R1 env) program)
((interp-R1 env) (cadr (uniquify program)))))

53
uniquify.scm Normal file
View File

@ -0,0 +1,53 @@
#lang racket
(provide uniquify uniquify-exp)
(define (uniquify p)
(match p
[`(program ,data ,exp)
(let ([res ((uniquify-exp (make-immutable-hash) (make-immutable-hash)) exp)])
`(,(car res)
(program ,data
,(cadr res))))]))
(define (add-unique-assoc symtable varname)
(hash-update symtable varname
(lambda (ref) (+ ref 1))
0))
(define (get-unique-assoc symtable varname)
(if (hash-has-key? symtable varname)
(string->symbol (format "~a.~a" varname (hash-ref symtable varname)))
varname))
(define (uniquify-exp symtable ctxtable)
(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 ...)
(begin
(define-values (new-symtable res)
(for/fold ([cur-symtable symtable]
[res (list '+)])
([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))])))