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

contrib/walker/TODO

@@ -0,0 +1,91 @@
+- [ ] DEFINE-MODIFY-MACRO
+- [X] LOOP
+- [X] NTH-VALUE
+- [ ] CHECK-TYPE
+- [ ] COND
+- [X] WITH-INPUT-FROM-STRING: with-single-binding-form
+- [ ] DEFCONSTANT
+- [ ] WITH-COMPILATION-UNIT
+- [ ] DEFPARAMETER
+- [ ] SETF
+- [ ] DEFINE-METHOD-COMBINATION
+- [ ] DEFINE-SYMBOL-MACRO
+- [ ] WITH-STANDARD-IO-SYNTAX
+- [ ] DEFSETF
+- [ ] RETURN
+- [ ] UNTRACE
+- [ ] RESTART-BIND
+- [ ] DEFSTRUCT
+- [ ] WITH-OPEN-STREAM
+- [ ] DO
+- [ ] PUSH
+- [ ] WITH-HASH-TABLE-ITERATOR
+- [ ] DO-SYMBOLS
+- [ ] TIME
+- [ ] DEFMACRO
+- [ ] PSETQ
+- [ ] DO-EXTERNAL-SYMBOLS
+- [ ] PROG*
+- [ ] DEFINE-COMPILER-MACRO
+- [ ] PPRINT-EXIT-IF-LIST-EXHAUSTED
+- [X] OR
+- [ ] DO-ALL-SYMBOLS
+- [ ] TYPECASE
+- [ ] IN-PACKAGE
+- [ ] DOTIMES
+- [ ] PROG2
+- [ ] DEFGENERIC
+- [ ] MULTIPLE-VALUE-BIND
+- [ ] DEFPACKAGE
+- [ ] PUSHNEW
+- [ ] DEFCLASS
+- [ ] POP
+- [ ] WITH-PACKAGE-ITERATOR
+- [ ] CALL-METHOD
+- [ ] WITH-CONDITION-RESTARTS
+- [ ] HANDLER-BIND
+- [X] WITH-OPEN-FILE: with-single-binding-form
+- [ ] WITH-SLOTS
+- [ ] SHIFTF
+- [ ] PPRINT-POP
+- [ ] ASSERT
+- [X] LAMBDA
+- [X] AND
+- [ ] TRACE
+- [X] WITH-OUTPUT-TO-STRING: with-single-binding-form
+- [ ] ROTATEF
+- [ ] CASE
+- [ ] MULTIPLE-VALUE-SETQ
+- [ ] MULTIPLE-VALUE-LIST
+- [ ] ETYPECASE
+- [ ] PPRINT-LOGICAL-BLOCK
+- [ ] WITH-SIMPLE-RESTART
+- [ ] PRINT-UNREADABLE-OBJECT
+- [ ] FORMATTER
+- [ ] PROG1
+- [ ] RESTART-CASE
+- [ ] WHEN
+- [ ] REMF
+- [ ] CTYPECASE
+- [ ] IGNORE-ERRORS
+- [ ] LOOP-FINISH
+- [ ] PROG
+- [ ] UNLESS
+- [ ] DECLAIM
+- [ ] DEFINE-CONDITION
+- [ ] DEFINE-SETF-EXPANDER
+- [X] DEFUN
+- [ ] HANDLER-CASE
+- [ ] CCASE
+- [ ] DO*
+- [ ] ECASE
+- [ ] WITH-ACCESSORS
+- [ ] STEP
+- [X] DECF
+- [ ] DEFVAR
+- [ ] DESTRUCTURING-BIND
+- [X] DEFMETHOD
+- [X] INCF
+- [ ] PSETF
+- [ ] DOLIST
+- [ ] DEFTYPE

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

@@ -0,0 +1,40 @@
+(in-package #:micros/walker)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun reader-name (symbol)
+    (intern (format nil "AST-~A" symbol)))
+
+  (defun expand-simple-walker-defclass (walker-name arguments)
+    `(defclass ,walker-name (ast)
+       ,(loop :for argument :in arguments
+              :collect `(,argument :initarg ,(intern (string argument) :keyword)
+                                   :reader ,(reader-name argument)))))
+
+  (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)
+         (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)))))))
+
+  (defun expand-simple-walker-defmethod-visit (walker-name arguments)
+    (with-gensyms (visitor ast)
+      `(defmethod visit (,visitor (,ast ,walker-name))
+         ,@(loop :for argument :in arguments
+                 :collect `(visit ,visitor (,(reader-name argument) ,ast))))))
+
+  (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-visit walker-name arguments))))
+
+(defmacro def-simple-walker (walker-name operator-name &rest arguments)
+  (expand-simple-walker walker-name operator-name arguments))
+
+(def-simple-walker nth-value-form nth-value n form)
+(def-simple-walker or-form or n form)
+(def-simple-walker incf-form incf n form)
+(def-simple-walker decf-form decf n form)

micros.asd

@@ -55,7 +55,8 @@
                                            (:file "walker")
                                            (:file "defun-form")
                                            (:file "defmethod-form")
-                                           (:file "loop-form")))))
+                                           (:file "loop-form")
+                                           (:file "data-and-control-flow")))))
                (:file "lsp-api")))
 
 (defsystem "micros/tests"