lisp-random / delay.lisp

(defun print-promise (object stream depth)
  (declare (ignore depth))
  (print-unreadable-object (object stream :type t :identity t)))

(defstruct (promise (:conc-name promise.)
                    (:predicate promisep)
                    (:print-function print-promise))
  (forcedp nil :type boolean)
  (value   nil :type t))

(defun force (promise)
  "Force a promise PROMISE. Return the value of the promise and
memoize it."
  (declare (type promise promise))
  (if (promise.forcedp promise)
      (promise.value promise)
      (setf (promise.forcedp promise) t
            (promise.value promise) (funcall (promise.value promise)))))

(defmacro delay (&body computation)
  "Delay the computation of COMPUTATION, creating a promise."
  `(make-promise :value (lambda () ,@computation)))

(defmacro call-with-delayed-arguments (func &rest arguments)
  "Call FUNC with the arguments ARGUMENTS delayed."
  `(funcall ,func
            ,@(loop :for argument :in arguments
                    :collect `(delay ,argument))))

(defmacro lazycall (func &rest arguments)
  `(call-with-delayed-arguments ,func ,@arguments))

(defmacro deflazy (name (&rest args) &body body)
  (let ((genargs (mapcar (lambda (x)
                           (declare (ignore x))
    `(defun ,name ,args
       (let ,(mapcar #'list genargs args)
         (declare (ignorable ,@genargs))
         (symbol-macrolet ,(mapcar (lambda (arg genarg)
                                     `(,arg (force ,genarg)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; NOTATION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun enable-lazy-syntax ()
   (lambda (stream char)
     (declare (ignore char))
     (let* ((lst (read-delimited-list #\] stream t)))
       (if (null lst)
           (destructuring-bind (f . args) lst
             `(lazycall ,(if (listp f)
                             `(function ,f))

   (get-macro-character #\))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; EXAMPLES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(deflazy if* (pred then else)
  (if pred then else))

(defun test-if* ()
  (if (functionp #'if*)
      (format t "Yes ~S is a function!" 'if*)
      (format t "ERROR! ~S is not a function!" 'if*))
  (lazycall 'if*
            (format t "~S worked!~%" 'if*)
            (error "This shouldn't get called.")))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.