From 8837c5ef62d686d6649892ceee708fd6754ecd0d Mon Sep 17 00:00:00 2001
From: cxxxr <g23tlm@gmail.com>
Date: Sat, 2 Dec 2023 16:05:55 +0900
Subject: [PATCH] extract function: make-keyword

---
 contrib/walker/data-and-control-flow.lisp | 20 ++++++++++++++------
 contrib/walker/loop-form.lisp             |  4 ++--
 contrib/walker/utils.lisp                 |  3 +++
 contrib/walker/walker.lisp                |  2 +-
 4 files changed, 20 insertions(+), 9 deletions(-)

diff --git a/contrib/walker/data-and-control-flow.lisp b/contrib/walker/data-and-control-flow.lisp
index 251f382..c2bd636 100644
--- a/contrib/walker/data-and-control-flow.lisp
+++ b/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)
diff --git a/contrib/walker/loop-form.lisp b/contrib/walker/loop-form.lisp
index 599f35a..f1b1078 100644
--- a/contrib/walker/loop-form.lisp
+++ b/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)
diff --git a/contrib/walker/utils.lisp b/contrib/walker/utils.lisp
index 4b87201..17670f3 100644
--- a/contrib/walker/utils.lisp
+++ b/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,
diff --git a/contrib/walker/walker.lisp b/contrib/walker/walker.lisp
index 5ce92a5..cb4825a 100644
--- a/contrib/walker/walker.lisp
+++ b/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)))