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))) |
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)))) |