PDP-10.its/src/teach/exlist.83

;;; -*- Mode:LISP -*-

(herald EXLIST)

;;; File hacking if on TOPS-20
(eval-when (eval compile load)
  (cond ((status feature TOPS-20)
	 (putprop 'teach  '(ps kmp/.teach) 'ppn))))

;;; Base setup
(eval-when (eval compile load)
  (setq base 10. ibase 10.))

;;; Macro support
(eval-when (eval compile)
  (load '((teach) macro)))

;;; Functional declarations
(declare (special *display-terminal* *disallow-interrupts*
		  *cons* *old-list*)
	 (*lexpr fresh-line
		 output 
		 program-record
		 recorded-read
		 query)
	 (*expr clear-screen
		display
		explanation-has-been-seen
		make-display-array))

(defun examine-list-doc ()
  (output
   "~%The function /"EXAMINE-LIST/" is designed to help you learn about list
operators such as CONS, CAR, CDR, and LIST. The function may be invoked with
one argument, in which case the value of that argument is used as the list to
be examined. If no argument is suplied, EXAMINE-LIST will check to see if it
has on hand another list that you have looked at, and will offer to reexamine
that one for you (this option is chosen by typing NIL at that point) or will
accept a new list to examine.

Having gotten its argument, EXAMINE-LIST will first show you what its internal 
representation as a tree looks like. Next it will tell you about how your list
could have been constructed using only the CONS operator, and how it could have
been constructed using LIST.~%"))
   


(defun examine-list-arg-default ()
  (cond  ((and *old-list*
	       (query "The last list you looked at was:~
		        ~2% ~N~
		        ~2%Shall I re-examine it for you?"
		      *old-list*))
	  (fresh-line)
	  *old-list*)
	 (t (output "~&Type in a list: ")
	    (let ((list (recorded-read)))
	      (cond((memq list '(? help))
		    (if (query "That's not a list! Want help?")
			(examine-list-doc)))
		   ((and (not (atom list))
			 (eq (car list) 'quote))
		    (output
		     "~2&Don't bother to quote it. That makes it look messy...~
		       ~%I'll pretend you didn't use quote.~%")	
		    (cadr list))
		   (t
		    (fresh-line)
		    list))))))

(defun examine-list (&optional (list (examine-list-arg-default)))
  (program-record "Function EXAMINE-LIST being invoked.")
  (explanation-has-been-seen 'examine-list)
  (cond	((null list)
	 (output
	  "~2&NIL, or (), is a special thing to Maclisp. It is both an atom ~
	   ~%and an empty list. The CAR and CDR of NIL are both NIL! NIL is ~
	   ~%also the false thing in Maclisp. In truth-value tests, anything ~
	   ~%that is not NIL is true.~%"))
	((atom list)
	 (cond ((memq list '(? help))
		(if (query "That's not a list! Want help?")
		    (examine-list-doc)))
	       (t (output "~&~S is not a list!~%" list)))) 
	((eq (car list) 'quote)
	 (output
	  "~2&Don't bother to quote it. That makes it look messy...~
	    ~%I'll pretend you didn't use quote.~%")
	 (examine-list (cadr list)))
	((not (make-display-array list nil))
	 (program-record
	  "Make-display-array failed. Examination of list aborted.")
	 (output "~2&Pick a small list for this demo or I can't do all my nice~
		  ~%display stuff on your terminal.~%"))
	(t (examine-normal-list list))))

(defun continue-display ()
  (if *display-terminal*
      (progn (clear-input tyi)
	     (output "~&Type any character when ready to continue.~%")
	     (tyi tyi)
	     (clear-screen))))
  
(defun examine-normal-list (list)
  (output "~&The list in question is: ~
	   ~%     ~N ~
	   ~%Now we'll look at how that's represented inside of Maclisp as a ~
	   ~%chain of pointers.~2%"
	  list)
  (continue-display)
  (display)
  (continue-display)
  (print-dotted list)
  (print-conses list)
  (print-lists list))

;;; Is this a list whose end is NIL?
(defun good-list (x)
  (cond ((atom x) nil)
	(t (do ((l x (cdr l)))
	       ((atom l) (null l))))))

(defun make-from-list (form)
  (cond ((null form) nil)
	((atom form) (list 'quote form))
	((good-list form)
	 (cons 'list
	       (list (make-from-list (car form))
		     (make-from-list (cdr form)))))
	(t
	 (setq *cons* form)
	 (cons 'cons
	       (list (make-from-list (car form))
		     (make-from-list (cdr form)))))))

(defun print-lists (x)
  (cond ((good-list x)
	 (output "~&You could have formed your list with LIST by:~2%")
	 (let ((*cons*))
	   (output "~N~%" (make-from-list x))
	   (if *cons*
	       (output
 	 "~2&A sequence of things in list-like form that doesn't end in NIL is~
	   ~%not really a list, and can't be formed with the operator LIST, so~
	   ~%they have to be made with CONS instead. (Note that it's subforms ~
	   ~%may use LIST if they are properly formed lists.) An example of ~
	   ~%this, using a subform of your list, is:~
	   ~2%~N  =>~
	   ~2%~N~%"
		*cons*
		(make-from-list *cons*)))))

	(t
	 (output
	  "~2&What you have typed in is not a proper list and so cannot be ~
	   ~%formed using LIST. A sequence of things in list-like form that ~
	   ~%doesn't end in NIL is not really a list, and can't be formed with~
	   ~%the operator LIST, so they have to be made with CONS instead. ~
	   ~%(Note that it's subforms may use LIST if they are properly formed~
	   ~%lists.) Your input is an example of this: ~
	   ~2%~N    =>~
	   ~2%~N~%"
	  x
	  (make-from-list x)))))

(defun print-dotted (x)
  (output
   "~2&A more compressed notation is usually used, called the dotted pair~
    ~%notation. Note that the stuff in parentheses is~
    ~%     /"<something> . <something-else>/" ~
    ~%where <something> is the left hand side of the tree and <something-else>~
    ~%is the right hand side of the tree...~2%")
  (print-dotted-worker x)
  x)

(defun print-dotted-worker (x)
  (cond ((atom x) (output "~S" x))
	(t (output "(")
	   (print-dotted-worker (car x))
	   (output " . ")
	   (print-dotted-worker (cdr x))
	   (output ")"))))

(defun print-conses (x)
  (output "~2&You could have formed the list with CONS by: ~
	   ~2%   ~N~2%"
	  (print-conses-worker x)))

(defun print-conses-worker (form)
  (cond ((null form) nil)
	((atom form) (list 'quote form))
	(t (cons 'cons
		 (list (print-conses-worker (car form))
		       (print-conses-worker (cdr form)))))))

;;; Local Modes:;
;;; Mode:LISP;
;;; Comment Column:50;
;;; End:;