From 070aad83aa19b5adee6a91a85e9f462617e8d014 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Thu, 18 Jul 1991 02:08:51 +0000
Subject: [PATCH] Added def-ir1-translator for compiler-option-bind.  Not for
 randoms to use.

---
 compiler/ir1tran.lisp | 24 +++++++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp
index d8c67ad53..a508ea680 100644
--- a/compiler/ir1tran.lisp
+++ b/compiler/ir1tran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.48 1991/05/24 01:03:52 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.49 1991/07/18 02:08:51 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2281,6 +2281,28 @@
   start cont; Ignore hack
   (compiler-error "Misplaced declaration."))
 
+
+;;; COMPILER-OPTION-BIND
+;;; 
+(def-ir1-translator compiler-option-bind ((bindings &body body) start cont)
+  "Compiler-Option-Bind ({(Name Value-Form)}*) Body-Form*
+   Establish the specified compiler options for the (lexical) duration of
+   the body.  The Value-Forms are evaluated at compile time."
+  (let ((*lexical-environment*
+	 (make-lexenv :options
+		      (mapcar #'(lambda (binding)
+				  (unless (and (listp binding)
+					       (cdr binding)
+					       (listp (cdr binding))
+					       (null (cddr binding)))
+				    (compiler-error "Bogus binding for ~
+						     COMPILER-OPTION-BIND: ~S"
+						    binding))
+				  (cons (car binding)
+					(eval (cadr binding))))
+			      bindings))))
+    (ir1-convert-progn-body start cont body)))
+
 
 ;;;; %Primitive:
 ;;;
-- 
GitLab