Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
with-contexts
with-contexts
Commits
73220926
Commit
73220926
authored
Nov 14, 2020
by
Marco Antoniotti
💬
Browse files
Initial commit.
parents
Changes
14
Hide whitespace changes
Inline
Side-by-side
COPYING
0 → 100644
View file @
73220926
Copyright (c) 2020 Marco Antoniotti
All rights reserved.
Permission is hereby granted, without written agreement and without
license or royalty fees, to use, copy, modify, and distribute this
software and its documentation for any purpose, provided that the
above copyright notice and the following two paragraphs appear in all
copies of this software.
IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE TO ANY PARTY FOR DIRECT,
INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF
THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR(S),
HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
THE AUTHOR(S) UNIVERSITY, COMPANY AND/OR AFFILIATION SPECIFICALLY
DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND
THE AUTHOR(S) HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT,
UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
README.md
0 → 100644
View file @
73220926
WITH-CONTEXTS
=============
Copyright (c) 2020 Marco Antoniotti
See file COPYING for licensing information
DESCRIPTION
-----------
This library contains an implementation of a
`WITH`
macro with
"contexts" inspired by Python, which, in turn was obviously inspired
by Common Lisp macros (and other earlier languages, like Pascal).
The Python library is described in the documentation of the
`contextlib`
documentation. The current library is an implementation
that overlaps with the Python one, as a few things are available in
Common Lisp that are not available in Python and two things are
present in Python, that are not available in Common Lisp: the
`yield`
statement and built-in threading for asynchronous computations. Note
that the
`yield`
statement could be built in Common Lisp using a
delimited continuation library like
`cl-cont`
. The asynchronous
extensions could instead be directly built on top of the current
library.
Most of the Python examples described in the ... context of
`contextlib`
are directly translatable into Common Lisp using the present library.
The main difference is that, in order to leverage the Common Lisp
Condition subsystem the "protocol" that "contexts" must implement is
comprised of three generic functions:
-
`ENTER <context>`
-
`HANDLE <context> <condition>`
-
`EXIT context`
The WITH macro is practically expanded as follows.
(with (VAR CONTEXT-ITEM ...) &body CODE)
becomes
(let ((VAR NIL))
(unwind-protect
(progn
(setf VAR (ENTER CONTEXT-ITEM))
(handler-case
CODE
(error (e)
(HANDLE VAR e))
))
(EXIT VAR)))
With this setup,
`WITH-OPEN-FILE`
can be immediately rewritten as
(with (f (open "some.txt"))
(loop for line = (read-line f)
while line
do (do-stuff-to line)))
provided that the proper
`ENTER`
/
`HANDLE`
/
`EXIT`
protocol is in place.
Something like the following.
(defmethod enter ((s file-stream) &key)
(if (open-stream-p s)
s
(error "Stream ~S is not open." context-item)))
(defmethod handle ((s file-stream) (e error) &key)
(call-next-method))
(defmethod exit ((s file-stream) &key)
(when (open-stream-p s)
(close s)))
Note that in Python,
`HANDLE`
does not exist and
`EXIT`
is called
`close`
.
More Elaborated Contexts
------------------------
The
`contextlib`
Python library contains more elaborated "contexts" that
can be used to perform a number of sophisticated operations in
conjunction with the
`WITH`
statement.
### `EXIT-STACK-CONTEXT`
Python introduces
`ExitStack`
as (the following is a direct quote from
Python
`contextlib`
documentation) a context manager that is designed
to make it easy to programmatically combine other context managers and
cleanup functions, especially those that are optional or otherwise
driven by input data.
For example, a set of files may easily be handled in a single with
statement as follows:
```
(with (stack (exit-stack))
(let\* ((files (mapcar (lambda (fname)
(enter-context stack (open fname)))
\*filenames\*)))
;; Hold on to the new exit stack (not the method pointe as in the
;; Python example), but don't call its UNWIND method
(setf \*close-files\* (pop-all stack))
;; If opening any file fails, all previously opened files will be
;; closed automatically. If all files are opened successfully,
;; they will remain open even after the with statement ends.
;;
;; (unwind \*close-files\*)
;;
;; can then be invoked explicitly to close them all.
;; ...
)
```
Each instance maintains a stack of registered callbacks that are
called in reverse order when the instance is closed (either explicitly
or implicitly at the end of a
`WITH`
statement).
Documentation
-------------
Please refer to the full documentation of the
`with-contexts`
library
for more details.
A NOTE ON FORKING
-----------------
Of course you are free to fork the project subject to the current
licensing scheme. However, before you do so, I ask you to consider
plain old "cooperation" by asking me to become a developer.
It helps keeping the entropy level at an acceptable level.
---
Enjoy!
Marco Antoniotti
20200720
TIMESTAMP
0 → 100644
View file @
73220926
20200724
contexts.lisp
0 → 100644
View file @
73220926
;;;; -*- Mode: Lisp -*-
;;;; contexts.lisp
;;;; Contexts to be used with the "WITH" macro.
(
in-package
"CTXTS"
)
(
defclass
context
()
()
(
:documentation
"The Context Class.
A class that can be used in conjunction with the WITH macro.
This class is the top of the hierarchy of \"context\" classes. It
shuld not be directly instantiated."
))
(
defgeneric
is-context
(
x
)
(
:method
((
c
context
))
t
)
(
:method
((
c
t
))
nil
))
(
defun
context-p
(
x
)
(
is-context
x
))
;;;; end of file -- with-cl.lisp
library/exit-stack-context.lisp
0 → 100644
View file @
73220926
;;;; -*- Mode: Lisp -*-
;;;; exit-stack-context.lisp
;;;; Another simple example from Python's contextlib.
;;;;
;;;; See file COPYING for copyright and licensing information.
(
in-package
"CTXTS"
)
(
defclass
exit-stack-context
(
context
)
((
callback-stack
:initform
()
:reader
callback-stack
:writer
set-callback-stack
; Unexported. See POP-ALL below.
))
(
:documentation
"The Exit Stack Class.
A class that serves to collect and unwind code (callbacks) that are
collected within a WITH macro body. The methods of this class provide
more control over what happens with errors that may happen within
ENTER calls in non-straightforward contexts.
Notes;
This class provides much of the functionalities displayed in the Pythn
examples.
"
)
)
(
defgeneric
is-exit-stack-context
(
x
)
(
:method
((
x
exit-stack-context
))
t
)
(
:method
((
x
t
))
nil
))
(
defclass
error-context
(
context
)
; Maybe it should be a condition.
((
ctx
:initform
()
:reader
error-context-item
:initarg
:item
)
(
cnd
:initform
()
:reader
error-context-condition
:initarg
:error
:initarg
:condition
))
)
(
defgeneric
is-error-context
(
x
)
(
:method
((
x
error-context
))
t
)
(
:method
((
x
t
))
nil
))
(
defun
error-context-p
(
x
)
(
is-error-context
x
))
;;; Constructors.
(
defun
exit-stack
()
(
make-instance
'exit-stack-context
))
(
defun
error-context
(
item
error
)
(
make-instance
'error-context
:item
item
:error
error
))
;;; Exit Stack methods as hinted by the Python - sketchy - documentation.
;;; enter-context
(
defgeneric
enter-context
(
exit-stack
context-manager
)
(
:method
((
es
exit-stack-context
)
(
cm
context
))
(
with-slots
(
callback-stack
)
cm
(
handler-case
(
prog1
(
enter
cm
)
(
push
cm
callback-stack
))
(
error
(
e
)
(
push
(
error-context
cm
e
)
callback-stack
))
))))
(
defgeneric
push-context
(
exit-stack
context-manager
)
(
:method
((
es
exit-stack-context
)
(
cm
context
))
;; This could be a :before method for ENTER-CONTEX.
(
with-slots
(
callback-stack
)
es
(
push
cm
callback-stack
))
cm
))
(
defgeneric
callback
(
exit-stack
function
&rest
args
)
(
:method
((
es
exit-stack-context
)
(
f
function
)
&rest
args
)
(
with-slots
(
callback-stack
)
es
(
push
(
cons
f
args
)
callback-stack
))
f
))
(
defgeneric
pop-all
(
exit-stack-context
)
(
:method
((
es
exit-stack-context
))
(
let
((
nes
(
exit-stack
)))
(
set-callback-stack
(
callback-stack
es
)
nes
)
(
set-callback-stack
(
callback-stack
es
)
())
;; Note that this zeroing the callback stack is implied by the
;; "transfer" in the Python's documentation.
;; Plus the 'files' example would not work if it weren't.
nes
)))
(
defgeneric
unwind
(
exit-stack
)
;; This is the CLOSE method in Python contextlib library.
;; Note that the semantics is different as we also have the HANDLE
;; method handy.
(
:method
((
es
exit-stack-context
))
(
loop
with
cs
=
(
copy-list
(
callback-stack
es
))
while
cs
do
(
let
((
item
(
pop
cs
)))
(
typecase
item
(
context
(
exit
item
))
(
list
(
apply
(
first
item
)
(
rest
item
)))
;; (t (error "Should this be an error?"))
)))
)
)
;;;; ENTER/HANDLE/EXIT protocol.
(
defmethod
enter
((
es
exit-stack-context
)
&key
)
es
)
(
defmethod
handle
((
es
exit-stack-context
)
(
e
error
)
&key
)
;; The question is what to do with the call stack at this point.
;; If the top of the stack is an ERROR-CONTEXT (note: better call it
;; EXIT-STACK-ERROR-CONTEXT), then this is
;; something signaled by the last ENTER-CONTEXT call the ENTER.
;; Therefore we HANDLE the error on the wrapped, error generatng
;; context.
(
with-slots
(
callback-stack
)
es
(
let
((
top
(
first
callback-stack
)))
(
if
(
typep
top
'error-context
)
;; Could also ASSERT equality of E and
;; (ERROR-CONTEXT-CONDITION TOP)
(
progn
(
pop
callback-stack
)
(
handle
(
error-context-item
top
)
(
error-context-condition
top
)))
(
error
e
)))))
(
defmethod
exit
((
es
exit-stack-context
)
&key
)
(
unwind
es
))
;;;; Example from Python doc.
;;;; This should be pretty much equivalent.
#|
(with (stack (exit-stack))
(let* ((files (mapcar (lambda (fname)
(enter-context stack (open fname)))
*filenames*)))
;; Hold on to the new exit stack (not the method pointe as in the
;; Python example), but don't call its UNWIND method
(setf *close-files* (pop-all stack))
;; If opening any file fails, all previously opened files will be
;; closed automatically. If all files are opened successfully,
;; they will remain open even after the with statement ends.
;;
;; (unwind *close-files*)
;;
;; can then be invoked explicitly to close them all.
;; ...
)
|#
;;;; end of file -- exit-stack-context.lisp
library/managed-resource-context.lisp
0 → 100644
View file @
73220926
;;;; -*- Mode: Lisp -*-
;;;; resource-examples.lisp
;;;; This is the Python example shown with a "decorator".
;;;; It is not quite clear what exactly the @contextmanager decorator
;;;; does in practice. Most likely it wraps a function with a
;;;; "context" object with __enter__ and __exit__ methods that both
;;;; call the generator (i.e., the said function containig the yield
;;;; statement)
;;;;
;;;; How do we do these things in Common Lisp?
;;;;
;;;; Solution one: we just build "state" objects.
;;;;
;;;; Other solutions are not feasable in Common Lisp given the lack of
;;;; proper (delimited) continuations.
;;;;
;;;;
;;;; Notes:
;;;;
;;;; This code is just and example that should be expanded upon to
;;;; become of any use. As is, it is just a placeholder showing how to
;;;; render, more or less, the Python examples in Common Lisp.
;;;;
;;;; See file COPYING for copyright and licensing information.
(
in-package
"CTXTS"
)
;;; managed-resource-context
(
defclass
managed-resource-context
(
context
)
((
resource
:initarg
:resource
:initform
nil
))
(
:documentation
"The Managed Resource Context Class.
A placeholder class showing how to render, more or less, the Python
examples in Common Lisp."
)
)
(
defgeneric
is-managed-resource-context
(
x
)
(
:method
((
x
managed-resource-context
))
t
)
(
:method
((
x
t
))
nil
)
(
:documentation
"Returns T if the argument X is a MANAGED-RESOURCE-CONTEXT."
))
(
defun
managed-resource-context-p
(
x
)
"Returns T if the argument X is a MANAGED-RESOURCE-CONTEXT.
Notes:
This function is a synonim of IS-MANAGED-RESOURCE-CONTEXT."
(
is-managed-resource-context
x
))
;;; Constructor.
(
defun
managed-resaouce
(
id
&key
&allow-other-keys
)
(
make-instance
'managed-resource-context
:resource
id
)
)
;;;; ACQUIRE/RELEASE protocol.
(
defgeneric
acquire
(
mr
&key
)
(
:method
((
mr
managed-resource-context
)
&key
)
mr
))
(
defgeneric
release
(
mr
&key
)
(
:method
((
mr
managed-resource-context
)
&key
)
mr
))
;;;; ENTER/HANDLE/EXIT protocol.
(
defmethod
enter
((
mr
managed-resource-context
)
&key
)
(
acquire
mr
))
(
defmethod
handle
((
mr
managed-resource-context
)
(
e
error
)
&key
)
(
call-next-method
)
; (error e)
)
(
defmethod
exit
((
mr
managed-resource-context
)
&key
)
(
release
mr
))
;;;; end of file -- managed-resource-context.lisp
library/null-context.lisp
0 → 100644
View file @
73220926
;;;; -*- Mode: Lisp -*-
;;;; null-context.lisp
;;;; A very simple example from Python's contextlib.
;;;;
;;;; See file COPYING for copyright and licensing information.
(
in-package
"CTXTS"
)
(
defclass
null-context
(
context
)
((
enter-result
:initarg
:enter-result
:reader
enter-result
))
(
:default-initargs
:enter-result
nil
)
(
:documentation
"The Null Context Class.
A context that just wraps a value that it is then returned by ENTER.
See Also:
ENTER, HANDLE, EXIT, WITH, NULL-CONTEXT (Function)
"
)
)
(
defgeneric
is-null-context
(
x
)
(
:method
((
x
null-context
))
t
)
(
:method
((
x
t
))
nil
))
(
defun
null-context-p
(
x
)
(
is-null-context
x
))
;;; Constructors.
(
defun
null-context
(
&optional
enter-result
)
"Creates a NULL-CONTEXT stashing ENTER-RESULT for ENTER.
A subsequent call to ENTER on the instance will extract ENTER-RESULT and return it.
See Also:
ENTER, HANDLE, EXIT, WITH, NULL-CONTEXT (Class)
"
(
make-instance
'null-context
:enter-result
enter-result
)
)
;;;; ENTER/HANDLE/EXIT protocol.
(
defmethod
enter
((
nc
null-context
)
&key
)
(
enter-result
nc
))
(
defmethod
handle
((
nc
null-context
)
(
e
error
)
&key
)
(
call-next-method
))
(
defmethod
exit
((
nc
null-context
)
&key
)
(
call-next-method
))
;;;; end of file -- null-context.lisp
library/redirect-context.lisp
0 → 100644
View file @
73220926
;;;; -*- Mode: Lisp -*-
;;;; redirect-context.lisp
;;;; Another simple example from Python's contextlib.
;;;;
;;;; See file COPYING for copyright and licensing information.
(
in-package
"CTXTS"
)
(
defclass
redirect-context
(
context
)
((
stream
:type
stream
:initarg
:stream
:reader
redirection
)
(
saved-stream
:type
stream
:accessor
%%saved-stream
)
)
(
:documentation
"The Redirect Context Class.
This is the context superclass for redirecting I/O. The library
creates instances of this class subclasses.
See Also:
REDIRECT-OUTPUT-CONTEXT, REDIRECT-INPUT-CONTEXT,
REDIRECT-STANDARD-OUTPUT-CONTEXT, REDIRECT-ERROR-OUTPUT-CONTEXT,
ENTER, HANDLE, EXIT, WITH
"
)
)
(
defclass
redirect-output-context
(
redirect-context
)
())
(
defclass
redirect-input-context
(
redirect-context
)
())
(
defclass
redirect-standard-output-context
(
redirect-output-context
)
())
(
defclass
redirect-error-output-context
(
redirect-output-context
)
())
(
defgeneric
is-redirect-context
(
x
)
(
:method
((
x
redirect-context
))
t
)
(
:method
((
x
t
))
nil
)
(
:documentation
"Returns T if the argument X is a REDIRECT-CONTEXT."
)
)
(
defun
redirect-context-p
(
x
)
"Returns T if the argument X is a REDIRECT-CONTEXT.
Notes:
This is a synonym of IS-REDIRECT-CONTEXT."
(
is-redirect-context
x
))
;;; Constructors.
(
defmethod
initialize-instance
:before
((
x
redirect-output-context
)
&key
(
stream
*standard-output*
))
(
assert
(
streamp
stream
))
(
assert
(
output-stream-p
stream
)))
(
defmethod
initialize-instance
:before
((
x
redirect-input-context
)
&key
(
stream
*standard-input*
))
(
assert
(
streamp
stream
))
(
assert
(
input-stream-p
stream
)))
(
defun
standard-output-redirection
(
stream
)
(
make-instance
'redirect-standard-output-context
:stream
stream
))