Commit b1bd0660 authored by Marco Antoniotti's avatar Marco Antoniotti 💬
Browse files

New version with LOOP-like syntax.

parent 9a77dbf4
......@@ -98,6 +98,184 @@ The main method dispatching on NIL is called when ENTER generates errors.
;;;; The WITH macro.
;;; New version with more LOOP/CL syntax
;;; (with [var = ] ctxt-item do ...)
(defmacro with (&rest with-spec)
"The WITH Macro.
The actual syntax of the WITH macro is the following:
with [VAR '='] CTXT-ITEM 'do' CODE
The macro establishes a 'context' based on the nature of CTXT-ITEM,
which is the result of an evaluated expression. VAR, if supplied, is
then bound to the result of ENTERing the context; i.e., VAR is bound
to the (first) value of applying the generic function ENTER to
CTXT-ITEM and it is available within CODE. If VAR is supplied, it
'escapes' the with construct as if SETQed in the enclosind
environment.
The WITH macro guarantees that the generic function EXIT is called as
the cleanup form in an UNWIND-PROTECT before returning the values
generated by CODE of after error conditions are signaled by it. EXIT
is called with VAR
Errors generated by CODE are passed alogside VAR to the generic function
HANDLE. This is done in a HANDLER-CASE within the UNWIND-PROTECT
that wraps CODE and uses the EXIT generic function as cleanup form.
The value(s) returned by EXIT are effectively ignored.
Notes:
The inspiration for this macro comes from Python, which reinvented and
expanded the concept from Common Lisp or Pascal or even somewhere
else. Julia may have something similar with its 'do' blocks.
Note that, unlike Python, Common Lisp does not have a \"yield\"
statement or (delimited) continuations; therefore, the mapping with
Python code cannot be one-to-one.
Exceptional Situations:
If an error occurs while evaluating CTXT-ITEM, then HANDLE is not
called, while EXIT is called with NIL as argument.
See Also:
ENTER, HANDLE, EXIT, WITH-OPEN-FILE
"
(if (null with-spec) ; Easy case.
`(progn) ; Could be (values) or just ().
;; Spec with do-body OR ctxt-spec non null.
(let* ((do-body (member-if #'(lambda (m) ; Being Paranoid.
(and (symbolp m)
(or (eq 'do m)
(string-equal 'do m))))
with-spec))
(ctxt-spec (ldiff with-spec do-body))
(body (rest do-body))
)
(flet ((parse-ctxt-spec (ctxt-spec)
(let ((item1 (first ctxt-spec))
(item2 (second ctxt-spec))
)
(cond ((and (symbolp item2) (string= item2 "="))
;; This must be (VAR = CTXT-EXPR)
(assert (symbolp item1) (ctxt-spec)
"WITH macro: ~S must be a symbol." item1)
(when (nthcdr 3 ctxt-spec)
(cerror "ignore the ~S rest?"
"WITH macro: the call has an incorrect head ~*~S."
(nthcdr 3 ctxt-spec)
ctxt-spec))
(values item1 (third ctxt-spec))
)
(t
;; This must be (CTXT-EXPR)
(when (cdr ctxt-spec)
(cerror "ignore the ~S rest?"
"WITH macro: the call has an incorrect head ~*~S."
(cdr ctxt-spec)
ctxt-spec))
(values nil (first ctxt-spec)))
)))
)
(multiple-value-bind (ctxt-var ctxt-expr)
(parse-ctxt-spec ctxt-spec)
;; Now we have all the bits and pieces of the syntax.
;; No error checking on DO-BODY (not really needed it would
;; be caught before).
;; Now we can produce the code.
;; The main difference is whether the variable CTXT-VAR or
;; BODY are provided or not.
;; The variable was supplied, we need to make it "excape" it
;; from the WITH construct. If not, the code produced can
;; be simpler.
(cond ((and ctxt-var body)
;; Full spec
(let* ((escape-value-var (gensym "CTXT-ESC-VAL-"))
(error-condition-var (gensym "CTCX-ERR-E-"))
)
`(let ((,escape-value-var nil))
(multiple-value-prog1
(let ((,ctxt-var nil))
(unwind-protect
(progn
(setq ,ctxt-var (enter ,ctxt-expr))
(handler-case
,@body
(error (,error-condition-var)
(handle ,ctxt-var ,error-condition-var))))
(multiple-value-prog1
(exit ,ctxt-var) ; This is going to
; be the result of
; the whole WITH
; form, thanks to
; the magic of
; MULTIPLE-VALUE-PROG1.
(setf ,escape-value-var ,ctxt-var)
)))
(setf ,ctxt-var ,escape-value-var)
)))
)
(ctxt-var ; Null body
(let ((escape-value-var (gensym "CTXT-ESC-VAL-")))
`(let ((,escape-value-var nil))
(multiple-value-prog1
(let ((,ctxt-var nil))
(unwind-protect
(setq ,ctxt-var (enter ,ctxt-expr))
(multiple-value-prog1
(exit ,ctxt-var) ; See above.
(setf ,escape-value-var ,ctxt-var)
)))
(setf ,ctxt-var ,escape-value-var)
)))
)
(body ; Null ctxt-var
(let ((error-condition-var (gensym "CTCX-ERR-E-"))
(ctxt-var (gensym "WITH-CTXT-VAR-"))
)
`(let ((,ctxt-var nil))
(unwind-protect
(progn
(setq ,ctxt-var (enter ,ctxt-expr))
(handler-case
,@body
(error (,error-condition-var)
(handle ,ctxt-var ,error-condition-var))))
(exit ,ctxt-var) ; See above
)))
)
(t ; Null ctxt-var and null body
(let ((ctxt-var (gensym "WITH-CTXT-VAR-")))
`(let ((,ctxt-var nil))
(unwind-protect
(setq ,ctxt-var (enter ,ctxt-expr))
(exit ,ctxt-var) ; See above
)))
)
)))
)))
#|
;;; New version with new syntax; next, version with "optimized" code
;;; generation.
......@@ -275,9 +453,10 @@ ENTER, HANDLE, EXIT, WITH-OPEN-FILE
)
)))
))
|#
#| (with (ctxt-expr :as var) ...) syntax.
#+checkpoint-version
(defmacro with ((ctxt-item
&key ((:as var) (gensym "CTXVAR-") as-var-supplied-p))
&body code)
......@@ -347,6 +526,7 @@ ENTER, HANDLE, EXIT, WITH-OPEN-FILE
`(setf ,var ,escape-value-var)
nil)
))))
|#
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment