zoukankan      html  css  js  c++  java
  • 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

  • 相关阅读:
    JS ipad图片拖动缩放 PHP
    PHP 格式化输出 PHP
    PHP Smarty模版使用 PHP
    PHP PDO小试 PHP
    PHP 获取网页所有连接 PHP
    C# 生成不重复随机字符串 (1秒内生成1000000个) PHP
    使用VS 开发PHP PHP
    PHP 扑捉未处理异常 PHP
    PHP 格式化MYSQL返回float类型 PHP
    CheckBox 选中判断及实现单选功能
  • 原文地址:https://www.cnblogs.com/ntestoc/p/10189370.html
Copyright © 2011-2022 走看看