diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index f7d27dcfc99b43a46bdea920b5a9fe40d10ccf0b..dd8d6e7f1dac7f2f3c00e912e3b6002b2180ceac 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.25 1991/01/22 12:11:15 ram Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.26 1991/01/30 23:21:37 ram Exp $
 ;;;
 ;;;    This file contains macro-like source transformations which convert
 ;;; uses of certain functions into the canonical form desired within the
@@ -37,6 +37,45 @@
 (def-source-transform identity (x) `(prog1 ,x))
 (def-source-transform values (x) `(prog1 ,x))
 
+;;; CONSTANTLY source transform  --  Internal
+;;;
+;;;    Bind the values and make a closure that returns them.
+;;;
+(def-source-transform constantly (value &rest values)
+  (let ((temps (loop repeat (1+ (length values))
+		     collect (gensym)))
+	(dum (gensym)))
+    `(let ,(loop for temp in temps and
+	         value in (list* value values)
+	         collect `(,temp ,value))
+       #'(lambda (&rest ,dum)
+	   (declare (ignore ,dum))
+	   (values ,@temps)))))
+
+
+;;; COMPLEMENT IR1 transform  --  Internal
+;;;
+;;;    If the function has a known number of arguments, then return a lambda
+;;; with the appropriate fixed number of args.  If the destination is a
+;;; FUNCALL, then do the &REST APPLY thing, and let MV optimization figure
+;;; things out.
+;;;
+(deftransform complement ((fun) * * :node node)
+  (multiple-value-bind (min max)
+		       (function-type-nargs (continuation-type fun))
+    (cond
+     ((and min (eql min max))
+      (let ((dums (loop repeat min collect (gensym))))
+	`#'(lambda ,dums (not (funcall fun ,@dums)))))
+     ((let* ((cont (node-cont node))
+	     (dest (continuation-dest cont)))
+	(and (combination-p dest)
+	     (eq (combination-fun dest) cont)))
+      '#'(lambda (&rest args)
+	   (not (apply fun args))))
+     (t
+      (give-up "Can't open-code COMPLEMENT of a non-fixed arg function.")))))
+
 
 ;;;; List hackery: