update compute-free-var hw5

Author: super zozo

hw5.rkt

@@ -147,25 +147,24 @@
 
 ;; We will test this function directly, so it must do
 ;; as described in the assignment
-(define (free-vars-helper e not-free)
-  ;;(println not-free)
-  ;;(print e)
-  (let ([f (lambda (g e) (free-vars-helper (g e) not-free))])
+(define (free-vars-helper e)
+  (let ([f (lambda (g e) (free-vars-helper (g e)))])
     (cond [(fun? e)
            (let* ([arg (fun-formal e)]
                  [body (fun-body e)]
-                 [s (free-vars-helper body (set-add not-free arg))])
-             (cons (fun-challenge (fun-nameopt e) arg (car s) (cdr s)) (cdr s)))]
+                 [s (free-vars-helper body)]
+                 [freevars (set-remove (cdr s) arg)])
+             (cons (fun-challenge (fun-nameopt e) arg (car s) freevars) freevars))]
           [(var? e)
-           (cons e (if (set-member? not-free (var-string e)) (set) (set (var-string e))))]
+           (cons e (set (var-string e)))]
           [(mlet? e)
            (let* ([name (mlet-var e)]
                   [val (mlet-e e)]
                   [body (mlet-body e)]
-                  [s1 (free-vars-helper val not-free)]
-                  [s2 (free-vars-helper body (set-add not-free name))])
+                  [s1 (free-vars-helper val)]
+                  [s2 (free-vars-helper body)])
                (cons (mlet name (car s1) (car s2))
-                     (set-union (cdr s1) (cdr s2))))]
+                     (set-union (cdr s1) (set-remove (cdr s2) name))))]
           [(add? e)
            (let ([s1 (f add-e1 e)]
                  [s2 (f add-e2 e)])
@@ -203,15 +202,22 @@
 
 
 (define (compute-free-vars e)
-  (car (free-vars-helper e (set))))
+  (car (free-vars-helper e)))
 
 
 
 
 ;; Do NOT share code with eval-under-env because that will make
 ;; auto-grading and peer assessment more difficult, so
 ;; copy most of your interpreter here and make minor changes
+
+(define (compute-env env freevars)
+  (set-map freevars (lambda (x) (cons x (envlookup env x)))))
+  
+
 (define (eval-under-env-c e env)
+  (println e)
+  (println env)
   (cond [(var? e) 
          (envlookup env (var-string e))]
         [(add? e) 
@@ -257,17 +263,17 @@
                         (if (var? fn-call)
                             (cons (cons (var-string fn-call) clojure) clojure-env) ;; Add bindings for recursive call
                             clojure-env))]
-                [arg-name (fun-formal fn)]
-                [fn-body (fun-body fn)])
-           (eval-under-env-c fn-body (cons (cons arg-name arg) envi)))]
+                [reduced-envi (compute-env envi (fun-challenge-freevars fn))]
+                [arg-name (fun-challenge-formal fn)]
+                [fn-body (fun-challenge-body fn)])
+           (eval-under-env-c fn-body (cons (cons arg-name arg) reduced-envi)))]
         [(apair? e)
          (apair (eval-under-env-c (apair-e1 e) env) (eval-under-env-c (apair-e2 e) env))]
         [(fst? e) (let ([pair (eval-under-env-c (fst-e e) env)])
                     (if (apair? pair) (apair-e1 pair) (error "MUPL fst applied to non-pair")))]
         [(snd? e) (let ([pair (eval-under-env-c (snd-e e) env)])
                     (if (apair? pair) (apair-e2 pair) (error "MUPL snd applied to non-pair")))]
         [(isaunit? e) (if (aunit? (eval-under-env-c (isaunit-e e) env)) (int 1) (int 0))]
-        ;;
         [#t (error (format "bad MUPL expression: ~v" e))]))
 
 ;; Do NOT change this

hw5test.rkt

@@ -0,0 +1,60 @@
+#lang racket
+;; Programming Languages Homework 5 Simple Test
+;; Save this file to the same directory as your homework file
+;; These are basic tests. Passing these tests does not guarantee that your code will pass the actual homework grader
+
+;; Be sure to put your homework file in the same folder as this test file.
+;; Uncomment the line below and, if necessary, change the filename
+;;(require "hw5")
+
+(require rackunit)
+
+(define tests
+  (test-suite
+   "Sample tests for Assignment 5"
+   
+   ;; check racketlist to mupllist with normal list
+   (check-equal? (racketlist->mupllist (list (int 3) (int 4))) (apair (int 3) (apair (int 4) (aunit))) "racketlist->mupllist test")
+   
+   ;; check mupllist to racketlist with normal list
+   (check-equal? (mupllist->racketlist (apair (int 3) (apair (int 4) (aunit)))) (list (int 3) (int 4)) "racketlist->mupllist test")
+
+   ;; tests if ifgreater returns (int 2)
+   (check-equal? (eval-exp (ifgreater (int 3) (int 4) (int 3) (int 2))) (int 2) "ifgreater test")
+   
+   ;; mlet test
+   (check-equal? (eval-exp (mlet "x" (int 1) (add (int 5) (var "x")))) (int 6) "mlet test")
+   
+   ;; call test
+   (check-equal? (eval-exp (call (closure '() (fun #f "x" (add (var "x") (int 7)))) (int 1))) (int 8) "call test")
+   
+   ;;snd test
+   (check-equal? (eval-exp (snd (apair (int 1) (int 2)))) (int 2) "snd test")
+   
+   ;; isaunit test
+   (check-equal? (eval-exp (isaunit (closure '() (fun #f "x" (aunit))))) (int 0) "isaunit test")
+   
+   ;; ifaunit test
+   (check-equal? (eval-exp (ifaunit (int 1) (int 2) (int 3))) (int 3) "ifaunit test")
+   
+   ;; mlet* test
+   (check-equal? (eval-exp (mlet* (list (cons "x" (int 10))) (var "x"))) (int 10) "mlet* test")
+   
+   ;; ifeq test
+   (check-equal? (eval-exp (ifeq (int 1) (int 2) (int 3) (int 4))) (int 4) "ifeq test")
+   
+   ;; mupl-map test
+   (check-equal? (eval-exp (call (call mupl-map (fun #f "x" (add (var "x") (int 7)))) (apair (int 1) (aunit)))) 
+                 (apair (int 8) (aunit)) "mupl-map test")
+   
+   ;; problems 1, 2, and 4 combined test
+   (check-equal? (mupllist->racketlist
+   (eval-exp (call (call mupl-mapAddN (int 7))
+                   (racketlist->mupllist 
+                    (list (int 3) (int 4) (int 9)))))) (list (int 10) (int 11) (int 16)) "combined test")
+   
+   ))
+
+(require rackunit/text-ui)
+;; runs the test
+(run-tests tests)