Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
45 lines (40 sloc) 1.65 KB
(in-package :optima)
(defmacro %or (&rest forms)
"Causes the latest pattern matching to fail. After this failure, matching
continues at the next pattern."
(setq forms (remove '(fail) forms :test #'equal))
(cond ((null forms)
'(fail))
((null (rest forms))
(first forms))
((self-evaluating-object-p (first forms))
(first forms))
(t
(let ((block (gensym "BLOCK")))
`(block ,block
(tagbody
,@(loop for form in (butlast forms)
for tag = (gensym "FAIL")
;; FIXME: ITER doesn't support MACROLET in
;; iteration body. So we use SYMBOL-MACROLET
;; instead.
;collect `(return-from ,block
; (macrolet ((fail () `(go ,',tag)))
; ,form))
collect `(return-from ,block
(symbol-macrolet ((%fail (go ,tag)))
,form))
collect tag)
(return-from ,block ,(car (last forms)))))))))
(defmacro %if (test then else)
"Similar to IF except %IF also allows to call (FAIL) in THEN branch
to jump to ELSE branch."
`(%or (if ,test ,then (fail)) ,else))
(defmacro fail ()
"Causes the latest pattern matching to fail. After this failure,
matching continues at the next pattern."
;; FIXME: Don't raise an error but expand to %FAIL for the hack
;; above.
;(error "Not pattern matching.")
'%fail)
(define-symbol-macro %fail (error "Not pattern matching."))
Something went wrong with that request. Please try again.