# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1677723154 18000
# Node ID 65478981d36d0c3d25a7f73458f05fa9dac020ea
# Parent  896559ec54b1226b8359f47c45592c989ed986de
Add ensuref, profile-when

diff -r 896559ec54b1 -r 65478981d36d DOCUMENTATION.markdown
--- a/DOCUMENTATION.markdown	Wed Feb 08 21:27:09 2023 -0500
+++ b/DOCUMENTATION.markdown	Wed Mar 01 21:12:34 2023 -0500
@@ -1055,6 +1055,14 @@
 
 Profile `form` and dump the report to `lisp.prof`.
 
+### `PROFILE-WHEN` (macro)
+
+    (PROFILE-WHEN CONDITION
+      &BODY
+      BODY)
+
+Evaluate and return `body`, profiling when `condition` is true.
+
 ### `SHUT-UP` (macro)
 
     (SHUT-UP
@@ -1965,6 +1973,28 @@
 
   
 
+### `ENSUREF` (macro)
+
+    (ENSUREF &REST PLACE-EXPR-PAIRS)
+
+Set each `place` that is currently `NIL` to its corresponding `expr`.
+
+  Syntactic sugar where `(ensuref place expr)` expands to something like
+  `(or place (setf place expr))` but doesn't multiply-evaluate the place.
+
+  Examples:
+
+    (defparameter *foo* nil)
+    *foo* ; => NIL
+
+    (ensuref *foo* (print 'hello)) ; prints HELLO
+    *foo* ; => HELLO
+
+    (ensuref *foo* (print 'world))
+    *foo* ; => HELLO
+
+  
+
 ### `MODF` (macro)
 
     (MODF PLACE DIVISOR)
diff -r 896559ec54b1 -r 65478981d36d src/debugging.lisp
--- a/src/debugging.lisp	Wed Feb 08 21:27:09 2023 -0500
+++ b/src/debugging.lisp	Wed Mar 01 21:12:34 2023 -0500
@@ -209,6 +209,14 @@
          (time ,form)
        (stop-profiling))))
 
+(defmacro profile-when (condition &body body)
+  "Evaluate and return `body`, profiling when `condition` is true."
+  (with-gensyms (thunk)
+    `(flet ((,thunk () ,@body))
+       (if ,condition
+         (profile (,thunk))
+         (,thunk)))))
+
 
 (defmacro timing ((&key (time :run) (result-type 'integer)) &body body)
   "Execute `body`, discard its result, and return the time taken.
diff -r 896559ec54b1 -r 65478981d36d src/mutation.lisp
--- a/src/mutation.lisp	Wed Feb 08 21:27:09 2023 -0500
+++ b/src/mutation.lisp	Wed Mar 01 21:12:34 2023 -0500
@@ -86,3 +86,34 @@
      ,@(loop :for (place function . nil) :on place-function-pairs :by #'cddr
              :collect `(%callf ,place ,function))))
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun build-ensure (place expr env)
+    (multiple-value-bind (temps exprs stores store-expr access-expr)
+        (get-setf-expansion place env)
+      `(let* (,@(mapcar #'list temps exprs))
+         (unless ,access-expr
+           (let ((,(car stores) ,expr))
+             ,store-expr))))))
+
+(defmacro ensuref (&rest place-expr-pairs &environment env)
+  "Set each `place` that is currently `NIL` to its corresponding `expr`.
+
+  Syntactic sugar where `(ensuref place expr)` expands to something like
+  `(or place (setf place expr))` but doesn't multiply-evaluate the place.
+
+  Examples:
+
+    (defparameter *foo* nil)
+    *foo* ; => NIL
+
+    (ensuref *foo* (print 'hello)) ; prints HELLO
+    *foo* ; => HELLO
+
+    (ensuref *foo* (print 'world))
+    *foo* ; => HELLO
+
+  "
+  `(progn
+    ,@(loop :for (place expr) :on place-expr-pairs :by #'cddr
+            :collect (build-ensure place expr env))))
+
diff -r 896559ec54b1 -r 65478981d36d src/package.lisp
--- a/src/package.lisp	Wed Feb 08 21:27:09 2023 -0500
+++ b/src/package.lisp	Wed Mar 01 21:12:34 2023 -0500
@@ -133,7 +133,8 @@
     :clampf
     :negatef
     :notf
-    :callf))
+    :callf
+    :ensuref))
 
 (defpackage :losh.shell
   (:use :cl :iterate :losh.base)
@@ -420,6 +421,7 @@
   (:export
 
     #+sbcl :profile
+    #+sbcl :profile-when
     #+sbcl :start-profiling
     #+sbcl :stop-profiling
     :aesthetic-string