;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "reader.ss" "plai" "lang")
(require mzlib/defmacro)
; Lecture Notes 
; Programming Languages and Types
; 
; Introduction to Monads

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-type FAE
  [num (n number?)]
  [add (lhs FAE?) (rhs FAE?)]
  [with (name symbol?) (named-expr FAE?) (body FAE?)]
  [id (name symbol?)]
  [fun (param symbol?) (body FAE?)]
  [app (fun-expr FAE?) (arg-expr FAE?)])

(define-type FAE-Value
  [numV (n number?)]
  [closureV (param symbol?) (body FAE?) (env Env?)])

(define-type Env
  [emptyEnv]
  [anEnv (name symbol?) (value FAE-Value?) (rest Env?)])

(define (lookup name env)
  (type-case Env env
    [emptyEnv () (error 'lookup "name not found")]
    [anEnv (n value rest)
           (if (symbol=? n name)
               value
               (lookup name rest))]))

; The identity Monad
; M = Identity on Types
; 
; bind: M a -> (a -> M b) -> M b
(define (bind x f)
  (f x))

; return : a -> M a
(define (return x) x)


(define-syntax do
  (syntax-rules (<-)
    ((do expr              ) expr)
    ((do (v <- expr) . rest) (bind expr (lambda (v) (do . rest))))
    ((do expr        . rest) (bind expr (lambda (v) (do . rest)))))) 

; interp: Expr Env -> M Value
(define (interp expr env)
  (type-case FAE expr
    [num (n) (return (numV n))]
;    [add (l r) (bind
;                (interp l env)
;                (lambda (lv)
;                  (bind
;                   (interp r env)
;                   (lambda (rv)
;                     (return (numV (+ (numV-n lv) (numV-n rv))))))))]
    [add (l r) (do
                   (lv <- (interp l env))
                   (rv <- (interp r env))
                   (return (numV (+ (numV-n lv) (numV-n rv)))))]    
    [id (v) (return (lookup v env))]
    [fun (bound-id bound-body) (return (closureV bound-id bound-body env))]
    [with (n e body) (interp (app (fun n body) e) env)]
;    [app (the-fun the-arg) 
;         (bind
;          (interp the-fun env)
;          (lambda (f)
;            (bind
;             (interp the-arg env)
;             (lambda (a)
;               (interp (closureV-body f)
;                       (anEnv
;                        (closureV-param f)
;                        a 
;                        (closureV-env f)))))))]))
    [app (the-fun the-arg) 
         (do
           (f <- (interp the-fun env))
           (a <- (interp the-arg env))
           (interp (closureV-body f)
                   (anEnv
                    (closureV-param f)
                    a
                    (closureV-env f))))]))

; Tests
(define test1 
  (with 'x (num 3)
         (with 'f (fun 'y (add (id 'x) (id 'y)))
               (with 'x (num 5)
                     (app (id 'f) (num 4))))))


(test (interp test1 (emptyEnv)) (numV 7))