A Made Up Programming Language__一个小型Interpreter

本文来源于UW的 PL,part B Assignment 5
原文件已上传到GitHub: 点这里

Mupl brief introduction

mupl (a Made Up Programming Language),是一个用racket编写interpreter,解释执行的mini-functional-language。
使用scheme的cons principle构建了简单的closure系统，支持procedure curry,map,curry等函数式特性。
它的关键字如下：

• If s is a Racket string, then (var s) is a mupl expression (a variable use).
• If n is a Racket integer, then (int n) is a mupl expression (a constant).
• If e1 and e2 are mupl expressions, then (add e1 e2) is a mupl expression (an addition).
• If s1 and s2 are Racket strings and e is a mupl expression, then (fun s1 s2 e) is a mupl expression (a
function). In e, s1 is bound to the function itself (for recursion) and s2 is bound to the (one) argument.
Also, (fun #f s2 e) is allowed for anonymous nonrecursive functions.
• If e1, e2, and e3, and e4 are mupl expressions, then (ifgreater e1 e2 e3 e4) is a mupl expression.
It is a conditional where the result is e3 if e1 is strictly greater than e2 else the result is e4. Only one
of e3 and e4 is evaluated.
• If e1 and e2 are mupl expressions, then (call e1 e2) is a mupl expression (a function call).
• If s is a Racket string and e1 and e2 are mupl expressions, then (mlet s e1 e2) is a mupl expression
(a let expression where the value resulting e1 is bound to s in the evaluation of e2).
• If e1 and e2 are mupl expressions, then (apair e1 e2) is a mupl expression (a pair-creator).
• If e1 is a mupl expression, then (fst e1) is a mupl expression (getting the first part of a pair).
• If e1 is a mupl expression, then (snd e1) is a mupl expression (getting the second part of a pair).
• (aunit) is a mupl expression (holding no data, much like () in ML or null in Racket). Notice
(aunit) is a mupl expression, but aunit is not.
• If e1 is a mupl expression, then (isaunit e1) is a mupl expression (testing for (aunit)).
• (closure env f) is a mupl value where f is mupl function (an expression made from fun) and env
is an environment mapping variables to values. Closures do not appear in source programs; they result
from evaluating functions.

我们可以这样使用它：

(eval-exp (ifgreater (int 3) (int 4) (int 3) (int 2)))				;;get (int 2)
(mlet "x" (int 1) (add (int 5) (var "x")))) 						;;get (int 6)
(snd (apair (int 1) (int 2))))  									;;get (int 2)
(call (closure '() (fun #f "x" (add (var "x") (int 7)))) (int 1))) 	;;get (int 8)
(isaunit (closure '() (fun #f "x" (aunit))))) 						;;get (int 0)
(mlet* (list (cons "x" (int 10))) (var "x"))) 						;;get (int 10)

Warm-Up

MUPL结构定义如下：
相比于define，struct风格更加良好，能够更加精确定义数据。自带get() set()，能够隐藏构造函数来强制invariants.

(struct var  (string) #:transparent)  ;; a variable, e.g., (var "foo")
(struct int  (num)    #:transparent)  ;; a constant number, e.g., (int 17)
(struct add  (e1 e2)  #:transparent)  ;; add two expressions
(struct ifgreater (e1 e2 e3 e4)    #:transparent) ;; if e1 > e2 then e3 else e4
(struct fun  (nameopt formal body) #:transparent) ;; a recursive(?) 1-argument function
(struct call (funexp actual)       #:transparent) ;; function call
(struct mlet (var e body) #:transparent) ;; a local binding (let var = e in body) 
(struct apair (e1 e2)     #:transparent) ;; make a new pair
(struct fst  (e)    #:transparent) ;; get first part of a pair
(struct snd  (e)    #:transparent) ;; get second part of a pair
(struct aunit ()    #:transparent) ;; unit value -- good for ending a list
(struct isaunit (e) #:transparent) ;; evaluate to 1 if e is unit else 0
(struct closure (env fun) #:transparent) 

根据racket list构造mupllist

Similar to Racket, we can build list values out of nested pair values that end with a mupl aunit. Such a
mupl value is called a mupl list

跟scheme一样，mupl的list也是嵌套的pair，以null结尾

(define (racketlist->mupllist rst)
  (if (null? rst)
      (aunit)
      (apair (car rst) (racketlist->mupllist (cdr rst)))))

反过来同理，我们用struct apair定义后的component apair-e1和apair-e2来完成构造

(define (mupllist->racketlist pst)
  (cond [(aunit? pst) null]
        [(apair? pst) (cons (apair-e1 mplst) (mupllist->racketlist (apair-e2 mplst)))]))

Implementing the mupl Language

envlookup，用于查找environment中的variable

(define (envlookup env str)
  (cond [(null? env) (error "unbound variable during evaluation" str)]
        [(equal? (car (car env)) str) (cdr (car env))]
        [#t (envlookup (cdr env) str)]))

eval-under-env,它接受一个表达式e，并返回e在空环境下计算得到的mul value，或者在求值遇到运行时类型错误或未绑定的变量时调用Racket 's error.
规则如下：

• All values (including closures) evaluate to themselves. For example, (eval-exp (int 17)) would
return (int 17), not 17.
• A variable evaluates to the value associated with it in the environment.
• An addition evaluates its subexpressions and assuming they both produce integers, produces the
integer that is their sum. (Note this case is done for you to get you pointed in the right direction.)
• Functions are lexically scoped: A function evaluates to a closure holding the function and the
current environment.
• An ifgreater evaluates its first two subexpressions to values v1 and v2 respectively. If both
values are integers, it evaluates its third subexpression if v1 is a strictly greater integer than v2
else it evaluates its fourth subexpression.
• An mlet expression evaluates its first expression to a value v. Then it evaluates the second
expression to a value, in an environment extended to map the name in the mlet expression to v.
• A call evaluates its first and second subexpressions to values. If the first is not a closure, it is an
error. Else, it evaluates the closure’s function’s body in the closure’s environment extended to map
the function’s name to the closure (unless the name field is #f) and the function’s argument-name
(i.e., the parameter name) to the result of the second subexpression.
• A pair expression evaluates its two subexpressions and produces a (new) pair holding the results.
• A fst expression evaluates its subexpression. If the result for the subexpression is a pair, then the
result for the fst expression is the e1 field in the pair.
• A snd expression evaluates its subexpression. If the result for the subexpression is a pair, then
the result for the snd expression is the e2 field in the pair.
• An isaunit expression evaluates its subexpression. If the result is an aunit expression, then the
result for the isaunit expression is the mupl value (int 1), else the result is the mupl value
(int 0).

实现：

(define (eval-under-env e env)
  (cond [(var? e) 
         (envlookup env (var-string e))]
        [(int? e) e]
        [(add? e) 
         (let ([v1 (eval-under-env (add-e1 e) env)]
               [v2 (eval-under-env (add-e2 e) env)])
           (if (and (int? v1)
                    (int? v2))
               (int (+ (int-num v1) 
                       (int-num v2)))
               (error "MUPL addition applied to non-number")))]
        [(ifgreater? e)
         (let ([v1 (eval-under-env (ifgreater-e1 e) env)]
                [v2 (eval-under-env (ifgreater-e2 e) env)])
               (if (and (int? v1) (int? v2))
                   (if (> (int-num v1) (int-num v2))
                       (eval-under-env (ifgreater-e3 e) env)
                       (eval-under-env (ifgreater-e4 e) env))
                   (error "greater applied to non-number")))]
        [(fun? e) (closure env e)]
        [(closure? e) e]
        [(call? e)
         (let ([fc (eval-under-env (call-funexp e) env)])
           (if (closure? fc)
               (let ([argval (eval-under-env (call-actual e) env)]
                     [fucname (fun-nameopt (closure-fun fc))]
                     [argname (fun-formal  (closure-fun fc))]
                     [fucexpr (fun-body    (closure-fun fc))])
                 (if (string? fucname)
                     (eval-under-env fucexpr (cons (cons fucname fc) 
                                                           (cons (cons argname argval) (closure-env fc))))
                     (eval-under-env fucexpr (cons (cons argname argval) (closure-env fc))))) 
               (error "call first arg applied to non-closure")))]
        [(mlet? e)
         (if (string? (mlet-var e))
             (let ([str (mlet-var e)]
                   [val (eval-under-env (mlet-e e) env)])
               (eval-under-env (mlet-body e) (cons(cons str val ) env)))
             (error "mlet first arg applied to non-string"))]
        [(apair? e)
         (apair (eval-under-env (apair-e1 e) env)
                (eval-under-env (apair-e2 e) env))]
        [(fst? e)
         (let ([v (eval-under-env (fst-e e) env)])
           (if (apair? v)
               (apair-e1 v)
               (error "pair applied to non-pair")))]
        [(snd? e)
         (let ([v (eval-under-env (fst-e e) env)])
           (if (apair? v)
               (apair-e2 v)
               (error "pair applied to non-pair")))]
        [(isaunit? e)
           (if (aunit? (eval-under-env (isaunit-e e) env)) (int 1) (int 0))]
        [(aunit? e) (aunit)]
        [#t (error (format "bad MUPL expression: ~v" e))]))
        
(define (eval-exp e)
  (eval-under-env e null))

对于不太熟悉scheme的人来说，看懂call过程比较需要想象力。它实际上将recursive procedure和funcname，argname和argval与env进行pack，传给下一层curry。
construction process abstraction 和 construction data abstraction在这里实现了完美的交融，真正的magic！

Expanding the Language

这个部分写一些类似于mupl macros的syntactic sugar扩展语言。

(a) Write a Racket function ifaunit that takes three mupl expressions e1, e2, and e3. It returns a
mupl expression that when run evaluates e1 and if the result is mupl’s aunit then it evaluates e2
and that is the overall result, else it evaluates e3 and that is the overall result. Sample solution:
1 line.
(b) Write a Racket function mlet* that takes a Racket list of Racket pairs ’((s1 . e1) . . . (si . ei)
. . . (sn . en)) and a final mupl expression en+1. In each pair, assume si is a Racket string and
ei is a mupl expression. mlet* returns a mupl expression whose value is en+1 evaluated in an
environment where each si is a variable bound to the result of evaluating the corresponding ei
for 1 ≤ i ≤ n. The bindings are done sequentially, so that each ei is evaluated in an environment
where s1 through si−1 have been previously bound to the values e1 through ei−1.
( c ) Write a Racket function ifeq that takes four mupl expressions e1, e2, e3, and e4 and returns
a mupl expression that acts like ifgreater except e3 is evaluated if and only if e1 and e2 are
equal integers. Assume none of the arguments to ifeq use the mupl variables _x or _y. Use this
assumption so that when an expression returned from ifeq is evaluated, e1 and e2 are evaluated
exactly once each.

(define (ifaunit e1 e2 e3) 
         (ifgreater (isaunit e1) (int 0) e2 e3))

(define (mlet* lstlst e2)
  (if (null? lstlst)
      e2
      (mlet (car (car lstlst)) (cdr (car lstlst)) (mlet* (cdr lstlst) e2))))

(define (ifeq e1 e2 e3 e4)
  (mlet "_x" e1 
        (mlet "_y" e2 
            (ifgreater (var "_x") (var "_y") e4 (ifgreater (var "_y") (var "_x") e4 e3)))))

从这里我们可以看出来，mlet实际上是用str表示val给env添加约束.

Using the Language

(a) Bind to the Racket variable mupl-map a mupl function that acts like map (as we used extensively
in ML). Your function should be curried: it should take a mupl function and return a mupl
function that takes a mupl list and applies the function to every element of the list returning a
new mupl list. Recall a mupl list is aunit or a pair where the second component is a mupl list.
(b) Bind to the Racket variable mupl-mapAddN a mupl function that takes an mupl integer i and
returns a mupl function that takes a mupl list of mupl integers and returns a new mupl list of
mupl integers that adds i to every element of the list. Use mupl-map (a use of mlet is given to
you to make this easier)

;;外层包装一个匿名函数，封装给内层调用
(define mupl-map
    (fun #f "f" 
        (fun "calc" "lst" 
            (ifaunit (var "lst")
                (aunit)
                (apair (call (var "f") (fst (var "lst"))) (call (var "calc") (snd (var "lst"))))))))

(define mupl-mapAddN
    (fun #f "y"
        (call mupl-map (fun #f "x" (add (var "x") (var "y"))))))