fixed eq?

jsiek · jsiek · commit cde6e03d4c7b · 2016-04-26T17:57:09.000-04:00
diff --git a/README.md b/README.md
@@ -5,9 +5,6 @@ Compiler Course
 
 ## To do:
 * Write Grammars for intermediate languages
-* Implement anonymous functions: `lambda.rkt`
-* Do: Look through S3 tests and think of more tests.
-* Read: `functions.rkt` for help with `lambda.rkt`
 
 Notes for work:
 
@@ -27,3 +24,5 @@ Notes for work:
 * Look in utilities for System V
 * Look in utilities for Debugging stuff (`check-passes`)
 
+Coding guidelines:
+* No more than 80 columns per line.
diff --git a/dynamic-interp.rkt b/dynamic-interp.rkt
@@ -61,18 +61,19 @@
        (let* ([elts (map recur es)]
               [tys (map get-tagged-type elts)])
          `(tagged ,(apply vector (map recur es)) (Vector ,@tys)))]
-      [`(vector-set! ,e1 ,n ,e2)
-       (let ([e1^ (recur e1)]
-             [e2^ (recur e2)])
-         (match e1^ 
-           [`(tagged ,vec ,ty) 
-            (vector-set! vec n e2^)
-            `(tagged (void) Void)]))]
-      [`(vector-ref ,e ,n)
-       (let ([e^ (recur e)])
-         (match e^ 
-           [`(tagged ,vec ,ty) 
-            (vector-ref vec n)]))]
+      [`(vector-set! ,(app recur e1^) ,(app recur n^) ,(app recur e2^))
+       (match e1^ 
+	 [`(tagged ,vec ,ty) 
+	  (match n^
+	    [`(tagged ,n ,ty)
+	     (vector-set! vec n e2^)
+	     `(tagged (void) Void)])])]
+      [`(vector-ref ,(app recur e^) ,(app recur n^))
+       (match e^ 
+	 [`(tagged ,vec ,ty) 
+	  (match n^
+	    [`(tagged ,n ,ty)
+	     (vector-ref vec n)])])]
       [`(let ([,x ,e]) ,body)
        (let ([v (recur e)])
          ((interp-r7 (cons (cons x v) env)) body))]
@@ -101,3 +102,5 @@
             (define new-env (append (map cons xs new-args) lam-env))
             ((interp-r7 new-env) body)]
            [else (error "interp-r7, expected function, not" f-val)]))])))
+
+
diff --git a/dynamic-typing.rkt b/dynamic-typing.rkt
@@ -26,44 +26,37 @@
       (lambda (e)
 	(define recur (type-check env))
         (match e
-          [`(vector-ref ,(app recur e t) ,i)
+          [`(vector-ref ,(app recur e t) ,(app recur i it))
            (match t
              [`(Vector ,ts ...)
               (unless (and (exact-nonnegative-integer? i)
                            (i . < . (length ts)))
-                (error 'type-check "invalid index ~a" i))
+                (error 'type-check "invalid index ~a in ~a" i e))
               (let ([t (list-ref ts i)])
                 (values `(has-type (vector-ref ,e (has-type ,i Integer)) ,t) 
 			t))]
              [`(Vectorof ,t)
-              (unless (exact-nonnegative-integer? i)
-                (error 'type-check "invalid index ~a" i))
-              (values `(has-type (vector-ref ,e (has-type ,i Integer)) ,t) t)]
+              (values `(has-type (vector-ref ,e ,i) ,t) t)]
              [else (error "expected a vector in vector-ref, not" t)])]
-          [`(vector-set! ,(app recur e-vec^ t-vec) ,i 
-			 ,(app recur e-arg^ t-arg) )
+          [`(vector-set! ,(app recur e-vec^ t-vec) ,(app recur i it) 
+			 ,(app recur e-arg^ t-arg))
            (match t-vec
              [`(Vector ,ts ...)
               (unless (and (exact-nonnegative-integer? i)
                            (i . < . (length ts)))
-                (error 'type-check "invalid index ~a" i))
+                (error 'type-check "invalid index ~a in ~a" i e))
               (unless (equal? (list-ref ts i) t-arg)
                 (error 'type-check "type mismatch in vector-set! ~a ~a" 
                        (list-ref ts i) t-arg))
               (values `(has-type (vector-set! ,e-vec^
                                               (has-type ,i Integer)
                                               ,e-arg^) Void) 'Void)]
              [`(Vectorof ,t)
-              (unless (exact-nonnegative-integer? i)
-                (error 'type-check "invalid index ~a" i))
               (unless (equal? t t-arg)
                 (error 'type-check "type mismatch in vector-set! ~a ~a" 
                        t t-arg))
-              (values `(has-type (vector-set! ,e-vec^
-                                              (has-type ,i Integer)
-                                              ,e-arg^) Void) 'Void)]
-             [else (error 'type-check
-                          "expected a vector in vector-set!, not ~a"
+              (values `(has-type (vector-set! ,e-vec^ ,i ,e-arg^) Void) 'Void)]
+             [else (error 'type-check "expected a vector in vector-set!, not ~a"
                           t-vec)])]
           [`(inject ,(app recur new-e e-ty) ,ty)
 	   (cond
@@ -427,10 +420,38 @@
           [else ((super reveal-functions funs) e)])))
 
 
-    ))
-
-
-
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; select-instructions : C -> psuedo-x86
+
+  (define/override (select-instructions)
+    (lambda (x)
+      (vomit "select instructions" x)
+      (match x
+        [`(assign ,lhs (vector-ref ,e-vec (has-type ,i ,Integer))) 
+	 #:when (not (number? i))
+         (define lhs^ ((select-instructions) lhs))
+         (define e-vec^ ((select-instructions) e-vec))
+         (define i^ ((select-instructions) i))
+         `((movq ,i^ (reg r11))
+	   (addq (int 1) (reg r11))
+	   (imulq (int 8) (reg r11))
+	   (addq ,e-vec^ (reg r11))
+	   (movq (deref r11 0) ,lhs^))]
+        [`(assign ,lhs (vector-set! ,e-vec (has-type ,i ,Integer) ,e-arg))
+	 #:when (not (number? i))
+         (define lhs^ ((select-instructions) lhs))
+         (define e-vec^ ((select-instructions) e-vec))
+         (define e-arg^ ((select-instructions) e-arg))
+         (define i^ ((select-instructions) i))
+         `((movq ,i^ (reg r11))
+	   (addq (int 1) (reg r11))
+	   (imulq (int 8) (reg r11))
+	   (addq ,e-vec^ (reg r11))
+	   (movq ,e-arg^ (deref r11 0))
+           (movq (int 0) ,lhs^))]
+        [else ((super select-instructions) x)])))
+
+  ));; compile-R7
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/interp.rkt b/interp.rkt
@@ -111,6 +111,7 @@
 
     (field [x86-ops (make-immutable-hash
                      `((addq 2 ,+)
+		       (imulq 2 ,*)
                        (subq 2 ,(lambda (s d) (- d s)))
                        (negq 1 ,-)))])
     
@@ -948,8 +949,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Interpreters for R6: type Any and inject/project
 
-;; to do: support eq? on two things of type Any -Jeremy
- 
 (define interp-R6
   (class interp-R4
     (super-new)
@@ -977,6 +976,15 @@
 		      (match v
 			 [`(tagged ,v1 (,ts ... -> ,rt)) #t]
 			 [else #f]))]
+	 ['eq? (lambda (v1 v2)
+		 (match (list v1 v2)
+ 		   [`((tagged ,v1^ ,ty1) (tagged ,v2^ ,ty2))
+		    (and (eq? v1^ v2^) (equal? ty1 ty2))]
+		   [else
+		    (cond [(or (and (fixnum? v1) (fixnum? v2)) 
+			       (and (boolean? v1) (boolean? v2))
+			       (and (vector? v1) (vector? v2)))
+			   (eq? v1 v2)])]))]
 	 [else (super interp-op op)]
 	 ))
 
@@ -1050,3 +1058,4 @@
 		   ))
 
     )) ;; interp-R6
+
diff --git a/run-tests.rkt b/run-tests.rkt
@@ -43,7 +43,7 @@
     (3 . ,(range 1 20))
     (4 . ,(range 0 8))
     (6 . ,(range 0 10))
-    (7 . ,(range 0 8))
+    (7 . ,(range 0 9))
     ))
 
 (define (suite-range x)
diff --git a/runtime.c b/runtime.c
@@ -486,5 +486,8 @@ void print_any(int64_t any) {
   case ANY_TAG_FUN:
     printf("#<procedure>");
     break;
+  default:
+    printf("unrecognized!");
+    exit(-1);
   }
 }
diff --git a/tests/s7_3.rkt b/tests/s7_3.rkt
@@ -1,5 +1,5 @@
 (let ([x (vector 1 2 3 42)])
-  (let ([y (vector-set! x 1 42)])
-    (let ([z (vector-set! x 0 42)])
+  (let ([voidy (vector-set! x 1 42)])
+    (let ([voidy (vector-set! x 0 42)])
       ((lambda (vec) (vector-ref vec 3)) x))))
 
diff --git a/tests/s7_5.rkt b/tests/s7_5.rkt
@@ -1,6 +1,10 @@
 (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))))))
+  (let ([y (hello)])
+    (let ([z (world)])
+      (let ([voidx (vector-set! x 0 (hello))])
+	(let ([voidy (vector-set! x 1 z)]) ;; change z to (world) for bug -Jeremy
+	  (+ (- 6) (+ (vector-ref x 0) (vector-ref x 1)))
+	  )))))
+
diff --git a/tests/s7_7.rkt b/tests/s7_7.rkt
@@ -1,8 +1,11 @@
-
-(define (vector-foo vec) (vector-set! vec 0 42))
-(define (vector-foo-too vec) (vector-set! vec 1 42))
+(define (vector-foo vec)
+  (let ([_ (vector-set! vec 0 42)])
+    vec))
+(define (vector-foo-too vec)
+  (let ([_ (vector-set! vec 1 42)])
+    vec))
 (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))))])
+  (let ([_ (vector-set! vec 2 42)])
+    (vector-ref vec 2)))
+(let ([x (vector-foo-three (vector-foo-too (vector-foo (vector 0 0 0))))])
   x)
diff --git a/utilities.rkt b/utilities.rkt
@@ -396,6 +396,8 @@
          (control-fun 'wait)
          (cond [(eq? (control-fun 'status) 'done-ok)
                 (let ([result (read-line (car progout))])
+		  (unless (not (eq? result eof))
+			  (error "error: program did not produce output"))
                   (if (eq? (string->symbol result) (string->symbol output))
                       (begin (display test-name)(display " ")(flush-output))
                       (error (format "test ~a failed, output: ~a, expected ~a" 
diff --git a/vectors.rkt b/vectors.rkt
@@ -97,9 +97,10 @@
 	      (for/list ([e (in-list e*)]
 			 [n (in-naturals)])
 			(let ([v (unique-var 'void)])
-			  `(assign ,v (has-type
-				       (vector-set! ,vec (has-type ,n Integer) ,e)
-				       Void)))))
+			  `(assign ,v
+				   (has-type
+				    (vector-set! ,vec (has-type ,n Integer) ,e)
+				    Void)))))
 	    `((if (has-type (collection-needed? ,size) Boolean)
 		  ((collect ,size))
 		  ())
@@ -243,7 +244,7 @@
     (lambda (x)
       (vomit "select instructions" x)
       (match x
-        ;[`(void) `(int 0)]   I don't think this line is needed. -Jeremy
+        [`(void) `(int 0)]
 	[`(assign ,(app (select-instructions) lhs^) (void))
 	 `((movq (int 0) ,lhs^))]
         [`(assign ,lhs (has-type (allocate ,length) (Vector ,ts ...)))

Original file line number	Diff line number	Diff line change
`@@ -486,5 +486,8 @@ void print_any(int64_t any) {`
`486`	`486`	`case ANY_TAG_FUN:`
`487`	`487`	`printf("#<procedure>");`
`488`	`488`	`break;`
	`489`	`+ default:`
	`490`	`+ printf("unrecognized!");`
	`491`	`+ exit(-1);`
`489`	`492`	`}`
`490`	`493`	`}`