#lang plait

;; Start with "object.rkt"

;; Make `{get <expr> m}` call the method `m` on the object
;; produced by <expr> if that object doesn't have an `m` field.
;; Provide 0 as the argument to the method.

(define-type Exp
  (numE [n : Number])
  (plusE [lhs : Exp]
         [rhs : Exp])
  (multE [lhs : Exp]
         [rhs : Exp])
  (argE)
  (thisE)
  (objectE [fields : (Listof (Symbol * Exp))]
           [methods : (Listof (Symbol * Exp))])
  (getE [obj-expr : Exp]
        [field-name : Symbol])
  (sendE [obj-expr : Exp]
         [method-name : Symbol]
         [arg-expr : Exp]))

(define-type Value
  (numV [n : Number])
  (objV [fields : (Listof (Symbol * Value))]
        [methods : (Listof (Symbol * Exp))]))

(module+ test
  (print-only-errors #t))

;; ----------------------------------------

(define (find [l : (Listof (Symbol * 'a))] [name : Symbol]) : 'a
  (type-case (Listof (Symbol * 'a)) l
    [empty
     (error 'find (string-append "not found: " (symbol->string name)))]
    [(cons p rst-l)
     (if (symbol=? (fst p) name)
         (snd p)
         (find rst-l name))]))

(module+ test
  (test (find (list (values 'a 1)) 'a)
        1)
  (test (find (list (values 'a 1) (values 'b 2)) 'b)
        2)
  (test/exn (find empty 'a)
            "not found: a")
  (test/exn (find (list (values 'a 1)) 'x)
            "not found: x"))

;; ----------------------------------------

(define interp : (Exp Value Value -> Value)
  (lambda (a this-val arg-val)
    (type-case Exp a
      [(numE n) (numV n)]
      [(plusE l r) (num+ (interp l this-val arg-val) 
                         (interp r this-val arg-val))]
      [(multE l r) (num* (interp l this-val arg-val) 
                         (interp r this-val arg-val))]
      [(thisE) this-val]
      [(argE) arg-val]
      [(objectE fields methods)
       (objV (map (lambda (f)
                    (let ([name (fst f)]
                          [exp (snd f)])
                      (values name (interp exp this-val arg-val))))
                  fields)
             methods)]
      [(getE obj-expr field-name)
       (let ([object (interp obj-expr this-val arg-val)])
         (type-case Value object
           [(objV fields methods)
            (try (find fields field-name)
                 (lambda () (interp (find methods field-name) object (numV 0))))]
           [else (error 'interp "not an object")]))]
      [(sendE obj-expr method-name arg-expr)
       (local [(define obj (interp obj-expr this-val arg-val))
               (define next-arg-val (interp arg-expr this-val arg-val))]
         (type-case Value obj
           [(objV fields methods)
            (let ([body-expr (find methods method-name)])
              (interp body-expr
                      obj
                      next-arg-val))]
           [else (error 'interp "not an object")]))])))

(define (num-op [op : (Number Number -> Number)]
                [op-name : Symbol] 
                [x : Value]
                [y : Value]) : Value
  (cond
    [(and (numV? x) (numV? y))
     (numV (op (numV-n x) (numV-n y)))]
    [else (error 'interp "not a number")]))

(define (num+ x y) (num-op + '+ x y))
(define (num* x y) (num-op * '* x y))

;; ----------------------------------------
;; Examples

(module+ test
  (define posn27
    (objectE
     (list (values 'x (numE 2))
           (values 'y (numE 7)))
     (list (values 'mdist
                   (plusE (getE (thisE) 'x) (getE (thisE) 'y)))
           (values 'addX
                   (plusE (getE (thisE) 'x) (argE)))
           (values 'multY (multE (argE) (getE (thisE) 'y))))))

  (define posn531
    (objectE
     (list (values 'x (numE 5))
           (values 'y (numE 3))
           (values 'z (numE 1)))
     (list (values 'mdist (plusE (getE (thisE) 'z)
                                 (plusE (getE (thisE) 'x) (getE (thisE) 'y))))))))

;; ----------------------------------------

(module+ test
  (test (interp (numE 10) 
                (objV empty empty) (numV 0))
        (numV 10))
  (test (interp (plusE (numE 10) (numE 17))
                (objV empty empty) (numV 0))
        (numV 27))
  (test (interp (multE (numE 10) (numE 7))
                (objV empty empty) (numV 0))
        (numV 70))
  (test (interp (objectE (list (values 'a (numE 1))
                               (values 'b (numE 2)))
                         (list (values 'm (numE 0))))
                (objV empty empty) (numV 0))
        (objV (list (values 'a (numV 1))
                    (values 'b (numV 2)))
              (list (values 'm (numE 0)))))
  
  (test (interp (sendE posn27 'mdist (numE 0))
                (objV empty empty) (numV 0))
        (numV 9))
  
  (test (interp (sendE posn27 'addX (numE 10))
                (objV empty empty) (numV 0))
        (numV 12))
  
  (test/exn (interp (plusE (numE 1) (objectE empty empty))
                    (objV empty empty) (numV 0))
            "not a number")
  (test/exn (interp (getE (numE 1) 'x)
                    (objV empty empty) (numV 0))
            "not an object")
  (test/exn (interp (sendE (numE 1) 'mdist (numE 0))
                    (objV empty empty) (numV 0))
            "not an object")
  (test (interp (getE (objectE empty (list (values 'a (numE 3))))
                      'a)
                (objV empty empty)
                (numV 0))
        (numV 3))
  
  (test (interp (getE (objectE (list (values 'b (numE 2)))
                               (list (values 'a
                                             (plusE (getE (thisE) 'b)
                                                    (argE)))))
                      'a)
                (objV empty empty)
                (numV 1))
        (numV 2)))