sabs-cexprs.lisp

(defmacro $ (&rest rest) `(funcall ,@rest))

(defstruct builder
  combine
  bind
  return
  return-from
  yield
  yield-from
  using
  for
  while
  try
  delay
  zero)

(defmacro %combine (expr1 expr2)
  `($ (builder-combine builder) ,expr1
      ,(if expr2
           `($ (builder-delay builder) (lambda () ,expr2))
           '($ (builder-zero builder)))))

(define-statement-abstractor (computation-expression builder)
  (:rules
     (let     ((name expr) rest) `(let ((,name ,expr)) ,rest))
     (let!    ((name expr) rest) `($ (builder-bind builder) ,expr (lambda (,name) ,rest)))
     (return  ((expr) rest)      `($ (builder-return builder) ,expr))
     (return! ((expr) rest)      `($ (builder-return-from builder) ,expr))
     (yield   ((expr) rest)      `(%combine ($ (builder-yield builder) ,expr) ,rest))
     (yield!  ((expr) rest)      `(%combine ($ (builder-yield-from builder) ,expr) ,rest))
     (use     ((name expr) rest) `($ (builder-using builder) ,expr (lambda (,name) ,rest)))
     (use!    ((name expr) rest) `($ (builder-bind builder) ,expr
                                     (lambda (x) ($ (builder-using builder) x
                                                    (lambda (,name) ,rest)))))
     (do!     ((expr) rest)           `($ (builder-bind builder) ,expr (lambda () ,rest)))
     (for     ((name expr body) rest) `(%combine ($ (builder-for builder) (lambda (,name) ,body)) ,rest))
     (while   ((expr body) rest)      `(%combine ($ (builder-while builder) (lambda () ,expr)
                                                    ($ (builder-delay builder) (lambda () ,body)))
                                                 ,rest))
     (if      ((expr then) rest)      `(%combine (if ,expr (%recurse ,then) ($ (builder-zero builder))) ,rest))
     (if-else ((expr then else) rest) `(%combine (if ,expr (%recurse ,then) ,else) ,rest))
     (try     ((expr finally) rest)   `(%combine ($ (builder-try builder)
                                                    ($ (builder-delay builder) expr)
                                                    (lambda () ,finally))
                                                 ,rest))))

(defconstant +ranged-nil+
  (make-builder
   :bind (lambda (x f) (if (and x (>= x 0) (<= x 100)) ($ f x) nil))
   :delay #'funcall
   :return #'identity))

(defmacro cexpr-do (builder &body body)
  `(statements-of (computation-expression ,builder) ,@body))

(cexpr-do +ranged-nil+
  (let  x 12)
  (let! y 11)
  (let! z 30)
  (return (+ x y z))) ;=> 53

(cexpr-do +ranged-nil+
  (let  x  12)
  (let! y -50)
  (let! z  30)
  (return (+ x y z))) ;=> nil