+(defun let-fopcompilable-p (operator args)
+ (when (>= (length args) 1)
+ (multiple-value-bind (body decls)
+ (parse-body (cdr args) :doc-string-allowed nil)
+ (declare (ignore body))
+ (let* ((orig-lexenv *lexenv*)
+ (*lexenv* (make-lexenv)))
+ ;; We need to check for declarations
+ ;; first. Otherwise the fake lexenv we're
+ ;; constructing might be invalid.
+ (and (null decls)
+ (loop for binding in (car args)
+ for name = (if (consp binding)
+ (first binding)
+ binding)
+ for value = (if (consp binding)
+ (second binding)
+ nil)
+ ;; Only allow binding locals, since special bindings can't
+ ;; be easily expressed with fops.
+ always (and (eq (info :variable :kind name)
+ :unknown)
+ (let ((*lexenv* (ecase operator
+ (let orig-lexenv)
+ (let* *lexenv*))))
+ (fopcompilable-p value)))
+ do (progn
+ (setf *lexenv* (make-lexenv))
+ (push (cons name
+ (make-lambda-var :%source-name name))
+ (lexenv-vars *lexenv*))))
+ (every #'fopcompilable-p (cdr args)))))))
+