extract function: make-keyword

contrib/walker/data-and-control-flow.lisp

@@ -7,17 +7,23 @@
   (defun expand-simple-walker-defclass (walker-name arguments)
     `(defclass ,walker-name (ast)
        ,(loop :for argument :in arguments
-              :collect `(,argument :initarg ,(intern (string argument) :keyword)
+              :collect `(,argument :initarg ,(make-keyword argument)
                                    :reader ,(reader-name argument)))))
 
-  (defun expand-simple-walker-defmethod-walk-form (walker-name operator-name arguments)
+  (defun expand-simple-walker-defmethod-walk-form
+      (walker-name operator-name arguments)
     (with-gensyms (walker name form env path)
-      `(defmethod walk-form ((,walker walker) (,name (eql ',operator-name)) ,form ,env ,path)
+      `(defmethod walk-form ((,walker walker)
+                             (,name (eql ',operator-name))
+                             ,form ,env ,path)
          (make-instance ',walker-name
                         ,@(loop :for argument :in arguments
                                 :for n :from 1
-                                :collect (intern (string argument) :keyword)
-                                :collect `(walk ,walker (elt ,form ,n) ,env (cons ,n ,path)))))))
+                                :collect (make-keyword argument)
+                                :collect `(walk ,walker
+                                                (elt ,form ,n)
+                                                ,env
+                                                (cons ,n ,path)))))))
 
   (defun expand-simple-walker-defmethod-visit (walker-name arguments)
     (with-gensyms (visitor ast)
@@ -28,7 +34,9 @@
   (defun expand-simple-walker (walker-name operator-name arguments)
     `(progn
        ,(expand-simple-walker-defclass walker-name arguments)
-       ,(expand-simple-walker-defmethod-walk-form walker-name operator-name arguments)
+       ,(expand-simple-walker-defmethod-walk-form walker-name
+                                                  operator-name
+                                                  arguments)
        ,(expand-simple-walker-defmethod-visit walker-name arguments))))
 
 (defmacro def-simple-walker (walker-name operator-name &rest arguments)

contrib/walker/loop-form.lisp

@@ -350,7 +350,7 @@
                      (when numeric-accumulation-p (type-spec))
                      (make-instance 'accumulation-clause
                                     :path (cons accumulation-pos path)
-                                    :keyword (intern (string keyword) :keyword)
+                                    :keyword (make-keyword keyword)
                                     :form form
                                     :into into)))))
              (conditional ()
@@ -386,7 +386,7 @@
                (let ((keyword (lookahead)))
                  (when (accept :while :until :repeat :always :never :thereis)
                    (make-instance 'termination-test-clause
-                                  :keyword (intern (string keyword) :keyword)
+                                  :keyword (make-keyword keyword)
                                   :form (walk-and-next)))))
              (for-as-clause ()
                (when (accept :for :as)

contrib/walker/utils.lisp

@@ -4,6 +4,9 @@
   (and (<= (length prefix) (length string))
        (string= prefix string :end2 (length prefix))))
 
+(defun make-keyword (x)
+  (intern (string x) :keyword))
+
 ;;; copy from alexandria
 (deftype string-designator ()
   "A string designator type. A string designator is either a string, a symbol,

contrib/walker/walker.lisp

@@ -29,7 +29,7 @@
     (prin1 (loop :for slot :in (micros/mop:class-slots (class-of object))
                  :for name := (micros/mop:slot-definition-name slot)
                  :when (slot-boundp object name)
-                 :collect (intern (string name) :keyword) :and
+                 :collect (make-keyword name) :and
                  :collect (slot-value object name))
            stream)))