aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDaniel Colascione2015-03-03 10:32:21 -0800
committerDaniel Colascione2015-03-03 10:32:32 -0800
commit02eb227e8163c6212e814b5b7e191b4d34306872 (patch)
tree246764fee19aa2d387d8cd3d53001e825fbff0fb
parent88f8a9d7d827b3780ae25e99b67e01d897fd5959 (diff)
downloademacs-02eb227e8163c6212e814b5b7e191b4d34306872.tar.gz
emacs-02eb227e8163c6212e814b5b7e191b4d34306872.zip
Rename globals in generator.el
* lisp/emacs-lisp/generator.el: Make globals conform to elisp style throughout.
-rw-r--r--lisp/ChangeLog5
-rw-r--r--lisp/emacs-lisp/generator.el156
2 files changed, 83 insertions, 78 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index af7d0d81323..e08263d4ab7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
12015-03-03 Daniel Colascione <dancol@dancol.org>
2
3 * emacs-lisp/generator.el: Make globals conform to elisp
4 style throughout.
5
12015-03-03 Artur Malabarba <bruce.connor.am@gmail.com> 62015-03-03 Artur Malabarba <bruce.connor.am@gmail.com>
2 7
3 * emacs-lisp/package.el (package-autoremove): Fix if logic. 8 * emacs-lisp/package.el (package-autoremove): Fix if logic.
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index a3759a27fdd..d41f13e29ca 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -79,14 +79,14 @@
79(require 'cl-lib) 79(require 'cl-lib)
80(require 'pcase) 80(require 'pcase)
81 81
82(defvar *cps-bindings* nil) 82(defvar cps--bindings nil)
83(defvar *cps-states* nil) 83(defvar cps--states nil)
84(defvar *cps-value-symbol* nil) 84(defvar cps--value-symbol nil)
85(defvar *cps-state-symbol* nil) 85(defvar cps--state-symbol nil)
86(defvar *cps-cleanup-table-symbol* nil) 86(defvar cps--cleanup-table-symbol nil)
87(defvar *cps-cleanup-function* nil) 87(defvar cps--cleanup-function nil)
88 88
89(defvar *cps-dynamic-wrappers* '(identity) 89(defvar cps--dynamic-wrappers '(identity)
90 "List of transformer functions to apply to atomic forms we 90 "List of transformer functions to apply to atomic forms we
91evaluate in CPS context.") 91evaluate in CPS context.")
92 92
@@ -128,10 +128,10 @@ control flow non-locally in goo that diverts this control flow to
128the CPS state machinery. 128the CPS state machinery.
129" 129"
130 (declare (indent 1)) 130 (declare (indent 1))
131 `(let ((*cps-dynamic-wrappers* 131 `(let ((cps--dynamic-wrappers
132 (cons 132 (cons
133 ,wrapper 133 ,wrapper
134 *cps-dynamic-wrappers*))) 134 cps--dynamic-wrappers)))
135 ,@body)) 135 ,@body))
136 136
137(defun cps--make-dynamic-binding-wrapper (dynamic-var static-var) 137(defun cps--make-dynamic-binding-wrapper (dynamic-var static-var)
@@ -155,13 +155,13 @@ DYNAMIC-VAR bound to STATIC-VAR."
155 "Create a new CPS state with body BODY and return the state's name." 155 "Create a new CPS state with body BODY and return the state's name."
156 (declare (indent 1)) 156 (declare (indent 1))
157 (let* ((state (cl-gensym (format "cps-state-%s-" kind)))) 157 (let* ((state (cl-gensym (format "cps-state-%s-" kind))))
158 (push (list state body *cps-cleanup-function*) *cps-states*) 158 (push (list state body cps--cleanup-function) cps--states)
159 (push state *cps-bindings*) 159 (push state cps--bindings)
160 state)) 160 state))
161 161
162(defun cps--add-binding (original-name) 162(defun cps--add-binding (original-name)
163 (car (push (cl-gensym (format "cps-binding-%s-" original-name)) 163 (car (push (cl-gensym (format "cps-binding-%s-" original-name))
164 *cps-bindings*))) 164 cps--bindings)))
165 165
166(defun cps--find-special-form-handler (form) 166(defun cps--find-special-form-handler (form)
167 (let* ((handler-name (format "cps--transform-%s" (car-safe form))) 167 (let* ((handler-name (format "cps--transform-%s" (car-safe form)))
@@ -187,17 +187,17 @@ don't yield.")
187 (not cps--yield-seen)))) 187 (not cps--yield-seen))))
188 188
189(defun cps--make-atomic-state (form next-state) 189(defun cps--make-atomic-state (form next-state)
190 (let ((tform `(prog1 ,form (setf ,*cps-state-symbol* ,next-state)))) 190 (let ((tform `(prog1 ,form (setf ,cps--state-symbol ,next-state))))
191 (cl-loop for wrapper in *cps-dynamic-wrappers* 191 (cl-loop for wrapper in cps--dynamic-wrappers
192 do (setf tform (funcall wrapper tform))) 192 do (setf tform (funcall wrapper tform)))
193 ;; Bind *cps-cleanup-function* to nil here because the wrapper 193 ;; Bind cps--cleanup-function to nil here because the wrapper
194 ;; function mechanism is responsible for cleanup here, not the 194 ;; function mechanism is responsible for cleanup here, not the
195 ;; generic cleanup mechanism. If we didn't make this binding, 195 ;; generic cleanup mechanism. If we didn't make this binding,
196 ;; we'd run cleanup handlers twice on anything that made it out 196 ;; we'd run cleanup handlers twice on anything that made it out
197 ;; to toplevel. 197 ;; to toplevel.
198 (let ((*cps-cleanup-function* nil)) 198 (let ((cps--cleanup-function nil))
199 (cps--add-state "atom" 199 (cps--add-state "atom"
200 `(setf ,*cps-value-symbol* ,tform))))) 200 `(setf ,cps--value-symbol ,tform)))))
201 201
202(defun cps--transform-1 (form next-state) 202(defun cps--transform-1 (form next-state)
203 (pcase form 203 (pcase form
@@ -221,8 +221,8 @@ don't yield.")
221 (cps--transform-1 221 (cps--transform-1
222 condition 222 condition
223 (cps--add-state "and" 223 (cps--add-state "and"
224 `(setf ,*cps-state-symbol* 224 `(setf ,cps--state-symbol
225 (if ,*cps-value-symbol* 225 (if ,cps--value-symbol
226 ,(cps--transform-1 `(and ,@rest) 226 ,(cps--transform-1 `(and ,@rest)
227 next-state) 227 next-state)
228 ,next-state))))) 228 ,next-state)))))
@@ -233,8 +233,8 @@ don't yield.")
233 (let ((tag-binding (cps--add-binding "catch-tag"))) 233 (let ((tag-binding (cps--add-binding "catch-tag")))
234 (cps--transform-1 tag 234 (cps--transform-1 tag
235 (cps--add-state "cps-update-tag" 235 (cps--add-state "cps-update-tag"
236 `(setf ,tag-binding ,*cps-value-symbol* 236 `(setf ,tag-binding ,cps--value-symbol
237 ,*cps-state-symbol* 237 ,cps--state-symbol
238 ,(cps--with-value-wrapper 238 ,(cps--with-value-wrapper
239 (cps--make-catch-wrapper 239 (cps--make-catch-wrapper
240 tag-binding next-state) 240 tag-binding next-state)
@@ -269,8 +269,8 @@ don't yield.")
269 (`(if ,cond ,then . ,else) 269 (`(if ,cond ,then . ,else)
270 (cps--transform-1 cond 270 (cps--transform-1 cond
271 (cps--add-state "if" 271 (cps--add-state "if"
272 `(setf ,*cps-state-symbol* 272 `(setf ,cps--state-symbol
273 (if ,*cps-value-symbol* 273 (if ,cps--value-symbol
274 ,(cps--transform-1 then 274 ,(cps--transform-1 then
275 next-state) 275 next-state)
276 ,(cps--transform-1 `(progn ,@else) 276 ,(cps--transform-1 `(progn ,@else)
@@ -328,8 +328,8 @@ don't yield.")
328 (cps--transform-1 328 (cps--transform-1
329 value-form 329 value-form
330 (cps--add-state "let*" 330 (cps--add-state "let*"
331 `(setf ,new-var ,*cps-value-symbol* 331 `(setf ,new-var ,cps--value-symbol
332 ,*cps-state-symbol* 332 ,cps--state-symbol
333 ,(if (or (not lexical-binding) (special-variable-p var)) 333 ,(if (or (not lexical-binding) (special-variable-p var))
334 (cps--with-dynamic-binding var new-var 334 (cps--with-dynamic-binding var new-var
335 (cps--transform-1 335 (cps--transform-1
@@ -349,8 +349,8 @@ don't yield.")
349 (cps--transform-1 349 (cps--transform-1
350 condition 350 condition
351 (cps--add-state "or" 351 (cps--add-state "or"
352 `(setf ,*cps-state-symbol* 352 `(setf ,cps--state-symbol
353 (if ,*cps-value-symbol* 353 (if ,cps--value-symbol
354 ,next-state 354 ,next-state
355 ,(cps--transform-1 355 ,(cps--transform-1
356 `(or ,@rest) next-state)))))) 356 `(or ,@rest) next-state))))))
@@ -364,13 +364,13 @@ don't yield.")
364 (let ((temp-var-symbol (cps--add-binding "prog1-temp"))) 364 (let ((temp-var-symbol (cps--add-binding "prog1-temp")))
365 (cps--add-state "prog1" 365 (cps--add-state "prog1"
366 `(setf ,temp-var-symbol 366 `(setf ,temp-var-symbol
367 ,*cps-value-symbol* 367 ,cps--value-symbol
368 ,*cps-state-symbol* 368 ,cps--state-symbol
369 ,(cps--transform-1 369 ,(cps--transform-1
370 `(progn ,@body) 370 `(progn ,@body)
371 (cps--add-state "prog1inner" 371 (cps--add-state "prog1inner"
372 `(setf ,*cps-value-symbol* ,temp-var-symbol 372 `(setf ,cps--value-symbol ,temp-var-symbol
373 ,*cps-state-symbol* ,next-state)))))))) 373 ,cps--state-symbol ,next-state))))))))
374 374
375 ;; Process `prog2'. 375 ;; Process `prog2'.
376 376
@@ -402,8 +402,8 @@ don't yield.")
402 (`(unwind-protect ,bodyform . ,unwindforms) 402 (`(unwind-protect ,bodyform . ,unwindforms)
403 ;; Signal the evaluator-generator that it needs to generate code 403 ;; Signal the evaluator-generator that it needs to generate code
404 ;; to handle cleanup forms. 404 ;; to handle cleanup forms.
405 (unless *cps-cleanup-table-symbol* 405 (unless cps--cleanup-table-symbol
406 (setf *cps-cleanup-table-symbol* (cl-gensym "cps-cleanup-table-"))) 406 (setf cps--cleanup-table-symbol (cl-gensym "cps-cleanup-table-")))
407 (let* ((unwind-state 407 (let* ((unwind-state
408 (cps--add-state 408 (cps--add-state
409 "unwind" 409 "unwind"
@@ -412,10 +412,10 @@ don't yield.")
412 ;; references inside it with lifted equivalents. 412 ;; references inside it with lifted equivalents.
413 `(progn 413 `(progn
414 ,@unwindforms 414 ,@unwindforms
415 (setf ,*cps-state-symbol* ,next-state)))) 415 (setf ,cps--state-symbol ,next-state))))
416 (old-cleanup *cps-cleanup-function*) 416 (old-cleanup cps--cleanup-function)
417 (*cps-cleanup-function* 417 (cps--cleanup-function
418 (let ((*cps-cleanup-function* nil)) 418 (let ((cps--cleanup-function nil))
419 (cps--add-state "cleanup" 419 (cps--add-state "cleanup"
420 `(progn 420 `(progn
421 ,(when old-cleanup `(funcall ,old-cleanup)) 421 ,(when old-cleanup `(funcall ,old-cleanup))
@@ -436,25 +436,25 @@ don't yield.")
436 (cps--transform-1 test loop-state)) 436 (cps--transform-1 test loop-state))
437 (loop-state-body 437 (loop-state-body
438 `(progn 438 `(progn
439 (setf ,*cps-state-symbol* 439 (setf ,cps--state-symbol
440 (if ,*cps-value-symbol* 440 (if ,cps--value-symbol
441 ,(cps--transform-1 441 ,(cps--transform-1
442 `(progn ,@body) 442 `(progn ,@body)
443 eval-loop-condition-state) 443 eval-loop-condition-state)
444 ,next-state))))) 444 ,next-state)))))
445 (push (list loop-state loop-state-body *cps-cleanup-function*) 445 (push (list loop-state loop-state-body cps--cleanup-function)
446 *cps-states*) 446 cps--states)
447 (push loop-state *cps-bindings*) 447 (push loop-state cps--bindings)
448 eval-loop-condition-state)) 448 eval-loop-condition-state))
449 449
450 ;; Process various kinds of `quote'. 450 ;; Process various kinds of `quote'.
451 451
452 (`(quote ,arg) (cps--add-state "quote" 452 (`(quote ,arg) (cps--add-state "quote"
453 `(setf ,*cps-value-symbol* (quote ,arg) 453 `(setf ,cps--value-symbol (quote ,arg)
454 ,*cps-state-symbol* ,next-state))) 454 ,cps--state-symbol ,next-state)))
455 (`(function ,arg) (cps--add-state "function" 455 (`(function ,arg) (cps--add-state "function"
456 `(setf ,*cps-value-symbol* (function ,arg) 456 `(setf ,cps--value-symbol (function ,arg)
457 ,*cps-state-symbol* ,next-state))) 457 ,cps--state-symbol ,next-state)))
458 458
459 ;; Deal with `iter-yield'. 459 ;; Deal with `iter-yield'.
460 460
@@ -463,12 +463,12 @@ don't yield.")
463 value 463 value
464 (cps--add-state "iter-yield" 464 (cps--add-state "iter-yield"
465 `(progn 465 `(progn
466 (setf ,*cps-state-symbol* 466 (setf ,cps--state-symbol
467 ,(if *cps-cleanup-function* 467 ,(if cps--cleanup-function
468 (cps--add-state "after-yield" 468 (cps--add-state "after-yield"
469 `(setf ,*cps-state-symbol* ,next-state)) 469 `(setf ,cps--state-symbol ,next-state))
470 next-state)) 470 next-state))
471 (throw 'cps--yield ,*cps-value-symbol*))))) 471 (throw 'cps--yield ,cps--value-symbol)))))
472 472
473 ;; Catch any unhandled special forms. 473 ;; Catch any unhandled special forms.
474 474
@@ -513,7 +513,7 @@ don't yield.")
513 ,form 513 ,form
514 (setf ,normal-exit-symbol t))) 514 (setf ,normal-exit-symbol t)))
515 (unless ,normal-exit-symbol 515 (unless ,normal-exit-symbol
516 (setf ,*cps-state-symbol* ,next-state))))))) 516 (setf ,cps--state-symbol ,next-state)))))))
517 517
518(defun cps--make-condition-wrapper (var next-state handlers) 518(defun cps--make-condition-wrapper (var next-state handlers)
519 ;; Each handler is both one of the transformers with which we wrap 519 ;; Each handler is both one of the transformers with which we wrap
@@ -541,7 +541,7 @@ don't yield.")
541 `(,condition 541 `(,condition
542 (setf ,error-symbol 542 (setf ,error-symbol
543 ,lexical-error-symbol 543 ,lexical-error-symbol
544 ,*cps-state-symbol* 544 ,cps--state-symbol
545 ,error-state))))))) 545 ,error-state)))))))
546 546
547(defun cps--replace-variable-references (var new-var form) 547(defun cps--replace-variable-references (var new-var form)
@@ -568,47 +568,47 @@ modified copy."
568(put 'iter-end-of-sequence 'error-message "iteration terminated") 568(put 'iter-end-of-sequence 'error-message "iteration terminated")
569 569
570(defun cps--make-close-iterator-form (terminal-state) 570(defun cps--make-close-iterator-form (terminal-state)
571 (if *cps-cleanup-table-symbol* 571 (if cps--cleanup-table-symbol
572 `(let ((cleanup (cdr (assq ,*cps-state-symbol* ,*cps-cleanup-table-symbol*)))) 572 `(let ((cleanup (cdr (assq ,cps--state-symbol ,cps--cleanup-table-symbol))))
573 (setf ,*cps-state-symbol* ,terminal-state 573 (setf ,cps--state-symbol ,terminal-state
574 ,*cps-value-symbol* nil) 574 ,cps--value-symbol nil)
575 (when cleanup (funcall cleanup))) 575 (when cleanup (funcall cleanup)))
576 `(setf ,*cps-state-symbol* ,terminal-state 576 `(setf ,cps--state-symbol ,terminal-state
577 ,*cps-value-symbol* nil))) 577 ,cps--value-symbol nil)))
578 578
579(defun cps-generate-evaluator (form) 579(defun cps-generate-evaluator (form)
580 (let* (*cps-states* 580 (let* (cps--states
581 *cps-bindings* 581 cps--bindings
582 *cps-cleanup-function* 582 cps--cleanup-function
583 (*cps-value-symbol* (cl-gensym "cps-current-value-")) 583 (cps--value-symbol (cl-gensym "cps-current-value-"))
584 (*cps-state-symbol* (cl-gensym "cps-current-state-")) 584 (cps--state-symbol (cl-gensym "cps-current-state-"))
585 ;; We make *cps-cleanup-table-symbol** non-nil when we notice 585 ;; We make *cps-cleanup-table-symbol** non-nil when we notice
586 ;; that we have cleanup processing to perform. 586 ;; that we have cleanup processing to perform.
587 (*cps-cleanup-table-symbol* nil) 587 (cps--cleanup-table-symbol nil)
588 (terminal-state (cps--add-state "terminal" 588 (terminal-state (cps--add-state "terminal"
589 `(signal 'iter-end-of-sequence 589 `(signal 'iter-end-of-sequence
590 ,*cps-value-symbol*))) 590 ,cps--value-symbol)))
591 (initial-state (cps--transform-1 591 (initial-state (cps--transform-1
592 (macroexpand-all form) 592 (macroexpand-all form)
593 terminal-state)) 593 terminal-state))
594 (finalizer-symbol 594 (finalizer-symbol
595 (when *cps-cleanup-table-symbol* 595 (when cps--cleanup-table-symbol
596 (when *cps-cleanup-table-symbol* 596 (when cps--cleanup-table-symbol
597 (cl-gensym "cps-iterator-finalizer-"))))) 597 (cl-gensym "cps-iterator-finalizer-")))))
598 `(let ,(append (list *cps-state-symbol* *cps-value-symbol*) 598 `(let ,(append (list cps--state-symbol cps--value-symbol)
599 (when *cps-cleanup-table-symbol* 599 (when cps--cleanup-table-symbol
600 (list *cps-cleanup-table-symbol*)) 600 (list cps--cleanup-table-symbol))
601 (when finalizer-symbol 601 (when finalizer-symbol
602 (list finalizer-symbol)) 602 (list finalizer-symbol))
603 (nreverse *cps-bindings*)) 603 (nreverse cps--bindings))
604 ;; Order state list so that cleanup states are always defined 604 ;; Order state list so that cleanup states are always defined
605 ;; before they're referenced. 605 ;; before they're referenced.
606 ,@(cl-loop for (state body cleanup) in (nreverse *cps-states*) 606 ,@(cl-loop for (state body cleanup) in (nreverse cps--states)
607 collect `(setf ,state (lambda () ,body)) 607 collect `(setf ,state (lambda () ,body))
608 when cleanup 608 when cleanup
609 do (cl-assert *cps-cleanup-table-symbol*) 609 do (cl-assert cps--cleanup-table-symbol)
610 and collect `(push (cons ,state ,cleanup) ,*cps-cleanup-table-symbol*)) 610 and collect `(push (cons ,state ,cleanup) ,cps--cleanup-table-symbol))
611 (setf ,*cps-state-symbol* ,initial-state) 611 (setf ,cps--state-symbol ,initial-state)
612 612
613 (let ((iterator 613 (let ((iterator
614 (lambda (op value) 614 (lambda (op value)
@@ -621,13 +621,13 @@ modified copy."
621 ((eq op :close) 621 ((eq op :close)
622 ,(cps--make-close-iterator-form terminal-state)) 622 ,(cps--make-close-iterator-form terminal-state))
623 ((eq op :next) 623 ((eq op :next)
624 (setf ,*cps-value-symbol* value) 624 (setf ,cps--value-symbol value)
625 (let ((yielded nil)) 625 (let ((yielded nil))
626 (unwind-protect 626 (unwind-protect
627 (prog1 627 (prog1
628 (catch 'cps--yield 628 (catch 'cps--yield
629 (while t 629 (while t
630 (funcall ,*cps-state-symbol*))) 630 (funcall ,cps--state-symbol)))
631 (setf yielded t)) 631 (setf yielded t))
632 (unless yielded 632 (unless yielded
633 ;; If we're exiting non-locally (error, quit, 633 ;; If we're exiting non-locally (error, quit,