;;--------------------------------------------------------------------------
;;      Solution for hw3
;;
;;      This solution is suggested by  Stefano Lonardi
;;--------------------------------------------------------------------------

;;; (beta-redex?)
;;; in:   a lambda expression in a parsed list pl
;;; out:  #t if pl is a beta-redex

(define beta-redex?
  (lambda (pl)
    (and (eq? (car pl) 'app)
         (eq? (caadr pl) 'lambda))))

;;; (free?)
;;; in:   a parsedlist pl, a variable var
;;; out:  #t if x occurs free in pl

(define free?
  (lambda (pl var)
    (case (car pl)
      ('varref
        (eq? (cadr pl) var))

      ('app
        (or (free? (cadr pl) var)
            (free? (caddr pl) var)))

      ('lambda
        (and (not (eq? (cadr pl) var))
             (free? (caddr pl) var)))

      (else
       #f))))

;;; (substitute)
;;; in:   a parsed expression e, a parsed expression m, a variable x
;;; out:  substitute e[m/x]
;;; note: apply the rules for substitution in EOPL pag.104-105
;;;       The significant case is the 'lambda situation when one
;;;       have to check if the parameter of the lambda expression occurs
;;;       free in m: if so we need two substitution (actually one is an
;;;       an alpha-conversion)


(define substitute
  (lambda (e m x)
    (case (car e)
      ('varref
        (if (eq? (cadr e) x)
          m
          e))
      ('app
        (list 'app
              (substitute (cadr e) m x)
              (substitute (caddr e) m x)))
      ('lambda
        (let ((param (cadr e))
              (body (caddr e))
              (z (gensym)))
          (if (eq? param x)
            e
            (if (free? m param)
              (list 'lambda
                    z
                    (substitute (substitute body (list 'varref z) param) m x))
              (list 'lambda
                    param
                    (substitute body m x))))))
      (else
       e))))


;;; (beta-reduce)
;;; in:   a parsed expression pl (non necessarly a beta-redex)
;;; out:  a cascade of beta-reductions of pl until the "simplest"
;;;       possible form is obtained
;;; note: (infinite loops are possible) If pl is a beta-redex we apply a
;;;       substitution and the resulting lambda-expr is recursively
;;;       beta-reduce(d). Otherwise the function scans the list looking
;;;       (at each nesting level) for beta-redex; if there exists then it apply
;;;       a substitution; again if the resulting expression is a beta-redex
;;;       a new substitution is applied.

(define beta-reduce
  (lambda (pl)
    (if (null? pl)
      '()
      (if (list? pl)
        (if (beta-redex? pl)
          (let ((lambda-expr (cadr pl))
                (rand (caddr pl)))
            (let ((param (cadr lambda-expr))
                  (body (caddr lambda-expr)))
              (beta-reduce (substitute body rand param))))
          (let ((reduced-list (cons (beta-reduce (car pl))
                                    (beta-reduce (cdr pl)))))
            (if (beta-redex? reduced-list)
              (beta-reduce reduced-list)
              reduced-list)))
        pl))))


;;; (eta-redex?)
;;; in:   a parsed lambda expression pl
;;; out:  #t if pl is an eta-redex,
;;;       that is (lambda (x) (app <function> (varref x)))
;;;       where x is bound in E

(define eta-redex?
  (lambda (pl)
    (and (eq? (car pl) 'lambda)
         (let ((param (cadr pl))
               (body (caddr pl)))
           (and (eq? (car body) 'app)
                (equal? (caddr body)
                        (list 'varref param))
                (not (free? (cadr body) param)))))))

;;; (eta-redex?)
;;; in:   a parsed lambda expression pl
;;; out:  #t if pl is an eta-redex,
;;;       that is (lambda (x) (app <function> (varref x)))
;;;       where x is bound in E

(define eta-reduce
  (lambda (pl)
    (if (null? pl)
      '()
      (if (list? pl)
        (if (eta-redex? pl)
          (eta-reduce (car (cdaddr pl)))
          (let ((reduced-list (cons (eta-reduce (car pl))
                                    (eta-reduce (cdr pl)))))
            (if (eta-redex? reduced-list)
              (eta-reduce reduced-list)
              reduced-list)))
        pl))))



;;==========================================================================
;;--------------------------------------------------------------------------
;;      Solution for hw3
;;
;;      This solution is suggested by Aria Prima Novianto
;;--------------------------------------------------------------------------

;;
;; (beta-redex? exp) takes a parsed lambda calculus expression and
;; indicates whether it is a beta-redex.
;; beta-redex = ((lambda (var) exp) rand)
;;

(define beta-redex?
  (lambda (exp)
    (and (app? exp)
         (lambda? (app->rator exp)))))
;;
;; (has-beta-redex? exp) takes a parsed lambda calculus expression and
;; indicates whether it contains 1 or more beta-redex's.
;; beta-redex = ((lambda (var) exp) rand)
;; used by beta-reduce
;;

(define has-beta-redex?
  (lambda (exp)
    (if (beta-redex? exp)
        #t
        (if (app? exp)
            (or (has-beta-redex? (app->rator exp))
                (has-beta-redex? (app->rand exp)))
            (if (lambda? exp)
                (has-beta-redex? (lambda->body exp))
                #f)))))

;;
;; (substitute e m x) takes two expressions e and m, and a variable x,
;; and returns e[m/x].
;;
(define substitute
  (lambda (e m x)
    (record-case e
      (varref (var)
        (if (eq? x (varref->var e)) m e))
      (app (rator rand)
        (make-app (substitute (app->rator e) m x)
                  (substitute (app->rand e) m x)))
      (lambda (formal body)
        (let ((y  (lambda->formal e))
              (e1 (lambda->body e)))
          (if (eq? y x)
              e
              (if (free? x e1)
                  (if (free? y m)
                      (let ((z (gensym)))
                        (make-lambda
                         z (substitute (substitute e1 (parse z) y) m x)))
                      (make-lambda y (substitute e1 m x)))
                  e)))))))

;;
;; (free v exp) takes variable v and expression exp, and indicates
;; whether v is a free variable in exp
;;
(define free?
  (lambda (v exp)
    (record-case exp
      (varref (var)
        (if (eq? (varref->var exp) v) #t #f))
      (app (rator rand)
        (or (free? v (app->rator exp)) (free? v (app->rand exp))))
      (lambda(formal body)
        (if (eq? (lambda->formal exp) v)
            #f
            (free? v (lambda->body exp)))))))


;;
;; (beta-reduce exp) takes a parsed beta-redex and returns the result of
;; applying the beta-reduction rule
;; Additional properties: reduction is done recursively until
;; the simplest form is found.
;; if exp is not beta-redex, check whether exp contains beta-redex, and
;; then returns that the exp with beta-redex(s) inside it reduced.
;;
(define beta-reduce
  (lambda (exp)
    (if (beta-redex? exp)
        (let ((x (lambda->formal (app->rator exp)))
              (e (lambda->body (app->rator exp)))
              (m (app->rand exp)))
          (beta-reduce (substitute e m x)))
        (if (has-beta-redex? exp)
            (if (app? exp)
                (beta-reduce (make-app (beta-reduce (app->rator exp))
                                       (beta-reduce (app->rand exp))))
                (beta-reduce (make-lambda (lambda->formal exp)
                                          (beta-reduce (lambda->body exp)))))
            exp))))

;;
;; (eta-redex? exp) takes a parsed lambda calculus expression and
;; indicates whether it is an eta-redex.
;; eta-redex = (lambda (x) (E x))
;; where E denotes a function of one variable nad x does not occur free in E

(define eta-redex?
  (lambda (exp)
    (and (lambda? exp)
         (app? (lambda->body exp))
         (varref? (app->rand (lambda->body exp)))
         (eq? (varref->var (app->rand (lambda->body exp))) (lambda->formal exp))
         (not (free? (lambda->formal exp) (app->rator (lambda->body exp)))))))

;;
;; (has-eta-redex? exp) takes a parsed lambda calculus expression and
;; indicates whether it contains 1 or more eta-redex's.
;; eta-redex = (lambda (x) (E x))
;; where E denotes a function of one variable nad x does not occur free in E
;;

(define has-eta-redex?
  (lambda (exp)
    (if (eta-redex? exp)
        #t
        (if (app? exp)
            (or (has-eta-redex? (app->rator exp))
                (has-eta-redex? (app->rand exp)))
            (if (lambda? exp)
                (has-eta-redex? (lambda->body exp))
                #f)))))


;;
;; (free v exp) takes variable v and expression exp, and indicates
;; whether v is a free variable in exp
;;
(define free?
  (lambda (v exp)
    (record-case exp
      (varref (var)
        (if (eq? (varref->var exp) v) #t #f))
      (app (rator rand)
        (or (free? v (app->rator exp)) (free? v (app->rand exp))))
      (lambda(formal body)
        (if (eq? (lambda->formal exp) v)
            #f
            (free? v (lambda->body exp)))))))

;;
;; (eta-reduce exp) takes a parsed eta-redex and returns the result of
;; applying the eta-reduction rule
;; Additional properties: reduction is done recursively until
;; the simplest form is found.
;; if exp is not eta-redex, check whether exp contains eta-redex, and
;; then returns that the exp with eta-redex(s) inside it reduced.
;;
(define eta-reduce
  (lambda (exp)
    (if (eta-redex? exp)
        (eta-reduce (app->rator (lambda->body exp)))
        (if (has-eta-redex? exp)
            (if (app? exp)
                (eta-reduce (make-app (eta-reduce (app->rator exp))
                                      (eta-reduce (app->rand exp))))
                (eta-reduce (make-lambda (lambda->formal exp)
                                         (eta-reduce (lambda->body exp)))))
            exp))))