11-08-22.rkt

#lang racket

;; How to handle let and let*
(let* ([x 1]
       [y x])
  ((lambda (z) z) y))

(define (prim? s) (member s '(+ - * = equal? list cons car cdr null?)))
(define prim->op (hash '+ + '- - '* * '= = 'equal? equal? 'list list 'cons cons
                       'car car 'cdr cdr 'null? null?))

(define (interp exp env)
  (pretty-print exp)
  (pretty-print env)
  (match exp
    [(? number? n) n]
    [(? boolean? b) b]
    [`(lambda ,xs ,e-body) `(closure ,exp ,env)]
    [(? symbol? x)
     (hash-ref env x)]
    [`(let* () ,e-body)
     (interp e-body env)]
    ;; equivalent to ((lambda (x) e-body) e0)
    [`(let* ([,x ,e0]) ,e-body)
     ;; the "compiler" approach, because I compile and build a synthetic expression
     ;; (interp `((lambda (,x) ,e-body) ,e0) env)
     ;; the "direct" approach
     (define v0 (interp e0 env))
     (define new-env (hash-set env x v0))
     (interp e-body new-env)]
    ;; (let* ([x 5] [z x] [y z]) (+ x (* z y)))
    
    [`(let* ([,xs ,es] ...) ,e-body)
     ;; the "direct" approach
     ;; evaluate each of es, and along the way, accumulate an environment
     ;; finally: use the environment to evaluate e-body
     
     ;; cooks up an environment after evaluating all of the bindings
     (define (h es xs env)
       (match es
         ['() env]
         [`(,e0 ,es ...)
          (h es (rest xs) (hash-set env (first xs) (interp e0 env)))]))
     (define new-env (h es xs env))
     (interp e-body new-env)

     ;; equivalently, we could use this fold (which is the same thing)
     (interp e-body
             (foldl (λ (x e env) (hash-set env x (interp e env)))
                    env
                    xs
                    es))
     
     ;; the "compiler" approach
     ;; translate (let* ([,xs ,es] ...) ,e-body) so that it "peels off" the first
     ;; binding, and translates the rest
     #;(pretty-print `(let ([,(first xs) ,(first es)])
                      (let* ([,(rest xs) ,(rest es)] ...)
                        ,e-body)))
     
     #;(interp `(let ([,(first xs) ,(first es)])
                (let* ([,(rest xs) ,(rest es)] ...)
                  ,e-body))
             env)]
    [''() '()]
    
    ;; builtins
    [`(,(? prim? p) ,e-args ...)
     ;; give me values for all arguments
     (define v-args (map (λ (e) (interp e env)) e-args))
     (apply (hash-ref prim->op p) v-args)]
     
    [`(,ef ,ea ...)
     (define v-f (interp ef env))
     (define v-a (interp ea env))
     (match v-f
       [`(closure (lambda (,x) ,e-body) ,env+)
        (interp e-body (hash-set env+ x v-a))]
       [(? symbol? builtin) 'todo])]))

(interp '(let* ([x 5] [z x] [y z]) (+ y x z)) (hash))


#;(match 
  [`(let* ([,xs ,es] ...) ,e-body)
   (pretty-print xs)
   (pretty-print es)
   (pretty-print e-body)])

#;((plus (λ (f) (λ (x) (f (f x)))))
 ((mult (λ (f) (λ (x) (f (f (f x))))))
  ((plus
    (λ (f) (λ (x) (f (f (f (f x)))))))
   (λ (f) (λ (x) (f x))))))

(define (church->nat n)
  (define (gen n)
    (if (= n 0)
        'x
        'todo))
  `(λ (f) (λ (x) ,(gen n))))

(define (transform-lambda expr)
  (match expr
    [`(lambda ,xs ,e-body) 'todo]))


(define mult (λ (n0)
               (λ (n1)
                 (λ (f) (λ (x) ((n0 (n1 f)) x))))))
(define plus (lambda (n) (lambda (k) 
                           (lambda (f) (lambda (x) ((k f) ((n f) x)))))))
  
(define x
  (((lambda (n) (lambda (k) 
                  (lambda (f) (lambda (x) ((k f) ((n f) x)))))) (λ (f) (λ (x) (f (f x)))))
   (((λ (n0)
       (λ (n1)
         (λ (f) (λ (x) ((n0 (n1 f)) x)))))
     (λ (f) (λ (x) (f (f (f x))))))
    (((lambda (n) (lambda (k) 
                    (lambda (f) (lambda (x) ((k f) ((n f) x))))))
      (λ (f) (λ (x) (f (f (f (f x)))))))
     (λ (f) (λ (x) (f x)))))))


;; 0 = '(λ (f) (λ (x) x))
;; 1 = '(λ (f) (λ (x) (f x)))
;; 2 = '(λ (f) (λ (x) (f (f x))))
(define (nat->church n)
  ;; this generates (f (f ... x))
  (define (gen n)
    (if (= n 0)
        'x
        `(f ,(gen (- n 1)))))
  `(λ (f) (λ (x) ,(gen n))))

;; ‘(λ (x y z) x) → ‘(λ (x) (λ (y) (λ (z) x)))
#;(define (curry-lambda expr)
  (match expr
    ))

(define (church-compile expr)
  (match expr
    [(? number? n) (nat->church n)]
    [(? symbol? x) x]
    [`(lambda () ,e-body) `(lambda (_) ,(church-compile e-body))]
    [`(lambda (,x) ,e-body) `(lambda (,x) ,(church-compile e-body))]
    [`(lambda ,xs ,e-body)
     `(lambda (,(first xs)) ,(church-compile `(lambda ,(rest xs) ,e-body)))]
    [`(,f) ;; I know f will be compiled to something like (lambda (_) e-body)
     ;; ((lambda (_) e-body) (lambda (x) x))
     `(,(church-compile f) (λ (x) x))]
    [`(,e0 ,e1)
     `(,(church-compile e0) ,(church-compile e1))]
    [`(,e0 ,es ...)
     'todo]
    ))