From 95cec82371b4a4fb9504ee44f027611d7cc51d52 Mon Sep 17 00:00:00 2001
From: Enrico Lumetti <enrico.lumetti@gmail.com>
Date: Mon, 26 Apr 2021 19:04:50 +0200
Subject: [PATCH] Add uniquify implementation

---
 .editorconfig     |  3 +++
 test-uniquify.scm | 64 +++++++++++++++++++++++++++++++++++++++++++++++
 uniquify.scm      | 53 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 120 insertions(+)
 create mode 100644 .editorconfig
 create mode 100644 test-uniquify.scm
 create mode 100644 uniquify.scm

diff --git a/.editorconfig b/.editorconfig
new file mode 100644
index 0000000..ec63ed3
--- /dev/null
+++ b/.editorconfig
@@ -0,0 +1,3 @@
+[*.scm]
+indent_style = space
+indent_size = 2
diff --git a/test-uniquify.scm b/test-uniquify.scm
new file mode 100644
index 0000000..abb327f
--- /dev/null
+++ b/test-uniquify.scm
@@ -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)))))
+     
diff --git a/uniquify.scm b/uniquify.scm
new file mode 100644
index 0000000..00fde74
--- /dev/null
+++ b/uniquify.scm
@@ -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))])))