Commit 41ca2e07 authored by Marco Antoniotti's avatar Marco Antoniotti 💬
Browse files

Major reworking. Added "syntax" with 'as' keyword. Added "escaping" of...

Major reworking.  Added "syntax" with 'as' keyword.  Added "escaping" of variable, as it is in Python.
parent 760ff03b
......@@ -98,7 +98,189 @@ The main method dispatching on NIL is called when ENTER generates errors.
;;;; The WITH macro.
(defmacro with ((var ctxt-item) &body code)
;;; New version with new syntax; next, version with "optimized" code
;;; generation.
;;; (with ctxt do body)
;;; (with ctxt as var do body)
(defmacro with (&rest with-spec)
"The WITH Macro.
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.
Syntax:
The syntax of the WITH macro is the following:
with CTXT-ITEM ['as' VAR] 'DO' code
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))
)
(destructuring-bind (&optional ctxt-expr as-kwd ctxt-var &rest more)
ctxt-spec
;; Now we have all the bits and pieces of the syntax.
;; Some error checking on CTXT-SPEC.
(when (not (null more))
(cerror "ignore the ~S rest?"
"WITH macro: the call has an incorrect head ~*~S."
more
ctxt-spec))
(when as-kwd
(assert (and (symbolp as-kwd)
(string-equal "AS" as-kwd)
(symbolp ctxt-var)
ctxt-var)
(as-kwd ctxt-var)
"WITH macro: either '~A' (should be 'as') or '~A' ~
(should be a symbol) are incorrect."
as-kwd
ctxt-var))
(when (and (null as-kwd) ctxt-var)
(cerror "ignore ~S."
"WITH macro: incorrect head ~*~S; check the NIL."
ctxt-var
ctxt-spec))
;; 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
)))
)
)))
))
#+checkpoint-version
(defmacro with ((ctxt-item
&key ((:as var) (gensym "CTXVAR-") as-var-supplied-p))
&body code)
"The WITH Macro.
The macro establishes a 'context' based on the nature of CTXT-ITEM,
......@@ -141,14 +323,30 @@ See Also:
ENTER, HANDLE, EXIT, WITH-OPEN-FILE
"
(assert (symbolp var) (var) "VAR must be a symbol.")
`(let ((,var nil))
(unwind-protect
(progn
(setq ,var (enter ,ctxt-item))
(handler-case
,@code
(error (e) (handle ,var e))))
(exit ,var))))
(let* ((escape-value-var (gensym "CTXT-ESC-VAL-"))
(error-condition-var (gensym "CTCX-ERR-E-"))
)
`(let ((,escape-value-var nil))
(multiple-value-prog1
(let ((,var nil))
(unwind-protect
(progn
(setq ,var (enter ,ctxt-item))
(handler-case
,@code
(error (,error-condition-var)
(handle ,var ,error-condition-var))))
(multiple-value-prog1
(exit ,var) ; This is going to be the result of the
; whole WITH form, thanks to the magic of
; MULTIPLE-VALUE-PROG1.
,(if as-var-supplied-p
`(setf ,escape-value-var ,var)
nil))))
,(if as-var-supplied-p
`(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