some progress and test cases

Author: mvitousek

dynamic-typing.rkt

@@ -286,10 +286,10 @@
                                    ,((cast-insert) e2))))]
           [`(not ,e) `(inject (not (project ,((cast-insert) e) Boolean)) Boolean)]
           [`(eq? ,e1 ,e2) `(inject (eq? ,((cast-insert) e1),((cast-insert) e2)) Boolean)]
-          [`(if ,eq ,et ,ef) `(if (eq? ,((cast-insert) eq) (inject #t Boolean)) ,((cast-insert) et) ,((cast-insert) ef))]
+          [`(if ,eq ,et ,ef) `(if (eq? ,((cast-insert) eq) (inject #f Boolean)) ,((cast-insert) ef) ,((cast-insert) et))]
           [`(vector ,es ...) `(inject (vector ,@(map (cast-insert) es)) (Vector ,@(map (lambda (x) 'Any) es)))]
           [`(vector-ref ,e1 ,n) `(vector-ref (project ,((cast-insert) e1) (Vectorof Any)) ,n)]
-          [`(vector-set! ,e1 ,n ,e2) `(vector-set! (project ,((cast-insert) e1) (Vectorof Any)) ,n ,((cast-insert) e2))]
+          [`(vector-set! ,e1 ,n ,e2) `(inject (vector-set! (project ,((cast-insert) e1) (Vectorof Any)) ,n ,((cast-insert) e2)) Void)]
           [`(void) `(inject (void) Void)] ; ???
           [`(lambda (,xs ...) ,e) `(inject (lambda: (,@(map (lambda (x) `[,x : Any]) xs)) : Any ,((cast-insert) e)) (,@(map (lambda (x) 'Any) xs) -> Any))]
           [`(app ,e ,es ...) `(app (project ,((cast-insert) e) (,@(map (lambda (x) 'Any) es) -> Any)) ,@(map (cast-insert) es))]

interp.rkt

@@ -366,6 +366,7 @@
         ['Boolean (if val #t #f)]
         ['Integer val]
         ['Void (void)]
+        ['Any `(inject ,(arithmetic-shift val -2) Integer)]
         [else (error (format "don't know how to display type ~a" ty))]))
 
     ));; class interp-R1

run-tests.rkt

@@ -41,7 +41,7 @@
     (2 . ,(range 1 19))
     (3 . ,(range 1 20))
     (4 . ,(range 0 8))
-    (6 . ,(range 0 8))
+    (6 . ,(range 0 10))
     (7 . ,(range 0 8))
     ))
 

tests/s6_10.rkt

@@ -0,0 +1,38 @@
+(define (hello29999) : Any (inject 24 Integer))
+(define (world30000) : Any (inject 24 Integer))
+
+(let ((x30001
+         (inject
+          (vector (inject 0 Integer) (inject 0 Integer))
+          (Vector Any Any))))
+    (let ((y30002
+           (inject
+            (vector-set!
+             (project x30001 (Vector Any Any))
+             0
+             (
+              (project (inject hello29999 (-> Any)) (-> Any))))
+            Void)))
+      (let ((z30003
+             (inject
+              (vector-set!
+               (project x30001 (Vector Any Any))
+               1
+               (
+                (project
+                 (inject world30000 (-> Any))
+                 (-> Any))))
+              Void)))
+        (inject
+         (+
+          (project
+           (inject (- (project (inject 6 Integer) Integer)) Integer)
+           Integer)
+          (project
+           (inject
+            (+
+             (project (vector-ref (project x30001 (Vector Any Any)) 0) Integer)
+             (project (vector-ref (project x30001 (Vector Any Any)) 1) Integer))
+            Integer)
+           Integer))
+         Integer))))

tests/s6_8.rkt

@@ -0,0 +1,28 @@
+(define (hello29999) : Any (inject 24 Integer))
+(define (world30000) : Any (inject 24 Integer))
+
+(let ((x30001
+          (vector (inject 0 Integer) (inject 0 Integer))
+          ))
+    (let ((y30002
+           (inject
+            (vector-set! x30001
+             0
+             (
+              (project (inject hello29999 (-> Any)) (-> Any))))
+            Void)))
+      (let ((z30003
+             (inject
+              (vector-set! x30001
+               1
+               (
+                (project
+                 (inject world30000 (-> Any))
+                 (-> Any))))
+              Void)))
+        (inject
+         (+ (- (project (inject 6 Integer) Integer))            
+            (+
+             (project (vector-ref x30001 0) Integer)
+             (project (vector-ref x30001 1) Integer)))
+         Integer))))

tests/s6_9.rkt

@@ -0,0 +1,27 @@
+(define (hello29999) : Any (inject 24 Integer))
+(define (world30000) : Any (inject 24 Integer))
+
+(let ((x30001
+         (inject
+          (vector (inject 0 Integer) (inject 0 Integer))
+          (Vector Any Any))))
+    (let ((y30002
+           (inject
+            (vector-set!
+             (project x30001 (Vector Any Any))
+             0
+             (
+              (project (inject hello29999 (-> Any)) (-> Any))))
+            Void)))
+      (let ((z30003
+             (inject
+              (vector-set!
+               (project x30001 (Vector Any Any))
+               1
+               (
+                (project
+                 (inject world30000 (-> Any))
+                 (-> Any))))
+              Void)))
+        (let ((a (project x30001 (Vector Any Any))))
+          (+ (- 6) (+ (project (vector-ref a 0) Integer) (project (vector-ref a 1) Integer)))))))

tests/s7_3.rkt

@@ -0,0 +1,5 @@
+(let ([x (vector 1 2 3 42)])
+  (let ([y (vector-set! x 0 42)])
+    (let ([z (vector-set! x 1 42)])
+      ((lambda (vec) (vector-ref vec 3)) x))))
+

tests/s7_4.in

@@ -0,0 +1 @@
+42

tests/s7_4.rkt

@@ -0,0 +1,4 @@
+(let ([x (vector 42 42 42)])
+  (if (read) ((lambda (x) (+ (- (vector-ref x 2)) 84)) x)
+    (if (and (eq? #t #f) (eq? (vector-ref x 0) (vector-ref x 1)))
+	(vector-ref x 0) (void))))

tests/s7_5.rkt

@@ -0,0 +1,6 @@
+(define (hello) 24)
+(define (world) 24)
+(let ([x (vector 0 0)])
+  (let ([y (vector-set! x 0 (hello))])
+    (let ([z (vector-set! x 1 (world))])
+      (+ (- 6) (+ (vector-ref x 0) (vector-ref x 1))))))

tests/s7_6.in

@@ -0,0 +1 @@
+42

tests/s7_6.rkt

@@ -0,0 +1,6 @@
+(define (hopefully-int) (lambda (x) (let ([maybe-int (read)])
+				     (if (eq? maybe-int 42) x
+					42))))
+(define (hopefully-bool) (lambda (x) (and (not x) #t)))
+(if (hopefully-bool) ((hopefully-int) 42)
+  (+ ((hopefully-int) 42) 0))

tests/s7_7.rkt

@@ -0,0 +1,8 @@
+
+(define (vector-foo vec) (vector-set! vec 0 42))
+(define (vector-foo-too vec) (vector-set! vec 1 42))
+(define (vector-foo-three vec)
+  (let ([veca (vector-set! vec 2 42)])
+    (vector-ref veca 2)))
+(let ([x (vector-foo (vector-foo-too (vector-foo-three (vector 0 0 0))))])
+  x)

utilities.rkt

@@ -269,9 +269,9 @@
                                          (display "in program")(newline)
                                          (pretty-print new-p)(newline)
                                          (error 'check-passes
-                                                "differing results in compiler '~a' pass '~a', expected ~a, not"
+                                                "differing results in compiler '~a' pass '~a', expected ~a, not ~a"
                                                 name pass-name result
-                                                #;new-result
+                                                new-result
                                                 )])]
                                  [else ;; no result to check yet
                                   (loop (cdr passes) new-p new-result)]))]

vectors.rkt

@@ -318,7 +318,8 @@
          (define new-e-vec ((select-instructions) e-vec))
          (define new-e-arg ((select-instructions) e-arg))
          `((movq ,new-e-vec (reg r11))
-	   (movq ,new-e-arg (deref r11 ,(* (add1 i) 8))))]
+	   (movq ,new-e-arg (deref r11 ,(* (add1 i) 8)))
+           (movq (int 0) ,new-lhs))]
         ;; If has to be overridden because it needs to propagate
         [`(if ,cnd ,thn-ss ,els-ss)
          (let ([cnd ((select-instructions) cnd)]