From 0245702bde208b434a7f31e4f875c641cbca3c60 Mon Sep 17 00:00:00 2001 From: cxxxr Date: Tue, 7 Nov 2023 21:44:01 +0900 Subject: [PATCH] split files --- contrib/walker/defun-form.lisp | 27 +++++++++++++++ contrib/walker/package.lisp | 3 ++ contrib/walker/types.lisp | 16 +++++++++ contrib/walker/walker.lisp | 61 +++++----------------------------- 4 files changed, 55 insertions(+), 52 deletions(-) create mode 100644 contrib/walker/defun-form.lisp create mode 100644 contrib/walker/package.lisp create mode 100644 contrib/walker/types.lisp diff --git a/contrib/walker/defun-form.lisp b/contrib/walker/defun-form.lisp new file mode 100644 index 0000000..ed09cdb --- /dev/null +++ b/contrib/walker/defun-form.lisp @@ -0,0 +1,27 @@ +(in-package :micros/walker) + +(defclass defun-form (ast) + ((name :initarg :name + :type variable-symbol + :reader ast-name) + (lambda-list :initarg :lambda-list + :reader ast-lambda-list) + (body :initarg :body + :type implict-progn-form + :reader ast-body))) + +(defmethod walk-form ((walker walker) (name (eql 'defun)) form env path) + (with-walker-bindings (name lambda-list &body body) (rest form) + (multiple-value-bind (lambda-list env) + (walk-lambda-list walker lambda-list env (cons 2 path)) + ;; TODO: declare + (make-instance 'defun-form + :name name + :lambda-list lambda-list + :body (make-instance 'implict-progn-form + :forms (walk-forms walker body env path 3)) + :path (cons 0 path))))) + +(defmethod visit (visitor (ast defun-form)) + (visit visitor (ast-lambda-list ast)) + (visit visitor (ast-body ast))) diff --git a/contrib/walker/package.lisp b/contrib/walker/package.lisp new file mode 100644 index 0000000..0390978 --- /dev/null +++ b/contrib/walker/package.lisp @@ -0,0 +1,3 @@ +(defpackage :micros/walker + (:use :cl) + (:export :collect-highlight-paths)) diff --git a/contrib/walker/types.lisp b/contrib/walker/types.lisp new file mode 100644 index 0000000..24c6ea2 --- /dev/null +++ b/contrib/walker/types.lisp @@ -0,0 +1,16 @@ +(in-package :micros/walker) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun proper-list-p (x) + (and (listp x) + (null (cdr (last x)))))) + +(deftype proper-list (&optional (element-type '*)) + (declare (ignore element-type)) + '(and list (satisfies proper-list-p))) + +(deftype variable-symbol () + '(and symbol (not keyword))) + +(deftype non-list () + '(and (not null) (not list))) diff --git a/contrib/walker/walker.lisp b/contrib/walker/walker.lisp index 8ab8f29..f10dc6c 100644 --- a/contrib/walker/walker.lisp +++ b/contrib/walker/walker.lisp @@ -1,24 +1,9 @@ -(defpackage #:micros/walker - (:use #:cl) - (:export #:collect-highlight-paths)) (in-package #:micros/walker) (define-condition unimplemented () ((context :initarg :context :reader unimplemented-context))) -(eval-when (:compile-toplevel :load-toplevel :execute) - (defun proper-list-p (x) - (and (listp x) - (null (cdr (last x)))))) - -(deftype proper-list (&optional (element-type '*)) - (declare (ignore element-type)) - '(and list (satisfies proper-list-p))) - -(deftype variable-symbol () - '(and symbol (not keyword))) - ;; copy from alexandria:parse-body (defun parse-body (body &key documentation whole) (let ((doc nil) @@ -298,16 +283,6 @@ :type implict-progn-form :reader ast-body))) -(defclass defun-form (ast) - ((name :initarg :name - :type variable-symbol - :reader ast-name) - (lambda-list :initarg :lambda-list - :reader ast-lambda-list) - (body :initarg :body - :type implict-progn-form - :reader ast-body))) - ;; walker (defclass walker () ()) @@ -465,18 +440,18 @@ walked-lambda-list))) (loop :with state := nil :for n :from 0 - :for ll :in lambda-list - :do (case ll + :for arg :in lambda-list + :do (case arg ((&aux &key &rest &body &optional) - (setf state ll)) + (setf state arg)) (otherwise (ecase state ((&rest &body) - (assert-type ll 'variable-symbol) - (add (make-instance 'lexical-variable-binding :name ll) + (assert-type arg 'variable-symbol) + (add (make-instance 'lexical-variable-binding :name arg) ; TODO: special variable (cons n path))) ((&key &optional &aux) - (let* ((var-value (uiop:ensure-list ll)) + (let* ((var-value (uiop:ensure-list arg)) (var (first var-value)) (value (second var-value))) (assert-type var 'variable-symbol) @@ -485,14 +460,14 @@ (walk walker value env (list* 1 n path))))) (when initial-value (push initial-value initial-forms)) - (add (make-instance 'lexical-variable-binding + (add (make-instance 'lexical-variable-binding ; TODO: special variable :name var :value initial-value) - (if (consp ll) + (if (consp arg) (list* 0 n path) (cons n path)))))) ((nil) - (add (make-instance 'lexical-variable-binding :name ll) + (add (make-instance 'lexical-variable-binding :name arg) ; TODO: special variable (cons n path)))))))) (values (make-instance 'lambda-list-form :variables (nreverse walked-lambda-list) @@ -741,20 +716,6 @@ (t (walk-form walker (first form) form env path)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defmethod walk-form ((walker walker) (name (eql 'defun)) form env path) - (with-walker-bindings (name lambda-list &body body) (rest form) - (multiple-value-bind (lambda-list env) - (walk-lambda-list walker lambda-list env (cons 2 path)) - (make-instance 'defun-form - :name name - :lambda-list lambda-list - :body (make-instance 'implict-progn-form - :forms (walk-forms walker body env path 3)) - :path (cons 0 path))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric visit (visitor ast)) @@ -878,10 +839,6 @@ (defmethod visit (visitor (ast macrolet-form)) (visit visitor (ast-body ast))) -(defmethod visit (visitor (ast defun-form)) - (visit visitor (ast-lambda-list ast)) - (visit visitor (ast-body ast))) - ;; (define-condition exit-visitor () ((value :initarg :value