programming-languages学习

programming-languages学习

programming-languages学习

1 最简单的算术表达式解析

实现加减表达式,最原始版本:

(ns my.eval1)
(defn Const [i] (list :Const i))
(defn Negate [e] (list :Negate e))
(defn Add [e1 e2] (list :Add e1 e2))
(defn Multiply [e1 e2] (list :Multiply e1 e2))

(defn Const? [x] (= (first x) :Const))
(defn Negate? [x] (= (first x) :Negate))
(defn Add? [x] (= (first x) :Add))
(defn Multiply? [x] (= (first x) :Multiply))

(defn Const-int [e] (first (rest e)))
(defn Negate-e [e] (first (rest e)))
(defn Add-e1 [e] (first (rest e)))
(defn Add-e2 [e] (first (rest (rest e))))
(defn Multiply-e1 [e] (first (rest e)))
(defn Multiply-e2 [e] (first (rest (rest e))))

(defn eval-exp
  [e]
  (cond
    (Const? e) e
    (Negate? e) (Const (- (Const-int (eval-exp (Negate-e e)))))
    (Add? e) (let [v1 (Const-int (eval-exp (Add-e1 e)))
                   v2 (Const-int (eval-exp (Add-e2 e)))]
               (Const (+ v1 v2)))
    (Multiply? e) (let [v1 (Const-int (eval-exp (Multiply-e1 e)))
                        v2 (Const-int (eval-exp (Multiply-e2 e)))]
                    (Const (* v1 v2)))
    :else (throw (Exception. "eval-exp expected an exp"))))

(eval-exp (Add (Const 9) (Const 1)))
(:Const 10)

使用map方式实现:

(ns my.eval2)
(defn const [val] {:type ::const :val val})
(defn negate [e] {:type ::negate :e e})
(defn add [e1 e2] {:type ::add :e1 e1 :e2 e2})
(defn multiply [e1 e2] {:type ::multiply :e1 e1 :e2 e2})

(defn eval-exp [e]
  (case (:type e)
    ::const e
    ::negate (const (- (:val (eval-exp (:e e)))))
    ::add (const (let [v1 (:val (eval-exp (:e1 e)))
                       v2 (:val (eval-exp (:e2 e)))]
                   (+ v1 v2)))
    ::multiply (const (let [v1 (:val (eval-exp (:e1 e)))
                            v2 (:val (eval-exp (:e2 e)))]
                        (* v1 v2)))
    (throw (Exception. "eval-exp expected an exp"))))

(eval-exp (multiply (const 8) (negate (const 2))))
{:type :my.eval2/const, :val -16}

使用multi method实现,更大的灵活性:

(ns my.eval3)
(defn const [val] {:type ::const :val val})
(defn negate [e] {:type ::negate :e e})
(defn add [e1 e2] {:type ::add :e1 e1 :e2 e2})
(defn multiply [e1 e2] {:type ::multiply :e1 e1 :e2 e2})

(defmulti my-eval :type)
(defmethod my-eval ::const [e] e)
(defmethod my-eval ::negate [{:keys [e]}]
  (const (- (:val (my-eval e)))))
(defmethod my-eval ::add [{:keys [e1 e2]}]
  (const (+ (:val (my-eval e1))
            (:val (my-eval e2)))))
(defmethod my-eval ::multiply [{:keys [e1 e2]}]
  (const (* (:val (my-eval e1))
            (:val (my-eval e2)))))
(defmethod my-eval :default [_]
  (throw (Exception. "eval-exp expected an exp")))

(my-eval (multiply (const 8) (negate (const 3))))
{:type :my.eval3/const, :val -24}

使用record实现:

(ns my.eval4)

(defprotocol Evalable
  (my-eval2 [e]))

(defrecord Const [val]
  Evalable
  (my-eval2 [e] e))

(defrecord Negate [e]
  Evalable
  (my-eval2 [e] (Const. (- (:val (my-eval2 (:e e)))))))

(defrecord Add [e1 e2]
  Evalable
  (my-eval2 [e] (Const. (+ (:val (my-eval2 (:e1 e)))
                          (:val (my-eval2 (:e2 e)))))))

(defrecord Multiply [e1 e2]
  Evalable
  (my-eval2 [e] (Const. (* (:val (my-eval2 (:e1 e)))
                          (:val (my-eval2 (:e2 e)))))))

(extend-type Object
  Evalable
  (my-eval2 [_] (throw (Exception. "eval-exp expected an exp"))))

(prn (my-eval2 (Add. (Const. 9) (Negate. (Const. 3)))))
#my.eval4.Const{:val 6}
nil

2 实现MUPL语言

支持变量,函数

  1: (ns my.lang
  2:   (:refer-clojure :exclude [int int?]))
  3: ;; 这里用到int,和clojure库中的同名,有冲突,要排除掉
  4: ;; 另外var是clojure的special form,无法覆盖,只能换个名字。
  5: 
  6: (defn variable [key] {:type ::var :key key})
  7: (defn variable? [e] (= ::var (:type e)))
  8: (defn variable-name [e] (:key e))
  9: 
 10: (defn int [num] {:type ::int :num num})
 11: (defn int? [e] (= ::int (:type e)))
 12: (defn int-v [e] (:num e))
 13: 
 14: (defn add [e1 e2] {:type ::add :e1 e1 :e2 e2})
 15: (defn add? [e] (= ::add (:type e)))
 16: (defn add-e1 [e] (:e1 e))
 17: (defn add-e2 [e] (:e2 e))
 18: 
 19: (defn ifgreater [e1 e2 e3 e4] {:type ::ifgreater :e1 e1 :e2 e2
 20:                                :e3 e3 :e4 e4})
 21: (defn ifgreater? [e] (= ::ifgreater (:type e)))
 22: (defn ifgreater-e1 [e] = (:e1 e))
 23: (defn ifgreater-e2 [e] = (:e2 e))
 24: (defn ifgreater-e3 [e] = (:e3 e))
 25: (defn ifgreater-e4 [e] = (:e4 e))
 26: 
 27: ;; nameopt为可选的函数名,用于实现递归, formal为单个函数参数
 28: (defn fun [nameopt formal body] {:type ::fun :nameopt nameopt
 29:                                  :formal formal :body body})
 30: (defn fun? [e] (= ::fun(:type e)))
 31: (defn fun-name [e] (:nameopt e))
 32: (defn fun-arg [e] (:formal e))
 33: (defn fun-body [e] (:body e))
 34: 
 35: ;; function call, funexp为闭包, actual为实参
 36: (defn call [funexp actual] {:type ::call :funexp funexp
 37:                             :actual actual})
 38: (defn call? [e] (= ::call (:type e)))
 39: (defn call-fun [e] (:funexp e))
 40: (defn call-arg [e] (:actual e))         ;实参
 41: 
 42: ;; local binding
 43: (defn mlet [variable e body] {:type ::mlet :variable variable
 44:                          :e e :body body})
 45: (defn mlet? [e] (= ::mlet (:type e)))
 46: (defn mlet-var [e] (:variable e))
 47: (defn mlet-e [e] (:e e))
 48: (defn mlet-body [e] (:body e))
 49: 
 50: ;; pair
 51: (defn apair [e1 e2] {:type ::apair :e1 e1 :e2 e2})
 52: (defn apair? [e] (= ::apair (:type e)))
 53: (defn apair-l [e] (:e1 e))
 54: (defn apair-r [e] (:e2 e))
 55: 
 56: (defn fst [e] {:type ::fst :e e})
 57: (defn fst? [e] (= ::fst (:type e)))
 58: (defn fst-e [e] (:e e))
 59: 
 60: (defn snd [e] {:type ::snd :e e})
 61: (defn snd? [e] (= ::snd (:type e)))
 62: (defn snd-e [e] (:e e))
 63: 
 64: ;; null
 65: (defn aunit [] {:type ::aunit})
 66: (defn aunit? [e] (= ::aunit (:type e)))
 67: 
 68: (defn isaunit [e] {:type ::isaunit :e e})
 69: (defn isaunit? [e] (= ::isaunit (:type e)))
 70: (defn isaunit-e [e] (:e e))
 71: 
 72: ;; closure,用于表示函数的内部实现。
 73: (defn closure [env fun] {:type ::closure :env env :fun fun})
 74: (defn closure? [e] (= ::closure (:type e)))
 75: (defn closure-env [e] (:env e))
 76: (defn closure-fun [e] (:fun e))
 77: 
 78: (defn vec->mupllist
 79:   [xs]
 80:   (reduce #(apair %2 %1) (aunit) (rseq xs)))
 81: (vec->mupllist [(int 1) (int 2) (int 3)])
 82: ;; => {:type :my.lang/apair,
 83: ;;     :e1 {:type :my.lang/int, :num 1},
 84: ;;     :e2
 85: ;;     {:type :my.lang/apair,
 86: ;;      :e1 {:type :my.lang/int, :num 2},
 87: ;;      :e2
 88: ;;      {:type :my.lang/apair,
 89: ;;       :e1 {:type :my.lang/int, :num 3},
 90: ;;       :e2 {:type :my.lang/aunit}}}}
 91: 
 92: (defn mupllist->vec
 93:   [e]
 94:   (cond
 95:     (apair? e)(conj (mupllist->vec (apair-r e)) (apair-l e))
 96:     (aunit? e) '()     ;用loop 累加可以用vector,效率高,递归用list头部添加效率高
 97:     :else (throw (Exception. "mupllist->vec not a valid mupl list"))))
 98: 
 99: (defn lookup-env-val
100:   "从环境中获得变量值,返回nil表示不存在此变量"
101:   [env key]
102:   (env key))
103: 
104: (defn define-var
105:   "定义一个变量,返回新的环境"
106:   [var value env]
107:   (assoc env var value))
108: 
109: ;; set同define语义不同,但由于环境是不可变的,实现相同
110: (def set-var "设置一个变量,并返回新的环境" define-var)
111: 
112: (defn eval-under-env
113:   [e env]
114:   (cond
115:     (int? e) e
116:     (aunit? e) e
117:     (closure? e) e
118:     (variable? e) (lookup-env-val env (variable-name e))
119:     (add? e) (let [v1 (eval-under-env (add-e1 e) env)
120:                    v2 (eval-under-env (add-e2 e) env)]
121:                (if (and (int? v1) (int? v2))
122:                  (int (+ (int-v v1) (int-v v2)))
123:                  (throw (Exception. "MUPL addition applied to non-number"))))
124:     (fun? e) (closure env e)
125:     (ifgreater? e) (let [v1-test (eval-under-env (ifgreater-e1 e) env)
126:                          v2-test (eval-under-env (ifgreater-e2 e) env)]
127:                      (if (and (int? v1-test) (int? v2-test))
128:                        (if (> (int-v v1-test) (int-v v2-test))
129:                          (eval-under-env (ifgreater-e3 e) env)
130:                          (eval-under-env (ifgreater-e4 e) env))
131:                        (throw (Exception. "MUPL ifgreater condition applied to non-number"))))
132:     (mlet? e) (let [n (mlet-var e)
133:                     v (mlet-e e)
134:                     nenv (define-var n (eval-under-env v env) env)]
135:                 (eval-under-env (mlet-body e) nenv))
136:     (call? e) (let [c (eval-under-env (call-fun e) env)
137:                     arg (eval-under-env (call-arg e) env)]
138:                 (if (closure? c)
139:                   (let [fenv (closure-env c)
140:                         f (closure-fun c)
141:                         fname (fun-name f)
142:                         farg (fun-arg f)
143:                         fbody (fun-body f)
144: 
145:                         ;; 添加环境,函数名和实参绑定
146:                         fenv (define-var farg arg fenv)
147:                         fenv (if fname (define-var fname c fenv)
148:                                  fenv)]
149:                     (eval-under-env fbody fenv))
150:                   (throw (Exception. "MUPL call apllied to non-closure"))))
151:     (apair? e) (let [l (eval-under-env (apair-l e) env)
152:                      r (eval-under-env (apair-r e) env)]
153:                  (apair l r))
154:     (fst? e) (let [v (eval-under-env (fst-e e) env)]
155:                (if (apair? v)
156:                  (apair-l v)
157:                  (throw (Exception. "MUPL fst apllied to non-pair"))))
158:     (snd? e) (let [v (eval-under-env (snd-e e) env)]
159:                (if (apair? v)
160:                  (apair-r v)
161:                  (throw (Exception. "MUPL snd apllied to non-pair"))))
162:     (isaunit? e) (let [v (eval-under-env (isaunit-e e) env)]
163:                    (if (aunit? v)
164:                      (int 1)
165:                      (int 0)))
166:     :else (throw (Exception. (str "eval-exp expected an exp, but given:" e)))))
167: 
168: (defn eval-exp
169:   [e]
170:   (eval-under-env e {}))
171: 
172: (eval-exp (add (int 3) (int 4)))
173: ;; => {:type :my.lang/int, :num 7}
174: 
175: (eval-exp (ifgreater (int 3) (int 4) (int 3) (int 4)))
176: ;; => {:type :my.lang/int, :num 4}
177: 
178: (eval-exp (ifgreater (int 5) (int 4) (int 5) (int 4)))
179: ;; => {:type :my.lang/int, :num 5}
180: 
181: (eval-exp (mlet :x (int 1) (add (int 5) (variable :x))))
182: ;; => {:type :my.lang/int, :num 6}
183: 
184: (eval-exp (call (fun false "x" (add (variable "x") (int 8)))
185:                 (int 2)))
186: ;; => {:type :my.lang/int, :num 10}
187: 
188: (eval-exp (snd (apair (int 1) (int 2))))
189: ;; => {:type :my.lang/int, :num 2}
190: 
191: (eval-exp (fst (apair (int 1) (int 2))))
192: ;; => {:type :my.lang/int, :num 1}
193: 
194: (eval-exp (isaunit (fun false "x" (aunit))))
195: ;; => {:type :my.lang/int, :num 0}
196: 
197: (eval-exp (isaunit (call (fun false "x" (aunit)) (int 0))))
198: ;; => {:type :my.lang/int, :num 1}
199: 
200: ;; 测试递归函数
201: (def add-x (fun "add" "x"
202:                 (ifgreater (int 1)
203:                            (variable "x")
204:                            (int 0)
205:                            (add (variable "x") (call (variable "add")
206:                                                      (add (variable "x")
207:                                                           (int -1))))))) 
208: (eval-exp (call add-x (int 10)))
209: ;; => {:type :my.lang/int, :num 55}
210: 
211: ;; 同名变量遮盖测试
212: (eval-exp (mlet "x" (int 100) (add (call add-x (int 10))
213:                                    (variable "x"))))
214: ;; => {:type :my.lang/int, :num 155}
215: 
216: ;; 以下函数等同于宏
217: (defn ifaunit
218:   [e1 e2 e3]
219:   (ifgreater (isaunit e1) (int 0) e2 e3))
220: 
221: (eval-exp (ifaunit (int 0) (int 3) (int 4)))
222: ;; => {:type :my.lang/int, :num 4}
223: 
224: (defn mlet*
225:   [xs fe]
226:   (let [l (apair-l xs)
227:         vname (apair-l l)
228:         e (apair-r l)
229:         r (apair-r xs)]
230:     (mlet vname e
231:           (if (aunit? r)
232:             fe
233:             (mlet* r fe)))))
234: 
235: (def m1 (mlet* (vec->mupllist [(apair "x" (int 1))
236:                                (apair "y" (add (variable "x") (int 2)))
237:                                (apair "z" (add (variable "y") (int 3)))])
238:           (add (variable "x")
239:                (variable "z"))))
240: 
241: (eval-exp m1)
242: ;; => {:type :my.lang/int, :num 7}
243: 
244: ;; 存在变量名字遮蔽的问题,没有实现卫生宏,会被动态作用域影响
245: (defn ifeq
246:   [e1 e2 e3 e4]
247:   (mlet "_x" e1
248:         (mlet "_y" e2
249:               (ifgreater (variable "_x")
250:                          (variable "_y")
251:                          e4
252:                          (ifgreater (variable "_y")
253:                                     (variable "_x")
254:                                     e4
255:                                     e3)))))
256: (eval-exp (ifeq (int 1) (int 2) (int 3) (int 4)))
257: ;; => {:type :my.lang/int, :num 4}
258: 
259: (eval-exp (ifeq (int 3) (int 3) (int 1) (int 2)))
260: ;; => {:type :my.lang/int, :num 1}
261: 
262: (def sum-xs (fun "sum" "xs"
263:                  (ifaunit (variable "xs")
264:                           (int 0)
265:                           (add (fst (variable "xs"))
266:                                (call (variable "sum") (snd (variable "xs")))))))
267: 
268: (eval-exp (call sum-xs (vec->mupllist [(int 1) (int 2) (int 3) (int 4) (int 5)])))
269: ;; => {:type :my.lang/int, :num 15}
270: 
271: (def mupl-map (fun "map" "f"
272:                    (fun false "xs"
273:                         (ifaunit (variable "xs")
274:                                  (aunit)
275:                                  (apair (call (variable "f") (fst (variable "xs")))
276:                                         (call (call (variable "map") (variable "f"))
277:                                               (snd (variable "xs"))))))))
278: (-> (eval-exp (call (call mupl-map (fun false "x" (add (variable "x") (int 1))))
279:                     (vec->mupllist [(int 1) (int 2) (int 3)])))
280:     mupllist->vec)
281: ;; => ({:type :my.lang/int, :num 2}
282: ;;     {:type :my.lang/int, :num 3}
283: ;;     {:type :my.lang/int, :num 4})
284: 
285: (def mupl-mapAddN (mlet "map" mupl-map
286:                         (fun false "i"
287:                              (call (variable "map")
288:                                    (fun false "x"
289:                                         (add (variable "i")
290:                                              (variable "x")))))))
291: 
292: (-> (eval-exp (call (call mupl-mapAddN (int 4))
293:                  (vec->mupllist [(int 1) (int 2) (int 3)])))
294:     mupllist->vec)
295: ;; => ({:type :my.lang/int, :num 5}
296: ;;     {:type :my.lang/int, :num 6}
297: ;;     {:type :my.lang/int, :num 7})

用record实现,包装函数用于减少改动,用record实现的话,堆栈中异常定位比较麻烦, 无法直接定位到出错的地方:

  1: (ns my.lang2
  2:   (:refer-clojure :exclude [int int?]))
  3: ;; 用record重新实现MUPL语言
  4: 
  5: (defn lookup-env-val
  6:   "从环境中获得变量值,返回nil表示不存在此变量"
  7:   [env key]
  8:   (env key))
  9: 
 10: (defn define-var
 11:   "定义一个变量,返回新的环境"
 12:   [var value env]
 13:   (assoc env var value))
 14: 
 15: (defprotocol Evalable
 16:   (eval-under-env [e env]))
 17: 
 18: (defrecord Variable [name]
 19:   Evalable
 20:   (eval-under-env [e env] (lookup-env-val env (:name e))))
 21: (defn variable [v] (Variable. v))
 22: 
 23: (defrecord Int [num]
 24:   Evalable
 25:   (eval-under-env [e env] e))
 26: 
 27: (defn int [n] (Int. n))
 28: (defn int-v [e] (:num e))
 29: (defn int? [e] (instance? Int e))
 30: 
 31: (defrecord Closure [env fun]
 32:   Evalable
 33:   (eval-under-env [e env] e))
 34: (defn closure [e f] (Closure. e f))
 35: (defn closure? [e] (instance? Closure e))
 36: (defn closure-env [e] (:env e))
 37: (defn closure-fun [e] (:fun e))
 38: 
 39: (defrecord Aunit []
 40:   Evalable
 41:   (eval-under-env [e env] e))
 42: (defn aunit [] (Aunit.))
 43: (defn aunit? [e] (instance? Aunit e))
 44: 
 45: (defrecord Add [e1 e2]
 46:   Evalable
 47:   (eval-under-env [e env]
 48:     (let [v1 (eval-under-env (:e1 e) env)
 49:           v2 (eval-under-env (:e2 e) env)]
 50:       (if (and (int? v1) (int? v2))
 51:         (int (+ (int-v v1) (int-v v2)))
 52:         (throw (Exception. "MUPL addition applied to non-number"))))))
 53: (defn add [e1 e2] (Add. e1 e2))
 54: 
 55: (defrecord Fun [nameopt formal body]
 56:   Evalable
 57:   (eval-under-env [e env] (closure env e)))
 58: (defn fun [nameopt formal body] (Fun. nameopt formal body))
 59: (defn fun-name [e] (:nameopt e))
 60: (defn fun-arg [e] (:formal e))
 61: (defn fun-body [e] (:body e))
 62: 
 63: (defrecord Ifgreater [e1 e2 e3 e4]
 64:   Evalable
 65:   (eval-under-env [e env]
 66:     (let [v1-test (eval-under-env (:e1 e) env)
 67:           v2-test (eval-under-env (:e2 e) env)]
 68:       (if (and (int? v1-test) (int? v2-test))
 69:         (if (> (int-v v1-test) (int-v v2-test))
 70:           (eval-under-env (:e3 e) env)
 71:           (eval-under-env (:e4 e) env))
 72:         (throw (Exception. "MUPL ifgreater condition applied to non-number"))))))
 73: (defn ifgreater [e1 e2 e3 e4] (Ifgreater. e1 e2 e3 e4))
 74: 
 75: (defrecord Mlet [var e body]
 76:   Evalable
 77:   (eval-under-env [e env]
 78:     (let [n (:var e)
 79:           v (:e e)
 80:           nenv (define-var n (eval-under-env v env) env)]
 81:       (eval-under-env (:body e) nenv))))
 82: (defn mlet [v e b] (Mlet. v e b))
 83: 
 84: (defrecord Call [fun arg]
 85:   Evalable
 86:   (eval-under-env [e env]
 87:     (let [c (eval-under-env (:fun e) env)
 88:           arg (eval-under-env (:arg e) env)]
 89:       (if (closure? c)
 90:         (let [fenv (closure-env c)
 91:               f (closure-fun c)
 92:               fname (fun-name f)
 93:               farg (fun-arg f)
 94:               fbody (fun-body f)
 95: 
 96:               ;; 添加环境,函数名和实参绑定
 97:               fenv (define-var farg arg fenv)
 98:               fenv (if fname (define-var fname c fenv)
 99:                        fenv)]
100:           (eval-under-env fbody fenv))
101:         (throw (Exception. "MUPL call apllied to non-closure"))))))
102: (defn call [f a] (Call. f a))
103: 
104: (defrecord Apair [e1 e2]
105:   Evalable
106:   (eval-under-env [e env]
107:     (let [l (eval-under-env (:e1 e) env)
108:           r (eval-under-env (:e2 e) env)]
109:       (Apair. l r))))
110: (defn apair [e1 e2] (Apair. e1 e2))
111: (defn apair? [e] (instance? Apair e))
112: (defn apair-l [e] (:e1 e))
113: (defn apair-r [e] (:e2 e))
114: 
115: (defrecord Fst [e]
116:   Evalable
117:   (eval-under-env [e env]
118:     (let [v (eval-under-env (:e e) env)]
119:       (if (apair? v)
120:         (apair-l v)
121:         (throw (Exception. "MUPL fst apllied to non-pair"))))))
122: (defn fst [e] (Fst. e))
123: 
124: (defrecord Snd [e]
125:   Evalable
126:   (eval-under-env [e env]
127:     (let [v (eval-under-env (:e e) env)]
128:       (if (apair? v)
129:         (apair-r v)
130:         (throw (Exception. "MUPL snd apllied to non-pair"))))))
131: (defn snd [e] (Snd. e))
132: 
133: (defrecord Isaunit [e]
134:   Evalable
135:   (eval-under-env [e env]
136:     (let [v (eval-under-env (:e e) env)]
137:       (if (aunit? v)
138:         (int 1)
139:         (int 0)))))
140: (defn isaunit [e] (Isaunit. e))
141: 
142: (extend-type Object
143:   Evalable
144:   (eval-under-env [e _] (throw (Exception. (str "eval-exp expected an exp, but given:" e)))))
145: 
146: (defn vec->mupllist
147:   [xs]
148:   (reduce #(apair %2 %1) (aunit) (rseq xs)))
149: 
150: (defn mupllist->vec
151:   [e]
152:   (cond
153:     (apair? e)(conj (mupllist->vec (apair-r e)) (apair-l e))
154:     (aunit? e) '()
155:     :else (throw (Exception. "mupllist->vec not a valid mupl list"))))
156: 
157: (defn eval-exp
158:   [e]
159:   (eval-under-env e {}))
160: 
161: ;; 注意打印的时候没有显示record类型,但是是有类型的,显示为map
162: (eval-exp (add (int 3) (int 4)))
163: ;; => {:num 7}
164: 
165: (eval-exp (ifgreater (int 3) (int 4) (int 3) (int 4)))
166: ;; => {:num 4}
167: 
168: (eval-exp (ifgreater (int 5) (int 4) (int 5) (int 4)))
169: ;; => {:num 5}
170: 
171: (eval-exp (mlet :x (int 1) (add (int 5) (variable :x))))
172: ;; => {:num 6}
173: 
174: (eval-exp (call (fun false "x" (add (variable "x") (int 8)))
175:                 (int 2)))
176: ;; => {:num 10}
177: 
178: (eval-exp (snd (apair (int 1) (int 2))))
179: ;; => {:num 2}
180: 
181: (eval-exp (fst (apair (int 1) (int 2))))
182: ;; => {:num 1}
183: 
184: (eval-exp (isaunit (fun false "x" (aunit))))
185: ;; => 0
186: 
187: (eval-exp (isaunit (call (fun false "x" (aunit)) (int 0))))
188: ;; => 1
189: 
190: (defn ifaunit
191:   [e1 e2 e3]
192:   (ifgreater (isaunit e1) (int 0) e2 e3))
193: (isaunit (int 0))
194: (eval-exp (ifaunit (int 0) (int 3) (int 4)))
195: ;; => {:num 4}
196: 
197: (def mupl-map (fun "map" "f"
198:                    (fun false "xs"
199:                         (ifaunit (variable "xs")
200:                                  (aunit)
201:                                  (apair (call (variable "f") (fst (variable "xs")))
202:                                         (call (call (variable "map") (variable "f"))
203:                                               (snd (variable "xs"))))))))
204: 
205: (eval-exp (call (call mupl-map (fun false "x" (add (variable "x") (int 1))))
206:                 (vec->mupllist [(int 1) (int 2) (int 3)])))
207: ;; => {:e1 {:num 2}, :e2 {:e1 {:num 3}, :e2 {:e1 {:num 4}, :e2 {}}}}
208: 
209: (-> (eval-exp (call (call mupl-map (fun false "x" (add (variable "x") (int 1))))
210:                     (vec->mupllist [(int 1) (int 2) (int 3)])))
211:     mupllist->vec)
212: ;; => ({:num 2} {:num 3} {:num 4})

作者: ntestoc

Created: 2018-12-29 Sat 19:46

原文地址:https://www.cnblogs.com/ntestoc/p/10189370.html