Skip to content

Commit 5fa6d4d

Browse files
yitzchakyitzchak
authored
Changes for Clasp integration (#12)
* Use gensym for all variables and tags * More sanititation * More * More more * more * More sanitation * More sanitation * Cleanup elements * Some fixes * Skip style warning * Add ignorable for termination clauses * Replace gensym with unique-name * Fix typos
1 parent 7c27373 commit 5fa6d4d

18 files changed

+580
-519
lines changed

‎code/binding.lisp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@
3838
(let ((car-p (traverse (car d-var-spec)))
3939
(cdr-p (traverse (cdr d-var-spec))))
4040
(when (and car-p cdr-p)
41-
(setf (gethash d-var-spec temps) (gensym "DE")))
41+
(setf (gethash d-var-spec temps) (unique-name :de)))
4242
(or car-p cdr-p))))))
4343
(traverse (var-spec binding))
4444
(setf (temps binding) temps))))

‎code/clause.lisp‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -101,17 +101,17 @@
101101
binding)
102102

103103
(defun add-simple-binding (clause
104-
&key (var "FORM") (type t) category (form nil formp)
104+
&key (var :form) (type t) category (form nil formp)
105105
((:ignorable ignorablep) nil)
106106
((:dynamic-extent dynamic-extent-p) nil)
107107
((:fold foldp) nil) (fold-test 'constantp))
108108
"Make a simple binding with an initial form. If the form is not specified then it will be
109109
deduced based on the type."
110110
(if (and foldp (funcall fold-test form))
111111
(values form nil)
112-
(let ((ref (if (symbolp var)
113-
var
114-
(gensym var))))
112+
(let ((ref (if (keywordp var)
113+
(unique-name var)
114+
var)))
115115
(values ref
116116
(add-binding clause
117117
(make-instance 'simple-binding

‎code/conditional-execution-clauses.lisp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -53,7 +53,7 @@
5353
:condition `(not ,(parse-token)))))
5454

5555
(defmethod body-forms ((clause conditional-clause))
56-
(let ((*it-var* (gensym)))
56+
(let ((*it-var* (unique-name :it)))
5757
`((let ((,*it-var* ,(condition clause)))
5858
(cond (,*it-var*
5959
,@(body-forms (car (then-clauses clause)))

‎code/expansion.lisp‎

Lines changed: 24 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@
1818

1919
(defun default-accumulation-variable ()
2020
(or *accumulation-variable*
21-
(setf *accumulation-variable* (gensym "ACC"))))
21+
(setf *accumulation-variable* (unique-name :acc))))
2222

2323
(defun get-scope (var)
2424
(gethash var *scopes*))
@@ -28,26 +28,26 @@
2828
(defvar *epilogue-tag*)
2929

3030
(defun prologue-body-epilogue (body-clause)
31-
(let* ((start-tag (gensym "BODY"))
32-
(body `(tagbody
33-
,@(prologue-forms body-clause)
34-
,@(step-intro-forms body-clause t)
35-
,@(step-outro-forms body-clause t)
36-
,start-tag
37-
,@(body-forms body-clause)
38-
,@(step-intro-forms body-clause nil)
39-
,@(step-outro-forms body-clause nil)
40-
(go ,start-tag)
41-
,*epilogue-tag*
42-
,@(epilogue-forms body-clause)
43-
(return-from ,*loop-name*
44-
,*accumulation-variable*)))
45-
(afterword (afterword-forms body-clause)))
46-
(if afterword
47-
`((unwind-protect
48-
,body
49-
,@afterword))
50-
`(,body))))
31+
(with-unique-names (body)
32+
(let ((body `(tagbody
33+
,@(prologue-forms body-clause)
34+
,@(step-intro-forms body-clause t)
35+
,@(step-outro-forms body-clause t)
36+
,body
37+
,@(body-forms body-clause)
38+
,@(step-intro-forms body-clause nil)
39+
,@(step-outro-forms body-clause nil)
40+
(go ,body)
41+
,*epilogue-tag*
42+
,@(epilogue-forms body-clause)
43+
(return-from ,*loop-name*
44+
,*accumulation-variable*)))
45+
(afterword (afterword-forms body-clause)))
46+
(if afterword
47+
`((unwind-protect
48+
,body
49+
,@afterword))
50+
`(,body)))))
5151

5252
(defun expand-extended-loop (client)
5353
(let* ((*accumulation-variable* nil)
@@ -64,12 +64,12 @@
6464

6565
(defun expand-simple-loop (client)
6666
(declare (ignore client))
67-
(let ((tag (gensym)))
67+
(with-unique-names (repeat)
6868
`(block nil
6969
(tagbody
70-
,tag
70+
,repeat
7171
,@*body*
72-
(go ,tag)))))
72+
(go ,repeat)))))
7373

7474
(defun expand-body (client *body* *epilogue-tag*)
7575
(trivial-with-current-source-form:with-current-source-form (*body*)

‎code/extension/being-combinations.lisp‎

Lines changed: 22 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -17,14 +17,14 @@
1717
(declare (ignore initargs))
1818
(khazern:add-binding instance (var instance))
1919
(setf (comb-ref instance) (khazern:add-simple-binding instance
20-
:var "COMB"
20+
:var :comb
2121
:form '(make-array 0
2222
:element-type 'fixnum)
2323
:type '(vector fixnum))
2424
(len-ref instance) (khazern:add-simple-binding instance
25-
:var "LEN" :type 'fixnum)
25+
:var :len :type 'fixnum)
2626
(pos-ref instance) (khazern:add-simple-binding instance
27-
:var "POS" :type 'fixnum)))
27+
:var :pos :type 'fixnum)))
2828

2929
(defmethod khazern:parse-clause
3030
((client extension-client) (region khazern:being-region) (name (eql :combination)) &key var)
@@ -52,7 +52,7 @@
5252

5353
(defun parse-being-combinations-of (instance)
5454
(setf (of-ref instance) (khazern:add-simple-binding instance
55-
:var "OF"
55+
:var :of
5656
:form (khazern:parse-token)
5757
:type 'sequence)))
5858

@@ -67,7 +67,7 @@
6767
(defmethod khazern:parse-preposition
6868
((client extension-client) (instance being-combinations) (key (eql :choose)))
6969
(setf (choose-ref instance) (khazern:add-simple-binding instance
70-
:var "CHOOSE"
70+
:var :choose
7171
:form (khazern:parse-token)
7272
:type 'fixnum)))
7373

@@ -89,16 +89,16 @@
8989
`((setq ,len-ref (length ,of-ref)
9090
,comb-ref (make-array ,choose-ref :element-type 'fixnum))
9191
,@(unless multip
92-
`((prog ((pos ,choose-ref))
93-
next
94-
(when (plusp pos)
95-
(decf pos)
96-
(setf (aref ,comb-ref pos) pos)
97-
(go next))))))
98-
(let ((next1-tag (gensym (symbol-name :next)))
99-
(next2-tag (gensym (symbol-name :next))))
92+
(khazern:with-unique-names (pos next)
93+
`((prog ((,pos ,choose-ref))
94+
,next
95+
(when (plusp ,pos)
96+
(decf ,pos)
97+
(setf (aref ,comb-ref ,pos) ,pos)
98+
(go ,next)))))))
99+
(khazern:with-unique-names (next1 next2)
100100
`( (setq ,pos-ref (1- ,choose-ref))
101-
,next1-tag
101+
,next1
102102
(when (minusp ,pos-ref)
103103
(go ,khazern:*epilogue-tag*))
104104
(unless (or (and (= (1+ ,pos-ref) ,choose-ref)
@@ -107,25 +107,26 @@
107107
(< (1+ (aref ,comb-ref ,pos-ref))
108108
(aref ,comb-ref (1+ ,pos-ref)))))
109109
(decf ,pos-ref)
110-
(go ,next1-tag))
110+
(go ,next1))
111111
(incf (aref ,comb-ref ,pos-ref))
112112
(incf ,pos-ref)
113-
,next2-tag
113+
,next2
114114
(when (< ,pos-ref ,choose-ref)
115115
(setf (aref ,comb-ref ,pos-ref)
116116
,(if multip
117117
`(aref ,comb-ref (1- ,pos-ref))
118118
`(1+ (aref ,comb-ref (1- ,pos-ref)))))
119119
(incf ,pos-ref)
120-
(go ,next2-tag)))))))
120+
(go ,next2)))))))
121121

122122
(defmethod khazern:step-outro-forms ((clause being-combinations) initialp)
123123
(declare (ignore initialp))
124124
(with-accessors ((comb-ref comb-ref)
125125
(of-ref of-ref)
126126
(result-type result-type))
127127
clause
128-
(khazern:expand-assignments (var clause) `(map ,result-type
129-
(lambda (pos)
130-
(elt ,of-ref pos))
131-
,comb-ref))))
128+
(khazern:with-unique-names (pos)
129+
(khazern:expand-assignments (var clause) `(map ,result-type
130+
(lambda (,pos)
131+
(elt ,of-ref ,pos))
132+
,comb-ref)))))

0 commit comments

Comments
 (0)