src/mutation.lisp @ 443af0e76dd6 default tip

(in-package :losh.mutation)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun build-zap (place expr env)
    (multiple-value-bind (temps exprs stores store-expr access-expr)
        (get-setf-expansion place env)
      `(let* (,@(mapcar #'list temps exprs)
              (,(car stores) (symbol-macrolet ((% ,access-expr))
                               ,expr)))
         ,store-expr))))

(defmacro zapf (&rest place-expr-pairs &environment env)
  "Update each `place` by evaluating `expr` with `%` bound to the current value.

  `zapf` works like `setf`, but when evaluating the value expressions the symbol
  `%` will be bound to the current value of the place.

  Examples:

    (zapf foo (1+ %)
          (car bar) (if (> % 10) :a :b))

  "
  ;; original idea/name from http://malisper.me/2015/09/29/zap/
  `(progn
    ,@(loop :for (place expr . nil) :on place-expr-pairs :by #'cddr
            :collect (build-zap place expr env))))


(define-modify-macro mulf (factor) *
  "Multiply `place` by `factor` in-place.")


(defun %divf (value &optional divisor)
  (if divisor
    (/ value divisor)
    (/ value)))

(define-modify-macro divf (&optional divisor) %divf
  "Divide `place` by `divisor` in-place.

  If `divisor` is not given, `place` will be set to `(/ 1 place)`.

  ")


(define-modify-macro modf (divisor) mod
  "Modulo `place` by `divisor` in-place.")

(define-modify-macro remainderf (divisor) rem
  "Remainder `place` by `divisor` in-place.")

(define-modify-macro truncatef (divisor) truncate
  "Truncate `place` by `divisor` in-place.")

(define-modify-macro clampf (from to) losh.math:clamp
  "Clamp `place` between `from` and `to` in-place.")

(define-modify-macro negatef () -
  "Negate the value of `place`.")

(define-modify-macro notf () not
  "Set `place` to `(not place)` in-place.")


(defun %funcall (value function)
  (funcall function value))

(define-modify-macro %callf (function) %funcall
  "Set `place` to the result of calling `function` on its current value.")


(defmacro callf (&rest place-function-pairs)
  "Set each `place` to the result of calling `function` on its current value.

  Examples:

    (let ((x 10) (y 20))
      (callf x #'1-
             y #'1+)
      (list x y))
    =>
    (9 21)
  "
  `(progn
     ,@(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))
         (or ,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))))