;; CSCE 314, Programming Languages, Homework 4

#lang racket
(provide (all-defined-out)) ;; so we can put tests in a second file

;; definition of structures for MUPL programs - Do NOT change
(struct var  (string) #:transparent)  ;; a variable, e.g., (var "foo")
(struct int  (num)    #:transparent)  ;; a constant number, e.g., (int 17)
(struct add  (e1 e2)  #:transparent)  ;; add two expressions
(struct isgreater (e1 e2)    #:transparent) ;; if e1 > e2 then 1 else 0
(struct ifnz (e1 e2 e3) #:transparent) ;; if not zero e1 then e2 else e3
(struct fun  (nameopt formal body) #:transparent) ;; a recursive(?) 1-argument function
(struct call (funexp actual)       #:transparent) ;; function call
(struct mlet (var e body) #:transparent) ;; a local binding (let var = e in body)
(struct apair   (e1 e2) #:transparent) ;; make a new pair
(struct first   (e)     #:transparent) ;; get first part of a pair
(struct second  (e)     #:transparent) ;; get second part of a pair
(struct munit   ()      #:transparent) ;; unit value -- good for ending a list
(struct ismunit (e)     #:transparent) ;; if e1 is unit then 1 else 0

;; a closure is not in "source" programs; it is what functions evaluate to
(struct closure (env fun) #:transparent)  ; a closure is a function's inputs and the environment where it was declared

;; Problem 1
;; A) Write a Racket function racketlist->mupllist that takes a Racket list (presumably of mupl
;; values but that should not affect your solution) and produces an analogous mupllist with the
;; same elements in the same order.

(define (racketlist->mupllist lst)
  (cond
    [(null? lst) (munit)]  ; if Racket list is empty -> return MUPL empty list
    [(pair? lst) (apair (racketlist->mupllist (car lst))  ; recursively convert the first element
                        (racketlist->mupllist (cdr lst)))] ; recursively convert the rest of the list
    [#t (error "not a list")]))  ; just in case

;; B) Write a Racket function mupllist->racketlist that takes a mupllist (presumably of mupl
;; values but that should not affect your solution) and produces an analogous Racket list (of mupl
;; values) with the same elements in the same order.

(define (mupllist->racketlist lst)
  (cond
    [(ismunit lst) null]  ; if empty
    [(apair? lst) (cons (mupllist->racketlist (first lst))  ; first element
                        (mupllist->racketlist (second lst)))]  ; everything else
    [#t (error "not a list")]))



;; Problem 2

(define (envlookup env str) (cond [(null? env) (error "unbound variable during evaluation" str)] [(equal? (car (car env)) str) (cdr (car env))] [#t (envlookup (cdr env) str)])) ; lookup a variable in an environment; Do NOT change this function

;; Do NOT change the two cases given to you.  
;; DO add more cases for other kinds of MUPL expressions.
;; We will test eval-under-env by calling it directly even though
;; "in real life" it would be a helper function of eval-exp.

(define (eval-under-env e env)
  (cond [(var? e)                                                 ; do not change
         (envlookup env (var-string e))]
        [(add? e)                                                 ; do not change
         (let ([v1 (eval-under-env (add-e1 e) env)]
               [v2 (eval-under-env (add-e2 e) env)])
           (if (and (int? v1)
                    (int? v2))
               (int (+ (int-num v1) 
                       (int-num v2)))
               (error "MUPL addition applied to non-number")))]
        [(int? e) e]
        [(isgreater? e)                                           ; isgreater? [isgreater (e1 e2) -> if e1 > e2 then 1 else 0]
        (let ([v1 (eval-under-env (isgreater-e1 e) env)]
              [v2 (eval-under-env (isgreater-e2 e) env)])
          (if (and (int? v1)
                    (int? v2))
              (if (> (int-num v1) (int-num v2))
                  (int 1)
                  (int 0))
              (error "MUPL isgreater applied to non-number")))]
        [(ifnz? e)                                                ; ifnz? [ifnz (e1 e2 e3) -> if not zero e1 then e2 else e3]
        (let ([v1 (eval-under-env (ifnz-e1 e) env)])
          (if (and (int? v1)
                    (not (zero? (int-num v1))))
              (eval-under-env (ifnz-e2 e) env)
              (eval-under-env (ifnz-e3 e) env)))]
        [(fun? e)                                                 ; fun? [(nameopt formal body) -> a recursive(?) 1-argument function
        (closure env e)]
        [(call? e)                                                ; call? [call (funexp actual) -> function call]
        (let ([v1 (eval-under-env (call-funexp e) env)]
              [v2 (eval-under-env (call-actual e) env)])
          (if (closure? v1)
              (let ([fun (closure-fun v1)]
                    [env* (cons (cons (closure-fun v1) v2) (closure-env v1))])
                (eval-under-env fun env*))
              (error "MUPL call applied to non-function")))]
        [(mlet? e)                                                ; mlet? [mlet (var e body) -> a local binding (let var = e in body)]
        (let ([v1 (eval-under-env (mlet-e e) env)])
          (eval-under-env (mlet-body e) (cons (cons (mlet-var e) v1) env)))]
        [(apair? e)                                               ; apair? [apair (e1 e2) -> make a new pair]
        (apair (eval-under-env (apair-e1 e) env)
                (eval-under-env (apair-e2 e) env))]
        [(first? e)                                               ; first? [first e -> get first part of a pair]
        (let ([v (eval-under-env (first-e e) env)])
          (if (apair? v)
              (first v)
              (error "MUPL first applied to non-pair")))]
        [(second? e)                                              ; second? [second e -> get second part of a pair]
        (let ([v (eval-under-env (second-e e) env)])
          (if (apair? v)
              (second v)
              (error "MUPL second applied to non-pair")))]
        [(munit? e) (munit)]                                      ; nothing -> nothing
        [(ismunit? e)                                             ; ismunit? [ismunit e -> if e1 is unit then 1 else 0]
        (if (ismunit (eval-under-env (ismunit-e e) env))
            (int 1)
            (int 0))]
        [#t (error (format "bad MUPL expression: ~v" e))]))

(define (eval-exp e) (eval-under-env e null)) ; Do NOT change
        
;; Problem 3

(define (ifmunit e1 e2 e3)
  (ifnz (ismunit e1) e2 e3))

(define (mlet* bs e2)
  (if (null? bs)
      (eval-under-env e2 null)
      (mlet (caar bs) (eval-under-env (car (cdr (car bs))) e2)
            (mlet* (cdr bs) e2))))

(define (ifeq e1 e2 e3 e4)
  (ifnz (isgreater e1 e2) e3 (ifnz (isgreater e2 e1) e4 (int 1))))

;; Problem 4

(define (mupl-filter pred-fun)
  (lambda (lst)
    (mlet "x" (first lst)
          (ifnz (call pred-fun (var "x"))
                (apair (var "x") (call mupl-filter pred-fun (second lst)))
                (call mupl-filter pred-fun (second lst))))))

(define mupl-all-gt
  (mlet "filter"
        (lambda (x)
          (ifnz (isgreater x "i") (int 1) (int 0)))
        (lambda (i)
          (lambda (lst)
            (call "filter" lst)))))




#|Overview: This homework is all about mupl(a Made Up Programming Language). muplprograms are
written directly in Racket by using the constructors defined by the structs defined at the beginning of
hw4.rkt. This is the definition of mupl’s syntax:
•If s is a Racket string, then (var s) is a muplexpression (a variable use). s represents the name of
the variable.
•If n is a Racket integer, then (int n) is a muplexpression (a constant). n represents tha value of the
integer constant.
•If e1 and e2 are muplexpressions, then (add e1 e2) is a muplexpression (an addition).
•If s1 and s2 are Racket strings and e is a muplexpression, then (fun s1 s2 e) is a muplexpression (a
function). In e, s1 is bound to the function itself (for recursion) and s2 is bound to the (one) argument.
Also, (fun null s2 e) is allowed for representing anonymous nonrecursive functions.
•If e1 and e2 are muplexpressions, then (isgreater e1 e2) is a muplexpression (a comparison).
•If e1, e2, and e3 are muplexpressions, then (ifnz e1 e2 e3) is a muplexpression. It is a condition
where the result is e2 if e1 is not zero otherwise the result is e3. Only one of e2 and e3 is evaluated.
•If e1 and e2 are muplexpressions, then (call e1 e2) is a muplexpression (a function call).
•If s is a Racket string and e1 and e2 are muplexpressions, then (mlet s e1 e2) is a muplexpression
(a let expression where the value resulting from evaluating e1 is bound to s in the evaluation of e2).
•If e1 and e2 are muplexpressions, then (apair e1 e2) is a muplexpression (a pair-creator).
•If e1 is a muplexpression, then (first e1) is a muplexpression (getting the first part of a pair).
•If e1 is a muplexpression, then (second e1) is a muplexpression (getting the second part of a pair).
•(munit) is a muplexpression (holding no data, much like () in OCaml or null in Racket). Notice
(munit) is a muplexpression, but munit is not.
•If e1 is a muplexpression, then (ismunit e1) is a muplexpression (testing for (munit)).
•(closure env f ) is a muplvalue where f is muplfunction (an expression made from fun) and env
is an environment mapping variables to values. Closures do not and cannot appear in source programs;
they only result from evaluating functions.

A muplvalue is a muplinteger constant, a muplclosure, a muplmunit, or a muplpair of muplvalues.
Similar to Racket, we can build list values out of nested pair values that end with a muplmunit. Such a
muplvalue is called a mupllist.
You should assume muplprograms are syntactically correct (e.g., do not worry about wrong things like (int
"hi") or (int (int 37)). But do not assume muplprograms are free of type errors like (add (munit)
(int 7)) or (first (int 7)).

Warm-Up:
(a) Write a Racket function racketlist->mupllist that takes a Racket list (presumably of mupl
values but that should not affect your solution) and produces an analogous mupllist with the
same elements in the same order.
(b) Write a Racket function mupllist->racketlist that takes a mupllist (presumably of mupl
values but that should not affect your solution) and produces an analogous Racket list (of mupl
values) with the same elements in the same order.
2. Implementing the muplLanguage: Write a muplinterpreter, i.e., a Racket function eval-exp
that takes a muplexpression e and either returns the muplvalue that e evaluates to under the empty
environment or calls Racket’s error if evaluation encounters a run-time mupltype error or unbound
muplvariable.
A muplexpression is evaluated under an environment (for evaluating variables, as usual). In your
interpreter, use a Racket list of Racket pairs to represent this environment (which is initially empty)
so that you can use without modification the provided envlookup function. Here is a description of
the semantics of muplexpressions:
•All values (including closures) evaluate to themselves. For example, (eval-exp (int 17)) would
return (int 17), not 17.
•A variable evaluates to the value associated with it in the environment.
•An addition evaluates its subexpressions and, assuming they both produce integers, produces the
integer that is their sum. (Note that this case is done for you in your started code to get you
pointed in the right direction.)
•An isgreater evaluates its two subexpressions to values v1 and v2 respectively. If both values
are integers, then if v1 > v2 the result of the isgreater expression is the muplvalue (int 1), else
the result is the muplvalue (int 0).
•An ifnz evaluates its first expression to a value v1. If it is an integer, then if it is not zero, then
ifnz evaluates its second subexpression, otherwise it evaluates its third subexpression.
•Functions are lexically scoped: A function evaluates to a closure holding the function and the
current environment.
•An mlet expression evaluates its first expression to a value v. Then it evaluates the second
expression to a value, in an environment extended to map the name in the mlet expression to v.
•A call evaluates its first and second subexpressions to values. If the first is not a closure, it is
an error. Else, it evaluates the closure’s function’s body in the closure’s environment extended
to map the function’s name to the closure in order to support recursion (unless the name field is
null) and the function’s argument-name (i.e., the parameter name) to the result of the second
subexpression.
•An apair expression evaluates its two subexpressions and produces a (new) pair holding the
results.
•A first expression evaluates its subexpression. If the result for the subexpression is a pair, then
the result for the first expression is the e1 field in the pair.
•A second expression evaluates its subexpression. If the result for the subexpression is a pair, then
the result for the second expression is the e2 field in the pair.
2
•An ismunit expression evaluates its subexpression. If the result is an munit expression, then the
result for the ismunit expression is the muplvalue (int 1), else the result is the muplvalue
(int 0).
Hint: The call case is the most complicated. In the sample solution, no case is more than 12 lines
and several are 1 line.
3. Expanding the Language: muplis a small language, but we can write Racket functions that act like
muplmacros so that users of these functions feel like muplis larger. The Racket functions produce
muplexpressions that could then be put inside larger muplexpressions or passed to eval-exp. In
implementing these Racket functions, do not use closure (which is used only internally in eval-exp).
Also do not use eval-exp (we are creating a program, not running it).
(a) Write a Racket function ifmunit that takes three muplexpressions e1, e2, and e3. It returns a
muplexpression that when run evaluates e1 and if the result is mupl’s munit then it evaluates
e2 and that is the result, else it evaluates e3 and that is the result. Sample solution: 1 line.
(b) Write a Racket function mlet* that takes a Racket list of Racket pairs ’((s1 . e1) . . . (si . ei)
. . . (sn . en)) and a final muplexpression en+1. In each pair, assume si is a Racket string and
ei is a muplexpression. mlet* returns a muplexpression whose value is en+1 evaluated in an
environment where each si is a variable bound to the result of evaluating the corresponding ei
for 1 ≤i ≤n. The bindings are done sequentially, so that each ei is evaluated in an environment
where s1 through si−1 have been previously bound to the values e1 through ei−1.
(c) Write a Racket function ifeq that takes four muplexpressions e1, e2, e3, and e4 and returns
a muplexpression that acts like ifnz except e3 is evaluated if and only if e1 and e2 are equal
integers. (An error occurs if the result of e1 or e2 is not an integer.) Assume none of the arguments
to ifeq use the muplvariables _x or _y. Use this assumption so that when an expression returned
from ifeq is evaluated, e1 and e2 are evaluated exactly once each.
4. Using the Language: We can write muplexpressions directly in Racket using the constructors for
the structs and (for convenience) the functions we wrote in the previous problem.
(a) Bind to the Racket variable mupl-filter a muplfunction that acts like filter (as we used in
OCaml). Your function should be curried: it should take a muplfunction and return a mupl
function that takes a mupllist and applies the function to every element of the list returning
a new mupllist with all the elements for which the function returns a number other than zero
(causing an error if the function returns a non-number). Recall a mupllist is munit or a pair
where the second component is a mupllist.
(b) Bind to the Racket variable mupl-all-gt a muplfunction that takes an muplinteger i and
returns a muplfunction that takes a mupllist of muplintegers and returns a new mupllist of
muplintegers containing the elements of the input list (in order) that are greater than i. Use
mupl-filter (a use of mlet is given to you to make this easier).
5. Challenge Problem: Write a second version of eval-exp (bound to eval-exp-c) that builds closures
with smaller environments: When building a closure, it uses an environment that is like the current
environment but holds only variables that are free variables in the function part of the closure. (A free
variable is a variable that appears in the function without being under some shadowing binding for the
same variable.)
Avoid computing a function’s free variables more than once by writing a function compute-free-vars
that takes an expression and returns a different expression that uses fun-challenge everywhere in
place of fun. The new struct fun-challenge (provided to you; do not change it) has a field freevars
to store exactly the set of free variables for the function. Store this set as a Racket set of Racket strings.
(Sets are predefined in Racket’s standard library; consult the documentation for useful functions such
as set, set-add, set-member?, set-remove, set-union, and any other functions you wish.)
You must have a top-level function compute-free-vars that works as just described — storing the
free variables of each function in the freevars field — so the grader can test it directly. Then write a
new “main part” of the interpreter that expects the sort of muplexpression that compute-free-vars
returns. The case for function definitions is the interesting one.
|#























;; Challenge Problem
#|Write a second version of eval-exp (bound to eval-exp-c) that builds closures
with smaller environments: When building a closure, it uses an environment that is like the current
environment but holds only variables that are free variables in the function part of the closure. (A free
variable is a variable that appears in the function without being under some shadowing binding for the
same variable.)
Avoid computing a function’s free variables more than once by writing a function compute-free-vars
that takes an expression and returns a different expression that uses fun-challenge everywhere in
place of fun. The new struct fun-challenge (provided to you; do not change it) has a field freevars
to store exactly the set of free variables for the function. Store this set as a Racket set of Racket strings.
(Sets are predefined in Racket’s standard library; consult the documentation for useful functions such
as set, set-add, set-member?, set-remove, set-union, and any other functions you wish.)
You must have a top-level function compute-free-vars that works as just described — storing the
free variables of each function in the freevars field — so the grader can test it directly. Then write a
new “main part” of the interpreter that expects the sort of muplexpression that compute-free-vars
returns. The case for function definitions is the interesting one.|#

(struct fun-challenge (nameopt formal body freevars) #:transparent) ;; a recursive(?) 1-argument function

(define (compute-free-vars e) ; this needs refactoring
  (cond
    [(var? e) (set (var-string e))]
    [(int? e) (set)]
    [(add? e) (set-union (compute-free-vars (add-e1 e))
                         (compute-free-vars (add-e2 e)))]
    [(isgreater? e) (set-union (compute-free-vars (isgreater-e1 e))
                              (compute-free-vars (isgreater-e2 e)))]
    [(ifnz? e) (set-union (compute-free-vars (ifnz-e1 e))
                          (compute-free-vars (ifnz-e2 e))
                          (compute-free-vars (ifnz-e3 e)))]
    [(fun? e) (let ([nameopt (fun-nameopt e)]
                   [formal (fun-formal e)]
                   [body (fun-body e)])
               (set-remove (compute-free-vars body) formal))]
    [(fun-challenge? e) (fun-challenge-freevars e)]
    [(call? e) (set-union (compute-free-vars (call-funexp e))
                          (compute-free-vars (call-actual e)))]
    [(mlet? e) (set-union (compute-free-vars (mlet-e e))
                          (set-remove (compute-free-vars (mlet-body e)) (mlet-var e)))]
    [(apair? e) (set-union (compute-free-vars (apair-e1 e))
                           (compute-free-vars (apair-e2 e)))]
    [(first? e) (compute-free-vars (first-e e))]
    [(second? e) (compute-free-vars (second-e e))]
    [(munit? e) (set)]
    [(ismunit? e) (compute-free-vars (ismunit-e e))]
    [else (error (format "bad MUPL expression: ~v" e))]))

(define (eval-under-env-c e env)
  (cond
    [(var? e) 
     (envlookup env (var-string e))]
    [(add? e)
     (let ([v1 (eval-under-env (add-e1 e) env)]
           [v2 (eval-under-env (add-e2 e) env)])
       (if (and (int? v1)
                (int? v2))
           (int (+ (int-num v1) 
                   (int-num v2)))
           (error "MUPL addition applied to non-number")))]
    [(isgreater? e)                                           ; isgreater? [isgreatera (e1 e2) -> if e1 > e2 then 1 else 0]
     (let ([v1 (eval-under-env (isgreater-e1 e) env)]
           [v2 (eval-under-env (isgreater-e2 e) env)])
       (if (and (int? v1)
                (int? v2))
           (if (> (int-num v1) (int-num v2))
               (int 1)
               (int 0))
           (error "MUPL isgreater applied to non-number")))]
    [(ifnz? e)                                                ; ifnz? [ifnz (e1 e2 e3) -> if not zero e1 then e2 else e3]
     (let ([v1 (eval-under-env (ifnz-e1 e) env)])
       (if (and (int? v1)
                (not (zero? (int-num v1))))
           (eval-under-env (ifnz-e2 e) env)
           (eval-under-env (ifnz-e3 e) env)))]
    [(fun? e)
     (closure env e)]
    [(call? e)
     (let ([v1 (eval-under-env (call-funexp e) env)]
           [v2 (eval-under-env (call-actual e) env)])
       (if (closure? v1)
           (let ([fun (closure-fun v1)]
                 [env* (cons (cons (closure-fun v1) v2) (closure-env v1))])
             (eval-under-env fun env*))
           (error "MUPL call applied to non-function")))]
    [(mlet? e)
     (let ([v1 (eval-under-env (mlet-e e) env)])
       (eval-under-env (mlet-body e) (cons (cons (mlet-var e) v1) env)))]
    [(apair? e)
     (apair (eval-under-env (apair-e1 e) env)
            (eval-under-env (apair-e2 e) env))]
    [(first? e)
     (let ([v (eval-under-env (first-e e) env)])
       (if (apair? v)
           (first v)
           (error "MUPL first applied to non-pair")))]
    [(second? e)
     (let ([v (eval-under-env (second-e e) env)])
       (if (apair? v)
           (second v)
           (error "MUPL second applied to non-pair")))]
    [(munit? e) (munit)]                                      ; nothing -> nothing lol
    [(ismunit? e)                                             ; ismunit? [ismunit e -> if e1 is unit then 1 else 0]
     (if (ismunit (eval-under-env (ismunit-e e) env))
         (int 1)
         (int 0))]
    [#t (error (format "bad MUPL expression: ~v" e))]
    [(var? e) (envlookup env (var-string e))]
    [(int? e) e]
    [(add? e) (let ([v1 (eval-under-env-c (add-e1 e) env)]
                   [v2 (eval-under-env-c (add-e2 e) env)])
               (if (and (int? v1)
                        (int? v2))
                   (int (+ (int-num v1) (int-num v2)))
                   (error "MUPL addition applied to non-number")))]
    [(fun-challenge? e)
     (closure (set->list (fun-challenge-freevars e)) e)]
    [(call? e)
     (let ([v1 (eval-under-env-c (call-funexp e) env)]
           [v2 (eval-under-env-c (call-actual e) env)])
       (if (closure? v1)
           (let ([fun (closure-fun v1)]
                 [env* (append (map (lambda (var) (cons var (envlookup env var)))
                                   (closure-env v1))
                              env)])
             (eval-under-env-c fun env*))
           (error "MUPL call applied to non-function")))]
    [else (error (format "bad MUPL expression: ~v" e))]))

(define (eval-exp-c e) (eval-under-env-c (compute-free-vars e) null)) ; Do NOT change this