Nyquist / XLISP 2.0  -  Contents | Tutorials | Examples | Reference

Environment


  1. *unbound*
  2. Lexical Environment
  3. lboundp - [Macro] - has this symbol a lexical variable value bound to it?
  4. lfboundp - [Macro] - has this symbol a lexical function value bound to it?
  5. lsymbol-value - [Macro] - get the lexical variable value
  6. lsymbol-function - [Macro] - get the lexical flet, labels, or macrolet function value
  7. lmacroexpand-1 - [Macro] - expand the first level of a a macrolet form
  8. Known Problems

*unbound*


A tricky problem with XLISP is that the symbol *unbound* can be bound as a value to any Lisp symbol, also to a lexical parameter variable if passed as a value to a Lisp function:

(defun test (x)
  (print x))

(test '*unbound*)  => error: unbound variable

The problem here is that the symbol *unbound* has been bound to the parameter variable 'x', so the expression (print x) instead of printing "*UNBOUND*" now causes an 'unbound variable' error. How can I test from inside of a function if the lexical parameter variable 'x' is bound to the symbol *unbound*? Unfortunately there is no standard Lisp way to solve this problem.

  Back to top


*obarray*


A symbol in the *obarray* is protected from garbage collection.

  Back to top


Lexical Environment


Lisp parameter variables together with local variables bound with let and let* and functions defined by flet and labels are not interned in the *obarray*, instead they are stored in the local lexical environment, maintained via an internal association list. The key for reading this list is the *evalhook* variable and the evalhook function.

Here are two Nyquist macros from 'evalenv.lsp':

(defmacro getenv ()        ; return the current environment
  '(progv '(*evalhook*) (list #'(lambda (exp env) env))
     (eval nil)))

(defmacro eval-env (arg)   ; evaluate in the current environment
  `(evalhook ,arg nil nil (getenv)))

  Back to top


getenv


The 'getenv' macro returns the association list of the current lexical environment:

(let ((v1 1)          ; first variable
      (v2 2))         ; second variable
  (flet ((f1 (a) a)   ; first function
         (f2 (b) b))  ; second function
    (getenv)))

=> ((((V2 . 1) (V1 . 2))) ((F2 . #<Closure...>) (F1 . #<Closure...>)))

The asymmetric layout is produced by print, the real structure of the lexical environment is a cons of two association lists:

(defmacro print-env ()
  (let ((env (gensym)))
    `(let ((,env (getenv)))
       (format t "(~s . ~s)~%" (car ,env) (cdr ,env)))))

Note: You could also use print-cons instead of format to print really all the details of the list, but format is enough for the examples here.

(let ((v1 1)          ; first variable
      (v2 2))         ; second variable
  (flet ((f1 (a) a)   ; first function
         (f2 (b) b))  ; second function
    (print-env)))

((((V2 . 2) (V1 . 1))) . (((F2 . #<Closure...>) (F1 . #<Closure...>))))

The basic layout is:

((((V2 . value) (V1 . value))) . (((F2 . value) (F1 . value))))

((<----- variable-list ----->) . (<----- function-list ----->))

(car (getenv))  => (variable-list)
(cdr (getenv))  => (function-list)

The different levels of bindings are maintained via multiple sublists:

(let ((v1 1))             ; first level variable
  (let ((v2 2))           ; second level variable
    (flet ((f1 (a) a))    ; first level function
      (flet ((f2 (b) b))  ; second level function
        (print-env)))))

((((V2 . value)) ((V1 . value))) . (((F2 . value)) ((F1 . value))))

(((<--level2-->) (<--level1-->)) . ((<--level2-->) (<--level1-->)))
((<------ variable-list ------>) . (<------ function-list ------>))

Variables appear always in the variable list, functions always in the function list:

(let ((v1 1))             ; first level variable
  (flet ((f1 (a) a))      ; first level function
    (let ((v2 2))         ; second level variable
      (flet ((f2 (b) b))  ; second level function
        (print-env)))))

((((V2 . value)) ((V1 . value))) . (((F2 . value)) ((F1 . value))))

(((<--level2-->) (<--level1-->)) . ((<--level2-->) (<--level1-->)))
((<------ variable-list ------>) . (<------ function-list ------>))

The inner-most bindings always appear at the front of the lists:

(let ((v1 1))             ; first level variable
  (let ((v2 2))           ; second level variable
    (flet ((f1 (a) a))    ; first level function
      (flet ((f2 (b) b))  ; second level function
        (let ((v3 3))     ; third level variable
          (print-env))))))

((((V3 . value)) ((V2 . value)) ((V1 . value))) . (((F2 . value)) ((F1 . value))))

(((<--level3-->) (<--level2-->) (<--level1-->)) . ((<--level2-->) (<--level1-->)))
((<------------- variable-list -------------->) . (<------ function-list ------>))

There may appear several variable bindings in the same sublist:

(let ((v1 1) (v2 2))      ; first level variables
  (flet ((f1 (a) a)       ; first level functions
         (f2 (b) b))
    (let ((v3 3))         ; second level variable
      (print-env))))

((((V3 . value)) ((V2 . value) (V1 . value))) . (((F2 . value) (F1 . value))))

(((<--level2-->) (<--------level1--------->)) . ((<---------level1-------->)))
((<------------ variable-list ------------->) . (<----- function-list ----->))

The basic principle is always the same:

(((level n ...) ... (level 1 variables)) . ((level n ...) ... (level 1 functions)))

(car (getenv))  => ((level n ...) (level n-1 ...) ... (level 1 variables))
(cdr (getenv))  => ((level n ...) (level n-1 ...) ... (level 1 functions))

Also the function parameter variables appear in the the lexical environment association list:

(defun test (parameter-var)
  (let ((local-var 'value))
    (print-env)))

((((LOCAL-VAR . value)) ((PARAMETER-VAR . value))) . NIL)  ; NIL = no functions

(((<-----level2------>) (<-------level1-------->)) . NIL)
((<--------------- variable-list --------------->) . NIL)

The variables bound by let appear before the function's parameter variables, that's why let bindings 'shadow' parameter variables with the same name. The 'test' function name does not appear in the environment list because the function name was interned in the *obarray* by defun.

  Back to top


eval-env


This still doen't work:

(setq x 'global)        ; define a global variable 'x'

(defun print-x ()       ; define a function PRINT-X in the global environment
  (print (getenv))      ; always prints ((NIL)), also with EVAL-ENV or EVALHOOK
  (print x))            ; always prints GLOBAL, also with EVAL-ENV or EVALHOOK

(let ((x 'local))       ; create a lexical variable 'x'
  (print-x))            ; evaluate PRINT-X
=> GLOBAL               ; value from the environment, where PRINT-X was defined

(let ((x 'local))       ; create a lexical variable 'x'
  (eval-env (print-x))  ; evaluate PRINT-X in the current environment
=> GLOBAL  ;wrong       ; value from the environment, where PRINT-X was called

(let ((x 'local))       ; create a lexical variable 'x'
  (eval-env (funcall 'print-x))  ; evaluate PRINT-X in the current environment
=> GLOBAL  ;wrong       ; value from the environment, where PRINT-X was called

  Back to top


lboundp


The 'lboundp' function tests if a valid variable value is bound to a symbol in the current lexical environment:

(lboundp symbol)
symbol - a quoted lisp symbol
returns -  T  if a lexical variable value is bound to the symbol, NIL otherwise

(defmacro lboundp (symbol)
  (cond ((not (or (symbolp symbol)
                  (and (consp symbol)
                       (eq 'quote (car symbol))
                       (symbolp (cadr symbol)))))
         (error "bad argument type" symbol))
        ((and (consp symbol) (cddr symbol))
         (error "too many arguments"))
        (t (let ((a-cons (gensym)) (level (gensym)) (binding (gensym)))
             `(let ((,a-cons (dolist (,level (car (getenv)) nil)
                               (let ((,binding (assoc ,symbol ,level)))
                                 (when ,binding (return ,binding))))))
                (and ,a-cons (not (eq (cdr ,a-cons) '*unbound*))))))))

The XLISP boundp function only can test global variables, interned in the *obarray*, so it cannot be used to test if a symbol has a variable value bound to it in the lexical environment:

(defun test (x)    ; bad example
  (if (boundp 'x)  ; <- global test
      (print x)
      (print '*unbound*)))

(test 'hello!)     => *UNBOUND*  ; bad result
(test 123)         => *UNBOUND*  ; bad result

(setq x t)         => T          ; create a global variable 'x'

(test 'hello!)     => 'HELLO!    ; OK
(test 123)         => 123        ; OK
(test '*unbound*)  => error: unbound variable - X  ; bad result

Here the same example with 'lboundp':

(defun test (x)     ; good example
  (if (lboundp 'x)  ; <- local test
      (print x)
      (print '*unbound*)))

(test 'hello!)     => 'HELLO!    ; OK
(test 123)         => 123        ; OK
(test '*unbound*)  => *UNBOUND*  ; OK

The 'lboundp' function cannot test symbol values at the top-level, because there is no lexical environment:

(setq x t)    => T   ; create a global variable 'x'
(lboundp 'x)  => NIL ; lexical test fails
(boundp 'x)   => T   ; global test succeeds

  Back to top


valuep


The 'valuep' function tests if a valid variable value is bound to a symbol at any level:

(defmacro valuep (symbol)
  (cond ((not (or (symbolp symbol)
                  (and (consp symbol)
                       (eq 'quote (car symbol))
                       (symbolp (cadr symbol)))))
         (error "bad argument type" ,symbol))
        ((and (consp symbol) (cddr symbol))
         (error "too many arguments"))
        (t (let ((a-cons (gensym)) (level (gensym)) (binding (gensym)))
             `(let ((,a-cons (dolist (,level (car (getenv)) nil)
                               (let ((,binding (assoc ,symbol ,level)))
                                 (when ,binding (return ,binding))))))
                (if ,a-cons
                    (not (eq (cdr ,a-cons) '*unbound*))
                    (boundp ,symbol)))))))

It's tricky to test if a symbol has a valid variable value bound to it because if the symbol is bound to *unbound* in a lexical environment, it still shadows a symbol with the same name in the *obarray*, making a possibly existing global variable inaccessible, like shown in the examples below.

Note: The lexical environment must be tested first, because this is the way how XLISP searches for symbol bindings.

Examples:

(when (valuep 'x) x)  => NIL  ; no global binding of 'x' found
(setq x 'ok)          => OK   ; create a global variable 'x'
(when (valuep 'x) x)  => OK   ; global binding of 'x' found

(let ((x 'local))             ; create a lexical variable 'x'
  (when (valuep 'x) x))       ; try to access the lexical variable
=> LOCAL                      ; lexical binding of 'x' found

XLISP problems with *unbound* lexical variables:

(setq x 'ok)          => OK   ; create a global variable 'x'
(when (valuep 'x) x)  => OK   ; global binding of 'x' found

(let ((x '*unbound*))         ; create an unbound lexical variable 'x'
  (when (valuep 'x) x))       ; try to access the global variable
=> NIL                        ; global binding of 'x' NOT found

(let ((x '*unbound*))         ; create an unbound lexical variable 'x'
  x)                          ; try to access the global variable
error: unbound variable - X

The 'valuep' function recognizes if a global variable value is shadowed by an *unbound* lexical variable and returns NIL if the global variable is inaccessible..

  Back to top


lfboundp


The 'lfboundp' function tests if a valid function value is bound to a symbol in the current lexical environment:

(lfboundp symbol)
symbol - a quoted lisp symbol
returns -  T  if a lexical function value is bound to the symbol, NIL otherwise

(defmacro lfboundp (symbol)
  (cond ((not (or (symbolp symbol)
                  (and (consp symbol)
                       (eq 'quote (car symbol))
                       (symbolp (cadr symbol)))))
         (error "bad argument type" symbol))
        ((and (consp symbol) (cddr symbol))
         (error "too many arguments"))
        (t (let ((a-cons (gensym)) (level (gensym)) (binding (gensym)))
             `(let ((,a-cons (dolist (,level (cdr (getenv)) nil)
                               (let ((,binding (assoc ,symbol ,level)))
                                 (when ,binding (return ,binding))))))
                (and ,a-cons (not (eq (cdr ,a-cons) '*unbound*))))))))

The XLISP fboundp function only works with symbols interned in the *obarray*, so it cannot be used to test if a symbol has a function value bound to it in the lexical environment:

(flet ((my-function (x) 'hello))
  (fboundp 'my-function))   ; <- global test
=> NIL

(flet ((my-function (x) 'hello))
  (lfboundp 'my-function))  ; <- local test
=> T

The 'lfboundp' function cannot test symbol function values at the top-level, because there is no lexical environment:

(lfboundp 'car)  => NIL ; lexical test fails
(fboundp 'car)   => T   ; global test succeeds

Problems with *unbound* lexical functions are less likely then with *unbound* parameter variables, because there is no buit-in way to bind a lexical function to *unbound*.

See also:

  Back to top


lsymbol-value


The function 'lsymbol-value' returns a variable value from the lexical environment:

(defmacro lsymbol-value (symbol)
  (cond ((not (or (symbolp symbol)
                  (and (consp symbol)
                       (eq 'quote (car symbol))
                       (symbolp (cadr symbol)))))
         (error "bad argument type" symbol))
        ((and (consp ,symbol) (cddr symbol))
         (error "too many arguments"))
        (t (let ((a-cons (gensym)) (level (gensym)) (binding (gensym)))
             `(let ((,a-cons (dolist (,level (car (getenv)) nil)
                               (let ((,binding (assoc ,symbol ,level)))
                                 (when ,binding (return ,binding))))))
                (when ,a-cons
                    (if (eq (cdr ,a-cons) '*unbound*)
                        '*unbound*
                        (cdr ,a-cons))))))))

  Back to top


lsymbol-function


The function 'lsymbol-function' returns a function value from the lexical environment:

(defmacro lsymbol-function (symbol)
  (cond ((not (or (symbolp symbol)
                  (and (consp symbol)
                       (eq 'quote (car symbol))
                       (symbolp (cadr symbol)))))
         (error "bad argument type" symbol))
        ((and (consp symbol) (cddr symbol))
         (error "too many arguments"))
        (t (let ((a-cons (gensym)) (level (gensym)) (binding (gensym)))
             `(let ((,a-cons (dolist (,level (cdr (getenv)) nil)
                               (let ((,binding (assoc ,symbol ,level)))
                                 (when ,binding (return ,binding))))))
                (when ,a-cons
                  (if (eq (cdr ,a-cons) '*unbound*)
                      '*unbound*
                      (cdr ,a-cons))))))))

The XLISP function symbol-function only works with symbols interned in the *obarray*, so it cannot return a function value, bound to a symbol in the lexical environment:

(flet ((my-function (x) 'hello))
  (symbol-function 'my-function))  ; <- searches the *obarray*
=> error: unbound function - MY-FUNCTION

(flet ((my-function (x) 'hello))
  (lsymbol-function 'my-function)) ; <- searches the lexical environment
=> #<Closure-MY-FUNCTION...>

  Back to top


lmacroexpand-1


(defmacro with-static-env (&rest body)
  (let ((env (gensym)) (rval (gensym)))
    `(let ((,env (getenv)))  ; environment snapshot
       (progv '(*evalhook*)
              '((lambda (exp env)
                 (labels ((,rval (exp env) ; recursive eval
                            (format t "exp: ~a env: ~a ,env: ~a~%" exp env ,env)
                            (evalhook exp #',rval NIL ,env)))
                   (format t "exp: ~a env: ~a ,env: ~a~%" exp env ,env)
                   (evalhook exp #',rval NIL ,env))))
         ,@body))))
(defmacro with-dynamic-env (&rest body)
  (let ((env (gensym)) (rval (gensym)))
    `(let ((,env (getenv)))  ; environment snapshot
       (progv '(*evalhook*)
              '((lambda (exp env)
                 (labels ((,rval (exp env) ; recursive eval
                            (format t "inner exp: ~a env: ~a~%" exp env)
                            (evalhook exp #',rval NIL env)))
                   (format t "outer exp: ~a env: ~a~%" exp env)
                   (evalhook exp #',rval NIL env))))
         ,@body))))
(defun display-env (env &optional (exp nil exp-p))
  (flet ((display-bindings (name bindings)
    (format t " ~a bindings: ~s~%" name bindings)
    (let ((frame-counter 1))
      (dolist (frame bindings)
        (format t "  ~a frame ~a: ~a~%" name frame-counter frame)
        (let ((binding-counter 1))
          (dolist (binding frame)
            (when (consp binding)
              (format t "   ~a ~a: ~s - value: ~s~%"
                  name binding-counter (car binding) (cdr binding))
              (incf binding-counter))))
        (incf frame-counter)))))
    (when exp-p (format t "eval: ~s~%" exp))
    (format t "environment: ~s~%" env)
    (display-bindings "variable" (car env))
    (display-bindings "function" (cdr env))))

(defmacro debug:env ()
  '(progv '(*evalhook*) '(nil)
     (display-env (getenv))))

(defmacro debug:env ()
  '(progv '(*evalhook*) '((lambda (exp env)
                            (display-env env)))
     (eval nil)))

(defmacro debug:env (&rest body)
  (when *evalhook*
    (format t "DEBUG:ENV ")
    (format t "*evalhook* was already modified~%"))
  (if (null body)
      '(progv '(*evalhook*) '((lambda (exp env)
                                (display-env env)))
         (eval nil))
      (let ((init (gensym)) (rval (gensym)))
        `(let ((,init (getenv)))  ; environment snapshot
           (progv '(*evalhook*)
                  '((lambda (exp env)
                     (labels ((,rval (exp env) ; recursive eval
                                (display-env env exp)
                                (evalhook exp #',rval nil env)))
                       (display-env ,init exp)
                       (evalhook exp #',rval nil ,init))))
             ,@body)))))

(defmacro with-evalhook (&rest body)
  (let ((init (gensym)) (rval (gensym)) (hook (gensym)) debug)
    `(let ((,init (getenv)))  ; environment snapshot
       (progv '(*evalhook*)
              '((lambda (exp env)
                 (labels ((,rval (exp env)  ; recursive eval
                            ,(print *evalhook*)
                            ,(when T `(funcall ,*evalhook* exp env))

                            (evalhook exp #',rval nil env)))
                   (evalhook exp #',rval nil ,init))))
         ,@body))))

(defmacro with-current-environment (&rest body)
  (when *evalhook* (error "*evalhook* already modified"))
  (let ((init (gensym)) (rval (gensym)) debug)
    (when (eq :debug (car body)) (setq debug t body (cdr body)))
    `(let ((,init (getenv)))  ; environment snapshot
       (progv '(*evalhook*)
              '((lambda (exp env)
                 (labels ((,rval (exp env)  ; recursive eval
                            ;; append environment from snapshot
                            (setq env (cons (append (car env) (car ,init))
                                            (append (cdr env) (cdr ,init))))
                            ,(when debug '(display-env env exp))
                            (evalhook exp #',rval nil env)))
                   ;; start with environment snapshot
                   ,(when debug `(display-env ,init exp))
                   (evalhook exp #',rval nil ,init))))
         ,@body))))

(defmacro with-env (&rest body)
  (let ((init (gensym)) (rval (gensym)))
    `(let ((,init (getenv)))  ; environment snapshot
       (progv '(*evalhook*)
              '((lambda (exp env)
                 (labels ((,rval (exp env) ; recursive eval
                            (display-env env exp)
                            (evalhook exp #',rval nil env)))
                   (display-env ,init exp)
                   (evalhook exp #',rval nil ,init))))
         ,@body))))
(with-current-environment
  (debug:env
    body))

(progv '(*evalhook)
       '((lambda (exp env)
           (labels ((rval (exp env)
                      (append-current-environment)
                      (debug:env ...)
                      (evalhook exp #'rval nil env)))
             (evalhook exp #'rval nil init)))))

(debug:env
  (with-current-environment
    body))

(progv '(*evalhook)
       '((lambda (exp env)
           (labels ((rval (exp env)
(defmacro with-current-environment (&rest body)
  (when *evalhook* (error "*evalhook* already modified"))
  (let ((debug nil) (init (gensym)) (rval (gensym)))
    (when (eq :debug (car body)) (setq debug t body (cdr body)))
    `(let ((,init (getenv)))  ; environment snapshot
       (progv '(*evalhook*)
              '((lambda (exp env)
                 (labels ((,rval (exp env)  ; recursive eval
                            ,(cond (debug
                                    `(setq env
                                       (cons (append (car env) (car ,init))
                                             (append (cdr env) (cdr ,init))))
                                    '(display-env env exp)
                                    `(evalhook exp #',rval nil env))
                                   (t
                                    `(evalhook exp #',rval nil
                                       (cons (append (car env) (car ,init))
                                             (append (cdr env) (cdr ,init))))))))
                   ,(when debug `(display-env ,init exp))
                   (evalhook exp #',rval nil ,init))))
         ,@body))))
(setq *rvalhook* nil)

(defmacro with-current-environment (&rest body)
  (let ((init (gensym)))
    `(let ((,init (getenv)))
       (rval-env #'(lambda (exp env)
                     (cons exp (cons (append (car env) (car ,init))
                                     (append (cdr env) (cdr ,init)))))
                 ,@body))))

(defmacro debug:env (&rest body)
  (rval-env #'(lambda (exp env)
                (display-env env exp)
                (cons exp env))
            ,@body))

(defmacro run-rvalhooks ()
  (let ((func (gensym)) (result (gensym)))
    `(dolist (,func *rvalhook*)
       (format t "func: ~a~%" ,func)
       (format t "exp: ~a~%" exp)
       (format t "env: ~a~%" env)
       (let ((,result (eval (list ,func 'exp 'env) )))
         (format t "result: ~a~%" ,result)
         (format t "exp: ~a~%" exp)
         (format t "car: ~a~%" (car ,result))
         (format t "env: ~a~%" env)
         (format t "cdr: ~a~%" (cdr ,result))
         (setq exp (car ,result) env (cdr ,result)) 
  ))))

(defmacro rval-env (function &rest body)
  (format t "function: ~a~%" function)
  (format t "body: ~a~%" body)
  (or *evalhook* (setq *rvalhook* nil))
  (format t "*rvalhook*: ~a~%" *rvalhook*)
  (if *rvalhook*
      `(prog2
         (push ,function *rvalhook*)
         (progn ,@body)
         (setq *rvalhook* (remove ,function *rvalhook*)))
      (let ((rval (gensym)) (func (gensym)) (result (gensym)))
        `(prog2
           (push ,function *rvalhook*)
           (progv '(*evalhook*)
                  `((lambda (exp env)
                      (print 'hallo)
                      (labels ((,rval (exp env)
                                 (run-rvalhooks)
                                 (evalhook exp #',rval nil env)))
                        ; (run-rvalhooks)
                        (evalhook exp #',rval nil env))))
             ,@body)
           (setq *rvalhook* (remove ,function *rvalhook*))))))

*rvalhook* must be a list of functions, each taking two arguments 'exp' [the Lisp expressions to evaluate] and 'env' [the environment], returning a cons of the format (exp . env).

In case of an error, the *evalhook* variable is automatically reset by the XLISP top-level function. This means that if *evalhook* is NIL and *rvalhook* is non-NIL, then *rvalhook* is invalid and must also be reset to NIL before pushing the next function on it.

(defmacro lmacroexpand-1 (form)
  (if (not (and (consp form)
                (eq 'quote (car form))
                (symbolp (caadr form))))
      form  ; if the form isn't '(symbol ... )
      (let ((a-cons (gensym)) (l-expr (gensym)))
        `(let ((,a-cons (assoc ',(caadr form) (cadr (getenv)))))
           (if (null ,a-cons)  ; (caadr form) = macro-name
               ,form  ; if no lexical binding was found
               (let ((,l-expr (get-lambda-expression (cdr ,a-cons))))
                 (if (eq 'macro (car ,l-expr)) ; if l-expr is a macro
                     (with-current-environment
                       ;; create an *unbound* macro in the *obarray*
                       (eval (append '(defmacro *unbound*) (cdr ,l-expr)))
                       ;; expand the macro in the current environment
                       (eval (list 'macroexpand-1  ; (cdadr form) =
                                   (list 'quote    ; macro-arguments as list
                                         (cons '*unbound* ',(cdadr form))))))
                     ,form)))))))  ; if l-expr is not a macro
(let ((x 1))
  (macrolet ((test (arg)
               `(progn
                  (print ,arg)
                  (print ,(eval x)))))
    (lmacroexpand-1 '(test 'hallo))))
=>

  Back to top


Known Problems


A lexical variable with the symbol *unbound* as a variable value bound to it will continue to shadow a global variable with the same name, even if the the lexical variable is 'unbound':

(setq x t)  => T        ; create a global variable 'x'

(let ((x '*unbound*))   ; create an unbound lexical variable 'x'
  (print x))            ; try to print the global variable
error: unbound variable - X

Tested with Nyquist 3.03 in December 2010.

Nyquist Bug: let* causes infinite recursion problems with either progv, evalhook, or *evalhook* [still needs more investigation], so this doesnt work:

(let* ((init (getenv)))
  (progv '(*evalhook*)
         '((lambda (exp env)
             (labels ((rval (exp env)
                        (print init)  ; <- causes infinite recursion
                        (evalhook exp #'rval nil env)))
               (evalhook exp #'rval nil init))))
    (eval nil)))
=> infinite recursion
while exactly the same form using let instead of let* works:
(let ((init (getenv)))
  (progv '(*evalhook*)
         '((lambda (exp env)
             (labels ((rval (exp env)
                        (print init)  ; <- no infinite recursion
                        (evalhook exp #'rval nil env)))
               (evalhook exp #'rval nil init))))
    (eval nil)))
(NIL)  ; PRINT output
=> NIL

Bug tested with Nyquist 3.03 in December 2010.

  Back to top


Nyquist / XLISP 2.0  -  Contents | Tutorials | Examples | Reference