Chris Welty - Dissertation

APPENDIX E
Functions for Textual Descriptions of Methods

; Generate a textual description of a method.
(defun describe-method (method)
  (let* ((parameters (cl-fillers method @has-parameters))
         (local-vars (set-difference (cl-fillers method @has-local-variables) 
                                     parameters))
         (name (car (cl-fillers method @name)))
         (attached-to-immed (car (cl-fillers method @immediate-method-of)))
         (attached-to-all (cl-fillers method @method-of))
         (return-type (car (cl-fillers method @has-return-data-type))))
    (format t "[~a], ~a, is a method attached to ~a,~%" 
            (cl-ind-name method) name (value-string attached-to-immed))
    (format t "and all its subclasses:~%~a~%" (mapcar #'value-string attached-to-all))
    (format t "~%The method has ~a parameter~a" 
            (if parameters (length parameters) "no")
            (if (= (length parameters) 1) "" "s"))
    (if parameters 
      (format t ": ~a,~%" (mapcar #'value-string parameters))
      (format t ","))
    (format t "~a local variable~a"
            (if local-vars (length local-vars) "no")
            (if (= (length local-vars) 1) "" "s"))
    (if local-vars 
      (format t ":~% ~a,~%" (mapcar #'value-string local-vars))
      (format t ",~%"))
    (format t "and returns a ~a.~%" (car (cl-fillers return-type @name)))
    (format t "~%The method is implemented as follows:~%")
    (describe-implementation (car (cl-fillers method @start)))))
;
(defun describe-implementation (action &optional stack (indent 0))
  (when action
    (cond ((member action stack)
           (format t "Loops back to ~a.~%~%" (cl-ind-name action)))
          ((indent indent) 
           (format t "~a" (car (cl-fillers action @description)))
           (cond ((cl-instance? action @return) (format t ".~%~%"))
                 ((cl-instance? action @switch)
                  (format t ":~%")
                  (describe-control-split (cl-fillers action @has-switch-cases)
                                          (cons action stack) indent))
                 (t (format t ".~%") 
                    (describe-implementation (car (cl-fillers action @next-action))
                                             (cons action stack) indent)))))))
;
(defun describe-control-split (cases stack indent)
  (do ((cases cases (cdr cases)))
      ((null cases))
    (indent indent) (format t "Case ~a:~%" 
                            (value-string (car (cl-fillers (car cases) 
                                                           @case-condition))))
    (describe-implementation (car (cl-fillers (car cases) @has-case-action))
                             stack (+ 5 indent))))
; 
(defun indent (num)
  (do ((i 0 (1+ i)))
      ((= i num) t)
    (format t " ")))

Generated with Harlequin WebMaker