/[gcl]/gcl/cmpnew/gcl_cmpeval.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmpeval.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.14 by camm, Mon Nov 29 01:33:54 2004 UTC revision 1.15 by camm, Mon Nov 29 21:43:51 2004 UTC
# Line 237  Line 237 
237             (cons-to-right (cdr x)))))             (cons-to-right (cdr x)))))
238  ;          (arg-appears (car x) (cdr x) nil))))  ;          (arg-appears (car x) (cdr x) nil))))
239    
240    (defun bind-before-cons (x y)
241      (and y (consp (car y)) (atom (cadar y))
242           (if (eq x (cadar y)) (caar y)
243             (bind-before-cons x (cdr y)))))
244      
245  (defun pull-evals-int (x form lets)  (defun pull-evals-int (x form lets)
246    (if (atom x)    (if (atom x)
247        (list (nreverse form) (nreverse lets))        (list (nreverse form) (nreverse lets))
248      (let* ((s (if (needs-pre-eval x) nil (car x)))      (let* ((s (if (needs-pre-eval x) (bind-before-cons (car x) lets) (car x)))
            (s (or s (caar (member (car x) lets :test (lambda (x y) (eq x (cadr y)))))))  
249             (lets (if s lets (cons (list (gensym) (car x)) lets)))             (lets (if s lets (cons (list (gensym) (car x)) lets)))
250             (s (or s (caar lets))))             (s (or s (caar lets))))
251        (pull-evals-int (cdr x) (cons s form) lets))))        (pull-evals-int (cdr x) (cons s form) lets))))

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26