/usr/lib/sbcl/sb-cltl2/compiler-let.lisp is in sbcl 2:1.0.55.0-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | (in-package :sb-cltl2)
(def-ir1-translator compiler-let ((bindings &rest forms) start next result)
(loop for binding in bindings
if (atom binding)
collect binding into vars
and collect nil into values
else do (assert (proper-list-of-length-p binding 1 2))
and collect (first binding) into vars
and collect (eval (second binding)) into values
finally (return (progv vars values
(sb-c::ir1-convert-progn-body start next result forms)))))
(defun walk-compiler-let (form context env)
(declare (ignore context))
(destructuring-bind (bindings &rest body)
(cdr form)
(loop for binding in bindings
if (atom binding)
collect binding into vars
and collect nil into values
else do (assert (proper-list-of-length-p binding 1 2))
and collect (first binding) into vars
and collect (eval (second binding)) into values
finally (return
(progv vars values
(let ((walked-body (sb-walker::walk-repeat-eval body env)))
(sb-walker::relist* form
'compiler-let bindings walked-body)))))))
(sb-walker::define-walker-template compiler-let walk-compiler-let)
#+sb-eval
(setf (getf sb-eval::*eval-dispatch-functions* 'compiler-let)
(lambda (form env)
(destructuring-bind (bindings &body body) (cdr form)
(loop for binding in bindings
if (atom binding)
collect binding into vars
and collect nil into values
else do (assert (proper-list-of-length-p binding 1 2))
and collect (first binding) into vars
and collect (eval (second binding)) into values
finally (return
(let ((new-env (sb-eval::make-env
:parent env
:vars (sb-eval::special-bindings vars env))))
(progv vars values
(sb-eval::eval-progn body new-env))))))))
|