Skip to content

Commit 0f43803

Browse files
yitzchakyitzchak
authored
Updates for new Eclector (#1430)
2 parents 9562097 + 5f9aa2c commit 0f43803

File tree

9 files changed

+81
-122
lines changed

9 files changed

+81
-122
lines changed

‎RELEASE_NOTES.md‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,12 @@
1+
# Version 2.3.0 (LLVM15) Pending
2+
3+
## Changed
4+
* Updated to Eclector v0.9.0
5+
6+
## Fixed
7+
* Use Eclector state protocol to enable readtable changes during compiling.
8+
Fixes [#1398][].
9+
110
# Version 2.2.0 (LLVM15) 2023-03-01
211

312
## Added
@@ -241,4 +250,5 @@ passing, and will miss the insightful conversations with him.
241250
[#1368]: https://github.com/clasp-developers/clasp/issues/1368
242251
[#1390]: https://github.com/clasp-developers/clasp/issues/1390
243252
[#1392]: https://github.com/clasp-developers/clasp/issues/1392
253+
[#1398]: https://github.com/clasp-developers/clasp/issues/1398
244254
[#1404]: https://github.com/clasp-developers/clasp/issues/1404

‎repos.sexp‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -88,15 +88,15 @@
8888
(:name :cleavir
8989
:repository "https://github.com/s-expressionists/Cleavir.git"
9090
:directory "src/lisp/kernel/contrib/Cleavir/"
91-
:commit "a73d313735447c63b4b11b6f8984f9b1e3e74ec9")
91+
:commit "cacdf4cca14647a258321effb3500ec4563fc570")
9292
(:name :closer-mop
9393
:repository "https://github.com/pcostanza/closer-mop.git"
9494
:directory "src/lisp/kernel/contrib/closer-mop/"
9595
:commit "d4d1c7aa6aba9b4ac8b7bb78ff4902a52126633f")
9696
(:name :concrete-syntax-tree
9797
:repository "https://github.com/s-expressionists/Concrete-Syntax-Tree.git"
9898
:directory "src/lisp/kernel/contrib/Concrete-Syntax-Tree/"
99-
:commit "4f01430c34f163356f3a2cfbf0a8a6963ff0e5ac")
99+
:commit "37291727196a3bc88a7be67c1427c52078d4b82c")
100100
(:name :documentation-utils
101101
:repository "https://github.com/Shinmera/documentation-utils.git"
102102
:directory "src/lisp/kernel/contrib/documentation-utils/"
@@ -105,7 +105,7 @@
105105
(:name :eclector
106106
:repository "https://github.com/s-expressionists/Eclector.git"
107107
:directory "src/lisp/kernel/contrib/Eclector/"
108-
:commit "dddb4d8af3eae78017baae7fb9b99e73d2a56e6b")
108+
:commit "0.9.0")
109109
(:name :esrap ; Needed both by the host and eclasp
110110
:repository "https://github.com/scymtym/esrap.git"
111111
:directory "src/lisp/kernel/contrib/esrap/"

‎src/lisp/kernel/cleavir/activate-clasp-readtables-for-eclector.lisp‎

Lines changed: 44 additions & 65 deletions
Original file line numberDiff line numberDiff line change
@@ -45,99 +45,78 @@
4545
(defvar core:*read-hook*)
4646
(defvar core:*read-preserving-whitespace-hook*)
4747

48-
49-
;;; to avoid that cl:*readtable* and eclector.readtable:*readtable* get out of sync
5048
;;; to avoid eclector.parse-result::*stack* being unbound, when *client* is bound to a parse-result-client
5149
;;; Not sure whether this a a fortunate design in eclector
5250

5351
(defclass clasp-non-cst-elector-client (clasp-cleavir::clasp-eclector-client-mixin) ())
5452
(defvar *clasp-normal-eclector-client* (make-instance 'clasp-non-cst-elector-client))
5553

56-
;;; From eclector macro functions:
57-
;;; So we need a way for readers for lists and vectors to explicitly
58-
;;; allow for backquote and comma, whereas BY DEFAULT, they should not
59-
;;; be allowed. We solve this by introducing two variables:
60-
;;; *BACKQUOTE-ALLOWED-P* and *BACKQUOTE-IN-SUBFORMS-ALLOWED-P*.
61-
;;; Initially the two are TRUE. Whenever READ is called, it binds the
62-
;;; variable *BACKQUOTE-ALLOWED-P* to the value of
63-
;;; *BACKQUOTE-IN-SUBFORMS-ALLOWED-P*, and it binds
64-
;;; *BACKQUOTE-IN-SUBFORMS-ALLOWED-P* to FALSE. If no special action
65-
;;; is taken, when READ is called recursively from a reader macro,
66-
;;; the value of *BACKQUOTE-ALLOWED-P* will be FALSE.
67-
68-
(defun read-with-readtable-synced (&optional
69-
(input-stream *standard-input*)
70-
(eof-error-p t)
71-
(eof-value nil)
72-
(recursive-p nil))
73-
(let ((eclector.readtable:*readtable* cl:*readtable*)
74-
(eclector.reader:*client* *clasp-normal-eclector-client*)
75-
#+(or)(eclector.reader::*backquote-in-subforms-allowed-p* t))
76-
(eclector.reader:read input-stream eof-error-p eof-value recursive-p)))
54+
(defmethod eclector.reader:state-value
55+
((client clasp-non-cst-elector-client) (aspect (eql 'cl:*readtable*)))
56+
cl:*readtable*)
7757

78-
;;; to avoid cl:*readtable* and eclector.readtable:*readtable* get out of sync
79-
(defun read-preserving-whitespace-with-readtable-synced (&optional
80-
(input-stream *standard-input*)
81-
(eof-error-p t)
82-
(eof-value nil)
83-
(recursive-p nil))
84-
(let ((eclector.readtable:*readtable* cl:*readtable*)
85-
(eclector.reader:*client* *clasp-normal-eclector-client*)
86-
#+(or)(eclector.reader::*backquote-in-subforms-allowed-p* t))
87-
(eclector.reader:read-preserving-whitespace input-stream eof-error-p eof-value recursive-p)))
58+
(defmethod eclector.reader:call-with-state-value
59+
((client clasp-non-cst-elector-client) thunk (aspect (eql 'cl:*readtable*)) value)
60+
(let ((cl:*readtable* value))
61+
(funcall thunk)))
62+
63+
(defun read-with-eclector (&optional (input-stream *standard-input*)
64+
(eof-error-p t)
65+
(eof-value nil)
66+
(recursive-p nil))
67+
(let ((eclector.reader:*client* *clasp-normal-eclector-client*))
68+
(eclector.reader:read input-stream eof-error-p eof-value recursive-p)))
8869

89-
;;; need also sync in clasp-cleavir::cclasp-loop-read-and-compile-file-forms
70+
(defun read-preserving-whitespace-with-eclector
71+
(&optional (input-stream *standard-input*)
72+
(eof-error-p t)
73+
(eof-value nil)
74+
(recursive-p nil))
75+
(let ((eclector.reader:*client* *clasp-normal-eclector-client*))
76+
(eclector.reader:read-preserving-whitespace input-stream eof-error-p
77+
eof-value recursive-p)))
9078

9179
(defun cl:read-from-string (string
9280
&optional (eof-error-p t) eof-value
9381
&key (start 0) (end (length string))
9482
preserve-whitespace)
95-
(let ((eclector.readtable:*readtable* cl:*readtable*)
96-
(eclector.reader:*client* *clasp-normal-eclector-client*))
83+
(let ((eclector.reader:*client* *clasp-normal-eclector-client*))
9784
(eclector.reader:read-from-string string eof-error-p eof-value
98-
:start start :end end :preserve-whitespace preserve-whitespace)))
85+
:start start :end end
86+
:preserve-whitespace preserve-whitespace)))
9987

10088
;;; Fixed in https://github.com/s-expressionists/Eclector/commit/19d2d903bb04e3e59ff0557051e134e8ee6195c7
10189
(defun cl:read-delimited-list (char &optional (input-stream *standard-input*) recursive-p)
102-
(let ((eclector.readtable:*readtable* cl:*readtable*)
103-
(eclector.reader:*client* *clasp-normal-eclector-client*))
90+
(let ((eclector.reader:*client* *clasp-normal-eclector-client*))
10491
(eclector.reader:read-delimited-list char input-stream recursive-p)))
10592

10693
(defun core::set-eclector-reader-readmacros (readtable)
10794
(eclector.reader::set-standard-macro-characters readtable)
10895
(eclector.reader::set-standard-dispatch-macro-characters readtable)
109-
(cl:set-dispatch-macro-character #\# #\a 'core:sharp-a-reader readtable)
11096
(cl:set-dispatch-macro-character #\# #\A 'core:sharp-a-reader readtable)
111-
(cl:set-dispatch-macro-character #\# #\I 'core::read-cxx-object readtable)
112-
;;; see issue https://github.com/s-expressionists/Eclector/issues/59
113-
;;; sharpsign-single-quote/relaxed will be exported, but isn't yet
114-
(cl:set-dispatch-macro-character #\# #\' (if (fboundp 'eclector.reader::sharpsign-single-quote/relaxed)
115-
'eclector.reader::sharpsign-single-quote/relaxed
116-
'eclector.reader::sharpsign-single-quote)
117-
readtable))
97+
(cl:set-dispatch-macro-character #\# #\I 'core::read-cxx-object readtable))
11898

11999
(defun init-clasp-as-eclector-reader ()
120-
(setq eclector.readtable:*readtable* cl:*readtable*)
121100
(core::set-eclector-reader-readmacros cl:*readtable*)
122101
(core::set-eclector-reader-readmacros (symbol-value 'core:+standard-readtable+))
123102
;;; also change read
124-
(setq core:*read-hook* 'read-with-readtable-synced)
125-
(setq core:*read-preserving-whitespace-hook* 'read-preserving-whitespace-with-readtable-synced)
126103
;;; read-from-string is overwritten above
127-
)
128-
129-
(eclector.readtable::init-clasp-as-eclector-reader)
130-
131-
(defun patch-object (client value-old seen-objects mapping)
132-
(multiple-value-bind (value-new found-p)
133-
(gethash value-old mapping)
134-
(if found-p
135-
value-new
136-
(progn
137-
(eclector.reader:fixup client value-old seen-objects mapping)
138-
value-old))))
139-
140-
(defmethod eclector.reader:fixup (client (object core:cxx-object) seen-objects mapping)
104+
(setq core:*read-hook* 'read-with-eclector)
105+
(setq core:*read-preserving-whitespace-hook* 'read-preserving-whitespace-with-eclector))
106+
107+
(eclector.readtable::init-clasp-as-eclector-reader)
108+
109+
(defun patch-object (client value-old seen-objects)
110+
(multiple-value-bind (state object*)
111+
(labeled-object-state client value-old)
112+
(case state
113+
((nil) ; normal object
114+
(eclector.reader:fixup client value-old seen-objects)
115+
value-old)
116+
((:final :final/circular) object*) ; fully resolved circular reference
117+
(otherwise value-old)))) ; unresolved reference - leave for later
118+
119+
(defmethod eclector.reader:fixup (client (object core:cxx-object) seen-objects)
141120
(let ((patcher (core:make-record-patcher (lambda (object)
142-
(patch-object client object seen-objects mapping)))))
121+
(patch-object client object seen-objects)))))
143122
(core:patch-object object patcher)))

‎src/lisp/kernel/cleavir/convert-special.lisp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@
1616
((,head (eql ',name)) ,cst ,environment (,system clasp-cleavir:clasp))
1717
(cst-to-ast:convert
1818
(destructuring-bind ,lambda-list (cst:raw (cst:rest ,cst))
19-
(cst:reconstruct (progn ,@body) ,cst ,system))
19+
(cst:reconstruct ,system (progn ,@body) ,cst))
2020
,environment ,system))))
2121

2222
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

‎src/lisp/kernel/cleavir/define-unicode-tables.lisp‎

Lines changed: 14 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -131,51 +131,20 @@
131131
("VERTICAL_LINE" . #.(code-char 124))
132132
("RIGHT_CURLY_BRACKET" . #.(code-char 125))
133133
("TILDE" . #.(code-char 126))
134-
("DEL" . #.(code-char 127))
135-
("U80" . #.(code-char #x80))
136-
("U81" . #.(code-char #x81))
137-
("U82" . #.(code-char #x82))
138-
("U83" . #.(code-char #x83))
139-
("U84" . #.(code-char #x84))
140-
("U85" . #.(code-char #x85))
141-
("U86" . #.(code-char #x86))
142-
("U87" . #.(code-char #x87))
143-
("U88" . #.(code-char #x88))
144-
("U89" . #.(code-char #x89))
145-
("U8A" . #.(code-char #x8a))
146-
("U8B" . #.(code-char #x8b))
147-
("U8C" . #.(code-char #x8c))
148-
("U8D" . #.(code-char #x8d))
149-
("U8E" . #.(code-char #x8e))
150-
("U8F" . #.(code-char #x8f))
151-
("U90" . #.(code-char #x90))
152-
("U91" . #.(code-char #x91))
153-
("U92" . #.(code-char #x92))
154-
("U93" . #.(code-char #x93))
155-
("U94" . #.(code-char #x94))
156-
("U95" . #.(code-char #x95))
157-
("U96" . #.(code-char #x96))
158-
("U97" . #.(code-char #x97))
159-
("U98" . #.(code-char #x98))
160-
("U99" . #.(code-char #x99))
161-
("U9A" . #.(code-char #x9a))
162-
("U9B" . #.(code-char #x9b))
163-
("U9C" . #.(code-char #x9c))
164-
("U9D" . #.(code-char #x9d))
165-
("U9E" . #.(code-char #x9e))
166-
("U9F" . #.(code-char #x9f))))
134+
("DEL" . #.(code-char 127))))
167135

168136
(defparameter *additional-clasp-character-names*
169-
(Alexandria:alist-hash-table *additional-clasp-character-mappings-alist* :test 'equal))
137+
(alexandria:alist-hash-table *additional-clasp-character-mappings-alist*
138+
:test 'equalp))
170139

171140
(defun simple-unicode-name (name)
172-
"Allow U00 - U10FFFF"
173-
(if (and (>= (length name) 3)(char= (char name 0) #\U))
174-
(let ((number (parse-integer name :start 1 :radix 16 :junk-allowed t)))
175-
(if (and (numberp number) (<= #X00 number #X10FFFF))
176-
(code-char number)
177-
nil))
178-
nil))
141+
"If NAME is a string from \"U00\" to \"U10FFFF\", return the corresponding Unicode character."
142+
(if (and (>= (length name) 3) (char-equal (char name 0) #\U))
143+
(let ((number (parse-integer name :start 1 :radix 16 :junk-allowed t)))
144+
(if (and (numberp number) (<= #X00 number #X10FFFF))
145+
(code-char number)
146+
nil))
147+
nil))
179148

180149
(defparameter *unicode-file-read* nil)
181150

@@ -229,10 +198,10 @@
229198
(process-low-mappings)))
230199

231200
(defun cl:name-char (string-designator)
232-
(let ((name (string-upcase (etypecase string-designator
233-
(string string-designator)
234-
(symbol (symbol-name string-designator))
235-
(character (string string-designator))))))
201+
(let ((name (etypecase string-designator
202+
(string string-designator)
203+
(symbol (symbol-name string-designator))
204+
(character (string string-designator)))))
236205
(eclector.reader:find-character *cst-client* name)))
237206

238207
(defun cl:char-name (char)

‎src/lisp/kernel/cleavir/inline-prep.lisp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -110,7 +110,7 @@
110110
;; FIXME: This will mess up inline definitions within macrolets etc.
111111
(env nil)
112112
(cst (if *compiling-cst*
113-
(cst:reconstruct form *compiling-cst* *clasp-system*)
113+
(cst:reconstruct *clasp-system* form *compiling-cst*)
114114
(cst:cst-from-expression form))))
115115
(fix-inline-ast (cst->ast cst env))))
116116

‎src/lisp/kernel/cleavir/satiation.lisp‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -297,10 +297,10 @@
297297
(clos:satiate #'cst:nthrest '(fixnum cst:cons-cst))
298298
;; SP NIL T T
299299
(clos:satiate #'cst:reconstruct
300-
'(cons cst:atom-cst clasp-64bit)
301-
'(cons cst:cons-cst clasp-64bit)
302-
'(cons null clasp-64bit)
303-
'(cons cons clasp-64bit)))
300+
'(clasp-64bit cons cst:atom-cst)
301+
'(clasp-64bit cons cst:cons-cst)
302+
'(clasp-64bit cons null)
303+
'(clasp-64bit cons cons)))
304304
305305
#+cst
306306
(eval-when (:load-toplevel)

‎src/lisp/kernel/cleavir/toplevel.lisp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -120,7 +120,7 @@
120120
(multiple-value-bind (expansion expandedp)
121121
(macroexpand (cst:raw cst) env)
122122
(let ((cst (if expandedp
123-
(cst:reconstruct expansion cst *cst-client*)
123+
(cst:reconstruct *cst-client* expansion cst)
124124
cst)))
125125
(etypecase cst
126126
(cst:atom-cst

‎src/lisp/kernel/cleavir/translate.lisp‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2072,14 +2072,15 @@
20722072
(origin (origin-source cst)))
20732073
(invoke-restart 'cst-to-ast:substitute-cst
20742074
(cst:reconstruct
2075+
clasp-cleavir:*clasp-system*
20752076
`(error 'cmp:compiled-program-error
20762077
:form ,(with-standard-io-syntax
20772078
(write-to-string form
20782079
:escape t :pretty t
20792080
:circle t :array nil))
20802081
:origin ',(origin-spi origin)
20812082
:condition ,(princ-to-string condition))
2082-
cst clasp-cleavir:*clasp-system* :default-source origin))))
2083+
cst :default-source origin))))
20832084

20842085
(defun cst->ast (cst &optional (env *clasp-env*))
20852086
"Compile a cst into an AST and return it.
@@ -2253,7 +2254,7 @@ COMPILE-FILE will use the default *clasp-env*."
22532254
(peek-char t source-sin nil)
22542255
;; FIXME: if :environment is provided we should probably use a different read somehow
22552256
(let* ((core:*current-source-pos-info* (cmp:compile-file-source-pos-info source-sin))
2256-
(cst (eclector.concrete-syntax-tree:cst-read source-sin nil eof-value)))
2257+
(cst (eclector.concrete-syntax-tree:read source-sin nil eof-value)))
22572258
#+debug-monitor(sys:monitor-message "source-pos ~a" core:*current-source-pos-info*)
22582259
(if (eq cst eof-value)
22592260
(return nil)

0 commit comments

Comments
 (0)