.editorconfig

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

c2.scm

@@ -2,7 +2,6 @@
 
 (require racket/fixnum)
 
-(provide interp-R1 interp-exp env-head-value env-head-symbol eval-symbol add-binding)
 
 (define (interp-R1 env)
   (lambda (p)
@@ -41,3 +40,24 @@
     [(equal? env `())                 (error "Symbol " s " not found")]
     [(equal? (env-head-symbol env) s) (env-head-value env)]
     [else                             (eval-symbol (cdr env) s)]))
+  
+
+(define (test-eq a b)
+   (if (equal? a b) #t (error "assert failed: " a " != " b)))
+
+(define (ppexp exp) (begin (print (exp)) (newline)))
+
+(test-eq (env-head-value `((a 1))) 1)
+(test-eq (env-head-symbol `((a 1))) `a)
+(test-eq (eval-symbol `((a 1)) `a) 1)
+(test-eq
+  (let ([env `((a 1) (b 2))])
+    ((interp-exp env) `(+ a (- b))))
+  -1)
+(test-eq
+  ((interp-exp `()) `(let ([a (+ 1 2)]) (+ a 3)))
+  6)
+
+(test-eq
+  ((interp-R1 `()) `(program `() (let ([a (+ 1 2)]) (+ a 3))))
+  6)

remove-complex-oper.scm

@@ -1,92 +0,0 @@
-#lang racket
-
-(require "uniquify.scm")
-
-(provide remove-complex-opera*)
-
-(define (remove-complex-opera* p)
-  (let ([uniq-res (uniquify p)])
-       (match (cadr uniq-res)
-         [`(program ,data ,exp) 
-          (begin
-            (define initial-tmpcount (hash-ref (car uniq-res) `tmp 0))
-            (define-values (new-exp bla) (rco-exp exp initial-tmpcount))
-            `(program ,data ,new-exp))])))
-
-(define (let-binding var val exp)
-  `(let ([,var ,val]) ,exp))
-
-(define (wrap-associations assoc-list exp)
-  (if (empty? assoc-list)
-    exp
-    (let ([binding (car assoc-list)])
-      (let-binding (car binding) (cadr binding)
-                   (wrap-associations (cdr assoc-list) exp)))))
-  
-(define (rco-exp exp tmpcount)
-  (match exp
-    [(? fixnum?) (values exp tmpcount)]
-    [(? symbol?) (values exp tmpcount)]
-    [`(read) (values exp tmpcount)]
-    [`(- ,e) 
-     (begin
-      (define-values (new-exp assoc-list new-tmpcount) (rco-arg e tmpcount))
-      (values (wrap-associations assoc-list `(- ,new-exp)) new-tmpcount))]
-    [`(,op ,e1 ,e2)
-     #:when (or (eq? op `+) (eq? op `-))
-     (begin
-      (define-values (new-exp1 assoc-list1 new-tmpcount1) (rco-arg e1 tmpcount))
-      (define-values (new-exp2 assoc-list2 new-tmpcount) (rco-arg e2 new-tmpcount1))
-      (values (wrap-associations (append assoc-list1 assoc-list2)
-                                 `(,op ,new-exp1 ,new-exp2)) new-tmpcount))]
-    [`(let ([,var ,e]) ,body)
-      (define-values (new-exp assoc-list exp-tmpcount) (rco-arg e tmpcount))
-      (define-values (new-body new-tmpcount) (rco-exp body exp-tmpcount))
-      (values (wrap-associations assoc-list
-                                 `(let ([,var ,new-exp]) ,new-body)) new-tmpcount)]))
-
-(define (get-unique-symbol tmpcount)
-  (string->symbol (format "tmp.~a" tmpcount)))
-
-(define (let-unique-exp tmpcount value)
-  (let-binding (get-unique-symbol tmpcount)
-               exp
-               (get-unique-symbol tmpcount)))
-
-(define (rco-arg exp tmpcount)
-  (match exp
-   [(? fixnum?) (values exp '() tmpcount)]
-   [(? symbol?) (values exp '() tmpcount)]
-   [`(read) (values exp '() tmpcount)]
-   [`(- ,e)
-    (begin
-     (define-values (new-exp exp-tmpcount) (rco-exp e tmpcount))
-     (define new-tmpcount (+ exp-tmpcount 1))
-     (define tmpname (get-unique-symbol new-tmpcount))
-     (values tmpname
-             `((,tmpname (- ,new-exp)))
-             new-tmpcount))]
-   [`(,op ,e1 ,e2)
-    #:when (or (eq? op `+) (eq? op `-))
-    (begin
-     (define-values (new-exp1 exp1-tmpcount) (rco-exp e1 tmpcount))
-     (define-values (new-exp2 exp2-tmpcount) (rco-exp e2 exp1-tmpcount))
-     (define new-tmpcount (+ exp2-tmpcount 1))
-     (define tmpname (get-unique-symbol new-tmpcount))
-     (values tmpname
-             `((,tmpname (,op ,new-exp1 ,new-exp2)))
-             new-tmpcount))]
-   [`(let ([,var ,rexp]) ,body)
-    (begin
-     (define-values (new-exp exp-tmpcount) (rco-exp rexp tmpcount))
-     (define-values (new-body body-tmpcount) (rco-exp body exp-tmpcount))
-     (define new-tmpcount (+ body-tmpcount 1))
-     (define tmpname (get-unique-symbol new-tmpcount))
-     (values tmpname
-             `((,tmpname (let ([,var ,new-exp]) ,new-body)))
-             new-tmpcount))]))
-     
-
-;(require racket/trace)
-;(trace rco-exp)
-;(trace rco-arg)

test-c2.scm

@@ -1,19 +0,0 @@
-#lang racket
-
-(require "test-util.scm")
-(require "c2.scm")
-
-(test-eq (env-head-value `((a 1))) 1)
-(test-eq (env-head-symbol `((a 1))) `a)
-(test-eq (eval-symbol `((a 1)) `a) 1)
-(test-eq
-  (let ([env `((a 1) (b 2))])
-    ((interp-exp env) `(+ a (- b))))
-  -1)
-(test-eq
-  ((interp-exp `()) `(let ([a (+ 1 2)]) (+ a 3)))
-  6)
-
-(test-eq
-  ((interp-R1 `()) `(program `() (let ([a (+ 1 2)]) (+ a 3))))
-  6)

test-remove-complex-opera.scm

@@ -1,62 +0,0 @@
-#lang racket
-
-(require "test-util.scm")
-(require "remove-complex-oper.scm")
-(require "c2.scm")
-
-(define programs 
-  (list
-   `(program ()
-             (- 20))
-   `(program () (+ 3 (- 20)))
-   `(program () (+ (+ 3 2) (+ 4 5)))
-   `(program () (let ([x (+ (- 2) 3)]) (+ x (+ 2 3))))
-   `(program () (+ (let ([x (+ (- 1) 2)]) (+ x 2)) (+ 4 5)))
-   `(program ()
-      (let ([a 42])
-        (let ([b a])
-          b)))
-   `(program () (let ([tmp (- 1)]) tmp))))
-
-(test-eq
-  (remove-complex-opera* (list-ref programs 0))
-  `(program () (- 20)))
-
-(test-eq
-  (remove-complex-opera* (list-ref programs 1))
-  `(program () (let ((tmp.1 (- 20))) (+ 3 tmp.1))))
-
-(test-eq
-  (remove-complex-opera* (list-ref programs 2))
-  `(program () (let ((tmp.1 (+ 3 2))) (let ((tmp.2 (+ 4 5))) (+ tmp.1 tmp.2)))))
-
-(test-eq
-  (remove-complex-opera* (list-ref programs 3))
-  `(program () 
-            (let ((tmp.1 (+ (- 2) 3))) 
-              (let ((x.1 tmp.1)) 
-                (let ((tmp.2 (+ 2 3))) 
-                  (+ x.1 tmp.2))))))
-
-(test-eq
-  (remove-complex-opera* (list-ref programs 4))
-  `(program ()
-            (let ((tmp.2
-                   (let ((x.1
-                          (let ((tmp.1 (- 1))) 
-                            (+ tmp.1 2)))) 
-                     (+ x.1 2)))) 
-              (let ((tmp.3 (+ 4 5))) 
-                (+ tmp.2 tmp.3)))))
-
-(test-eq
-  (remove-complex-opera* (list-ref programs 5))
- `(program () (let([a.1 42]) (let ([b.1 a.1]) b.1))))
- 
-(test-eq
-  (remove-complex-opera* (list-ref programs 6))
- `(program () (let ((tmp.2 (- 1))) (let ((tmp.1 tmp.2)) tmp.1))))
-
-(for/list ([program programs] [env (build-list (length programs) (lambda (_) '()))])
-     (test-eq ((interp-R1 env) program)
-              ((interp-R1 env) (remove-complex-opera* program))))

test-uniquify.scm

@@ -1,73 +0,0 @@
-#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])
-                (- 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)))))
-
-(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)))))
-     

test-util.scm

@@ -1,8 +0,0 @@
-#lang racket
-
-(provide test-eq ppexp)
-
-(define (test-eq a b)
-   (if (equal? a b) #t (error "assert failed: " a " != " b)))
-
-(define (ppexp exp) (begin (print exp) (newline)))

uniquify.scm

@@ -1,53 +0,0 @@
-#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))])))