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)))