X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/3da7d5a7e9ce7effb472f7bf0f09ee71dd84ac9b..8a4a92d5fd8d5639293f62f9c12c2712d526cb72:/src/codegen-proto.lisp?ds=sidebyside

diff --git a/src/codegen-proto.lisp b/src/codegen-proto.lisp
index 3f479b5..a3f3e51 100644
--- a/src/codegen-proto.lisp
+++ b/src/codegen-proto.lisp
@@ -155,26 +155,68 @@
    symbols."
 
   (multiple-value-bind (bvl public private)
+      ;; The hard part of this is digging through the BVL to find the slot
+      ;; names.  Collect them into an actual BVL which will be acceptable to
+      ;; `defun', and (matching) lists of the PUBLIC and PRIVATE names of the
+      ;; slots.
+
       (let ((state :mandatory)
 	    (bvl (make-list-builder))
 	    (public (make-list-builder))
 	    (private (make-list-builder)))
+
 	(labels ((recurse-arg (arg path)
+		   ;; Figure out the argument name in ARG, which might be a
+		   ;; symbol or a list with the actual argument name buried
+		   ;; in it somewhere.  Once we've found it, return the
+		   ;; appropriate entries to add to the BVL, PUBLIC, and
+		   ;; PRIVATE lists.
+		   ;;
+		   ;; The PATH indicates a route to take through the tree to
+		   ;; find the actual argument name: it's a list of
+		   ;; nonnegative integers, one for each level of structure:
+		   ;; the integer indicates which element of the list at that
+		   ;; level to descend into to find the argument name
+		   ;; according to the usual BVL syntax.  It's always
+		   ;; acceptable for a level to actually be a symbol, which
+		   ;; is then the argument name we were after.  If we reach
+		   ;; the bottom and we still have a list, then it must be a
+		   ;; (PUBLIC PRIVATE) pair.
+
 		   (cond ((symbolp arg)
+			  ;; We've bottommed out at a symbol.  If it starts
+			  ;; with a `%' then that's the private name: strip
+			  ;; the `%' to find the public name.  Otherwise, the
+			  ;; symbol is all we have.
+
 			  (let ((name (symbol-name arg)))
 			    (if (and (plusp (length name))
 				     (char= (char name 0) #\%))
 				(let ((public (intern (subseq name 1))))
 				  (values public public arg))
 				(values arg arg arg))))
+
 			 ((atom arg)
+			  ;; Any other kind of atom is obviously bogus.
 			  (error "Unexpected item ~S in lambda-list." arg))
+
 			 ((null path)
+			  ;; We've bottommed out of the path and still have a
+			  ;; list.  It must be (PUBLIC PRIVATE).
+
 			  (multiple-value-bind (public private)
 			      (if (cdr arg) (values (car arg) (cadr arg))
 				  (values (car arg) (car arg)))
 			    (values public public private)))
+
 			 (t
+			  ;; We have a list.  Take the first step in the
+			  ;; PATH, and recursively process corresponding list
+			  ;; element with the remainder of the PATH.  The
+			  ;; PUBLIC and PRIVATE slot names are fine, but we
+			  ;; must splice the given BVL entry into our list
+			  ;; structure.
+
 			  (let* ((step (car path))
 				 (mine (nthcdr step arg)))
 			    (multiple-value-bind (full public private)
@@ -184,12 +226,21 @@
 					      (cdr mine))
 				      public
 				      private))))))
+
 		 (hack-arg (arg maxdp)
+		   ;; Find the actual argument name in a BVL entry, and add
+		   ;; the appropriate entries to the `bvl', `public', and
+		   ;; `private' lists.
+
 		   (multiple-value-bind (full public-name private-name)
 		       (recurse-arg arg maxdp)
 		     (lbuild-add bvl full)
 		     (lbuild-add public public-name)
 		     (lbuild-add private private-name))))
+
+	  ;; Process the augmented BVL, extracting a standard BVL suitable
+	  ;; for `defun', and the public and private slot names into our
+	  ;; list.
 	  (dolist (arg args)
 	    (cond ((or (eq arg '&optional)
 		       (eq arg '&rest)
@@ -197,37 +248,56 @@
 		       (eq arg '&aux))
 		   (setf state arg)
 		   (lbuild-add bvl arg))
+
 		  ((eq arg '&allow-other-keys)
 		   (lbuild-add bvl arg))
+
 		  ((or (eq state :mandatory)
 		       (eq state '&rest))
 		   (hack-arg arg '()))
+
 		  ((or (eq state '&optional)
 		       (eq state '&aux))
 		   (hack-arg arg '(0)))
+
 		  ((eq state '&key)
 		   (hack-arg arg '(0 1)))
+
 		  (t
 		   (error "Confusion in ~S!" 'definst)))))
+
+	;; Done!  That was something of a performance.
 	(values (lbuild-list bvl)
 		(lbuild-list public)
 		(lbuild-list private)))
+
+    ;; Now we can actually build the pieces of the code-generation machinery.
     (let* ((inst-var (gensym "INST"))
 	   (class-name (symbolicate code '-inst))
 	   (constructor-name (symbolicate 'make- code '-inst))
 	   (keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword))
 			 public)))
+
+      ;; We have many jobs to do in the expansion.
       `(progn
+
+	 ;; A class to hold the data.
 	 (defclass ,class-name (inst)
 	   ,(mapcar (lambda (public-slot private-slot key)
 		      `(,private-slot :initarg ,key
 			      :reader ,(symbolicate 'inst- public-slot)))
 		    public private keys))
+
+	 ;; A constructor to make an instance of the class.
 	 (defun ,constructor-name (,@bvl)
 	   (make-instance ',class-name ,@(mappend #'list keys public)))
+
+	 ;; A method on `inst-metric', to feed into inlining heuristics.
 	 (defmethod inst-metric ((,inst-var ,class-name))
 	   (with-slots (,@private) ,inst-var
 	     (+ 1 ,@(mapcar (lambda (slot) `(inst-metric ,slot)) private))))
+
+	 ;; A method to actually produce the necessary output.
 	 (defmethod print-object ((,inst-var ,class-name) ,streamvar)
 	   (with-slots ,(mapcar #'list public private) ,inst-var
 	     (if *print-escape*
@@ -235,10 +305,14 @@
 		   (format ,streamvar "~@<~@{~S ~@_~S~^ ~_~}~:>"
 			   ,@(mappend #'list keys public)))
 		 (block ,code ,@body))))
+
+	 ;; Maybe export all of this stuff.
 	 ,@(and export `((export '(,class-name ,constructor-name
 				   ,@(mapcar (lambda (slot)
 					       (symbolicate 'inst- slot))
 					     public)))))
+
+	 ;; And try not to spam a REPL.
 	 ',code))))
 
 ;; Formatting utilities.