diff --git a/contrib/walker/TODO b/contrib/walker/TODO new file mode 100644 index 0000000..8b42bde --- /dev/null +++ b/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 diff --git a/contrib/walker/data-and-control-flow.lisp b/contrib/walker/data-and-control-flow.lisp new file mode 100644 index 0000000..43151fc --- /dev/null +++ b/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) diff --git a/micros.asd b/micros.asd index 9abe2d0..aeb5d87 100644 --- a/micros.asd +++ b/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"