X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fnode.lisp;h=0615b216bdfe62572400c51d4eb0189dc7adb476;hb=204f2fa9771ad9e55718dc76205afec7d11b3011;hp=502d4b56601790f3c536b1733c6c9291f50f4b59;hpb=39ca94ec421224c78cb01f7d2d7b49321c66a2d4;p=sbcl.git

diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index 502d4b5..0615b21 100644
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -1070,6 +1070,22 @@
   ;; *UNDEFINED-WARNING-LIMIT* calls.
   (warnings () :type list))
 
+;;; a helper for the POLICY macro, defined late here so that the
+;;; various type tests can be inlined
+(declaim (ftype (function ((or list lexenv node functional)) list)
+		%coerce-to-policy))
+(defun %coerce-to-policy (thing)
+  (let ((result (etypecase thing
+		  (list thing)
+		  (lexenv (lexenv-policy thing))
+		  (node (lexenv-policy (node-lexenv thing)))
+		  (functional (lexenv-policy (functional-lexenv thing))))))
+    ;; Test the first element of the list as a rudimentary sanity
+    ;; that it really does look like a valid policy.
+    (aver (or (null result) (policy-quality-name-p (caar result))))
+    ;; Voila.
+    result))
+
 ;;;; Freeze some structure types to speed type testing.
 
 #!-sb-fluid