Question

我有自由变量的定义，我没有用指定的语法正确执行它，你能帮我解释一下我的解释器代码中的自由变量定义.....

(define run
  (lambda (string)
    (eval-program (scan&parse string))))

;; needed for testing
(define equal-external-reps? equal?)

;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
(define the-lexical-spec
  '((whitespace (whitespace) skip)
    (comment ("%" (arbno (not #\newline))) skip)
    (identifier
     (letter (arbno (or letter digit "_" "-" "?")))
     symbol)
    (number (digit (arbno digit)) number)))

(define the-grammar
  '((program (expression) a-program)
    (expression (number) lit-exp)
    (expression (identifier) var-exp)   
    (expression
     (primitive "(" (separated-list expression ",") ")")
     primapp-exp)
    (expression
     ("if" expression "then" expression "else" expression)
     if-exp)
    (expression
     ("let" (arbno  identifier "=" expression) "in" expression)
     let-exp)
    (expression
     ("proc" "(" (separated-list identifier ",") ")" expression)
     proc-exp)
    (expression
     ("(" expression (arbno expression) ")")
     app-exp)
    (expression
     ("begin" expression (arbno ";" expression) "end")
     begin-exp)

    (primitive ("+")     add-prim)
    (primitive ("-")     subtract-prim)
    (primitive ("*")     mult-prim)
    (primitive ("add1")  incr-prim)
    (primitive ("sub1")  decr-prim)
    (primitive ("zero?") zero-test-prim)))

(sllgen:make-define-datatypes the-lexical-spec the-grammar)

(define show-the-datatypes
  (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))

(define scan&parse
  (sllgen:make-string-parser the-lexical-spec the-grammar))

(define just-scan
  (sllgen:make-string-scanner the-lexical-spec the-grammar))


;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;

(define eval-program 
  (lambda (pgm)
    (cases program pgm
      (a-program (body)
                 (eval-expression body (init-env))))))

(define eval-expression 
  (lambda (exp env)
    (cases expression exp
      (lit-exp (datum) datum)
      (var-exp (id) (apply-env env id))
      (primapp-exp (prim rands)
                   (let ((args (eval-rands rands env)))
                     (apply-primitive prim args)))
      (if-exp (test-exp true-exp false-exp) ;\new4
              (if (true-value? (eval-expression test-exp env))
                  (eval-expression true-exp env)
                  (eval-expression false-exp env)))
      (begin-exp (exp1 exps)
                 (let loop ((acc (eval-expression exp1 env))
                            (exps exps))
                   (if (null? exps) acc
                       (loop (eval-expression (car exps) env) (cdr exps)))))
      (let-exp (ids rands body)  ;\new3
               (let ((args (eval-rands rands env)))
                 (eval-expression body (extend-env ids args env))))
      (proc-exp (ids body) (closure ids body env)) ;\new1
      (app-exp (rator rands) ;\new7
               (let ((proc (eval-expression rator env))
                     (args (eval-rands rands env)))
                 (if (procval? proc)
                     (apply-procval proc args)
                     (eopl:error 'eval-expression
                                 "Attempt to apply non-procedure ~s" proc))))
      ;&      
      (else (eopl:error 'eval-expression "Not here:~s" exp)))))

;;;; Right now a prefix must appear earlier in the file.
(define eval-rands
  (lambda (rands env)
    (map (lambda (x) (eval-rand x env)) rands)))

(define eval-rand
  (lambda (rand env)
    (eval-expression rand env)))

(define apply-primitive
  (lambda (prim args)
    (cases primitive prim
      (add-prim  () (+ (car args) (cadr args)))
      (subtract-prim () (- (car args) (cadr args)))
      (mult-prim  () (* (car args) (cadr args)))
      (incr-prim  () (+ (car args) 1))
      (decr-prim  () (- (car args) 1))
      ;&      
      (zero-test-prim () (if (zero? (car args)) 1 0)))))

(define init-env 
  (lambda ()
    (extend-env
     '(i v x)
     '(1 5 10)
     (empty-env))))

;;;;;;;;;;;;;;;; booleans ;;;;;;;;;;;;;;;;

(define true-value?
  (lambda (x)
    (not (zero? x))))

;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
(define-datatype procval procval?
  (closure-one 
   (ids (list-of symbol?)) 
   (body expression?)
   (env environment?)))

(define apply-procval
  (lambda (proc args)
    (cases procval proc
      (closure-one (ids body env)
                   (eval-expression body (extend-env ids args env))))))

;;;;;;;;;;;;;;;; environments ;;;;;;;;;;;;;;;;
(define-datatype environment environment?
  (empty-env-record)
  (extended-env-record
   (syms (list-of symbol?))
   (vec vector?)              ; can use this for anything.
   (env environment?)))

(define empty-env
  (lambda ()
    (empty-env-record)))

(define extend-env
  (lambda (syms vals env)
    (extended-env-record syms (list->vector vals) env)))
(define apply-env
  (lambda (env sym)
    (cases environment env
      (empty-env-record ()
                        (eopl:error 'apply-env "No binding for ~s" sym))
      (extended-env-record (syms vals env)
                           (let ((position (rib-find-position sym syms)))
                             (if (number? position)
                                 (vector-ref vals position)
                                 (apply-env env sym)))))))
(define rib-find-position 
  (lambda (sym los)
    (list-find-position sym los)))
(define list-find-position
  (lambda (sym los)
    (list-index (lambda (sym1) (eqv? sym1 sym)) los)))
(define list-index
  (lambda (pred ls)
    (cond
      ((null? ls) #f)
      ((pred (car ls)) 0)
      (else (let ((list-index-r (list-index pred (cdr ls))))
              (if (number? list-index-r)
                  (+ list-index-r 1)
                  #f))))))
(define iota
  (lambda (end)
    (let loop ((next 0))
      (if (>= next end) '()
          (cons next (loop (+ 1 next)))))))

(define difference
  (lambda (set1 set2)
    (cond
      ((null? set1) '())
      ((memv (car set1) set2)
       (difference (cdr set1) set2))
      (else (cons (car set1) (difference (cdr set1) set2))))))
(define (remove-duplicates l)
  (cond ((null? l)
         '())
        ((member (car l) (cdr l))
         (remove-duplicates (cdr l)))
        (else
         (cons (car l) (remove-duplicates (cdr l))))))

（定义free-vars-list（lambda（body）

（if（pair？body）

(append (free-vars-list (car body)) 

    (free-vars-list (cdr body)))

（案例表达主体

   (lit-exp (number?) '())

   (var-exp (symbol?) (list body))

    (primapp-exp (prim rands) (append(free-vars-list (car rands)) 

   (free-vars-list (cdr rands)))) 

    (if-exp (test-exp true-exp false-exp)

    (append (free-vars-list test-exp) 

    (free-vars-list true-exp) (free-vars-list false-exp)))

     (let-exp (ids rands body)

      (append (free-vars-list body)))

       (proc-exp (ids body) (append (free-vars-list body)))

       (app-exp (rator rands)

        (append (free-vars-list rator) (free-vars-list rands))) 

       (begin-exp (exp1 exps) 

       (append (free-vars-list exp1) (free-vars-list exps))) ))))

（定义闭包（lambda（ids body env）（让（（freevars（差异（free-vars body）ids）））（让（（saved-env （延伸-ENV
freevars （map（lambda（v）（apply-env env v））freevars）（空-ENV））））（lambda（args）（eval-expression body（extend-env ids args saved-env））））））））

Answer 1

您在程序begin-exp中遗漏了free-vars的案例。

我对自由变量的定义并没有正确执行

1 个答案: