54 lines
1.9 KiB
Racket
54 lines
1.9 KiB
Racket
#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 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))])))
|