- (($ <lambda> src meta body)
- (make-lambda src meta (and body (lp body))))
-
- (($ <lambda-case> src req opt rest kw inits gensyms body alternate)
- (make-lambda-case src req opt rest kw (map lp inits) gensyms (lp body)
- (and alternate (lp alternate))))
-
- (($ <let> src names gensyms vals body)
- (make-let src names gensyms (map lp vals) (lp body)))
-
- (($ <letrec> src in-order? names gensyms vals body)
- (make-letrec src in-order? names gensyms (map lp vals) (lp body)))
-
- (($ <fix> src names gensyms vals body)
- (make-fix src names gensyms (map lp vals) (lp body)))
-
- (($ <let-values> src exp body)
- (make-let-values src (lp exp) (lp body)))
-
- (($ <prompt> src escape-only? tag body handler)
- (make-prompt src escape-only? (lp tag) (lp body) (lp handler)))
-
- (($ <abort> src tag args tail)
- (make-abort src (lp tag) (map lp args) (lp tail)))))))
+ (($ <lambda> src meta body)
+ (let ((body* (and body (lp body))))
+ (if (eq? body body*)
+ x
+ (make-lambda src meta body*))))
+
+ (($ <lambda-case> src req opt rest kw inits gensyms body alternate)
+ (let ((inits* (map lp inits))
+ (body* (lp body))
+ (alternate* (and alternate (lp alternate))))
+ (if (and (elts-eq? inits inits*)
+ (eq? body body*)
+ (eq? alternate alternate*))
+ x
+ (make-lambda-case src req opt rest kw inits* gensyms body*
+ alternate*))))
+
+ (($ <let> src names gensyms vals body)
+ (let ((vals* (map lp vals))
+ (body* (lp body)))
+ (if (and (elts-eq? vals vals*)
+ (eq? body body*))
+ x
+ (make-let src names gensyms vals* body*))))
+
+ (($ <letrec> src in-order? names gensyms vals body)
+ (let ((vals* (map lp vals))
+ (body* (lp body)))
+ (if (and (elts-eq? vals vals*)
+ (eq? body body*))
+ x
+ (make-letrec src in-order? names gensyms vals* body*))))
+
+ (($ <fix> src names gensyms vals body)
+ (let ((vals* (map lp vals))
+ (body* (lp body)))
+ (if (and (elts-eq? vals vals*)
+ (eq? body body*))
+ x
+ (make-fix src names gensyms vals* body*))))
+
+ (($ <let-values> src exp body)
+ (let ((exp* (lp exp))
+ (body* (lp body)))
+ (if (and (eq? exp exp*)
+ (eq? body body*))
+ x
+ (make-let-values src exp* body*))))
+
+ (($ <prompt> src escape-only? tag body handler)
+ (let ((tag* (lp tag))
+ (body* (lp body))
+ (handler* (lp handler)))
+ (if (and (eq? tag tag*)
+ (eq? body body*)
+ (eq? handler handler*))
+ x
+ (make-prompt src escape-only? tag* body* handler*))))
+
+ (($ <abort> src tag args tail)
+ (let ((tag* (lp tag))
+ (args* (map lp args))
+ (tail* (lp tail)))
+ (if (and (eq? tag tag*)
+ (elts-eq? args args*)
+ (eq? tail tail*))
+ x
+ (make-abort src tag* args* tail*)))))))))