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

Diff of /gcl/cmpnew/gcl_cmpfun.lsp

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

revision 1.14 by camm, Sun Sep 18 01:46:25 2005 UTC revision 1.15 by camm, Thu Sep 22 17:26:49 2005 UTC
# Line 1066  Line 1066 
1066  (si::putprop 'sublis 'co1sublis 'co1)  (si::putprop 'sublis 'co1sublis 'co1)
1067  (defun co1sublis (f args &aux test) f  (defun co1sublis (f args &aux test) f
1068   (and (case (length args)   (and (case (length args)
1069          (2 (setq test 'eql))          (2 (setq test 'eql1))
1070          (4 (and (eq (third args) :test)          (4 (and (eq (third args) :test)
1071                  (cond ((member (fourth args) '(equal (function equal))) (setq test 'equal))                  (cond ((member (fourth args) '(equal (function equal))) (setq test 'equal1))
1072                        ((member (fourth args) '(eql (function eql))) (setq test 'eql))                        ((member (fourth args) '(eql (function eql))) (setq test 'eql1))
1073                        ((member (fourth args) '(eq (function eq))) (setq test 'eq))                        ((member (fourth args) '(eq (function eq))) (setq test 'eq))
1074                        ))))                        ))))
1075        (let ((s (gensym)))        (let ((s (gensym)))
# Line 1079  Line 1079 
1079    
1080  (defun sublis1-inline (a b c)  (defun sublis1-inline (a b c)
1081    (let ((tst (car (find (cadr c) *objects* :key 'cadr))))    (let ((tst (car (find (cadr c) *objects* :key 'cadr))))
1082      (or (member tst '(eq equal eql)) (error "bad test"))      (or (member tst '(eq equal1 eql1)) (error "bad test"))
1083    (wt "(check_alist("    (wt "(check_alist("
1084        a        a
1085       "),sublis1("a "," b "," (format nil "~(&~a~)))" tst))))       "),sublis1("a "," b "," (format nil "~(&~a~)))" tst))))

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