blob: 237db92722c2a75013e907660ab2334824a0b3f5 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
Patch backported by Sage.
Fix from upstream that happens to work around
https://trac.sagemath.org/ticket/23011
diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp
index 77ca799..53b887c 100644
--- a/src/lsp/format.lsp
+++ b/src/lsp/format.lsp
@@ -307,11 +307,13 @@
:start (format-directive-start struct)
:end (format-directive-end struct))))
+(defconstant +format-directive-limit+ (1+ (char-code #\~)))
+
#+formatter
(defparameter *format-directive-expanders*
- (make-array char-code-limit :initial-element nil))
+ (make-array +format-directive-limit+ :initial-element nil))
(defparameter *format-directive-interpreters*
- (make-array char-code-limit :initial-element nil))
+ (make-array +format-directive-limit+ :initial-element nil))
(defparameter *default-format-error-control-string* nil)
(defparameter *default-format-error-offset* nil)
@@ -550,24 +552,24 @@
(write-string directive stream)
(interpret-directive-list stream (cdr directives) orig-args args))
(#-ecl format-directive #+ecl vector
+ (multiple-value-bind
+ (new-directives new-args)
+ (let* ((code (char-code (format-directive-character directive)))
+ (function
+ (and (< code +format-directive-limit+)
+ (svref *format-directive-interpreters* code)))
+ (*default-format-error-offset*
+ (1- (format-directive-end directive))))
+ (unless function
+ (error 'format-error
+ :complaint "Unknown format directive."))
(multiple-value-bind
(new-directives new-args)
- (let ((function
- (svref *format-directive-interpreters*
- (char-code (format-directive-character
- directive))))
- (*default-format-error-offset*
- (1- (format-directive-end directive))))
- (unless function
- (error 'format-error
- :complaint "Unknown format directive."))
- (multiple-value-bind
- (new-directives new-args)
- (funcall function stream directive
- (cdr directives) orig-args args)
- (values new-directives new-args)))
- (interpret-directive-list stream new-directives
- orig-args new-args)))))
+ (funcall function stream directive
+ (cdr directives) orig-args args)
+ (values new-directives new-args)))
+ (interpret-directive-list stream new-directives
+ orig-args new-args)))))
args))
@@ -639,11 +641,12 @@
(values `(write-string ,directive stream)
more-directives))
(format-directive
- (let ((expander
- (aref *format-directive-expanders*
- (char-code (format-directive-character directive))))
- (*default-format-error-offset*
- (1- (format-directive-end directive))))
+ (let* ((code (char-code (format-directive-character directive)))
+ (expander
+ (and (< code +format-directive-limit+)
+ (svref *format-directive-expanders* code)))
+ (*default-format-error-offset*
+ (1- (format-directive-end directive))))
(if expander
(funcall expander directive more-directives)
(error 'format-error
|
