Add uniquify implementation
This commit is contained in:
parent
e6c4b50adf
commit
95cec82371
|
|
@ -0,0 +1,3 @@
|
|||
[*.scm]
|
||||
indent_style = space
|
||||
indent_size = 2
|
||||
|
|
@ -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)))))
|
||||
|
||||
|
|
@ -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))])))
|
||||
Loading…
Reference in New Issue