Scheme宏扩展显示变量未绑定

时间:2014-12-26 16:18:23

标签: macros scheme

我正在编写一个简单的lisp解释器,因为我在Small Pieces中读过Lisp,但是现在我已经被这个错误困住了2个多小时。我定义了一个本地genv变量,但我仍然遇到此错误。必须有一些宏观扩展的东西,我无法理解,我已经使用引号检查了扩展,看起来似乎没问题。如果有人可以解决一些问题,那就太棒了。 (该代码适用于r5rs语言和guile方案)

;; Macro to print it's given arguments line by line and end with a ------
(define-syntax println
  (syntax-rules ()
    ((_ expr expr* ...) (begin (display expr)
                               (newline)
                               (println expr* ...)))
    ((_ expr) (begin (display expr) (newline)))
    ((_) (display "--------\n"))))

(define (evaluate expr env)
  (begin (println "Evaluating" expr)
  (if (not (pair? expr))
      (cond ((symbol? expr) (lookup env expr))
            ((or (number? expr) (string? expr) (char? expr) (boolean? expr) (vector? expr)) expr)
            (else (error "Cannot evaluate" expr)))

      ;; not atom
      (case (car expr)
        ((quote) (cadr expr))

        ;; (define name expr)
        ((define) (update (cadr expr) (caddr expr) env))

        ((if) (if (evaluate (cadr expr) env)
                  (evaluate (caddr expr) env)
                  (evaluate (cadddr expr) env)))

        ((begin) (eprogn (cdr expr) env))

        ((set!) (update (cadr expr) (evaluate (caddr expr) env) env))

        ((lambda) (make-function (cadr expr) (cddr expr) env))

        (else (invoke (evaluate (car expr) env)
                      (evlis (cdr expr) env)))))))

;; Evaluates all the expressions (exprs) in the given environment (env)
(define (eprogn exprs env)
  (if (pair? exprs)

      ;; False when exprs contains just one item
      (if (pair? (cdr exprs))

          (begin (evaluate (car exprs) env)
                 (eprogn (cdr exprs) env))

          (evaluate (car exprs) env))

      '()))


(define (evlis exprs env)
  (if (pair? exprs)
      (cons (evaluate (car exprs) env)
            (evlis (cdr exprs) env))
      '()))

;; Makes a new applicable function, that closes the environment (env)
(define (make-function vars body env)
  (lambda (vals)
    (eprogn body (extend-environment env vars vals))))


(define (invoke fn args)
  (if (procedure? fn)
      (fn args)
      (error "Not a function" fn)))

;; Environment suite

;; Helper macros for working with an environment vector

;; Returns the parent environment of (env)
(define-syntax parent-env-of
  (syntax-rules ()
    ((parent-env-of env) (vector-ref env 0))))

;; Returns the bind-map of (env)
(define-syntax bind-map-of
  (syntax-rules ()
    ((bind-map-of env) (vector-ref env 1))))

;; Sets the parent environment of (env)
(define-syntax set-parent-env!
  (syntax-rules ()
    ((set-parent-env! env parent-env) (vector-set! env 0 parent-env))))

;; Sets the bind-map of (env)
(define-syntax set-bind-map!
  (syntax-rules ()
    ((set-bind-map! env bind-map) (vector-set! env 1 bind-map))))

;; Makes a new environment with the parent env set to (parent-env)
(define (make-new-environment parent-env)
  (let ((new-env (vector #f #f)))
    (begin
      (set-parent-env! new-env parent-env)
      (set-bind-map! new-env '())
      new-env)))

;; Searches for the value of (sym) in (env), raises
;; error if it can't find
(define (lookup env sym)
  (if (null? env)
      (error "Unbound name" sym)
      (let ((val (assoc sym (bind-map-of env))))
        (if (equal? val #f) (lookup (parent-env-of env) sym) (cdr val)))))

;; Create the binding update the (sym)'s value to (value) in the given (env)
(define (update sym value env)
  (begin (println "Called update with env: " env "sym: " sym "value: " value)
         (define new-bind-map (assoc-set! (bind-map-of env) sym value))
         (set-bind-map! env new-bind-map)))

;; Extends an (env) by creating a new environment and setting the
;; bindings specified by the list of symbols (vars) and the
;; list of values (vals)
(define (extend-environment vars vals env)
  (define new-env (make-new-environment env))
  (update-all vars vals env))

;; Helper function
(define (update-all vars vals env)
  (cond ((pair? vars) (if (not (pair? vals))
                          (error "More symbols than values to bind with")
                          (begin (update (car vars) (car vals) env)
                                 (extend (cdr vars) (cdr vals) env))))
        ((null? vars) (if (not (null? vals))
                          (error "More values than symbols to bind with")
                          env))))

;; Helper macros for initializing the global env bind map

有问题的代码:

;; ------------PROBLEM IN THESE MACROS------------------

(define-syntax _def-initial
  (syntax-rules ()
    ((_def-initial name)
     (update 'name 'void genv))
    ((_def-initial name value)
     (update 'name value genv))))

(define-syntax _def-primitive
  (syntax-rules ()
    ((_def-primitive name value arity)
     (_def-initial name (lambda (args)
                          (if (equal? arity (length args))
                              (apply value args)
                              (error "Incorrect arity" (list 'name value))))))))

(define-syntax _fill-global-env
  (syntax-rules ()
    ((_fill-global-env)
     (begin
       (println "Filling the environment")
       (_def-primitive + (lambda (x y) (+ x y)) 2)
       (_def-primitive - (lambda (x y) (- x y)) 2)
       (_def-primitive * (lambda (x y) (* x y)) 2)
       (_def-primitive / (lambda (x y) (/ x y)) 2))
    )))


;; Racket and Guile SAY genv IS UNBOUND

(define get-global-environment
  ;; name must be `genv' coz of the above macros
  (let ( (genv #f) )
    (lambda ()
      (if (equal? genv #f) ;; If uninitialized
          (begin (set! genv (make-new-environment '()))
                 (println "Before filling: "genv)
                 (_fill-global-env)
                 (println "After filling: " genv)
                 genv)
          genv))))

;; ------------------- END OF PROBLEMATIC CODE(IT SEEMS) ---------------

继续:

;; - Start the interpreter
(define (main args)
  ;; Define the global environment
  (define genv (get-global-environment))
  (println "Global environment: " genv)
  (let loop ((expr (read (current-input-port))))
    (if (eof-object? expr)
        (println "Done")
        (begin (println (evaluate expr genv))
               (loop (read (current-input-port)))))))

(main "")

这是我从Racket收到的错误(在有问题的代码get-global-environment的正文中,而不在main的正文中):< / p>

. . genv: undefined;
 cannot reference undefined identifier

1 个答案:

答案 0 :(得分:1)

Scheme宏是hygienic。您在genv中定义的get-global-environmentgenv中的_def-initial不同(genv使用_def-initial_fill-global-env已定义,在这种情况下将是顶级的,正如您所指出的那样不存在)。

为了让您的宏工作,您必须调整_def-primitive_def-initialgenv以使_def-initial参数为genv {{1}}使用 {{1}}代替顶层。