zoukankan      html  css  js  c++  java
  • the little schemer 笔记(10.1)

    This work is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 2.5 China Mainland License.

    下面是 the little schemer 中的 简单interpreter实现以及在DrRacket中的一步步的调试观察。

    这里注意运行下面的代码需要设置一下

    另外,使用DrRacket的调试来step by step 观察 Scheme 程序运行非常不错。

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    ;a simple scheme interpreter run on scheme (DrRacket 5.3)
    ;date:2012-9-3

    ;some trivil functions
    (define (atom? x)
      (and (not (null? x))
           (not (pair? x))))

    (define first
      (lambda (p)
        (car p)))

    (define second
      (lambda (p)
        (car (cdr p))))

    (define third
      (lambda (p)
        (car (cdr (cdr p)))))

    (define build
      (lambda (s1 s2)
        (cons s1 (cons s2 (quote ())))))

    (define new-entry build)


    ;entry and table
    (define lookup-in-entry-help
      (lambda (name names values entry-f)
        (cond
          ((null? names) (entry-f name))
          ((eq? (car names) name) (car values))
          (else (lookup-in-entry-help name (cdr names) (cdr values) entry-f)))))

    (define lookup-in-entry
      (lambda (name entry entry-f)
        (lookup-in-entry-help name
                              (first entry)
                              (second entry)
                              entry-f)))

    (define extend-table cons)

    (define lookup-in-table
      (lambda (name table table-f)
        (cond
          ((null? table) (table-f name))
          (else (lookup-in-entry name
                                 (car table)
                                 (lambda (name)
                                   (lookup-in-table name (cdr table) table-f)))))))



    ;;;;;;;;;;;actions
    (define atom-to-action
      (lambda (e)
        (cond
          ((number? e) *const)
          ((eq? e #t) *const)
          ((eq? e (quote cons)) *const)
          ((eq? e (quote car)) *const)
          ((eq? e (quote cdr)) *const)
          ((eq? e (quote null?)) *const)
          ((eq? e (quote eq?)) *const)
          ((eq? e (quote atom?)) *const)
          ((eq? e (quote zero?)) *const)
          ((eq? e (quote add1)) *const)
          ((eq? e (quote sub1)) *const)
          ((eq? e (quote number?)) *const)
          (else *identifier))))

    (define list-to-action
      (lambda (e)
        (cond
          ((atom? (car e))
           (cond
             ((eq? (car e) (quote quote)) *quote)
             ((eq? (car e) (quote lambda)) *lambda)
             ((eq? (car e) (quote cond)) *cond)
             (else *application)))
          (else *application))))

    (define expression-to-action
      (lambda (e)
        (cond
          ((atom? e) (atom-to-action e))
          (else (list-to-action e)))))

    ;*const action
    (define *const
      (lambda (e table)
        (cond
          ((number? e) e)
          ((eq? e #t) #t)
          ((eq? e #f) #f)
          (else (build (quote primitive) e)))))

    ;*quote action
    (define text-of second)

    (define *quote
      (lambda (e table)
        (text-of e)))

    ;identifier action
    (define initial-table
      (lambda (name)
        (car (quote ()))))

    (define *identifier
      (lambda (e table)
        (lookup-in-table e table initial-table)))

    ;*lambda action
    (define *lambda
      (lambda (e table)
        (build (quote non-primitive)
               (cons table (cdr e)))))

    ;*cond action
    (define table-of first)

    (define formals-of second)

    (define body-of third)


    (define else?
      (lambda (x)
        (cond
          ((atom? x) (eq? x (quote else)))
          (else #f))))

    (define question-of first)

    (define answer-of second)

    (define evcon
      (lambda (lines table)
        (cond
          ((else? (question-of (car lines)))
           (meaning (answer-of (car lines)) table))
          ((meaning (question-of (car lines)) table)
           (meaning (answer-of (car lines)) table))
          (else (evcon (cdr lines) table)))))

    (define cond-lines-of cdr)

    (define *cond
      (lambda (e table)
        (evcon (cond-lines-of e) table)))

    ;*application action
    (define evlis
      (lambda (args table)
        (cond
          ((null? args) (quote ()))
          (else
           (cons (meaning (car args) table)
                 (evlis (cdr args) table))))))

    (define function-of car)

    (define arguments-of cdr)

    (define primitive?
      (lambda (l)
        (eq? (first l) (quote primitive))))

    (define non-primitive?
      (lambda (l)
        (eq? (first l) (quote non-primitive))))

    (define :atom?
      (lambda (x)
        (cond
          ((atom? x) #t)
          ((null? x) #t)
          ((eq? (car x) (quote primitive)) #t)
          (else #f))))

    (define apply-primitive
      (lambda (name vals)
        (cond
          ((eq? name (quote cons))
           (cons (first vals) (second vals)))
          ((eq? name (quote car))
           (car (first vals)))
          ((eq? name (quote vals))
           (cdr (first vals)))
          ((eq? name (quote null?))
           (null? (first vals)))
          ((eq? name (quote eq?))
           (eq? (first (second vals))))
          ((eq? name (quote atom?))
           (:atom? (first vals)))
          ((eq? name (quote zero?))
           (zero? (first vals)))
          ((eq? name (quote add1))
           (add1 (first vals)))
          ((eq? name (quote sub1))
           (sub1 (first vals)))
          ((eq? name (quote number?))
           (number? (first vals))))))

    (define apply-closure
      (lambda (closure vals)
        (meaning (body-of closure)
                 (extend-table
                  (new-entry (formals-of closure) vals) (table-of closure)))))

    (define apply
      (lambda (fun vals)
        (cond
          ((primitive? fun)
           (apply-primitive (second fun) vals))
          ((non-primitive? fun) (apply-closure (second fun) vals)))))

    (define *application
      (lambda (e table)
        (apply
         (meaning (function-of e) table)
         (evlis (arguments-of e) table))))

    ;;;;;;;;;value--the interpreter entrance
    (define meaning
      (lambda (e table)
        ((expression-to-action e) e table)))


    (define value
      (lambda (e)
        (meaning e (quote ()))))




    ;;;;test examples;;;
    ;;DrRacket中注释代码COMMENT in DrRacket:    select codes and press ctrl + alt + ";"
    ;;DrRacket中取消注释UNCOMMENT in DrRacket:  select codes and press ctrl + alt + "="


    ;example1.(meaning e table)是什么,其中e是(lambda (x) (cons x y)),table 是(((y z) ((8) 9)))。

    ;(define e '(lambda (x) (cons x y)))
    ;(define table '(((y z) ((8) 9))))
    ;(meaning e table)


    ;example2.(*cond e table), 其中e是(cond (coffee klastsch) (else party)), table 是 (((coffee) (#t)) ((klastsch party) (5 (6))))

    ;(define e '(cond (coffee klastsch) (else party)))
    ;(define table '(((coffee) (#t)) ((klastsch party) (5 (6)))))
    ;(*cond e table)


    ;example3.
    (define e '((lambda (nothing)
                  (cond
                    (nothing (quote something))
                    (else (quote nothing))))
                #t))
    (value e)

  • 相关阅读:
    P3275 [SCOI2011]糖果 题解
    hdu 2962 题解
    hdu 2167 题解
    hdu 2476 题解
    hdu 5418 题解
    2019.10.16&17小结
    poj 3061 题解(尺取法|二分
    poj 1852&3684 题解
    NOIP2017[提高组] 宝藏 题解
    一类经典问题的解法
  • 原文地址:https://www.cnblogs.com/weekbo/p/10297443.html
Copyright © 2011-2022 走看看