pene

#lang plai

(require "grammars.rkt")
(require "parser.rkt")

(define (interp expr env)
    (match expr
        [(id i) (lookup i env)]
        [(num n) (numV n)]
        [(binop op izq der)
            (let ([lhs (interp izq env)] [rhs (interp der env)])
                (cond
                    [(exceptionV? lhs) lhs]
                    [(exceptionV? rhs) rhs]
                    [else (numV (op (numV-n lhs) (numV-n rhs)))]))]
        [(if0 test-expr then-expr else-expr)
            (let ([cnd (interp test-expr env)])
                 (if (exceptionV? cnd)
                     cnd
                     (if (zero? (numV-n cnd))
                         (interp then-expr env)
                         (interp else-expr env))))]
        [(rec id value body)
            (interp body (cyclically-bind-and-interp id value env))]
        [(throws exception-id)
            (let/cc k (exceptionV exception-id k))]
        [(try/catch catched-exception-id fail-expr try-expr)
            (let ([expr-val (interp try-expr env)])
                (if (and (exceptionV? expr-val) (equal? (exceptionV-exception-id expr-val) catched-exception-id))
                    ((exceptionV-continuation expr-val) (interp fail-expr env))
                    expr-val))]
        [(fun param body)
            (closureV param body env)]
        [(app fun-expr arg)
            (let ([fun-val (interp fun-expr env)])
                (if (exceptionV? fun-val)
                    fun-val
                    (interp
                        (closureV-body fun-val)
                        (aSub
                            (closureV-param fun-val)
                            (interp arg env)
                            (closureV-env fun-val)))))]))

(define (lookup id env)
    (match env
        [(mtSub) (error 'lookup "Free identifier")]
        [(aSub sub-id value rest-env)
            (if (symbol=? id sub-id)
                value
                (lookup id rest-env))]
        [(aRecSub sub-id value rest-env)
            (if (symbol=? id sub-id)
                (unbox value)
                (lookup id rest-env))]))

(define (cyclically-bind-and-interp id value env)
    (let* ([value-holder (box (numV 1729))]
           [new-env (aRecSub id value-holder env)]
           [named-expr-val (interp value new-env)])
        (begin
            (set-box! value-holder named-expr-val)
            new-env)))