From 3b77ee3320736899da89e2a64bf9bd183892180d Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Sun, 28 Oct 2018 11:17:06 -0700 Subject: [PATCH] Added TEACH;TS XLISP -- teaches lisp. Resolves #377. --- Makefile | 2 +- build/lisp.tcl | 31 ++ doc/programs.md | 1 + doc/teach/-read-.-this- | 5 + doc/teach/teach.bugs | 21 ++ doc/teach/to-do.7 | 67 ++++ src/teach/apropo.10 | 64 ++++ src/teach/compla.19 | 24 ++ src/teach/databa.45 | 118 +++++++ src/teach/errhan.64 | 692 ++++++++++++++++++++++++++++++++++++++++ src/teach/errhel.38 | 261 +++++++++++++++ src/teach/exlist.83 | 199 ++++++++++++ src/teach/global.15 | 22 ++ src/teach/init.41 | 155 +++++++++ src/teach/io.48 | 56 ++++ src/teach/lessn.130 | 515 ++++++++++++++++++++++++++++++ src/teach/lesson.assq | 89 ++++++ src/teach/lesson.cond | 99 ++++++ src/teach/lesson.defun | 109 +++++++ src/teach/lesson.do | 182 +++++++++++ src/teach/lesson.dot | 191 +++++++++++ src/teach/lesson.eval | 63 ++++ src/teach/lesson.fib | 102 ++++++ src/teach/lesson.info | 226 +++++++++++++ src/teach/lesson.input | 65 ++++ src/teach/lesson.intro | 228 +++++++++++++ src/teach/lesson.lambda | 143 +++++++++ src/teach/lesson.lesson | 87 +++++ src/teach/lesson.memq | 111 +++++++ src/teach/lesson.object | 177 ++++++++++ src/teach/lesson.output | 132 ++++++++ src/teach/lesson.prog | 190 +++++++++++ src/teach/lesson.setq | 48 +++ src/teach/lesson.trace | 68 ++++ src/teach/macro.29 | 99 ++++++ src/teach/more.19 | Bin 0 -> 1595 bytes src/teach/no.8 | 103 ++++++ src/teach/record.71 | 149 +++++++++ src/teach/start.2 | 18 ++ src/teach/tags.3 | 325 +++++++++++++++++++ src/teach/tdump.2 | 14 + src/teach/teach.159 | 221 +++++++++++++ src/teach/teach.dump | 5 + src/teach/teach.init | 1 + src/teach/teach.midas | 27 ++ src/teach/treepr.62 | 341 ++++++++++++++++++++ src/teach/yes.13 | 101 ++++++ 47 files changed, 5946 insertions(+), 1 deletion(-) create mode 100755 doc/teach/-read-.-this- create mode 100755 doc/teach/teach.bugs create mode 100755 doc/teach/to-do.7 create mode 100755 src/teach/apropo.10 create mode 100755 src/teach/compla.19 create mode 100755 src/teach/databa.45 create mode 100755 src/teach/errhan.64 create mode 100755 src/teach/errhel.38 create mode 100755 src/teach/exlist.83 create mode 100755 src/teach/global.15 create mode 100755 src/teach/init.41 create mode 100755 src/teach/io.48 create mode 100755 src/teach/lessn.130 create mode 100755 src/teach/lesson.assq create mode 100755 src/teach/lesson.cond create mode 100755 src/teach/lesson.defun create mode 100755 src/teach/lesson.do create mode 100755 src/teach/lesson.dot create mode 100755 src/teach/lesson.eval create mode 100755 src/teach/lesson.fib create mode 100755 src/teach/lesson.info create mode 100755 src/teach/lesson.input create mode 100755 src/teach/lesson.intro create mode 100755 src/teach/lesson.lambda create mode 100755 src/teach/lesson.lesson create mode 100755 src/teach/lesson.memq create mode 100755 src/teach/lesson.object create mode 100755 src/teach/lesson.output create mode 100755 src/teach/lesson.prog create mode 100755 src/teach/lesson.setq create mode 100755 src/teach/lesson.trace create mode 100755 src/teach/macro.29 create mode 100755 src/teach/more.19 create mode 100644 src/teach/no.8 create mode 100755 src/teach/record.71 create mode 100755 src/teach/start.2 create mode 100755 src/teach/tags.3 create mode 100755 src/teach/tdump.2 create mode 100755 src/teach/teach.159 create mode 100755 src/teach/teach.dump create mode 100644 src/teach/teach.init create mode 100755 src/teach/teach.midas create mode 100755 src/teach/treepr.62 create mode 100644 src/teach/yes.13 diff --git a/Makefile b/Makefile index e79583b8..f12aed24 100644 --- a/Makefile +++ b/Makefile @@ -31,7 +31,7 @@ DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \ xfont maxout ucode moon acount alan channa fonts games graphs humor \ kldcp libdoc lisp _mail_ midas quux scheme manual wp chess ms macdoc \ - aplogo _klfe_ pdp11 chsncp cbf rug bawden llogo eak clib + aplogo _klfe_ pdp11 chsncp cbf rug bawden llogo eak clib teach BIN = sys2 emacs _teco_ lisp liblsp alan inquir sail comlap c decsys \ graphs draw datdrw fonts fonts1 fonts2 games macsym maint imlac \ _www_ hqm gt40 llogo bawden diff --git a/build/lisp.tcl b/build/lisp.tcl index f02e44cf..029f1cdd 100644 --- a/build/lisp.tcl +++ b/build/lisp.tcl @@ -830,3 +830,34 @@ respond "?" "LLOGO\r" respond "?" "1700\r" expect ":KILL" respond "*" ":link sys1; ts llogo, llogo; ts llogo\r" + +# TEACH;TS XLISP + +respond "*" ":complr\r" +respond "_" "teach;macro\r" +respond "_" "\032" +type ":kill\r" + +respond "*" ":complr\r" +respond "_" "teach;apropos\r" +respond "_" "teach;compla\r" +respond "_" "teach;databa\r" +respond "_" "teach;errhan\r" +respond "_" "teach;errhel\r" +respond "_" "teach;exlist\r" +respond "_" "teach;io\r" +respond "_" "teach;lessn\r" +respond "_" "teach;more\r" +respond "_" "teach;record\r" +respond "_" "teach;teach\r" +respond "_" "teach;treepr\r" +respond "_" "\032" +type ":kill\r" + +respond "*" ":lisp\r" +respond "Alloc?" "n" +respond "*" "(load '((teach) start))" +respond "T" "(load '((teach) teach dump))" +expect ":KILL" + +respond "*" ":rename teach;ts xlisp,ts lisp\r" diff --git a/doc/programs.md b/doc/programs.md index 7e022549..652e21ec 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -289,6 +289,7 @@ - VTTIME, display running time on the terminal. - VV/VJ/DETREE, list jobs. - XHOST, tool for replacing host nicknames with real hostnames. +- XLISP, teaches Lisp -- part of TEACH system. - WA, a Wumpus advisor game. - WEBSER, HTTP server. - WHAT, humorous quips to various "what" questions. diff --git a/doc/teach/-read-.-this- b/doc/teach/-read-.-this- new file mode 100755 index 00000000..47ab6035 --- /dev/null +++ b/doc/teach/-read-.-this- @@ -0,0 +1,5 @@ + + +This directory is maintained by RWK and KMP. It is used for the Lisp teacher +and related things. If you think it is taking up too much space, please contact +one of us before moving or deleting anything. diff --git a/doc/teach/teach.bugs b/doc/teach/teach.bugs new file mode 100755 index 00000000..db37d5f0 --- /dev/null +++ b/doc/teach/teach.bugs @@ -0,0 +1,21 @@ +Date: 16 April 1984 16:14-EST +From: Kent M Pitman +Subject: teach-emacs +To: RREINER @ SIMTEL20 +cc: BUG-TEACH @ MIT-MC +In-reply-to: Msg of Tue 3 Apr 84 11:30:15-MST from Robert Reiner + + Date: Tue 3 Apr 84 11:30:15-MST + From: Robert Reiner + To: bug-teach at MIT-MC.ARPA + Re: teach-emac + + We use an Otrona Attache as a terminal with the Softcom program. The + Softcom progjram uses the escape character to interruopt the terminal + program and to store buffers etc. Any suggestions oon how to use + Teach-EMacs + +No. I suggest you get another kind of terminal. You will have troubles with +more than just TEACH-EMACS if you cannot send an escape character through. +-kmp + diff --git a/doc/teach/to-do.7 b/doc/teach/to-do.7 new file mode 100755 index 00000000..2836b566 --- /dev/null +++ b/doc/teach/to-do.7 @@ -0,0 +1,67 @@ +;;; -*- Mode:TEXT; -*- + +WORK TO BE DONE ON XTEACH + +0. numbered dumps for... +1. fix files + +2. Think about handlers for the control characters that do fun things +like explain that they've typed ^B or ^D or whatever and ask them if +they are losing utterly or have some idea of what magic they've +tripped over. + +3. Think about having lessons that enable features of the system so +that once they're at a certain level of sophistication, they can hack +fun things like breakpoints and stuff. + +4. Make the lessons go lots farther so that these are fun things to +think 'bout. + +5. RENAMEF and back copies. KMP says: + + I suspect the right thing is to write a subroutine which reaps + all but the most recent version and/or to set the generation + retention count of that file to 1. + +6. MORE stuff... + + (defvar **more**-chars nil) + (defmacro bind-**more**-chars (specs &body body) + `(let ((**more**-chars (append **more**-chars ',specs))) ;or some such + ,@body)) + (defun some-lesson-part () + (bind-**more**-chars ((#^A abort-lesson "Abort lesson")) + ...cruft...)) + (defun **maybe-more** (...) + (cond ... + ((assq c **more**-chars) + (funcall (assq c **more**-chars))) + ... + (flag + (format t ...hair...)))) + the hair comes from what happens if you do + (bind-**more**-chars ((#^A thing1)) + (bind-**more**-chars ((#^A thing2)) + ...)) + to get (SPACE=Continue,RUBOUT=Flush,^A=thing2) + and not thing1. the reason i suggest append is you can do + (do ((l **more**-chars (cdr l))) + ((null l)) + (cond ((not (assq (caar l) (cdr l))) ;no other awaits us + (format outstream "...")))) ;so type out info... + +7. Should we give them a script file to play with? (mention it +in LESSON INFO, if so. + +8. Lessons-- + +INFO + is there to be a special lisp for them, or just xteach itself? + +EVAL + makes the claim that evaluation will be talked about "in greater detail" +later. Hah! + application does not seem to be addressed any place. + +OBJECT + says we'll deal with uses of TYPEP in later lessons. we don't. diff --git a/src/teach/apropo.10 b/src/teach/apropo.10 new file mode 100755 index 00000000..07519ddb --- /dev/null +++ b/src/teach/apropo.10 @@ -0,0 +1,64 @@ +;;; -*- Mode:LISP; -*- + +(herald APROPOS) + +;;; APROPOS takes an argument of a string to search for as a substring +;;; in some list of strings. This list can be supplied via the arg +;;; STRUCTURE or can default to the obarray. The additional optional +;;; arg says whether to print each string that is found to match as it +;;; is found. APROPOS returns a list of the matches. + + +;;; *APROPOS-STRING* is the string to use in the search. +;;; *APROPOS-VERBOSE* is the printing flag. +;;; *APROPOS-RESULT* is the growing list of matches. +;;; *APROPOS-STRING-LENGTH* is the length of the string wanted. +;;; *APROPOS-SYM* is the current string being searched from STRUCTURE. + +(declare (special *apropos-string* *apropos-verbose* + *apropos-result* *apropos-string-length* + *apropos-sym*)) + +(defun obarrayp (x) + (and (eq (typep x) 'array) + (eq (car (arraydims x)) 'obarray))) + +(defun apropos (*apropos-string* &optional structure (*apropos-verbose* t)) + (let ((*apropos-result* nil) + (*apropos-string-length* (flatc *apropos-string*))) + (cond ((not structure) (mapatoms #'apropos-match)) + ((obarrayp structure) (mapatoms #'apropos-match structure)) + (t (mapc #'apropos-match structure))) + *apropos-result*)) + +(defun apropos-match (*apropos-sym*) + (cond ((apropos-sym-matches?) + (if *apropos-verbose* (apropos-display)) + (push *apropos-sym* *apropos-result*)))) + +(defun apropos-display () + (let ((bound? (boundp *apropos-sym*)) + (fbound? (getl *apropos-sym* + '(expr fexpr subr fsubr lsubr macro autoload)))) + (format t "~&~S" *apropos-sym*) + (cond ((or bound? fbound?) + (format t " - ") + (if bound? (format t "Bound")) + (if (and bound? fbound?) (format t ", ")) + (if fbound? (format t "~S" (car fbound?))))))) + +(defun apropos-sym-matches? () + (let* ((*apropos-sym-length* (flatc *apropos-sym*)) + (bound (1+ ;account for GETCHARN's being 1-based + (- *apropos-sym-length* *apropos-string-length*)))) + (do ((i 1 (1+ i))) + ((> i bound)) + (if (apropos-sym-matches-here? i) (return t))))) + +(defun apropos-sym-matches-here? (n) + (do ((string-subscript 1 (1+ string-subscript)) + (sym-subscript n (1+ sym-subscript))) + ((> string-subscript *apropos-string-length*) t) + (if (not (= (getcharn *apropos-string* string-subscript) + (getcharn *apropos-sym* sym-subscript))) + (return nil)))) diff --git a/src/teach/compla.19 b/src/teach/compla.19 new file mode 100755 index 00000000..efa9750b --- /dev/null +++ b/src/teach/compla.19 @@ -0,0 +1,24 @@ +;;; -*- Mode:LISP -*- + +(herald COMPLAIN) + +(defvar *complaint-handler* nil "At toplevel we don't handle complaints.") +(declare (*lexpr bug diagnose recorded-output)) + +(eval-when (eval load compile) + (cond ((not (memq compiler-state '(nil toplevel))) + (*lexpr complain)))) + +(defun complain (&rest stuff) + (if stuff + (progn + (lexpr-funcall #'diagnose stuff) + (recorded-output "~&"))) + (cond (*complaint-handler* (*throw 'complaint-handler nil)) + (t (bug "~&User error")))) + + +;;; Local Modes:; +;;; Mode:LISP; +;;; Comment Column:50; +;;; End:; diff --git a/src/teach/databa.45 b/src/teach/databa.45 new file mode 100755 index 00000000..2cc490f7 --- /dev/null +++ b/src/teach/databa.45 @@ -0,0 +1,118 @@ +;;; -*- Mode:LISP; -*- + +(herald DATABASE) + +;;; File hacking if on TOPS-20 +(eval-when (eval compile load) + (cond ((status feature TOPS-20) + (putprop 'teach '(ps kmp/.teach) 'ppn)))) + +;;; Outside functional declarations +(declare (*lexpr bug sysread) + (*expr time:print-current-time) + (special *database-new-filename* + *database-old-filename* + *database-temp-filename* + *novice-flag*)) + +;;; Macro support +(eval-when (eval compile) + (load '((teach) macro))) + +;;; Base setup +(eval-when (eval compile load) + (setq base 10. ibase 10.)) + +;;; IOTA snarfing (from BREAK, BREAK1) +(eval-when (eval compile) + (cond ((not (status feature iota)) + (load '((liblsp) iota fasl))))) + + +;; get the properties associated with an old user from the file +;; ((teach) USERID db) and initialize various user information +;; from this file. if there is a file for this user, he's not +;; considered a novice. + +(defvar *user-status-information* nil) + +(defun load-props () + (setq *user-status-information* + (cond ((probef *database-old-filename*) + (setq *novice-flag* nil) + (iota ((stream *database-old-filename* '(in ascii dsk))) + (sysread stream))) + (t (setq *novice-flag* t) + (ncons nil))))) + +;; write the properties that the user has set for himself out +;; to some file for use in the user's next TEACH-LISP session. + +(defun save-props () + (iota ((stream *database-temp-filename* '(out ascii dsk))) + (format stream ";;; -*- Mode:LISP; -*-~ + ~%;;; TEACH.~A saved user database for ~A~ + ~%;;; Created ~A by ~A~2%" + (or (get 'teach 'version) 0) + (status userid) + (time:print-current-time nil) + (status uname)) + (print *user-status-information* stream) + (cond ((status feature its) + (renamef stream *database-new-filename*)) + (t + (let ((name (truename stream))) + (close stream) + (renamef name *database-new-filename*)))))) + +;; functions for getting information out of the database. + +(defun prop (propname &optional (default nil)) + (do ((plist (plist *user-status-information*) + (cddr plist))) + ((null plist) default) + (if (eq (car plist) propname) + (return (cadr plist))))) + +(defun set-prop (propname value) + (putprop *user-status-information* value propname) + (save-props) + value) + +(defun rem-prop (propname) + (remprop *user-status-information* propname) + (save-props) + nil) + +;;; Function to note in our database that explanation about a particular +;;; type of error has been seen. + +(defun explanation-has-been-seen (name) + (let ((seen (prop 'seen))) + (if (not (memq name seen)) + (set-prop 'seen (cons name seen))))) + +(defun seen-explanation? (name) + (let ((seen (prop 'seen))) + (cond ((memq name seen) t) + (t nil)))) + + +;;; Function to note in our database that a lesson has been completed. + +(defun lesson-has-been-seen (name) + (let ((seen (prop 'lessons-seen))) + (if (not (memq name seen)) + (set-prop 'lessons-seen (cons name seen))))) + +(defun seen-lesson? (name) + (let ((seen (prop 'lessons-seen))) + (cond ((memq name seen) t) + (t nil)))) + + + +;;; Local Modes:; +;;; Mode:LISP; +;;; Comment Column:50; +;;; End:; diff --git a/src/teach/errhan.64 b/src/teach/errhan.64 new file mode 100755 index 00000000..67747da2 --- /dev/null +++ b/src/teach/errhan.64 @@ -0,0 +1,692 @@ +;;; -*- Mode:LISP; -*- + +(herald ERRHAN) + +;;; Outside functional declarations +(declare (special *user-status-information*) + (*lexpr complain + output + program-record + recorded-output + recorded-read + explain) + (*expr declare-error-reporter + defined-function? + explanation-has-been-seen + find-error-context + sysmemq)) + +;;; Get DEFSTRUCT package loaded in. +(eval-when (eval compile) + (cond ((status feature its) (load '((lisp) struct))) + (t (load '((liblsp) struct))))) + +;;; Base setup +(eval-when (eval compile load) + (setq base 10. ibase 10.)) + +;;; IOTA snarfing +(eval-when (eval compile) + (cond ((not (status feature iota)) + (load '((liblsp) iota fasl))))) + +;;; Variable declarations + +(defvar *symbol-started-with-colon-flag* nil) +(defvar *illegal-functional-notation-flag* nil) +(defvar *special-quit-atom-flag* nil) +(defvar *special-quit-atom-list* '(quit stop)) +(defvar *special-lesson-atom-flag* nil) +(defvar *special-lesson-atom-list* + '(? help info lesson + :lesson :teach:lisp + :teach-lisp teach-lisp + teach :teach)) +(defvar *errors-handled* '()) + + +;;; Data structure for doing documentation on Lisp errors handled by us. + +(defstruct (error-handled :conc-name :named) + name short-desc long-desc error-desc) + +(defmacro define-explanation (n bvl sd ld ed) + bvl ;ignored + `(progn 'compile + (putprop ',n (make-error-handled + name ',n + short-desc ',sd + long-desc ',ld + error-desc ',ed) + 'error-doc) + (push ',n *errors-handled*))) + +;;; Selectors for error-doc. +(defun short-desc-error-handled (error) + (error-handled-short-desc (get error 'error-doc))) + +(defun long-desc-error-handled (error) + (error-handled-long-desc (get error 'error-doc))) + +(defun error-desc-error-handled (error) + (error-handled-error-desc (get error 'error-doc))) + +(defun name-error-handled (error) + (error-handled-name (get error 'error-doc))) + + +;;; Let's define some error documentation! + +(define-explanation random-lossage (var) + "random lossage" + + "~2&I'm afraid I can't be of much help here. You have made a random error +that was not caught by one of the common error handlers, so I don't exactly +know what you did wrong.~2%" + + "~2& RANDOM LOSSAGE + I'm afraid I can't be of much help here. This type of error (it's called +FAIL-ACT by Maclisp occurs in a large number of cases where it can't figure +out quite what you've done so doesn't know how to help with a more explicit +message.~2%") + + +(define-explanation bad-go-tag (var) + "bad go tags" + + "~2& Not yet implemented~%" + + "~2& BAD GO TAGS + Not yet implemented.~%") + + +(define-explanation io-lossage (var) + "io errors" + + "~2& Not yet implemented.~%" + + "~2& IO LOSSAGE + Not yet implemented.~%") + + +(define-explanation wrong-type-args (var) + "type of arguments to supply to functions" + + "~2& A wrong type of args error is generated when you try to invoke +a function that expects to receive arguments of a certain type and you +give it arguments of a different type, so that it doesn't know how to +apply the function to them. For example, the function /">/" expects to +see 2 numeric arguments, so if you type + (> 3 'FOO) +Maclisp is confused because FOO is a symbol and not a number. If the value +of FOO were a number, say 4, then + (> 3 'FOO) +would still be an error, but + (> 3 FOO) +would be acceptable and would return (in my example) T.~2%" + + "~2& WRONG TYPE ARGUMENTS + A wrong type of args error is generated when you try to invoke +a function that expects to receive arguments of a certain type and you +give it arguments of a different type, so that it doesn't know how to +apply the function to them. For example, the function /">/" expects to +see 2 numeric arguments, so if you type + (> 3 'FOO) +Maclisp is confused because FOO is a symbol and not a number. If the value +of FOO were a number, say 4, then + (> 3 'FOO) +would still be an error, but + (> 3 FOO) +would be acceptable and would return T.~2%") + +(define-explanation wrong-num-args (var) + "number of arguments to supply to functions" + + "~2& The majority of functions in Maclisp know how many arguments they expect +to receive. Most of them, like ATOM, want some fixed number of arguments; +others, like PRINT, want a different number depending on the circumstances. For +example, PRINT can be given only 1 argument, as in + (PRINT 'foo) +which will print the symbol FOO on your terminal. It can be given an extra +argument of where to print its first argument. But if you gave PRINT 3 args +it would be unhappy because it would not know what to do with the third. Don't +worry about the details of this now, it is mentioned just to let you be aware +that functions can take varying numbers of arguments. + +A wrong number of args error is generated when you try to invoke a function +with a different number of arguments than it understands or expects.~%" + + + "~2& WRONG NUMBER OF ARGUMENTS + Most functions in Maclisp know how many arguments they expect to receive. +Most of them, like ATOM, want somme fixed number of arguments; others, like +PRINT, want a different number depending on the circumstances. For example, +PRINT can be given only 1 argument, as in + (PRINT 'foo) +which will print the symbol FOO on your terminal. It can be given an extra +argument of where to print its first argument. But if you gave PRINT 3 args +it would be unhappy because it would not know what to do with the third arg. +Don't worry about the details of this now, it is mentioned just to let you be +aware that functions can take varying numbers of arguments. + +A wrong number of args error is generated when you try to invoke a function +with a different number of arguments than it understands or expects.~%") + + +(define-explanation undefined-function (function) + "undefined functions" + + "~2& When Maclisp sees a list to be evaluated, it takes the first element +of the list and assumes it to be a function name. The other elements of +the list are the arguments to the function and may be symbols (variables) +or lists (other function calls). You have put ~s as the first +element of a list to be evaluated but it has no function definition. +This created an error condition.~2%" + + "~2& UNDEFINED FUNCTIONS + When Maclisp sees a list to be evaluated, it takes the first element +of the list and assumes it to be a function name. The other elements of +the list are the arguments to the function and may be symbols (variables) +or lists (other function calls). If you put a symbol as the first element +of a list to be evaluated and it has no function definition an error +condition is created.~2%") + + +(define-explanation unbound-variable (var) + "unbound variables" + +"~2& If you type a symbol all by itself to Maclisp, it will be evaluated +as a variable and its value will be typed on your console. On the other +hand, when Maclisp sees a list to be evaluated, it takes the first element +of the list and assumes it to be a function name. The other elements of +the list are the arguments to the function and may be symbols (variables) +or lists (other function calls). You have used the symbol ~S in one +of these ways, and it has no value, so an error condition has occurred.~2%" + + "~2& UNBOUND VARIABLES + + If you type a symbol all by itself to Maclisp, it will be evaluated as a +variable and its value will be typed on your console. If Maclisp does not have +a value associated with that symbol, an error is generated. On the other +hand, when Maclisp sees a list to be evaluated, it takes the first element +of the list and assumes it to be a function name. The other elements of +the list are the arguments to the function and may be symbols (variables) +or lists (other function calls). You cannot put the name of a function +outside of the parentheses.~2%") + + +;;; Error handlers + +(defmacro define-error-handler (name bvl &body body) + `(progn 'compile + (declare-error-reporter ',name) + (defun ,name ,bvl + (find-error-context) + ,@body)))) + +;;; This handler is given a 2 element list. Its CAR is the erring form. +;;; Its CDR is a cons having the correct number of args in its CDR. +;;; +;;; NCONS will either be one of: +;;; 1. a BVL-- return its length +;;; 2. (NIL . num)-- return num +;;; 3. (num1 . num2)-- if num1=num2 return num1 +;;; otherwise, return (num1 . num2)-- it takes v'ble num + +(defun num-wanted (ncons) + (cond ((listp (cdr ncons)) ;BVL + (length ncons)) + ((null (car ncons)) ;(NIL . num) + (cdr ncons)) + ((= (car ncons) (cdr ncons)) ;num1=num2 + (cdr ncons)) + (t ncons))) + +(define-error-handler wrong-num-args-handler (ncons-of-wna) + (let ((num-given (1- (length (car ncons-of-wna)))) + (num-wanted (num-wanted (cadr ncons-of-wna))) + (fnname (caar ncons-of-wna))) + (recorded-output "a wrong number of args error occurred.~2%") + (cond ((listp num-wanted) + (recorded-output "~&The function ~S takes a variable number of ~ + arguments. ~ + ~%It wants somewhere between ~D and ~D arguments, but you ~ + gave it ~D.~%" + fnname + (car num-wanted) + (cdr num-wanted) + num-given)) + (t + (recorded-output "~&The function ~S has been given ~D ~ + argument~:*~P; it should receive ~D ~ + argument~:*~P.~%" + fnname + num-given + num-wanted))) + (explain 'wrong-num-args fnname num-given num-wanted) + (complain))) + + +;;; In the case of a FAIL-ACT error we can't do much except +;;; let the poor person know they've messed up and to tell +;;; him what the system would have anyway. + +(define-error-handler random-lossage-handler (ncons-of-random-lossage) + ncons-of-random-lossage ;ignored + (recorded-output "a random error occurred.~2%") + (let ((info (caddr (errframe nil)))) + (recorded-output "~&The information we have about your error is:~%") + (cond ((= (length info) 1) + (recorded-output ";~A" (car info))) + (t + (recorded-output ";~S ~A" + (cadr info) + (car info)))) + (explain 'random-lossage) + (complain))) + +(define-error-handler wrong-type-args-handler (ncons-of-wta) + ncons-of-wta ;ignored + (recorded-output "a wrong type args error occurred.~2%") + (let ((info (caddr (errframe nil)))) + (recorded-output "~&The information we have about your error is:~%") + (cond ((= (length info) 1) + (recorded-output ";~A" (car info))) + (t + (recorded-output ";~S ~A" + (cadr info) + (car info)))) + (explain 'wrong-type-args) + (complain))) + +(define-error-handler io-lossage-handler (ncons-of-io-lossage) + ncons-of-io-lossage ;ignored + (recorded-output "an io error occurred.~2%") + (let ((info (caddr (errframe nil)))) + (recorded-output "~&The information we have about your error is:~%") + (cond ((= (length info) 1) + (recorded-output ";~A" (car info))) + (t + (recorded-output ";~S ~A" + (cadr info) + (car info)))) + (explain 'io-lossage) + (complain))) + +(define-error-handler bad-go-tag-handler (ncons-of-bgt) + ncons-of-bgt ;ignored + (recorded-output "an unseen go tag error occurred.~2%") + (let ((info (caddr (errframe nil)))) + (recorded-output "~&The information we have about your error is:~%") + (cond ((= (length info) 1) + (recorded-output ";~A" (car info))) + (t + (recorded-output ";~S ~A" + (cadr info) + (car info)))) + (explain 'bad-go-tag) + (complain))) + + +;;; What to do if the user types a garbage function name. +;;; Check to see if perhaps the user might think the function is +;;; called something else. + +(define-error-handler undefined-function-handler (ncons-of-undefined-function) + (let ((function-call (car ncons-of-undefined-function)) + (temp)) + (recorded-output "it was used in a functional position, ~ + ~%but has no definition as a function.~2%") + (cond ((setq temp (dialect-variant function-call)) + (program-record "dialect variant error") + (output "~2&Some lisps have a function by that name, but ~ + Maclisp doesn't. Maybe ~ + ~%you should find out about the Maclisp construct ~A.~ + ~%It might be what you want, though the syntax may ~ + be different.~%" + (cdr temp))) + ((numberp function-call) + (maybe-messed-up-arithmetic-call function-call)) + (t (check-for-odd-symbol function-call))) + (explain 'undefined-function function-call) + (complain))) + +;;; Odd symbols -- +;;; +;;; First char a space? eg, | 5| probably means he typed (/ 5 4). +;;; +;;; First char a number or lowercase when rest is uppercase? Probably he +;;; typed (/5 3) or (/x 4) instead of (// 5 3) or (// x 4). +;;; +;;; First char a funny symbol like //, *, +, etc. (+X 3) (*5 4) etc. + +(defun check-for-odd-symbol (name) + (let ((firstchar (getchar name 1)) + (firstcharnum (getcharn name 1))) + (cond ((memq firstchar '(* ^ // \)) + (program-record "postulating attempt at arithmetic function") + (output "~&Did you perhaps mean to use the function /"~S/" ~ + and accidentally ~ + ~%left out the space after the function name? The space ~ + is important ~ + ~%because Maclisp thought you intended ~S to be the name ~ + of your ~ + ~%function and was confused since it has no definition ~ + as a function.~%" + firstchar + name)) + ((or (= firstcharnum #\space) (weird-first-char firstcharnum name)) + (program-record "we think he typed a // when he meant \ or ////") + (output "~&Did you perhaps mean to use the function /"\/" or the ~ + function /"/////"? ~ + ~%You probably typed // as your first character and this ~ + tricked the Maclisp ~ + ~%reader into thinking that your function was named ~S. ~ + ~%If you don't understand why this confused it, or why it ~ + thought your ~ + ~%function had that funny name, you should do ~ + ~% (LESSON OBJECT) ~ + ~%at your earliest convenience.~%" + name))))) + +(defun weird-first-char (first name) + (or (and (not (< first #/0)) (not (> first #/9))) ;number + (let ((second (getcharn name 2))) + (if (and (not (< first #/a)) ;first is lower-case + (not (> first #/z))) + (or (and (not (< second #/A)) ;but second is upper-case + (not (> second #/Z))) ;indicates slashified first + (and (not (< second #/0)) ;(or maybe a digit) + (not (> second #/9))) + (= second 0.)) ;no second char + nil)))) + +;;; Number? -- user might have done (+5 5) which reads as (5 5). He might +;;; also have wanted '(5 5) tho', so this is tricky. We should think about +;;; getting the chars he types saved away someplace. In the case of a negative +;;; number, we have a better guess. Eg, (-5 5) is more likely to be a +;;; subtraction because we're sure the guy really put a "-" and also because +;;; we know negative numbers are used less than positive numbers as constant +;;; data. +;;; + +(defun maybe-messed-up-arithmetic-call (number) + (cond ((minusp number) + (program-record "we think the user accidentally meant to ~ + invoke -, so we're correcting it.") + (output "~&Did you perhaps mean to use the function /"-/" ~ + and accidentally ~ + ~%left out the space after the function name?~%")) + (t + (program-record "we aren't sure-- could have been an attempt ~ + at + or a quoted structure ~ + ~%gone wrong") + (output "~&I'm not sure what you typed here. Did you perhaps ~ + mean to type ~ + ~%(+ ~D ...) and forgot the space? The other possibility ~ + that occurs to ~ + ~%me is that you perhaps meant to type '(~D ...) and forgot ~ + the /"'/", so ~ + ~%your expression got evaluated by accident. ~ + ~2%If my first guess is correct...~%" + number + number))) + (output "~&The space is important because Maclisp thought you intended~ + ~%~D to be the name of your function, even though you are NOT~ + ~%allowed to give functions numeric names (function names can~ + ~%contain numeric characters, but can't evaluate to numbers.)~%" + number)) + +;;; Selector functions for competing definitions of Maclisp functions. +;;; Used to see if the user thinks we've a function by some warpo name. + +(defmacro define-dialect-variant (other-name Maclisp-name) + `(putprop ',other-name ',Maclisp-name 'dialect-variant)) + +(defun dialect-variant (other-name) + (get other-name 'dialect-variant)) + + +;;; UNBOUND-VARIABLE Special cases: +;;; 1. one of the special atoms (like LESSON, :TEACH, etc.) +;;; that we expect the user to think might be typeable. +;;; 2. bad functional notation disguised as an unbound +;;; variable: f(a,b) +;;; 3. symbols that have colons in front of them (might think +;;; he's at DDT or on a LispM) +;;; 4. anything else. + +(define-error-handler unbound-variable-handler (ncons-of-unbound-variable) + (let ((var (car ncons-of-unbound-variable))) + (recorded-output "~A was used as a variable, ~ + ~%but it has no value.~2%" + var) + (cond ((memq var *special-lesson-atom-list*) + (special-lesson-atom-handler var)) + ((memq var *special-quit-atom-list*) + (special-quit-atom-handler var)) + ((and (> (listen) 0.) ; type-ahead exists + (= (tyipeek) #/()) ; pending open paren against atom? + (illegal-functional-notation-check var)) + ((= (getcharn var 1) #/:) (colon-symbol var)) + (t (explain 'unbound-variable var))) + (complain))) + + +;;; this looks for the occurence of certain frequently typed atoms, +;;; such as LESSON, :LESSON, or TEACH, and lets the user know the world +;;; don't work the way he thinks. + +(defun special-lesson-atom-handler (special-lesson-atom-var) + (program-record "special lesson atom handler invoked") + (cond ((not *special-lesson-atom-flag*) + (output + "~&Typing a symbolic name at Maclisp with no parentheses around ~ + ~%it causes the name to be evaluated as a variable. /"~S/"~ + ~%has not been assigned a value, so if I evaluate that I will~ + ~%get an error. Are you perhaps looking for help with lessons~ + ~%available? If so, you should type /"(LESSON )/" with~ + ~%the parentheses. Parentheses are very important to Maclisp and~ + ~%should never be ignored when you see them in an example.~ + ~%Function names in Maclisp are found only as the first word~ + ~%after a /"(/". Now try typing (LESSON INTRO) to get the first~ + ~%lesson or (LESSON) to get a menu of available lessons.~%" + special-lesson-atom-var) + (setq *special-lesson-atom-flag* t) + (explanation-has-been-seen 'special-lesson-atom) + '*) + (t + (output + "~&Are you perhaps still confused about how to get lessons from me?~ + ~%If you need help concerning what lessons are available, you~ + ~%should type /"(LESSON)/" to get a list of all the ~ + lessons.~%") + '*)) + (clear-input tyi)) + +(defun special-quit-atom-handler (special-quit-atom-var) + (program-record "special quit atom handler invoked") + (cond ((not *special-quit-atom-flag*) + (output + "~&Typing a symbolic name at Maclisp with no parentheses around ~ + ~%it causes the name to be evaluated as a variable. /"~S/"~ + ~%has not been assigned a value, so if I evaluate that I will~ + ~%get an error. Are you perhaps trying to get out of this program?~ + ~%If so, you should type /"(QUIT)/" with the parentheses.~ + ~%Parentheses are very important to Maclisp and should never be~ + ~%ignored when you see them in an example. Function names in ~ + ~%Maclisp are found only as the first word after a /"(/" and, ~ + ~%after all, getting out of this program is done by a function.~%" + special-quit-atom-var) + (setq *special-quit-atom-flag* t) + (explanation-has-been-seen 'special-quit-atom) + '*) + (t + (output + "~&Are you perhaps still confused about how to get away from me?~ + ~%Try typing /"(QUIT)/".~%") + '*)) + (clear-input tyi)) + +;; when get unbound v'ble that doesn't fit other special cases, +;; check to see if it is of form :foo. +;; only reasons might have thought :symbol was a good idea: +;; *1. ddt command +;; *2. lispm or NIL (Reading manual, silly beasts) + +(defun colon-symbol (var) + (program-record "symbol starting with colon handler invoked") + (if (not *symbol-started-with-colon-flag*) + (progn + (setq *symbol-started-with-colon-flag* t) + (explanation-has-been-seen 'symbol-started-with-colon) + (output "~2&That symbol started with a colon. There are only a few ~ + cases in which ~ + ~%you might want to do that. (LispMachine Lisp and NIL both ~ + use symbols ~ + ~%that start with a colon for special reasons that you don't ~ + want to ~ + ~%bother with at the moment.) If you were trying to get ~ + a DDT-style ~ + ~%command, you've made an error because commands to Maclisp ~ + must be functions ~ + ~%and functions do not work that way in Maclisp.~%"))) + (explain 'unbound-variable var)) + + +;;; Checks for input of the form f(a,b) or f(a b) + +(defun comma-check (x) + (cond ((atom x) (eq x '|`,/||)) + (t + (or (comma-check (car x)) + (comma-check (cdr x)))))) + +(defun illegal-functional-notation-check (fnname) + (let ((|`-,-level/|| 1000.) (comma-flag nil)) + (declare (special |`-,-level/||)) + (setq comma-flag (comma-check (recorded-read))) + (program-record "Correcting user model of functional notation.") + (cond ((not *illegal-functional-notation-flag*) + (output "~&Maclisp doesn't use that type of syntax for ~ + functions. While ~ + ~%/"conventional/" computer languages may use a notation ~ + like ~S (...) ~ + ~%to mean apply the function ~S to a list of arguments, ~ + Maclisp uses ~ + ~%the notation (~S ...) instead. ~ + ~%The general form of a function call is: ~ + ~% ( ... ). ~ + ~%Make sure your function name always goes INSIDE the ~ + parentheses!~%" + fnname + fnname + fnname) + (setq *illegal-functional-notation-flag* t) + (explanation-has-been-seen 'illegal-functional-notation) + (if comma-flag + (output "~2&...and by the way, commas are wrong here. Put ~ + spaces between args.~ + ~%Comma means something to Maclisp which is much ~ + different than what you ~ + ~%are trying to use them for... Now try typing in ~ + that form again ~ + ~%(correctly this time) if you want...~%")) + '*) + (t + (program-record "Correcting functional syntax model again.") + (output "~&Remember: Use (~S ...), not ~S (...) ~ + ~%Also, the general form of a function call is: ~ + ~% ( ... ).~%" + fnname + fnname) + (if comma-flag + (output "~2&... and no commas! Put spaces between args. ~ + Try again...~%")) + '*)))) + + +;;; An attempt is made herein to catch some common errors that +;;; new Maclisp users tend to make that can most easily be caught +;;; by an eval-handler. These are errors that occur by putting +;;; some sort of garbage in the CAR of a list that is to eval'ed. + +;;; Eval handler hacking + ;; A necessary evil + +(defun eval-handler (nasty-form) + (caseq (caar nasty-form) + ((QUOTE) (diagnose-quoted-function nasty-form)) + (t (diagnose-random-functional-form nasty-form)))) + + +;;; input of form ('FNNAME ...) +(defun diagnose-quoted-function (form) + (let (((functional-form . arg-list) form)) + (cond ((cddr functional-form) + (diagnose-random-functional-form form)) + (t + (let ((function-name (cadr functional-form))) + (cond ((defined-function? function-name) + (explain-dont-quote-functions function-name) + (eval (cons function-name arg-list))) + (t + (explain-put-quote-outside form) + form))))))) + +;;; input of the form ('FNNAME ...) where FNNAME is a recognized function. +(defun explain-dont-quote-functions (name) + (program-record "Explaining not to quote functions." tyo) + (explanation-has-been-seen 'dont-quote-functions) + (output "~&You seem to have quoted the function ~S ...~ + ~%That isn't necessary. In fact, it's really wrong.~ + ~%Do just:~ + ~% (~S ...) ~ + ~%No need to put in the quote. Anyway, since you're ~ + ~%just learning, I'll correct the error and continue...~2%" + name + name)) + +;;; input of the form ('FNNAME ...) where FNNAME isn't a recognized function. +(defun explain-put-quote-outside (form) + (setf (car form) (cadr (car form))) ;((quote x) ...) => (x ...) + (program-record "Explaining to put ' outside the form.") + (explanation-has-been-seen 'put-quote-outside) + (output "~&You seem to have put the quote mark inside a form. ~ + ~%You said: ~ + ~% ~N~ + ~%where I bet you meant: ~ + ~% '~N.~ + ~%Remember the ' always goes on the outside of the thing ~ + ~%you are trying to quote! I'll correct it this time for ~ + ~%you -- real Maclisp isn't so forgiving...~2%" + `((quote ,(car form)) ,@(cdr form)) + form)) + +;;; input of the form ((...) ...) --uninterpretable garbage. +(defun diagnose-random-functional-form (form) + (program-record "Random functional form dianosis") + (explanation-has-been-seen 'random-functional-form) + (complain "~&The form~ + ~% ~N~ + ~%is completely meaningless ... ~ + ~%The form for a lisp expression is a function name inside ~ + ~%the first parenthesis followed by arguments to the function~ + ~%separated by spaces. The first thing inside the parentheses~ + ~%is not a function name here, so I can't evaluate it.~%" + form)) + +;;; We really want to use the system ^G, but we want it recorded +;;; in our various files that it was typed. + +(defun redefined-^G-handler (x y) + x y ;ignored + (let ((errset nil)) + (errset (program-record "^G typed") nil)) + (^G)) + + +;;; Local Modes:; +;;; Mode:LISP; +;;; Comment Column:50; +;;; End:; diff --git a/src/teach/errhel.38 b/src/teach/errhel.38 new file mode 100755 index 00000000..06ac43f1 --- /dev/null +++ b/src/teach/errhel.38 @@ -0,0 +1,261 @@ +-*- Mode:LISP; -*- + +(herald ERRHEL) + +(declare (special *errors-handled*) + (*lexpr bug + output + prop + query + program-record + recorded-output + recorded-sysread) + (*expr set-prop + explanation-has-been-seen + short-desc-error-handled + long-desc-error-handled + error-desc-error-handled + name-error-handled)) + +;;; File hacking if on TOPS-20 +(eval-when (eval compile load) + (cond ((status feature TOPS-20) + (putprop 'teach '(ps kmp/.teach) 'ppn)))) + +;;; Macros +(eval-when (eval compile) + (load '((teach) macro))) + +;;; Base setup +(eval-when (eval compile load) + (setq base 10. ibase 10.)) + +;;; IOTA snarfing +(eval-when (eval compile) + (cond ((not (status feature iota)) + (load '((liblsp) iota fasl))))) + +;; The following is a fairly general set of functions for dealing with a +;; list of things that we want to be able to use in a menu and to choose +;; entries and do something with them. +;; +;; 1. (MENU &optional ( nil)) +;; MENU prints out a menu, given a list of items to go in the menu and +;; a function to tell how to get the information that is to be printed in +;; the menu, and then get a request from user of which item he wants. +;; 2. (CHOICE ) +;; CHOICE takes an item and applies an action to it. +;; 3. (ACTIVE-MENU +;; &optional ( nil)) +;; ACTIVE-MENU does 1 and 2 for a single item. +;; 4. (ACTIVE-MENU-LOOP +;; &optional ( nil)) +;; ACTIVE-MENU-LOOP loops about doing 1 and 2 until it get a NIL item. +;; 5. (DESCRIBE-ERROR &optional name) +;; DESCRIBE-ERROR goes into this loop for the errors we know about or +;; of gives documentation on a specific one. + +;; Print a menu with the ITEMS given using the function WHAT-DESC to +;; tell you what string to output. + +(defun print-menu (items name what-desc) + (catch-**more** + (if name (output "~2&~A~2&" name)) + (do ((items items (cdr items)) ;give menu at first + (count 0 (1+ count))) + ((null items)) + (output "~&[~D] ~A" count (funcall what-desc (car items)))))) + + +;; (MENU &optional ( nil)) +;; Get an entry from a list of options in a nice way that allows +;; printing a menu or giving help. + +(defun menu (items what-desc &optional (menu-name nil)) + (program-record "Menu~@[ (~A)~] ..." menu-name) + (print-menu items menu-name what-desc) + (do ((index) + (len (length items))) + (nil) + (catch-**more** + (output "~2&Option (? gives help): ") + (setq index (recorded-sysread tyi 'over-rubout)) + (clear-input tyi) + (format t "~&") + (cond ((null index) (return nil)) + ((eq index 'over-rubout) (comment ignore)) + ((eq index '?) + (output "~2&Type an integer (0-~D) to get an entry,~ + ~% MENU for the menu,~ + ~% ? to see this again~ + ~% or NIL to quit." + (1- len))) + ((eq index 'menu) + (print-menu items menu-name what-desc)) + ((or (not (numberp index)) + (not (fixnump index)) + (minusp index) + (not (< index len))) + (output + "Type NIL to exit or an integer (0-~D) to select a menu item." + (1- len))) + (t + (let ((result (nth index items))) + (program-record "Selected ~S = ~S" index result) + (return result))))))) + + +;; Print out a menu and get a request from user. +;; Take the request and find the entry based on ACTION. +;; Take the entry found and print it. + +(defun choice (item action) + (funcall action item)) + +;; Loop about until you get a NIL item. + +(defun active-menu-loop (items what-desc action &optional menu-name) + (do ((item (menu items what-desc menu-name) + (menu items what-desc menu-name))) + ((null item)) + (choice item action))) + +(defun active-menu (items what-desc action &optional menu-name) + (let ((item (menu items what-desc menu-name))) + (if item (choice item action)))) + +;; Function to take either a name of an error and print its documentation +;; or no argument and loop about getting error documentation. + +(defun print-error-desc (item) + (let ((desc (error-desc-error-handled item))) + (if desc (output desc)))) + +(defun describe-error () + (active-menu-loop *errors-handled* + #'short-desc-error-handled + #'print-error-desc + "Menu of error descriptions")) + + +;;; Functions for finding out if the user wants to know about a +;;; certain type of error and to handle telling him or not. This +;;; group is invoked when the user actually makes one of the errors. + +(defun explain (name &rest data) + (let ((message (long-desc-error-handled name))) + (cond (message (if (explain? name) + (progn (lexpr-funcall #'output message data) + (explanation-has-been-seen name)))) + (t (bug "EXPLAIN got bad arg of ~S" name))))) + +(defun explain? (name) + (let ((explain? (prop name (prop 'global-explanation 'query)))) + (cond ((eq explain? 'query) + (query-explain name)) + (explain? (clear-input tyi) t) + (t nil)))) + +(defun query-explain (name) + (clear-input tyi) + (cond ((query "Would you like help with ~A?" + (short-desc-error-handled name)) + t) + ((query "Do you already know about ~A?" + (short-desc-error-handled name)) + (explanation-has-been-seen name) + (set-prop name nil) + nil) + (t nil))) + + +;;; Code for finding out where the error our poor schnook did was found. +;;; +;;; While in the function F, ... +;;; < was given too few arguments ... +;;; Do you want help? +;;; Do you know about? +;;; [Debug? maybe or maybe just put him there. Make a place for this but +;;; don't really call it 'cuz he has to be taught about it first.] +;;; +;;; When displaying the function, set PRINLEVEL and PRINLENGTH as in: +;;; +;;; (LET ((PRINLEVEL 3) (PRINLENGTH 3)) +;;; (FORMAT T "~&While in the function ~S, ...")) +;;; +;;; ----- +;;; walk back up the stack as follows +;;; +;;; 1. if *RSET is NIL, give up. +;;; 2. if (EVALFRAME NIL) is NIL, give up. (this should only happen with *RSET +;;; nil, but check just in case.) +;;; 3. iterate doing (EVALFRAME NIL) until you pass your own error handler +;;; function. this will let you run your code interpreted. +;;; now iterate past anything which is either something that has an +;;; ERROR-REPORTER property (abstract this) or for which the following +;;; returns true: +;;; (AND (SYMBOLP fn) (STATUS SYSTEM fn) (GETL fn '(FSUBR MACRO))) +;;; and past symbol evaluations. +;;; +;;; probably you should write some predicate INTERESTING-STACK-FRAME? which +;;; answers T unless (EVAL ... atom ...) or one of the things which are in +;;; the two categories above. +;;; +;;; the fn will be the car of the caddr of an EVALFRAME. see doc on +;;; evalframe for format detail. +;;; +;;; (APPLY ... (fn arglist) ...) +;;; (EVAL ... (fn arg1 arg2 ...) ...) +;;; OR (EVAL ... atom ...) +;;; +;;; if you fall off the end of the EVALFRAME stack, you're at toplevel and +;;; should print out "in a toplevel expression" or some such siliness +;;; something that is clearer since thats likely to confuse novices -- +;;; mostly just avoid saying "while in the function at toplevel") + +(defun find-error-context () + (cond ((not *rset) nil) + ((not (evalframe nil)) nil) + (t (let ((fn (do ((stack-frame (evalframe nil) + (evalframe (cadr stack-frame)))) + (nil) + (cond ((not stack-frame) (return t)) + ((interesting-stack-frame? stack-frame) + (return (car (caddr stack-frame)))))))) + (if fn + (let ((prinlevel 3) (prinlength 3)) + (cond ((eq fn '*eval) + (recorded-output "~&In a top-level evaluation, ")) + (t (recorded-output "~&While in the function ~S, " + fn))))))))) + +(defmacro error-reporter (x) `(get ,x 'error-reporter)) + +(defun interesting-stack-frame? (frame) + (let ((block (caddr frame))) + (cond ((atom block) nil) + (t (let ((fn (car block))) + (not (or (error-reporter fn) + (and (symbolp fn) (status system fn) + (getl fn '(fsubr macro)))))))))) + +(defun declare-error-reporter (x) (setf (error-reporter x) t)) + +(declare-error-reporter 'ERROR) +(declare-error-reporter 'CERROR) +(declare-error-reporter 'FERROR) +(declare-error-reporter '+INTERNAL-UDF-BREAK) +(declare-error-reporter '+INTERNAL-UBV-BREAK) +(declare-error-reporter '+INTERNAL-WTA-BREAK) +(declare-error-reporter '+INTERNAL-UGT-BREAK) +(declare-error-reporter '+INTERNAL-WNA-BREAK) +(declare-error-reporter '+INTERNAL-FAC-BREAK) +(declare-error-reporter '+INTERNAL-IOL-BREAK) +(declare-error-reporter 'find-error-context) +(declare-error-reporter 'interesting-stack-frame?) + + +;;; Local-Modes:; +;;; Mode:LISP; +;;; Lisp CATCH-**MORE** Indent:0; +;;; End:; diff --git a/src/teach/exlist.83 b/src/teach/exlist.83 new file mode 100755 index 00000000..7b68ded2 --- /dev/null +++ b/src/teach/exlist.83 @@ -0,0 +1,199 @@ +;;; -*- 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~ + ~% /" . /" ~ + ~%where is the left hand side of the tree and ~ + ~%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:; diff --git a/src/teach/global.15 b/src/teach/global.15 new file mode 100755 index 00000000..3133b2ea --- /dev/null +++ b/src/teach/global.15 @@ -0,0 +1,22 @@ +(? + ** + *** + ++ + +++ + :LESSON + :TEACH + :TEACH:LISP + :TEACH-LISP + APROPOS + DESCRIBE-ERROR + EXAMINE-LIST + HELP + INFO + LESSON + DISPLAY-LIST + QUIT + SCRIPT + STOP + STOP-SCRIPT + TEACH + TEACH-LISP) diff --git a/src/teach/init.41 b/src/teach/init.41 new file mode 100755 index 00000000..4efc6153 --- /dev/null +++ b/src/teach/init.41 @@ -0,0 +1,155 @@ +;;; -*- Mode:LISP; -*- + + +;;; Suppression of load messages + +(sstatus feature noldmsg) + +;;; Init bases +;;; +;;; Note: The most novice users should not be bothered by "." on the end of +;;; numbers. Something later may want to set up *NOPOINT NIL since it's +;;; really the most useful setting, but would be confusing to novices. + +(setq base 10. ibase 10. *nopoint t) + +;;; Debugging + +(nouuo t) ; make tracing easy +(*rset t) ; enable all the debugging lisp offers + +;;; File hacking if on TOPS-20 +(cond ((status feature TOPS-20) + (putprop 'teach '(ps kmp/.teach) 'ppn))) + +;;; Functions used to change TOPS-20 userid's to get rid of all +;;; non-alphanumerics. + +(defun alpha-numeric? (char) + (or (and (not (< char #/0)) + (not (> char #/9))) + (and (not (< char #/A)) + (not (> char #/Z))) + (and (not (< char #/a)) + (not (> char #/z))))) + +(defun alpha-userid (name) + (implode (mapcan #'(lambda (c) (if (alpha-numeric? c) (ncons c))) + (exploden name)))) + + +;;; Various files that we're gonna need to read and write to and from. + +(defvar *default-lesson-filename* '((teach) lesson *)) +(defvar *default-script-filename* + (caseq (status filesys) + ((ITS) '((dsk *) script >)) + ((DEC20) '((ps *) teach-lisp script /0)))) +(defvar *list-of-lessons-filename* '((teach) lessons dir)) +(defvar *ITS-list-of-list-of-lessons-filenames* (list '((teach) lesson *))) +(defvar *TOPS-20-list-of-lessons-filename* '((teach) lessons dir)) + + +;;; Error handlers + +(setq fail-act #'random-lossage-handler) +(setq unbnd-vrbl #'unbound-variable-handler) +(setq undf-fnctn #'undefined-function-handler) +(setq wrng-type-arg #'wrong-type-args-handler) +(setq wrng-no-args #'wrong-num-args-handler) +(setq unseen-go-tag #'unseen-go-tag-handler) +(setq io-lossage #'io-lossage-handler) + + +;;; Evaluation control +; Make eval hold our eval-handler. + +(setq eval 'eval-handler) + +;;; Interrupt Characters + +(sstatus ttyint #^A #'abort-lesson-handler) ;normally (SETQ ^A T) +;^B is control-B break +(sstatus ttyint #^C NIL) ;normally (SETQ ^D NIL) +(sstatus ttyint #^D NIL) ;normally (SETQ ^D T) +;^E is free +;^F is free +(sstatus ttyint #^G #'redefined-^G-handler) ;quit, but recorded +;^H is free (backspace) +;^I is free (tab) +;^J is free (linefeed) +;^K is free (used by reader) +;^L is free (used by reader) +;^M is free (return) +(sstatus ttyint #^N #'read-lesson-section-handler) +(sstatus ttyint #^O #'repeat-lesson-section-handler) +(sstatus ttyint #^P #'read-previous-lesson-section-handler) +(sstatus ttyint #^Q nil) ;normally (SETQ ^Q T) +(sstatus ttyint #^R nil) ;normally (SETQ ^R T) +(sstatus ttyint #^S nil) ;normally (SETQ ^W T) +(sstatus ttyint #^T nil) ;normally (SETQ ^R NIL) +;^U is free +(sstatus ttyint #^V nil) ;normally (SETQ ^W NIL) +;^X is (ERROR 'QUIT) -- should this be on by default? +;^Y is free +;^Z is return to superior +;^_ is free, but is hard to type anyway +;^^ is free +;^\ is free +;^] is free +;Alt is alphabetic + +;;; **MORE** hacking + + ;; Special var controlling if  quits are enabled. + +(setq quit-disable nil) + + ;; If this is the first time loading the file, save out info on tty + ;; initial specifications. + +(defvar *tty-spec-info* nil) +(cond ((not (boundp '*tty-spec-info*)) + (setq *tty-spec-info* (syscall 3. 'ttyget tyi)))) + + ;; This is the DISPLAY stream to output to if we have a + ;; fancy display terminal (opened only if needed.) + +(setq display-tyo nil) + + ;; Use our **MORE** handler + +(endpagefn tyo '**more**) + + +;;; Random other flags + +(setq gc-overflow #'gc-overflow-handler) +(setq *rset-trap ()) +(setq tty-return-msg "(Console Connected with Teach Lisp)") + + +(sstatus toplevel '(teach-lisp-top-level)) +(sstatus breaklevel '(breakloop t)) + +;;; Dialect variant definitions + +(define-dialect-variant define "DEFUN") +(define-dialect-variant defq "SETQ") +(define-dialect-variant df "(DEFUN name FEXPR ...)") +(define-dialect-variant de "DEFUN") +(define-dialect-variant def "DEFUN") + +(setq *help-wait-time* 120.) + +;;; Figure out what all the lessons will have said about them in +;;; the menu. +(get-list-of-lessons) +(set-up-lesson-descriptions) + + +;;; Local Modes:; +;;; Mode:LISP; +;;; Comment Column:50; +;;; Lisp DEFVAR Indent:-2; +;;; End:; diff --git a/src/teach/io.48 b/src/teach/io.48 new file mode 100755 index 00000000..f741f415 --- /dev/null +++ b/src/teach/io.48 @@ -0,0 +1,56 @@ +;;; -*- Mode:LISP; -*- +(herald IO) + +(declare (*lexpr gprint program-record)) + +;;; File hacking if on TOPS-20 +(eval-when (eval compile load) + (cond ((status feature TOPS-20) + (putprop 'teach '(ps kmp/.teach) 'ppn)))) + +;;; Macro support +(eval-when (eval compile) + (load '((teach) macro))) + +(defun string-length (x) (flatc x)) +(defun char-n (x n) (getcharn x (1+ n))) + +(defun diagnose (&rest stuff) + (lexpr-funcall #'format t stuff)) + +(defun bug (&rest stuff) + (program-record "~&Bug in TEACH: ~A" + (lexpr-funcall #'format nil stuff)) + (error (format nil "~&Bug in TEACH: ~A" + (lexpr-funcall #'format nil stuff)))) + +(defun quiet-bug (&rest stuff) + (program-record "~&Bug in TEACH: ~A" + (lexpr-funcall #'format nil stuff))) + +(defun output (&rest stuff) + (lexpr-funcall #'format t stuff)) + +(defun query (string &rest stuff) + (format t "~2&") + (y-or-n-p (lexpr-funcall #'format nil string stuff))) + +(defun clear-screen () (format t "~/|")) + +(defun fresh-line (&optional number) + (format t "~&") + (if number (do ((n number (1- n))) + ((= n 0)) + (format t "~%")))) + +(defun sysread (&rest stuff) ;rethink this sometime + (with-saved-obarray (lexpr-funcall #'read stuff))) + +(defun defined-function? (name) + (getl name '(expr fexpr macro subr fsubr lsubr))) + + +;;; Local Modes:; +;;; Mode:LISP; +;;; Comment Column:50; +;;; End:; diff --git a/src/teach/lessn.130 b/src/teach/lessn.130 new file mode 100755 index 00000000..49af1f79 --- /dev/null +++ b/src/teach/lessn.130 @@ -0,0 +1,515 @@ +;;; -*- Mode:LISP; -*- +(herald LESSN) + +;;;; Declarations +(declare (special *default-lesson-filename* + *in-more-break* + *ITS-list-of-list-of-lessons-filenames* + *lessons-known* + *TOPS-20-list-of-lessons-filename*) + (*expr clear-screen + lesson-has-been-seen + seen-lesson? + set-prop + user-record) + (*lexpr active-menu + complain + fresh-line + output + program-record + prop + quiet-bug + recorded-output + sysread + query)) + +;;; File hacking if on TOPS-20 +(eval-when (eval compile load) + (cond ((status feature TOPS-20) + (putprop 'teach '(ps kmp/.teach) 'ppn)))) + +;;; IOTA snarfing +(eval-when (eval compile) + (cond ((not (status feature iota)) + (load '((liblsp) iota fasl))))) + +;;; Base setup +(eval-when (eval compile load) + (setq base 10. ibase 10.)) + +;;; Macro support +(eval-when (eval compile) + (load '((teach) macro))) + +;;; Variable declarations + +(defvar *disallow-interrupts* nil) +(defvar *lesson-file* nil) +(defvar *lesson-name* nil) +(defvar *lesson-exit-handler* nil "Don't handle lesson exits at toplevel") + ; *lesson-information* is a list of the form: + ; ( (eval name position) ... + ; (eval-print name position) + ; (try name position) ... etc ...) + ; associated with the current lesson file. +(defvar *lesson-information* nil) + +(define-interrupt-handler abort-lesson-handler + (abort-lesson)) +(define-interrupt-handler read-lesson-section-handler + (read-lesson-section)) +(define-interrupt-handler read-previous-lesson-section-handler + (read-previous-lesson-section)) +(define-interrupt-handler repeat-lesson-section-handler + (repeat-lesson-section)) + +;;; Macro support, etc. + +(defmacro catch-lesson-exit (&body body) + `(*catch 'lesson-exit-handler + (let ((*lesson-exit-handler* t)) + ,@body))) + +(defun exit-lesson () (*throw 'lesson-exit-handler nil)) + +(defmacro lesson-function (name) `(get ,name 'lesson-function)) + +(defmacro define-lesson-function (type doc &body body) + doc ;ignored + `(defun (,type lesson-function) nil + ,@body)) + +(defun add-lesson-information (type) + (let ((name (read-optional-label *lesson-file*)) + (information-location (filepos *lesson-file*))) + (push (list type name information-location) + (cdr *lesson-information*)))) + +;;; Functions for retrieving the various types of information +;;; stored in *lesson-information*. + +(defun get-lesson-information (types list) + (ass #'(lambda (x y) (memq y x)) types list)) + +(defun ass (fn obj list) + (do ((l list (cdr l))) + ((null l) nil) + (if (funcall fn obj (caar l)) + (return (car l))))) + +(defun get-optional-label (types list) + (cadr (get-lesson-information types list))) + +;;; Functions for getting names and positions from a piece of information. +(defun get-name (obj) (cadr obj)) +(defun get-position (obj) (caddr obj)) + +(defun read-optional-label (stream) + (prog1 (do ((c (tyipeek nil stream) (tyipeek nil stream))) + ((= c #\return) nil) + (if (not (member c '(#\space #\tab))) + (return (read stream))) + (tyi stream)) + (do ((c (tyipeek nil stream) (tyipeek nil stream))) + ((= c #\return) (tyi stream)) + (tyi stream)))) + +;;;; Other stuff + +(declare (*lexpr *lesson open-lesson)) + +;;; Find out what lessons we've available for this incarnation +;;; of XTEACH. + +(defun get-list-of-lessons () + (cond ((status feature ITS) + (mapallfiles '(lambda (x) (push (caddr x) *lessons-known*)) + *ITS-list-of-list-of-lessons-filenames*)) + (t(setq *lessons-known* + (cond ((probef *TOPS-20-list-of-lessons-filename*) + (iota ((stream *TOPS-20-list-of-lessons-filename* + '(in ascii dsk))) + (sysread stream))) + (t nil))))) + (setq *lessons-known* (sort *lessons-known* 'alphalessp))) + +;;; Function for providing a full file name in the place of the single +;;; word names for lessons. + +(defun full-lesson-name (name) + (mergef (mergef `(* ,name) *default-lesson-filename*) + defaultf)) + +;;; Function to find a particular special function request in an open file. + +(defun find-special-function-in-file (function file) + (cautiously-incrementing-filepos file + (do ((c (tyipeek nil file -1) + (tyipeek nil file -1))) + ((= c -1) nil) + (caseq c + ((#\linefeed) (tyi file)) + ((#/.) (tyi file) + (let ((special (sysread file))) + (if (eq special function) + (let ((special-func (lesson-function special))) + (if special-func + (return (filepos file)) + (quiet-bug + "unknown lesson command requested in ~ + find-special-function-in-file: ~S~%" + function) + (return nil))) + (readline file)))) + (t (let ((line (readline file))) + (if (null line) (return nil)))))))) + +;;; Get the description of each lesson that is to be printed from the +;;; lesson file. this one time code is run by TEACH-LISP-TOP-LEVEL. + +(defun set-up-lesson-descriptions () + (do ((lessons *lessons-known* (cdr lessons))) + ((null lessons)) + (let* ((name (car lessons)) + (full-name (full-lesson-name name))) + (if (probef full-name) + (iota ((stream full-name '(in ascii dsk))) + (if (find-special-function-in-file 'document stream) + (putprop name (readline stream) 'lesson-description) + (putprop name name 'lesson-description))) + (putprop name +"Oops... thought i had a lesson here. +Please report this by sending mail to BUG-XTEACH." + 'lesson-description))))) + +(defun describe-lesson (name) + (get name 'lesson-description)) + +(defun in-lesson? () + (if (not *lesson-file*) + (complain "~&You're not in the middle of a lesson."))) + +(defmacro lesson (&optional (name nil name?)) + (cond (name? `(*lesson ',name)) + (t (*lesson)))) + +(defun *lesson (&optional (name nil name?)) + (let ((*disallow-interrupts* t)) + (cond ((and *lesson-file* + name? + (query "You're already in lesson ~A.~ + ~%Shall I start the new one for you anyway?" + *lesson-name*)) + (kill-lesson) + (*lesson name)) + (*lesson-file* + (cond ((query "Want to go on with lesson ~A now?" + *lesson-name*) + (catch-complaints + (fresh-line 1) + (read-lesson-section))) + ((query "Want a menu of available lessons?") + (catch-complaints + (when-abnormal-exit (open-lesson) + (output + "~&Ok, lesson ~A's still around waiting for you.~%" + *lesson-name*)) + (fresh-line 1) + (read-lesson-section))) + (t + (output "~&Ok, lesson ~A's still around waiting for you.~%" + *lesson-name*))) + '*) + (t + (catch-complaints + (cond (name? (open-lesson name)) + (t (open-lesson))) + (fresh-line 1) + (read-lesson-section)) + '*)))) + +(defun start-lesson (name) + (let ((full-name (full-lesson-name name))) + (if (not (probef full-name)) + (complain "~2&I'm sorry, I can find no lesson by the name ~A." + name)) + (clear-screen) + (if *lesson-file* (kill-lesson)) ;clean up if needed + (setq *lesson-file* (open full-name 'in) + *lesson-information* (list *lesson-file*) + *lesson-name* name) + (program-record "Starting lesson ~A." name))) + +(defun open-lesson (&optional (name *lesson-name* name?)) + (cond ((not name?) + (let ((wanted-lesson (active-menu *lessons-known* + #'describe-lesson + #'start-lesson + "Menu of available lessons"))) + (if (not wanted-lesson) (complain)))) + ((not name) + (complain "~&NIL is not a valid lesson! If you want a menu of ~ + lessons, type /"(LESSON)/"~%")) + (t + (start-lesson name)))) + + +;;; Functions for doing stuff in a lesson file (moving around and reading and +;;; killing...) + +;;; Go back to the previous tag marked in *file-information* if there +;;; is one; signal error, otherwise. +;;; Moving backwards entails moving the file position and changing +;;; the state of file-information* to be as though things after +;;; the tag had not been read. + + +;;; first hit is the one that caused us to be in a position +;;; to be paid attention to. +;;; second is the lesson we just stopped. +;;; third is lesson before lesson just done. + +(defun trimmed-lesson-information (list) + (let ((inf (get-lesson-information '(tag try) list))) + (cdr (memq inf list)))) + +(defun repeat-lesson-section () + ;; trim off the try that got us here + ;; and then looke for the next try or tag. + (in-lesson?) + (let ((list (trimmed-lesson-information (cdr *lesson-information*)))) + (let ((flag (get-lesson-information '(tag try) list))) + (if flag (set-lesson-section-to flag) + (complain "You're at the beginning of this sesson"))))) + + +(defun read-previous-lesson-section () + ;; trim off the try that got us here and the lesson we just did. + ;; look for a preceding tag or try. + (in-lesson?) + (let ((list (trimmed-lesson-information + (trimmed-lesson-information + (cdr *lesson-information*))))) + (let ((flag (get-lesson-information '(tag try) list))) + (if flag (set-lesson-section-to flag) + (complain "There isn't a section before this one"))))) + + +(defun set-lesson-section-to (flag) + (filepos *lesson-file* (get-position flag)) + (setq *lesson-information* + (cons (car *lesson-information*) + (memq flag *lesson-information*))) + (read-lesson-section)) + + +;;; assume cursor is at start of a lesson. +;;; read lines until reach end of this section, end of file, +;;; or "try" (it says stop here for user to play) +;;; for each line, +;;; 1. normal line, just echo. +;;; 2. try line, give over to user. +;;; 3. eval line, read in lisp exprs and eval them until +;;; hit (). +;;; 4. end-of-file line, close file and return. + +(defun want-lesson? () + (recorded-output "~&You're not in a lesson at the moment.~%") + (cond ((and *lesson-name* + (query "Restart lesson ~A?" *lesson-name*)) + (*lesson *lesson-name*)) + ((query "Start a new lesson?") + (active-menu *lessons-known* + #'(lambda (x) x) + #'*lesson + "Menu of available lessons")))) + +(defun kill-lesson () + (cond ((or (filep *lesson-file*) + (sfap *lesson-file*)) + (close *lesson-file*))) + (program-record "Killing lesson ~A." *lesson-name*) + (setq *lesson-file* nil)) + +(defun abort-lesson () + (in-lesson?) + (kill-lesson) + (output "~&Lesson ~A aborted.~%" *lesson-name*)) + +(defun end-of-lesson-file () + (kill-lesson) + (if (query "Would you care to have lesson ~A restarted?" + *lesson-name*) + (*lesson *lesson-name*))) + +(defvar *muzzled* nil "If this is on, the lessons aren't typed out.") + +(defun read-lesson-section () + (let ((*muzzled* nil)) ;special -- may be rebound by lesson-function IF + (cond ((not *lesson-file*) + (catch-complaints + (catch-**more** + (catch-lesson-exit + (want-lesson?))))) + (t (catch-**more** + (catch-complaints + (cautiously-incrementing-filepos *lesson-file* + (catch-lesson-exit + (do ((c (tyipeek nil *lesson-file* -1) + (tyipeek nil *lesson-file* -1))) + ((= c -1) (end-of-lesson-file)) + (caseq c + ((#\linefeed) (tyi *lesson-file*)) + ((#/.) (tyi *lesson-file*) + (let* ((special (sysread *lesson-file*)) + (special-func (lesson-function special))) + (if special-func + (funcall special-func) + (quiet-bug + "warpo lesson command encountered: ~S~%" + special) + (readline *lesson-file*)))) + (t (let ((line (readline *lesson-file*))) + (cond ((null line) + (end-of-lesson-file) + (return nil)) + ((not *muzzled*) + (output "~&~A~%" line))))))))))))))) + + +;;; Special functions to be run. + +; note -- a .IF will conditionalize only to the next .IF, .END-IF or +; something that ends a section like a .PAUSE or a .TRY + +(define-lesson-function if "conditionalize out a section of text" + (setq *muzzled* (not (eval (read *lesson-file*))))) + +(define-lesson-function end-if "end an if" + (setq *muzzled* nil)) + +(define-lesson-function eval "invisibly eval a form to the user's environment" + (eval (read *lesson-file*))) + +;; This reads an entire Lisp form and prints it, including any ;...'s +(defun read-verbosely (instream) + (let ((start-filepos (filepos instream))) + (let ((form (read instream))) + (readline instream) ;toss rest of line (in case of trailing semi) + (let ((end-filepos (filepos instream))) + (filepos instream start-filepos) + (do ((l (readline instream nil) (readline instream nil))) + ((or (null l) (not (< (filepos instream) end-filepos))) + (if l (output "~&~A~%" l))) ;output the last line + (output "~&~A~%" l)) + form)))) + +(define-lesson-function eval-print "same as eval but not invisible" + (eval (read-verbosely *lesson-file*))) + +(define-lesson-function pp + "have a Lisp form pretty printed in the text without having it evaled" + (read-verbosely *lesson-file*)) + +(define-lesson-function try "return from this lesson retaining file info" + (add-lesson-information 'try) + (recorded-output "~2&You try now. To continue, type ^N.~%") + (exit-lesson)) + +(define-lesson-function pause "return from this lesson without implying try" + (add-lesson-information 'pause) + (recorded-output "~2&To continue, type ^N.~%") + (exit-lesson)) + +(define-lesson-function tag "tag marks the beginning of a file" + (add-lesson-information 'tag) + nil) + +(define-lesson-function comment "comments to be allowed in the file" + (readline *lesson-file*) + nil) + +(define-lesson-function document "comments to be allowed in the file" + (readline *lesson-file*) + nil) + +(define-lesson-function eof "note lesson is over" + (lesson-has-been-seen *lesson-name*)) + +;;; This lesson is finished. Do you want to go on? (Y or N) Yes. +;;; The next recommended lesson is ADVANCED. Wanna try that? (Y or N) No. +;;; Ok, sucker. Type the lesson you want ended by Return: WIZARD +;;; This function is only to be used as the last thing in a lesson. + +(define-lesson-function next "used to point to the next lesson. should + only occur as last thing in a lesson, cuz it kills this lesson." + (lesson-has-been-seen *lesson-name*) + (let ((first-choice (sysread *lesson-file*))) + (kill-lesson) + (cond ((query "Lesson ~A is finished. Would you care to proceed?" + *lesson-name*) + (get-apropriate-next-lesson first-choice)) + (t (if (query "Would you care to retry lesson ~A?" + *lesson-name*) + (*lesson *lesson-name*))))) + (exit-lesson)) + +(defun get-apropriate-next-lesson (first-choice) + (do ((flag nil t) + (lesson-choice first-choice (get-next-next-lesson lesson-choice flag))) + ((not lesson-choice) + (output "~&I've no~@[~* further~] suggestions for you.~%" flag) + (get-a-new-lesson)) + (if (not (seen-lesson? lesson-choice)) + (return (if (query "The next recommended lesson is ~A. Do you ~ + wish to try that?" + lesson-choice) + (*lesson lesson-choice) + (get-a-new-lesson)))))) + +(defun get-next-next-lesson (choice flag) + (output "~2&The next recommended lesson~@[~* after that~] is ~S, ~ + ~%but you've already seen it...~ + ~%Hold on while I try to think of some other suggestion...~2%" + flag + choice) + (let ((full-name (full-lesson-name choice))) + (if (probef full-name) + (iota ((stream full-name '(in ascii dsk))) + (if (find-special-function-in-file 'next stream) + (sysread stream) + nil)) + nil))) + +(defun get-a-new-lesson () + (output "~2&Here is a list of lessons to choose from:~%") + (active-menu *lessons-known* + #'(lambda (x) x) + #'*lesson + "Menu of available lessons")) + +(define-lesson-function required + "there are lessons that should be run before this one" + (let ((requirement (read *lesson-file*))) + (if (not (seen-lesson? requirement)) + (progn + (recorded-output "Before you start lesson ~S you really should know ~ + ~%about what is in Lesson ~S." + *lesson-name* + requirement) + (if (query "Should I start it for you?") + (progn + (kill-lesson) + (program-record + "User is gonna be reasonable and do the prereq first") + (*lesson requirement)) + (program-record "user is a turkey and is ignoring the prereq.") + (output "~&Ok, but don't say i didn't warn you...~2%")))))) + + +;;; Local Modes:; +;;; Mode:LISP; +;;; Comment Column:50; +;;; Lisp WHEN-ABNORMAL-EXIT Indent:1; +;;; Lisp CAUTIOUSLY-INCREMENTING-FILEPOS Indent:1; +;;; End:; diff --git a/src/teach/lesson.assq b/src/teach/lesson.assq new file mode 100755 index 00000000..71ed5ae2 --- /dev/null +++ b/src/teach/lesson.assq @@ -0,0 +1,89 @@ +.comment -*- Mode:TEXT; -*- +.comment ASSQ, ASSOC +.document ASSQ - Making Association Lists; using ASSQ and ASSOC to get the info +.tag ASSQ +Lesson Searching Constructs ASSQ and ASSOC, Version 2 + Kent M. Pitman, 5/27/79 + revised by Victoria Pigman, 9/1/82 + +A very useful type of structure which is used often by Lisp programmers is +something called an Association list (or alist). It is a list which the user +can construct which has special things true about it that make it easy to +search through. In particular, it is a list of lists, and the first element of +each of the sub-lists is a tag that you would like to keep information about. +For instance: + +.eval-print +(SETQ INFO-LIST '((DOG MAMMAL) + (CAT MAMMAL) + (LIZARD REPTILE))) + +Notice that this list, INFO-LIST, is composed of sub-lists, each of which +contains information about the thing in the CAR of the sub-list. There are +functions which will retrieve the element of INFO-LIST which has a CAR that +is the same as some value we ask for. The most efficient of these is a function +called ASSQ. ASSQ returns the sub-list containing the info we desired, or NIL +if such a list was not found. (INFO-LIST has been set up for you.) + +For example: + + (ASSQ 'DOG INFO-LIST) should return (DOG MAMMAL) + (ASSQ 'FROG INFO-LIST) should return NIL +.try +Like MEMQ, ASSQ only works for finding symbols. Here's another example to +give a try... + + (ASSQ '(FOO BAR) '(((FOO BAR) WE LOSE!) (A B))) +.try +But like with MEMQ, there is a function we can resort to when we have more +complex things to look for: ASSOC. This function will look for numbers or +lists. Example: + + (ASSOC '(FOO BAR) '(((FOO BAR) WE WIN) (A B))) + + returns ((FOO BAR) WE WIN) + + (ASSOC '(BAR BAZ) '(((FOO BAR) IF IT FINDS THEN ASSOC IT IS BROKEN) + (A B))) + + returns NIL. +.try +Let's do something useful with Association lists now. Suppose we define +some functions: + +.eval-print +(DEFUN INIT-DATABASE () (SETQ DATABASE NIL)) + +.eval-print +(DEFUN DEFINE-CATEGORY (THING CATEGORY) + (SETQ DATABASE ;remember that "thing" + (CONS (LIST THING CATEGORY) DATABASE)) ;has a category of "category" + 'DEFINED) ;return something so the user knows it worked + +.eval-print +(DEFUN WHAT-CATEGORY? (THING) + (COND ((NOT (ASSQ THING DATABASE)) ;thing was not in database + '(SORRY -- MAY YOU SHOULD TEACH IT TO ME?)) + (T + (CADR (ASSQ THING DATABASE))))) ;just return the info about it + + +Try doing the following: + + (INIT-DATABASE) ; have to make sure our database is initialized! + (DEFINE-CATEGORY 'HORSE 'MAMMAL) + (DEFINE-CATEGORY 'FROG 'AMPHIBIAN) + (WHAT-CATEGORY? 'HORSE) + (WHAT-CATEGORY? 'DOG) +.try +To define ASSQ in Lisp, by the way, we'd just do this: + +.pp + (DEFUN MYASSQ (TAG A-LIST) + (COND ((NULL A-LIST) + NIL) + ((EQ TAG (CAAR A-LIST)) + (CAR A-LIST)) + (T + (MYASSQ TAG (CDR A-LIST))))) +.next LAMBDA diff --git a/src/teach/lesson.cond b/src/teach/lesson.cond new file mode 100755 index 00000000..12707fd3 --- /dev/null +++ b/src/teach/lesson.cond @@ -0,0 +1,99 @@ +.comment -*- Mode:TEXT; -*- +.document COND - Predicates and conditionals. +.tag COND +Lesson COND, Version 2 Modified by Victoria Pigman, 9/1/82 + +In order for a program to do anything useful it must be able to do one thing +one time and one thing another. In Lisp this is done with the same functional +style as everything else. That is to say, doing something conditionally, and +testing conditions, are both done with the use of functions. The primary +function for conditional execution is the function COND. COND is a magic +function in that it doesn't evaluate its arguments normally. We shall call +these functions special forms because they behave differently than normal +forms. + +Before we can start using COND however, we need some tests. The first test we +shall discuss is called EQUAL, and its purpose is probably pretty obvious. +Its function is not so obvious, however, so let's try a couple of examples. +.eval +(setq foo '((a b) c d e (f g)) + bar foo + dog 'animal + cat 'animal + geranium 'plant + violet 'plant + fadip nil + dore nil + man t + god t + pigs 7 + figs 7 + monkeys 8 + thing1 'dog + thing2 'cat + thing3 'violet + thing4 'monkey + thing5 'man + thing6 'geranium + thing7 'pigs) + +The following atoms have been given values for you: + FOO BAR + DOG CAT + GERANIUM VIOLET + FADIP DORE + MAN GOD + PIGS FIGS + MONKEYS THING1 + THING2 THING3 + THING4 THING5 + THING6 THING7 + +Find their values, and then use them (or your own) to find out which are EQUAL. +That is, apply the function EQUAL to pairs of them until you figure out the +pattern. I'll give you a hint... T means true, and NIL means false in Lisp. +For example: + (equal dog dog) will return T. +.try +As you saw, EQUAL things are things which print out the same. In time, we will +be able to more precisely define EQUAL in terms of an even more primitive +function, EQ. However, we are not yet prepared to deal with that. + +And now let us see how we can use predicates to choose what we want to do. + + +The special form COND is a way to take one of several actions depending on the +truth/falsity of several predicates. + +The description of T above as meaning TRUE is a little misleading. In fact, +ANY non-NIL can and will be interpreted as true. T is special in that it always +evaluates to itself and cannot be modified. + +COND is a special form which takes 1 to infinity of arguments. Each argument, +or clause, is of the form + "( ...)" + +where is something which is evaluated to see if it is true or false +(non-NIL or NIL), and the FORM-I's are optional forms to be evaluated. Each of +these clauses has its predicate evaluated in turn until one of them evaluates +non-NIL. If the predicate is nil, the forms following it in the clause are +not evaluated. However, if the predicate is non-nil, then the rest of its +forms are evaluated in turn, and the last one is returned as the value of the +COND. The remainder of the COND is not examined at all. If no predicate is +true, the value of the COND is NIL. + +A few examples will help clarify: + +.pp +(COND ((EQUAL thing 'dog) 'animal) + ((EQUAL thing 'geranium) 'plant) + (t 'dont-know)) + +Will return ANIMAL if THING is has the value DOG, PLANT if it has the value +GERANIUM, and otherwise it will return DONT-KNOW. Note that the T in the last +clause is always true. Hence if nothing else is true, the last clause will be +evaluated. This corresponds to ELSE in many other languages. + +You should now try experimenting with COND. +.try +.next FIB diff --git a/src/teach/lesson.defun b/src/teach/lesson.defun new file mode 100755 index 00000000..e9913c77 --- /dev/null +++ b/src/teach/lesson.defun @@ -0,0 +1,109 @@ +.comment -*- Mode:TEXT; -*- +.comment Documentation about DEFUN. +.document DEFUN - How to use DEFUN to make your own functions. +.tag DEFUN +Lesson DEFUN, Version 3 Kent M. Pitman 1/22/80 + revised by Victoria Pigman 9/1/82 + +You may find it very advantageous to assign names to LAMBDA's. The +mechanism for doing this in Lisp is called DEFUN. If you have not +read about LAMBDA's yet, you should definitely kill this lesson +right now and do (LESSON LAMBDA) before proceeding... + +The form of a DEFUN is similar to that of LAMBDA -- + + (DEFUN ...) + +This associates the lambda expression + + (LAMBDA ...) + +with in a way that Lisp's evaluator knows how to find when +you put in the CAR of a list. + + Thus if you do + + (DEFUN X-PLUS-ONE-SQUARED (X) (+ (* X X) (* X 2) 1.)) + +you will get back X-PLUS-ONE-SQUARED (DEFUN always returns the name of +the function it has defined) and from then on (until/unless you redefine +this function) you will be able to just say + + (X-PLUS-ONE-SQUARED 3) ; Returns 4 squared, or 16 + +See if you can type in that definition and get it to work on a few numbers. +.try +Note also that you can try it on more complicated expressions -- + + (X-PLUS-ONE-SQUARED (X-PLUS-ONE-SQUARED 1)) + +for example, will return (I hope) 25 ... I haven't tried this function -- +maybe you should check it out for me. +.try +Here's a really interesting idea which will get touched again in +other lessons. It's a key feature of Lisp -- the ability to do recursion +(or allow functions to reference themselves). + +For example, suppose someone asked you how to climb to the top of a staircase +of a specified number of stairs. You might, if you'd read (LESSON DO), +reply to him ... + +.eval-print +(DEFUN CLIMB-STAIRS (NUMBER-OF-STAIRS) + (DO ((I 0 (+ 1 I))) + ((= I NUMBER-OF-STAIRS)) + (PRINT '(CLIMB UP A STAIR))) + (PRINT '(WE MUST BE DONE))) + +This function has been defined for you, so try running it on some small number +of stairs. +.try +That's one way to do it, I guess. Another way to formulate the same problem +is this one ... + +.eval-print +(DEFUN CLIMB-STAIRS-ANOTHER-WAY (NUMBER-OF-STAIRS) + (COND ((= NUMBER-OF-STAIRS 0) + (PRINT '(WE MUST BE DONE))) + (T + (PRINT '(CLIMB UP A STAIR)) + (CLIMB-STAIRS-ANOTHER-WAY (- NUMBER-OF-STAIRS 1))))) + +Do you see how this works? If we're at the top, we should just stop. Otherwise, +we'll put off figuring out how to do the real task for a minute -- just climb +one stair for now -- and then we'll go and climb one less stair ... How do +we do that? The same way as we've just described ... before we know it, +we're at the top! (This one has also been defined for you.) +.try +Here is another simple recursive function to try: + +Write a function which makes a list of the numbers 1 through N and +returns it. Remember that a list of no numbers is NIL and that you +can add a new number to a list by doing (CONS number old-list). + +Don't come back until you've given up! +.try +Did it look something like this...? + +.eval-print +(DEFUN MAKE-LIST-N-LONG (N) + (COND ((= N 0) NIL) + (T (CONS N (MAKE-LIST-N-LONG (- N 1)))))) + +This function has been defined for you, so run it. Do you notice something +funny about the result it returns? What might you do to fix that problem? +(Hint: You might want to re-write this idea to use two functions instead of +one.) +.try +The solution to this problem is to make two functions. They might look like +these that I've written for you -- + +.eval-print +(DEFUN MAKE-LIST-N-LONG (N) + (REVERSE (MAKE-BACKWARDS-LIST-N-LONG N))) + +.eval-print +(DEFUN MAKE-BACKWARDS-LIST-N-LONG (N) + (COND ((= N 0) NIL) + (T (CONS N (MAKE-BACKWARDS-LIST-N-LONG (- N 1)))))) +.next OUTPUT diff --git a/src/teach/lesson.do b/src/teach/lesson.do new file mode 100755 index 00000000..d813cf6e --- /dev/null +++ b/src/teach/lesson.do @@ -0,0 +1,182 @@ +.comment -*- Mode:TEXT; -*- +.comment this file documents the DO construct. +.document DO - How to use the Maclisp iteration primitive. +.tag DO +Lesson DO, Version 2 Kent M. Pitman, 5/30/79 + revised by Victoria Pigman,9/1/82 + +The MacLISP iteration construct is called DO. It has two syntaxes, one of +which is obsolete and you should not use. That syntax is + +(DO ) + +We will not deal with this syntax. It is documented by (DESCRIBE DO), +however, if you are interested in looking it up. + +The 'new' syntax is + +(DO ( ) ) + +It may seem to be a pretty cumbersome thing at first, but it's very +versatile. Let's examine each of the pieces of the DO before we +put it all together. + +First the ... + +In a sort of BNF format (if you're not familiar with this format, don't +worry, but its meaning shouldn't be hard to guess) ... + + ::= ( ... ) + ::= ! + () ! + ( ) ! + ( ) + +In other words, is a list of elements. Each element represents +a binding (creation of a local variable). + +If the is a symbol or a list containing just a symbol, +that atom is bound locally to NIL and its value does not change +unless explicitly changed by a SETQ. + +If is a list of 2 elements, the first is a variable name and +the second is a form to be evaluated and assigned to that variable. This +form is evaluated before the local variable is created, so saying +(X X) will bind a local X to the value of X outside the loop. This may +be useful since it means you can begin with a value of X and re-assign +X locally later without hurting the global value of X. + +If is a list of 3 elements, the first is a variable, the +second is its initial binding (see description of 2-element lists) and +the third is a form which is evaluated newly each succeeding pass through +the loop after the first, and to which the variable will be re-assigned. +For example, (X 1 (+ X 1)) will set X initially to 1 and then add 1 to X +each time (reassigning that back to X) afterward through the loop. +.pause +Now the ( ) stuff. + + is any lisp form which will be evaluated after the bindings +have been done for a given pass through the loop ... if it returns a +non-null value, the statements in (if any) will be executed +in sequence and the last value returned by one of the statements in +exit-body will be returned as the value of the DO statement. If +returns NIL, the of the loop is entered. + +Finally is a sequence of 0 or more lisp statements to be +executed. Like PROG, atoms at the top level of the loop are taken as +GO tags. The function GO may be used to transfer control to one of these +tags. The function RETURN may be used to prematurely return a value +from the DO before it would have exited with . Doing RETURN +does NOT cause to be run. +.pause +Now let's put it all together and write a few programs... + +Here's one that prints the numbers from 1 to 10. + +(DO ((I 1 (+ I 1))) ; Variable I initially 1, and add 1 to it each time + ((> I 10)) ; Exit if I is greater than 10 + (PRINT I)) ; Print I's value. + +See if you can modify it to print all even numbers from 1 to 10. +.try +Here's one that CONS's up a list of all the numbers from 1 to 10. Note +that it doesn't need a body! Everything is done from the first two +clauses... + +(DO ((I 1 (+ I 1)) ; Count using I again + (L () (CONS I L))) ; L grows getting new I's CONS'd onto it. + ((> I 10) L)) + +returns (10 9 8 7 6 5 4 3 2 1) ... You might have expected it to return +(11 10 9 8 7 6 5 4 3 2) instead. The reason that it doesn't is that +the incremental values are all evaluated in parallel and THEN the binding +is done. So the second pass through the loop, I is 1 and L is () as it +enters the bindings ... (+ I 1) returns 2 and (CONS I L) returns (1) ... +THEN I is set to the 2 and L is set to the (1). + +Note that this is not the same as what you might expect if the bindings +were done in series. In such a case, I would be set to 2 before the (CONS I L) +and you'd get (11 ... 2) as a result ... this is NOT what Lisp does. + +Try this example: + +(DO ((I 0 (+ I 1)) + (J 0 I)) + ((> I 10) 'DONE) + (PRINT (LIST I J))) + +and see if you can understand what we mean by parallel binding. +.try +Compare the result of your previous experiment with this loop: + +(DO ((I 0 (+ I 1)) + (J)) + ((> I 10) 'DONE) + (SETQ J I) + (PRINT (LIST I J))) +.try +Now let's try something more substantial - the FACTORIAL program... + +Recursive solution: + +.eval-print +(DEFUN FACT (X) + (COND ((ZEROP X) 1) + (T (TIMES X (FACT (SUB1 X)))))) + + +Iterative solution: + +.pp +(DEFUN FACT (X) + (DO ((I 1 (ADD1 I)) + (F 1 (TIMES F I))) + ((GREATERP I X) F))) + +Recursive solutions are pretty, but they often run out of what is +called 'stack' - Lisp has to remember all the recursive calls and +it keeps them stacked up to come back to later. Try + + (FACT 200) and (FACT 1000) + +now and see the error message that happens if you recurse too deep. +(FACT has been defined for you via the recursive method.) +.try +.eval +(DEFUN FACT (X) + (DO ((I 1 (ADD1 I)) + (F 1 (TIMES F I))) + ((GREATERP I X) F))) +Now and try it with the iterative solution. (We've swapped definitions +to the iterative method for you)... +Do (FACT 200) and (FACT 1000) +(Note that the second one may take a short time ... give it a chance to +finish.) +.try +Try to rewrite the FIB definition so that it uses iteration. Remember we +defined it for you as + +.eval-print +(DEFUN FIB (X) + (COND ((ZEROP X) 1) + ((EQUAL X 1) 1) + (T (PLUS (FIB (SUB1 X)) + (FIB (DIFFERENCE X 2)))))) + +Now try rewriting this function using iteration. Keep in mind that the +way to calculate fibonacci numbers is to start computing from the first one, +adding succeeding values to previous values. You may need more than one +loop variable. +.try +Did you come up with something like this? + +.eval-print +(DEFUN FIB (X) + (DO ((COUNT 1 (ADD1 COUNT)) + (OLD 1 (PLUS OLD OLDER)) + (OLDER 0 OLD)) + ((GREATERP COUNT X) OLD))) + +If not, see if you can at least understand why this one works. +.try +.next TRACE diff --git a/src/teach/lesson.dot b/src/teach/lesson.dot new file mode 100755 index 00000000..527780f3 --- /dev/null +++ b/src/teach/lesson.dot @@ -0,0 +1,191 @@ +.comment -*- Mode:TEXT; -*- +.comment talks about dotted pairs and points to the functions +.comment EXAMINE-LIST and DISPLAY-LIST +.document DOT - A description of the dotted pair formalism for Lisp lists. +.tag DOT +Lesson DOT, Version 2 Kent M. Pitman, 5/25/79 + revised by Victoria Pigman, 9/3/82 + +This lesson deals with a special notation for describing list structure +called the dotted-pair. + +As discussed in Lesson INTRO, the Lisp function CONS is used for putting +two objects together. In essence, you may think of CONS as saying that you +want to create a new something which is composed of two pieces (the arguments +to CONS). Let's take an example: + + (CONS 'A 'B) + +will make a new object that has a CAR which is the atom A and a CDR which +is the atom B. We can represent this object conceptually (Note: we are not +talking about how to talk to Lisp now - but formalizing a conceptual notation) +by saying the object is a pair of the form + + (A . B) + +where A is the left half and B is the right half. Similarly, the result of: + + (CONS '(A B) '(C D)) + +might be represented in our conceptual scheme by the notation: + + ((A B) . (C D)) + +A more cumbersome (but visually helpful) notation which you may see +on occasion for the same concept would be: + + --------- + | . | . | + -/-----\- + / \ + (A B) (C D) + + +In other words, CONS creates an object with two arms extending from it. +One arm points to the CAR, or (A B) in this case. The other arm points +to the CDR, which is (C D) in this case. A common version of this notation +that takes up more room, but is sometimes quite helpful, breaks down each +piece of the CONS into its constituent CONS's and keeps going until it gets +down to having just individual symbols in each box. This notation gets the +"tree structure" of your list for you, a name that makes sense if you look +at it for a bit. Here's the same CONS as above displayed in this more +long-winded fashion. + + --------- + | | | + | . | . | + | | | + -/-----\- + / \ + --------- --------- + | | | | | | + | A | . | | C | . | + | | | | | | + ------|-- ------|-- + | | + --------- --------- + | | | | | | + | B | / | | D | / | + | | | | | | + --------- --------- + +(/ is used to indicate a NIL atome goes in that box.) +.pause +Let us now conceptualize how we could create a structure which acts +like a list using our dotted pair notation. We will have to build it out +of pieces that have exactly two pieces. How can we do this? + +To start with, let's take the empty list, NIL... If we want to add an +element, FOO, to it, we could do this by saying (CONS 'FOO NIL). This +will return us an object of the form + + (FOO . NIL) + +But now we have a problem. There is no more space in the CONS for another +element to be added. So to add a new element, BAR, we might make a new +dotted pair whose first element is BAR and whose second element is the pair +(FOO . NIL). Thus we say + + (CONS 'BAR (CONS 'FOO NIL)) + +which returns a form like this: + + (BAR . (FOO . NIL)) + +To add yet another element to the list, we do the same sort of thing. + + (CONS 'BAZ (CONS 'BAR (CONS 'FOO NIL))) + +will produce + + (BAZ . (BAR . (FOO . NIL))) + +These dots are getting annoying! Let's create a shorthand notation. Suppose +that every time you see a "." you look at the next thing after it. If the next +thing is an atom, print the "." and then the atom. But if it's also a pair, +don't print the "." and leave off the extra parentheses around the next pair. +For example: + + (BAZ . BAR) => (BAZ . BAR) ; It was an atom. + + (BAZ . (BAR . GUNK)) => (BAZ BAR . GUNK) ; This is a bit nicer! + + (A . (B . (C . D))) => (A B C . D) ; This is a lot nicer! +.pause +In the case of NIL, we do a special trick. If NIL is the last atom in a list, +just forget about printing the " . NIL" at the end of a list completely. So, + + (A . NIL) => (A) + + (A . (B . (C . NIL))) => (A B C) + +Study these shorthand rules -- they will be used often. In fact,the Lisp +printer does just that when printing out a list. In a minute, you'll get +a chance to type in a few lists using this dotted pair notation. + +When you try, remember the following rules: + +[1] Make sure you quote the lists if you don't want them to + be evaluated! just saying (A . B) to Lisp will cause Lisp + to try to call a function A! Be sure to say '(A . B) so + that it knows you just want back literally what you type in. + +[2] Make sure that you put exactly one thing to the right and left + of a dot. For instance... + + '(A . B . C) is NOT allowed. Dotted pairs have exactly + two halves. No fair forcing 3 things in! + + HOWEVER, + + '(A B . C) IS allowed because it is really a contraction + for '(A . (B . C)) which is a legal form. + + If you get a ";DOT CONTEXT ERROR" message from Lisp it means you + botched up by having a "." without exactly 1 thing on either side + of it. + +Give some of these examples a try. Note how Lisp abbreviates +the printout. + + '(A . NIL) + + '(A . (B . (C . NIL))) + + '((A . NIL) . (B . NIL)) +.try +Note that you can also mix notations. For example, if you know taht +(A . (B . (C . NIL))) will contract to just (A B C) then +it should be clear that '(D . (A B C)) will contract to (D A B C). + +Give these examples a try: + + '(A . (C D E . (D . NIL))) + + '((A B C) . (D E F)) +.try +Make sure you understand how Lisp abbreviates dotted pairs when it types +out lists. It makes things much simpler when you start playing with CAR +and CDR. If you ever get stuck understanding what CAR and CDR are going +to return, you can always draw out the dotted pair notation for a list and +see what's on the right or left side of the outermost pair. + +Now as a last exercise, try doing it the other way around. Given a list like +(A B (C D E) (F G)) can you construct it using CONS? Try the function +EXAMINE-LIST which we have provided for you to view the internal structure of +a list. If you type + + (EXAMINE-LIST) + +it will either offer to re-examine the last argument you gave to it or to read +a new list from the console and then describe its structure to you. If you do + + (EXAMINE-LIST ) + +it will describe the list-structure of the value of . + +The function DISPLAY-LIST has the same convention about what arguments it +takes, but just shows you the tree structure of your list and not the other +stuff that EXAMINE-LIST does. +.try +.next SETQ diff --git a/src/teach/lesson.eval b/src/teach/lesson.eval new file mode 100755 index 00000000..0e6c9606 --- /dev/null +++ b/src/teach/lesson.eval @@ -0,0 +1,63 @@ +.comment -*- Mode:TEXT; -*- +.comment something about READ-EVAL-PRINT loops and EVAL +.document EVAL - A very quick introduction to the Lisp evaluator. +.tag EVAL +Lesson EVAL, Version 1 Kent Pitman 2/1/80 + revised by Victoria Pigman, 9/1/82 + +This is a VERY simple introduction to how Lisp evaluation works. At the +appropriate time, we will discuss evaluation in greater detail. + +Lisps are initially in something called the READ-EVAL-PRINT loop. +That means they read a form, evaluate it, and type the result. + +For example, if you type in a number, eg, 4 it will evaluate it (numbers +evaluate to themselves) and type back the result (which will be 4). + +If you put something in parentheses, it is assumed by Lisp that the +first thing inside the parentheses is a function and the other things +that follow it are things to perform the function on. Hence,(+ 4 3) says +to apply the + (addition) function to 4 and 3 (7 is typed back by Lisp). + +The objects to which functions are applied need not be simple. For +example, (* 4 (+ 3 2)) says to multiply 4 with the result of adding +3 and 2. + +Note that Lisp ALWAYS returns a value of some sort back to whatever has +called a function. This may mean returning the value to some other function +that has called this function, so that, in the example above, the call to ++ returns a 5 back to the function * so that it can then multiply that +value by its other argument and then have its value returned to whatever +called it. In this case that would be the terminal, and 20 would printed +on your terminal. This behaviour can be confusing in some places, notably +in output functions like PRINT. Don't worry too much about it now; we'll +mention it again later on. + +If you just want to get back a form literally, with no evaluation, +you use the magic function QUOTE. Saying (QUOTE (+ 3 4)) does not return +7, it returns (+ 3 4). Saying (QUOTE (QUOTE (+ 3 4))) returns +(QUOTE (+ 3 4)) and so on. + +There is a shorthand notation for (QUOTE something) and that is 'something. +If you say 'ABC that is the same as typing (QUOTE ABC) and will return +ABC. If you just type ABC, you will be asking Lisp to look up the value +which is associated with the symbol ABC and return it. If no such value +exists, Lisp will complain. + +White space (like spaces and tabs) is also unimportant in Lisp. +Typing (+ 3 4) is the same as typing (+ 3 4) +or (+ 3 + 4) so don't hesitate to put extra spaces in to make things more legible. +.pause +If you are used to programming in a non-lisp language, you may be familiar +with the syntax + FUNCTIONNAME(ARG1,ARG2,...). +In Lisp you will have to remember that that won't work -- you always say + (FUNCTIONNAME ARG1 ARG2 ...) +with the function name inside the parentheses and white space between it and +each of the arguments.(DO NOT USE commas, they mean something totally different +to Lisp, that you should not worry about now.) + +This should be enough to keep you going through the other lessons. +Good luck. +.next OBJECT diff --git a/src/teach/lesson.fib b/src/teach/lesson.fib new file mode 100755 index 00000000..7e27f75c --- /dev/null +++ b/src/teach/lesson.fib @@ -0,0 +1,102 @@ +.comment -*- Mode:TEXT; -*- +.comment shows them how to write FIB and FACT and talks about recursion +.comment and scope of variable bindings. +.document FIB - Examples of how to write two simple recursive Lisp functions. +.tag FIB +Lesson FIB, Version 2 Revised by Victoria Pigman, 9/1/82 + +This lesson is designed to give you an introduction to writing actual +programs in Lisp. The first example we shall use is the Fibonacci +function. Later we shall play with Factorial. Aren't we lucky! + + +--- FIBONACCI --- + +Just as a reminder as to what the Fibonacci function is, (which I shall +call FIB from here on...) let me give the definition: + + FIB (0) = 1 + FIB (1) = 1 + FIB (N) = FIB (N-1) + FIB (N-2) + +This type of definition is called RECURSIVE, becuase FIB is defined in +terms of previous values of FIB until it gets to a value it knows (1 or 0). + +We have defined for you a function FIB which will do this in a similar manner. + +.eval-print +(DEFUN FIB (N) + (COND ((= N 0) 1) + ((= N 1) 1) + (T (+ (FIB (1- N)) + (FIB (- N 2)))))) + +[Note: The function = returns T if its arguments are equal (they must be + integer numbers) and NIL otherwise. The function 1- returns one less + than its argument. (1- n) could have been written (- n 1)] + + +Play with this for a while to convince yourself it does what it claims. If +you have difficulty, try it out in pieces. That is, pick an n for yourself +and decide whether: + (= n 0) +is true, and if so, say 1. If you've decided that was false, then decide about + (= n 1) +and again say 1 if it returns T. Otherwise, start on + (fib (1- n)) +etc. until it becomes clear. In other words, play computer and follow through +the algorithm. +.try + +Note that the function doesn't get confused when you call it from itself. In +languages like FORTRAN this would not be the case (in FORTRAN it would even get +confused trying to return and would loop endlessly). The reason it doesn't get +confused is that every atom on the bound variable list gets a new value that +merely OBSCURES the old one; it doesn't destroy the old one. The new value goes +away when the function is exited. In other words, the SCOPE of the value is +just inside the call to the function. So, if you say (FIB 0) after FIB returns +1, N will have the same value it had before (FIB 0) was called. If it had been +previously undefined, it will still be undefined. + + +--- FACTORIAL --- + +Now let's play with FACTORIAL. (Let's call it FACT for short.) To remind you +of what factorial does, here's its definition: + + FACT (0) is 1 + FACT (1) is 1 + FACT (N) is N*FACT (N-1) + +Since you've seen how we go from the definition of FIB to the actual program, +it's your turn to try on factorial. + +Please don't continue until you think you have got it, as I will give the +solution in the next section. +.try + +Did it look something like this? +.pp +(DEFUN FACT (N) + (COND ((= N 0) 1) ; necessary for the case n=0... + ((= N 1) 1) ; is this one necessary at all? + (T (* N (FACT (-1 N)))))) + + +Note that it is possible for one function to call another, and indeed all +large programs are written like this. This is the basis behind structured +programming, i.e. you write a program and wherever you need to do something +complicated, you just say (PERFORM-HAIRY-OPERATION-ON ) and then +when you are done, you write a function PERFORM-HAIRY-OPERATION-ON which is +simpler than writing the whole big problem, and the hard parts you just call +a function to do and write that function later. You don't write the smaller +functions until you know exactly what they have to do, and you can call them +in your definitions of the larger operation just like they were pre-defined +functions. But don't forget to write them before you are done! The system will +complain about functions which are not defined when you actually try to use the +function. + +OK, that's the end of this lesson. There will be more of them soon, and we +will get into some more ways of writing programs and just how to handle more +complicated objects and problems. +.next MEMQ diff --git a/src/teach/lesson.info b/src/teach/lesson.info new file mode 100755 index 00000000..ce57b1d9 --- /dev/null +++ b/src/teach/lesson.info @@ -0,0 +1,226 @@ +.comment -*- Mode:TEXT; -*- +.comment this lesson tells all sorts of stuff about the mechanics of +.comment moving about in this program. it needs stuff about SHOW-LIST +.comment and EXAMINE-LIST. also about how to get a menu of lessons. +.document INFO - General information about the Teach-Lisp program. +.tag INFO +Lesson INFO, version 4 by Kent Pitman + and Victoria Pigman 9/3/82 + +Hi! Welcome to Teach-Lisp ... We will be running through a large number +of lessons -- showing you things and then asking you to try them on your +own. Before we get into the meat of the matter, however, let's talk for +a second about things you'll have to know in order to get through these +lessons. + +Going from lesson to lesson +--------------------------- + +IMPORTANT: You are going to see a lot of lessons that will stop to let +you try something and then continue. To continue, you will have to know +to type Control-N. This signals to Teach-Lisp that you are done fooling +around on your own and want to continue with the lesson. We'll pause for +a second here so you can get a feel for that. +.pause +Good. Welcome back. We can now continue with our lesson... + + +Moving about in a lesson +------ ----- -- - ------ + +Control-P goes to the previous section of your current lesson, so typing it +N times in succession will take you back N lesson sections, if there were +that many. A lesson section is taken to mean the stuff between two pauses +to let you fool around. + +Control-O repeats the lesson section just covered. + +Aborting a lesson +-------- - ------ + +If you want to give up on a particular lesson without letting it run its +full course, type Control-A. This will abort the lesson and leave Maclisp +sitting around waiting for you to try another lesson or just fool around. +.pause +Aborting What's Going On +------------------------ + +If you get stuck and don't know what's going on, type Control-G. That is +the magic quit character. It will stop everything that is happening and +bring you back to Lisp's main reader. From there you can invoke the +lesson function again. So if you are expecting a response and don't get +one for a long time, you might type Control-G and then retry typing +what you were trying before it. + + +Control-B is similar except that it doesn't kill what is happening, just +makes it stop so you can find out what is going on. (This is not recommended +for use until you have a good idea of what is going on. + +$P (P) continues from one of these "breakpoints". + +Refreshing the screen or your input +---------- --- ------ -- ---- ----- + +Now for a couple of convenient features... Type the following, +where ^L means L and ^K means K: + +'(this is a test^K +) + +'(this is another test^L +) +And see how it redisplays! +IMPORTANT: Remember to type the ")"'s to finish the input and then return to +this lesson. +.try +What happens is that when you type an ^K, Maclisp redisplays the expression +you are currently typing in, without clearing the rest of the screen for you. +This is useful for seeing exactly what Maclisp thinks you've typed thus far +without destroying your context. When it sees ^L, on the other hand, Maclisp +clears the screen of everything except the current expression. This is +redisplayed at the top of your screen. + +Flushing what you have typed +---------------------------- + +For now you will probably find that when you have made a typo way back, +it is easiest just to type Control-G and start typing again rather than +deleting back to it. As you become more sophisticated, you will find it +is really not the right thing to use, but it will be ok to use for now. + +Control-D and Control-U which are used by other programs and other +operating systems to flush typeahead on the current line do *NOT* work +in Lisp to do this. Control-D has a very special use and Control-U +is initially undefined. + +Getting Help +------------ + +If you get stuck, this Lisp has a special feature built into it for +teaching purposes. If you type the expression (HELP), it will request an +online helper (if one is logged in) to help you out. (Actually, this feature +has not yet been implemented.) + +Exiting +-------- + +When you are done, you can type the expression (QUIT) and this Lisp will +go away. +.pause +Parentheses! +------------ + +Lisp stands for LISt Processing language. Its main distinguishable feature, +even if you're just glancing at it, is surely the number of parentheses. +It is VERY important that you balance all your parentheses. If you type +a "(", Lisp is not going to do ANYTHING until it sees the ")" that matches +it. It is not a line-oriented machine. Every time you reach a point where +all pending open parentheses have been matched with close parentheses, it +will go and try to execute it without waiting for a space or a carriage +return. Hence, typing + + (COMMENT (THIS IS) (A TEST) TO SEE + (IF (IT IS GOING TO (DO SOMETHING)))) + +will not do anything until you type the last ")" and then Lisp will go and +try to execute the form as a program. (Don't worry about what it does right +yet -- we'll get to that -- this happens to be a form that does nothing but +return the word COMMENT so that you can put notes in the middle of programs.) + +[A general note about carriage returns and spaces. Lisp ignores carriage +returns entirely. Thus you can type one in the middle of a word. A space or +parenthesis MUST be used to end a word.] + +Errors you may encounter +------ --- --- --------- + +While learning to use Maclisp you are bound to make mistakes. It is possible +to generate lots of different kinds of errors in Maclisp. Usually Maclisp +detects the errors and gives you an error message of some sort. The particular +error message may seem totally obscure. For the duration of your stay in +Teach-Lisp, several of the most common types of errors are being handled in a +friendlier way by the program. In some cases, Teach-Lisp will make a guess +at what it thinks you meant and will fix the mistake for you according to what +it thinks is right. + +The specific types of errors which are handled by Teach-Lisp are + + 1. Unbound variables + 2. Undefined functions + 3. Wrong number of args supplied to a function + 4. Wrong type of args supplied to a function + 5. IO errors + 6. Occurence of a go tag in an illegal place (If you don't know + about go tags, don't worry about this.) + 7. Random lossage-- this is a catch-all for errors that aren't + specifically understood anywhere else. + +If you want to see what is known about a particular error, type + (DESCRIBE-ERROR) +and Teach-Lisp will give you a menu and prompt you for which error to +explain about. +.pause +.if (status feature its) +Getting a normal Lisp +------- - ------ ---- + +To get a Lisp, one normally types LISP^K or just L^K (or one of several +variations on this.....) However, for the purposes of this course there +has been created a special version of Lisp (one of the neatest things +about Lisp is that it makes such things surprisingly easy.). To run it, +just say :RWK;LISP +.if (status feature tops-20) +Getting a normal Lisp +------- - ------ ---- + +To get a Lisp, one normally types LISP or just L (or one of several +variations on this.....) However, for the purposes of this course there +has been created a special version of Lisp (one of the neatest things +about Lisp is that it makes such things surprisingly easy.). To run it, +just say XTEACH. +.end-if + +Session Record +------- ------ + +A file will be kept of everything which happens when you use this program, +so when you have difficulties and request help from one of the special people, +it will not be necessary for you to tell that person all about it; just tell +him you are having problems and he can look and see. Since it is very +important from the implementors' standpoint to find out just what kind of +problems you might encounter, don't worry about looking dumb-- feel absolutely +free to try things to see what happens. + + +Script File +------ ---- + +If you would like to keep a script file of your session with Teach-Lisp (That +is, a file similar to the session record that contains everything in it that +you type and everything that is typed back at you.), you can do so by using +the function SCRIPT. If you type + (SCRIPT) +just like that, with no arguments, Teach-Lisp will create (or add to if it +already exists as a script file) a file called +.if (status feature its) + SCRIPT > +.if (status feature tops-20) + TEACH-LISP.SCRIPT.# +.end-if +on your home directory. If you prefer, you can give SCRIPT an argument of +the name of the file to use. In that case, that file will be created or +added to, as appropriate. If you give SCRIPT an argument, you must put +doubled quotes (") around the file name, or Lisp will be confused. + +As soon as SCRIPT is invoked, Teach-Lisp will commence to write everything +that happens to the appropriate file. There is no way for it to write the +things that have happened before you invoke it, so if you want a record of +the entire session, (SCRIPT) must be the first thing you type upon entering. +It will also not record the script of any lessons you invoke, so you don't +have to worry about genereating a monstrously large file this way. You can +stop scripting any time you like by typing + (STOP-SCRIPT) +without any arguments. + +.next INTRO diff --git a/src/teach/lesson.input b/src/teach/lesson.input new file mode 100755 index 00000000..a0e26a44 --- /dev/null +++ b/src/teach/lesson.input @@ -0,0 +1,65 @@ +.comment -*- Mode:TEXT; -*- +.comment this lesson and its associate (OUTPUT) describe basic Lisp I/O. +.document INPUT - A description of some of the basic Lisp input functions. +.tag INPUT +Lesson INPUT, Version 2 Kent M. Pitman, 5/27/79 + revised by Victoria Pigman, 9/1/82 + +Lisp, unlike almost all other languages, has a basic primitive for reading +itself (that is, for reading Lisp code). If you are a Fortran programmer, +imagine trying to write a function that reads and parses a Fortran statement +using Fortran to write the function. Yuck! Yet Lisp, the beautiful language +that it is, allows this to be done simply and painlessly. + +*** Program and data in Lisp have exactly the same representation. *** +*** This is an important and useful feature! *** + +The command for reading in a Lisp object is READ. It has two optional arguments +which you will not need to use until a later time since they are for doing +input and output from files. The simplest call to read is just (READ) and will +read an s-expression (ie, an atom or list) from the terminal. +.try +There is also a command for reading a single character at a time. This command +is called TYI. It is like the opposite of TYO (see the TYO command in the +lesson on output). Like many of the Lisp read commands, TYI also takes a +variable number of arguments but you will deal now only with the one argument +case. Note that what is returned by the TYI function is the numeric value of a +character. That numeric value can be fed to TYO in order to print it back out +later. For example, typing (TYI) will not do anything until you type another +character. At that time, it will read another character and return its +numeric value. + +Try doing: + + (TYI)A +.try +Now remember that "A" and "a" are not the same character. Try comparing the +result of + + (TYI)A + +with the result of + + (TYI)a + +and notice that different values come back. +.try +Just to verify that TYI and TYO are opposites, try doing this one: + + (TYO (TYI)) + +Don't forget to type a character after it or it will just sit there +waiting for you... +.try +There is also a function like TYI that returns the character atom rather than +the numeric value of a character. This function is called READCH. The value +returned by READCH can be printed back out by the PRINC command. Try the +following: + + (READCH)a + (READCH)A + +and see how this differs from the TYI function above. Note that again +characters read in upper and lower cases are different. +.try +.next PROG diff --git a/src/teach/lesson.intro b/src/teach/lesson.intro new file mode 100755 index 00000000..16320b0e --- /dev/null +++ b/src/teach/lesson.intro @@ -0,0 +1,228 @@ +.comment -*- Mode:TEXT; -*- +.comment this file gives basic info about atoms and values and then +.comment calls the lesson that introduces lists. +.document INTRO - Basic lesson. If you're new, start with this lesson. +.tag INTRO +Lesson INTRO, version 4 by Robert Kerns + and Victoria Pigman 9/1/82 + +IF YOU NEED HELP, just type (HELP). If nothing happens, try typing +control-G (^G) first. ^G is the magic quit character which will reset +every thing to normal. If things don't work,try ^G, then retry.... + + +--- SYMBOLS, NUMBERS, and things --- + +For the purposes of this course, LISP has two basic kinds of objects-- ATOMS +and LISTS. The first group includes such things as variable names (called +SYMBOLS), numbers (called FIXNUMS, FLONUMS, or BIGNUMS for integers, +floating-point numbers, and HUGE integers), files, arrays, and several other +types of objects. The second group, LISTS, are composites. A list consists of +a (possibly empty) list of atoms or other lists. Hence: + +A -- is an atom. +ATOM -- is an atom. +(A) -- is the list of the atom A. +(A ATOM) -- is the list of the atoms A and ATOM. +NIL -- is the empty list. + +Oddly enough, NIL is also an atom (because you cannot get any smaller-- +just like A can't). + +() -- Another way of writing NIL (the null list). +(()) -- The list of the null list. +(NIL) -- The list of the null list. +(NIL A) -- The list of the null list and A. +((A B) C (D E)) -- See if you can figure this one out. + + +There are other kinds of atoms besides things like A and (), such as numbers, +but for the moment we shall deal with () and those atoms called SYMBOLS. It +is SYMBOLS that we use for what other languages use variables for. However, +in LISP they are put to a lot of other uses as well. This is part of what +makes LISP such an interesting language. +.pause +--- Talking to LISP --- + +Before you can try any of this out, you must first know about what Lisp tries +.if (status feature ITS) +to do. When you do :TEACH;LISP (or LISP^K--but use :TEACH;LISP please) LISP +.if (status feature TOPS-20) +to do. When you do XTEACH (or LISP -- but use XTEACH please) LISP +.end-if +sits listening for a form to evaluate. You cannot just type A, because it will +try to evaluate A and A doesn't have a value until you give it one. To get +around that we use the magic function QUOTE. QUOTE, when applied to something, +just returns what it was applied to without evaluating it. [To apply something, +just put parentheses around it and its argument. More on this in a bit.]. + +Hence, (QUOTE FOO) evaluates to FOO, + (QUOTE (FOO BAR STUFF)) evaluates to (FOO BAR STUFF) + (QUOTE QUOTE) evaluates to QUOTE, + and (QUOTE (QUOTE FOO)) evaluates to (QUOTE FOO). + +However, it is a pain to be always typing (QUOTE ), so an easier way +was invented-- the character "'". + +It is used like this: 'FOO +When this is read, it becomes: (QUOTE FOO), +which is then evaluated normally, giving: FOO. +Thus, the expression: '(FOO BAR STUFF) +will evaluate to (FOO BAR STUFF). + + +(Always remember that when typing atoms one must end with a space or CR. This +is not necessary when ending a list, however.) +.try + +--- LIST functions --- + +Now let's analyze some list structure. +Consider: + ((THIS IS) A (LIST OF STUFF)) +.eval +(setq this-stuff '((this is) a (list of stuff)) + apple '(apple) + fish '(can fly) + pig '(alive future-pork-of-america) + pork '(chops) + pie '(cherry lemon apple) + dog '(terrier afghan poodle runt) + cat '(siamese purrrsian alley tiger purring pussy cheshire) + man '((complex) (entity called) man (is (a many (leveled) beast)))) + +"THIS-STUFF" has been given a value. + +Find out "THIS-STUFF"'s value, by typing: + THIS-STUFF +followed by a space. +.try +The following symbols have been given values for you to use in the +following questions: + +APPLE +FISH +PIG +PORK +PIE +DOG +CAT +MAN + +There are two basic functions to take lists apart into their pieces. The first +of these is called CAR for historical reasons. Now find out the value of + (CAR this-stuff) +.try +As you saw, CAR gets you the first part of the list. It is illegal to try to +take the CAR of something other than a list. The other operation gets you the +rest of the list; that is, all of the list except the CAR. Try taking the CDR +of "THIS-STUFF" now, by typing + (cdr this-stuff) +Note that upper/lower case do not matter. +.try +As we have seen, each list is composed of exactly two parts,the CAR and the +CDR. Each of these parts may be composed of many parts. For example, take the +CAR of both the CAR and the CDR of "THIS-STUFF" via + (car (car this-stuff)) + and (car (cdr this-stuff)) +.try +Now take the CDR of the CDR of the CDR and note that the operation CDR always +gives a list. That isn't quite always true, but for our purposes, we can say +that the CDR of a list is always a list. +.try + +--- CONS --- + +There is only one operation really needed to construct lists, and it is +called CONS. CONS takes two arguments. The first argument becomes the +CAR of the new list while the second becomes the CDR. Note that this +means that the second argument must always be a list. Now create a few +lists. Don't forget to quote the arguments if you don't want their values +instead... Of course, you can CONS things with "THIS-STUFF" or FOO. (Be +careful with FOO, it has no value yet!) +.try +Now do: + (CONS 'FOO THIS-STUFF) +and then find out the value of "THIS-STUFF". +.try +Notice that this did not have any effect on the value of "THIS-STUFF". CONS +returns an entirely NEW OBJECT, which points to FOO and the same thing that +THIS-STUFF points to. +.try + +--- Number functions --- + +Now we are ready to learn about numbers. We shall stick to integers for now. +Type 5 and see what happens. Don't forget the space after it! +.try +Numbers do not need to be quoted, because they evaluate to themselves. +Now find the value of: + (CONS 5 '(6)) +But note that just because 6 evaluates to itself doesn't mean that (6) does! +.try +Ok, numbers can be elements of lists just like anything else. But let's do +some number things with numbers. Type (+ 5 6). +.try +I'll bet you expected that one. Now try the following functions: \, //, *, - +on the numbers 7 and 23 and any others you want. +.try +OK, now did you get them? +// is the division operator, dividing the first argument by the second; +\ is the remainder from this division: (\ 5 7) ==> 7; +* multiplies, +and - subtracts. + +Now, for a surprise, try: + (+ 1 2 3 4). +.try +See, we can add a bunch at a time. We can also do this for multiplication: + (* 5 6 9). +.try + +--- DEFUN --- + +Now for a brief introduction to DEFUN. Later on there is another +lesson (DEFUN) that explains about DEFUN in more detail, but that can +wait until you know a bit more. + +We can now do a few useful things, so let's learn how to define a new +function. We do this with a function called DEFUN. DEFUN is another +magic function, which doesn't evaluate any of its arguments. See if +you can guess what this function does: + +.eval-print +(DEFUN TWICE (A) (* 2 A)) + +Now that you have made your guess, let's give it a try. Use it on a few +numbers (one at a time, please--it doesn't know what to do with more). If +you didn't guess, the function is called twice, and has been defined for +you already, so you can just say (twice 2) or whatever. +.try +OK, let me explain what that did. The first part given to a DEFUN is the +name of the new function, (TWICE in this case). The second part is a list +of variable names. In this case there is just one, "A", but there could +have been many (that's why you use a list, so that it can tell whether you +want just one or many.) The last part is what you want the function to do. +When this part is evaluated, any occurences of a variable which is in the +list of variable names before it, are replaced with the corresponding argument. +Thus (TWICE 2) means (* 2 2), (TWICE 5) means (* 2 5), etc. A is sometimes +called a bound variable, or is said to be "bound" to 2 or 5, respectively. +The second argument to DEFUN is called the BOUND-VARIABLE-LIST. + +Now try to write a function which computes A+5*B where A and B are the first +and second arguments, respectively. (Hint: use a bound variable list with TWO +elements... you don't have to call them A and B if you don't want. +.try +Did it look something like this? (The function below has also been defined for +you.) + +.eval-print +(DEFUN POLY (A B) (+ A (* 5 B))) + +This is the way LISP "programs" are written. They are functions which when +evalutated do the desired task. + +Before we can do anything really useful, we have to be able to do something +one time, but not another. Hence (LESSON PRED) will make this lesson seem +much more useful..... +.next eval diff --git a/src/teach/lesson.lambda b/src/teach/lesson.lambda new file mode 100755 index 00000000..66339355 --- /dev/null +++ b/src/teach/lesson.lambda @@ -0,0 +1,143 @@ +.comment -*- Mode:TEXT; -*- +.document LAMBDA - Description of the special form LAMBDA. +.tag LAMBDA +Lesson LAMBDA, Version 3 Kent M. Pitman, 1/22/80 + revised by Victoria Pigman, 9/1/82 + +LAMBDA is not a function. Lists of a certain form which begin with the atom +LAMBDA are specially recognized by Lisp to describe functional operations. + +For example, suppose I wanted to describe a function which operated on two +objects and found the sum of their squares. I could describe such a function +in Lisp as follows... + + (LAMBDA (OBJECT1 OBJECT2) ; This is a list of the objects + ; we are working with... + + (+ (* OBJECT1 OBJECT1) ; This is an operation to do + (* OBJECT2 OBJECT2)) ; on the object. + ) + +The general form of a LAMBDA expression is: + + (LAMBDA ... ) + +where means "bound variable list". This is a list of the names which +you wish to use locally to refer to the objects to which the function will +be applied. These values to which the function is being applied are called +the `actual parameters' or `actual arguments' or sometimes just `actuals'; +the names which you are assigning to them in the bound variable list of the +formal lambda definition are called `formal parameters' or `formal arguments' +or (you guessed it) just `formals.' + + ... are Lisp expressions which will be evaluated from left to +right, returning the value of the last form. + +Be careful, because if you just type (LAMBDA (X Y) (* X Y)) into Lisp you'll +get an error. Lisp will complain that LAMBDA is not a function, since when it +sees a list it looks at the CAR for what to do. Lisp only understands lists +with LAMBDA in the CAR when it wants to apply the list. Just saying + + (LAMBDA (VALUE1 VALUE2) (PLUS VALUE1 VALUE2)) + +is like saying + + PLUS + +When found in the CAR of a list, they both have special meaning, i.e. they +designate a functional operation, but on their own, they are meaningless. + +Try typing these two and see what happens (expect an error ... you will be +asked if you want help with the type of error you got. Look if it interests +you, but then come back to me.) +.try +Functional operators must be applied. Since Lisp applies the CAR of a form to +its CDR, we can use LAMBDA in the same way as you would use any function. Since +you would say + + (PLUS 7 B) + +(assuming B has a value) you must also put LAMBDA expressions in the CAR of the +list, like so: + + ((LAMBDA (VALUE1 VALUE2) + (PLUS (* VALUE1 VALUE1) + (* VALUE2 VALUE2))) + 7 B) +.eval +(progn + (format t "~&") + (cond ((not (boundp 'B)) + (setq b 3) + (format t "(B has been given a value of 3 for your convenience)")) + ((not (numberp B)) + (format t "You have assigned a non-numeric value to B, ~ + so you should pick another value to use instead.")))) +.try +A form which contains a LAMBDA expression (which we sometimes call a LAMBDA +operator) applied to some arguments is called a LAMBDA combination. + +LAMBDA combinations have the general form: + + ((LAMBDA ...) + ... ) + +where the number of 's must be equal to the number of elements in the +bound variable list. + +When a LAMBDA combination is executed, the following steps are taken in this +order: + + (1) The actual args, ... in the above example, + are evaluated in order from LEFT to RIGHT. + + (2) When all values have been computed, the old values of all + the symbols in the bound variable list (if they had old + values) are saved in a place where they can be gotten back + later. Then the symbols are assigned the new local values + which were gotten by evaluating the actual arguments. This + process is called binding (which is why the list of local + variables is called a bound variable list). + + (3) The body of the LAMBDA expression is executed in a context + in which the local variables are bound to these values. + + (4) The value returned by the last expression in a LAMBDA + will be returned from a LAMBDA. + + (5) Unbeknownst to you (practically), Lisp goes and restores the + old values of the variables in the bound variable list so + that if any other functions had been using them as storage + places, they won't be confused by having called your + function. + +Try some of these examples: + + ((LAMBDA (X) (+ (* X X) (* 2 X) 1)) 3) + + ((LAMBDA (X) (^ (+ X 1) 2)) 3) ; Does same thing as the one above it + + ((LAMBDA (A B C) + (PRINT (LIST 'GOT-THE-ARGUMENTS A B C)) ; Print out info + (+ A B C)) ; Return their sum + 3 4 5) ; Actual arguments to the function description +.try +LAMBDA expressions do not need to have any variables in their bound variable +list. If they have no variables, they need have no arguments ... Here is an +example ... + + ((LAMBDA () T)) + +These may seem useless, but they illustrate an important concept. A LAMBDA +expression is a functional description, and we can describe any kind of +function, including one with no arguments. LAMBDA's are often used when we +wish to build a function to pass to another function which will then use it +for its own purposes; in such a circumstance a function of no arguments can be +useful. + + In fact, people rarely use un-named LAMBDA's at all. If you are going to do +an operation more than once, it makes sense to assign it a name and call it by +name. What you want to do now is proceed to (LESSON DEFUN) where you can learn +all about naming your LAMBDA's for later use. +.next DEFUN + diff --git a/src/teach/lesson.lesson b/src/teach/lesson.lesson new file mode 100755 index 00000000..2f4b8d4b --- /dev/null +++ b/src/teach/lesson.lesson @@ -0,0 +1,87 @@ +.comment -*- Mode:TEXT; -*- +.comment Menu of available lessons. It is important that this file be updated +.comment every time a new lesson is added. +.document LESSON - Menu of available lessons (pretty much this stuff). +.tag LESSON +Lesson LESSON, Version 1 Victoria Pigman, 9/1/82 + +This is lesson LESSON. Included herein you will find a list of all the lessons +currently available to you, in the order in which we think it would be useful +for you to go through them. This ordering is not hard and fast, but it is +recommended that the first 5 be done in order. + +INFO: + How to use :STUDNT;XTEACH + +INTRO: + Basic lesson. If you're new, start with this lesson. + +EVAL: + A very quick introduction to the Lisp evaluator. Just enough + to keep you going until we can get you worked up to a more + sophisticated discussion of what's really going on. + +OBJECT: + Information about Lisp objects. You need to know about this + before you can proceed to the other lessons. + +DOT: + A description of the dotted pair formalism for Lisp + lists. A good way of thinking about CAR, CDR, and CONS. + +SETQ: + How to use the SETQ function to give variables values. + +COND: + Lesson on predicates and conditionals. + +FIB: + Lesson on defining functions using fibonacci and + factorial as examples. + +MEMQ: + Lesson on how to check for membership of elements in a list + using the functions MEMQ and MEMBER. + +ASSQ: + Lesson on how to make Association lists and how to find + info in them using ASSQ and ASSOC. +.pause +LAMBDA: + What is the magic thing called LAMBDA? + +DEFUN: + Lesson on use of DEFUN and various function types + (how to write your own "magic" functions which + don't eval their arguments; how to write functions + which take a variable number of args) + +OUTPUT: + A description of some of the basic Lisp output functions: + PRINC, PRIN1, PRINT, TYO, TERPRI, FLATC, and FLATSIZE. + +INPUT: + A description of some of the basic Lisp input functions: + READ, TYI, and READCH. + +PROG: + Lesson on what PROGN does and how/why it came into + being in the first place. + Lesson on what PROG2 is and how to use it. Gives an + example of how to implement stack operations PUSH and + POP in Lisp. + Lesson on the Maclisp PROG statement (which allows + explicit GOTO's, RETURN's, and statement labels). + Former FORTRAN hackers are encouraged not to program + with PROG until they have learned the more elegant + constructs available (by which time hopefully they + won't want to use PROG). + +DO: + A lesson in how to use the Maclisp iteration + primitive: DO. + +TRACE: + Advanced lesson: How to use the Lisp TRACE package to + debug your programs. +.eof diff --git a/src/teach/lesson.memq b/src/teach/lesson.memq new file mode 100755 index 00000000..8f83e51b --- /dev/null +++ b/src/teach/lesson.memq @@ -0,0 +1,111 @@ +.comment -*- Mode:TEXT; -*- +.comment MEMQ, MEMBER +.document MEMQ - Checking for membership in a list using MEMQ and MEMBER. +.tag MEMQ +Lesson Searching Constructs MEMQ and MEMBER, Version 2 + Kent M. Pitman, 5/27/79 + revised by Victoria Pigman, 9/1/82 + +By the time you read this lesson, let's hope you understand something about +what a list is and how to play with it in some basic ways. Now let's discuss +some of the more interesting kinds of things that you can do with lists. + +To begin with, it's nice to be able to find if a certain symbol occurs in a +list. This can be done with the function MEMQ. MEMQ takes two arguments. The +first should be a symbol and the second a list, so a typical call to MEMQ +could look like: + (MEMQ SYMBOL SOME-LIST) +The above form will return NIL if SYMBOL cannot be found as a member of +SOME-LIST. If it is found, MEMQ returns the portion of SOME-LIST that starts +with the first occurrence of SYMBOL. It uses EQ to test for equivalence, so is +mainly useful for testing the membership of symbols in the list. + +Try these examples: + + (MEMQ 'A '(C D E)) + + (MEMQ 'A '(A B C)) + + (MEMQ 'B '(A B C A B C)) +.try +MEMQ is only for testing membership in the top level of a list. For instance, +arg 1 will not be found in the second arg if it is buried in it by other list +structure. Try these examples: + + (MEMQ 'A '(FOO (A B C) BAR)) + + (MEMQ 'A '(FOO (A B C) A B C)) +.try +Since MEMQ uses the EQ test, which will not say two lists are the same unless +they are pointers to the same instance of a list, It will fail in most cases +to find a list in the second list. Try these examples: + + (MEMQ '(A B) '(FOO (A B) BAR)) +.try +But notice we said 'in most cases' ... In fact, if you are looking for a +pointer to exactly the same list, you will find it. Here's an example: + + (SETQ A '(FOO BAR)) + +Returns => (FOO BAR) + + (SETQ B (LIST 'A A 'B)) + +Returns => (A (FOO BAR) B) + + (MEMQ A B) + +Returns => ((FOO BAR) B) + +because a pointer to the same instance of the list A was found in the list you +were looking in. This will never happen unless you do something to force it to +happen (such as how we constructed B above). Normally two lists are created out +of completely unrelated pieces. (We have set up A and B for you in this way, +if you'd like to check this out for yourself.) +.eval +(SETQ A '(FOO BAR) B (LIST 'A A 'B)) +.try +It should have been apparent that the extra (...)'s hide the existence of A in +the list. In most practical programming problems this will be what you want +anyway. It is not a misfeature as it may seem at first because it is [1] much +more efficient to do and [2] much more useful. + +The function MEMQ could be defined using other functions in Lisp. (It isn't -- +for efficiency, since it is used often, it's written in assembly code, but it +needn't be). This is how MEMQ could be defined in Lisp: + +.pp +(DEFUN MYMEMQ (ELEMENT LIST-TO-LOOK-IN) + (COND ((NULL LIST-TO-LOOK-IN) + NIL) + ((EQ (CAR LIST-TO-LOOK-IN) ELEMENT) + LIST-TO-LOOK-IN) + (T + (MYMEMQ ELEMENT (CDR LIST-TO-LOOK-IN))))) + +Now let's try another function which is very much like MEMQ but will look for +non-symbols (ie, numbers or lists) in a list. This function is called MEMBER. +It is just like MEMQ except it uses the EQUAL predicate instead of the EQ test +for checking equality. (It is, of course, slower than MEMQ - generality costs.) + +Try this example: + + (MEMQ '(A B) '(FOO (A B) BAR)) + + (MEMBER '(A B) '(FOO (A B) BAR)) +.try +MEMBER is also useful for finding numbers in a list. (NOTE: Due to an +implementation-dependent feature of Maclisp, most small FIXNUM's in Maclisp +are EQ and can be found by an EQ test. Do not rely on this! It is not a +reliable feature.) + + (MEMQ 1 '(3 2 1)) ; This works by accident! + (MEMBER 1 '(3 2 1)) ; This works because it should! + + (MEMQ 895 '(455 895 129)) ; This doesn't work! + (MEMBER 895 '(455 895 129)) ; This works because it should! + + (MEMQ '(A B) '((A B) (C D) (E F))) ; This better not work! + (MEMBER '(A B) '((A B) (C D) (E F))) ; This better work! +.try +.next ASSQ diff --git a/src/teach/lesson.object b/src/teach/lesson.object new file mode 100755 index 00000000..cfcc945a --- /dev/null +++ b/src/teach/lesson.object @@ -0,0 +1,177 @@ +.comment -*- Mode:TEXT; -*- +.comment all types of objects +.document OBJECT - Information about Lisp objects. +.tag OBJECT +Lesson OBJECT, Version 2 Kent Pitman, 12/5/80 + revised by Victoria Pigman, 9/1/82 + +The things you type in and the things Lisp types back at you are +printed representations for internal objects and structures. +Different flavors of objects have different uses and different +printed representations. This lesson will deal with some of the +more common objects that Lisp knows about -- how to type them +in, manipulate them, and get Lisp to type them back out. + + +ATOMS and LISTS + +For the purposes of this course, Lisp has two basic kinds of objects: +ATOMs and LISTs. An atom, like you probably learned in science class, +is a very small thing. Words (or SYMBOLs as we call them in Lisp) and +Numbers are examples of atoms. LISTs are collections of things -- either +collections of atoms or collections of other lists. + +SYMBOLS + +SYMBOLs are just what they sound like -- they are symbolic names +for things. For example, the following objects are symbols: + + FOO HOUSE ELECTRIC-OUTLET CAR + +Try typing in some of these SYMBOLs. (You will have to type a +single-quote mark before the name as in 'FOO or 'HOUSE to keep +Lisp from evaluating them. If you haven't read about evaluation, +see Lesson EVAL at your earliest opportunity.) +.try +SYMBOLs can have funny characters in them, too. For instance, if you +wanted to put a space in a SYMBOL's name, you could do it in either of +two ways -- one is to use the magic character "/" which says the next +character is to be taken non-specially. So you could type in the atom +FOO BAR (with a space in it) by typing FOO/ BAR. The space in this atom +name is said to be slashified. + +Another way to do the same thing is to use the magic character "|". This +says that Lisp should gobble characters after the "|" until another "|" +is seen and pretend there were slashes in front of all of the characters +in between. So, + + |ABC DEF GHI| is the same as ABC/ DEF/ GHI + +Lisp will optimize the printing of these things to try to +minimize the number of characters it has to print. Try typing in +some of these examples and see what comes out: + + A ; Normal atom A + a ; Note that Lisp normally makes everything uppercase + /a ; But you can inhibit that + /a/b ; This keeps both characters small + |ab| ; So does this + |ABC| ; And it knows when vertical bars were un-needed + |A C| ; and when they aren't. + +Don't forget the single quote. +.try +You may have noticed something funny if you tried rubbing +out the / ... If you type A/b you will rub out both the +slash and the b. That's because Lisp treats the /b as one +character. Even harder to understand perhaps, but useful on +occasion, is that if you want to insert a rubout (it is a valid +character, after all) into an atom name, you can say / +Thus if you type a / un-intentionally, it may take you two +rubouts to get rid of it. + +Also note that if you wanted to get a / into an atom, you +wouldn't be able to because / is already reserved for that +special meaning ... so you do the obvious thing: // ... The +symbol // is a one-character symbol. The first slash is just a +marker saying the next character is to be taken as a normal +character. Similarly, to get vertical bar into an atom, you +would say /| ... Try typing in some of these odd atom names: + + FOO//BAR |FOO//BAR| ; Two names for same symbol! + + FOO/|BAR |FOO/|BAR| ; Also two names for same symbol! + + foo/|bar |foo/|bar| ; These are DIFFERENT symbols. + +Don't forget the single quote. +.try +Here is a cute set of atom names to try... + + /a //a ///a ////a /////a ...etc (do you see the pattern?) + +Don't forget the single quote. +.try +FIXNUMS + + Numbers come in many flavors. There are integer numbers +(like 5 or 30 or -17). Lisp calls these numbers FIXNUMs. Try +typing in some FIXNUMs and see what gets typed back. Numbers +have the nice property of evaluating to themselves so you won't +have to use a quote mark. +.try +FLONUMS + + There are also ``floating point numbers'' or ``real +numbers'' like Pi or 1/2 or the square root of 2. Lisp calls +these numbers FLONUMs. It would take too much storage (actually, +an infinite amount) to store these numbers exactly, so decimal +approximations are used. For example, Pi might be stored as just +"3.14159" but 1/2 could be stored as "0.5". FLONUMs must have +digits before and after the decimal point. eg, 3.7 is a FLONUM +but 3. is a FIXNUM. +.try +BIGNUMS + + Maclisp also has a special class of numbers that are like +FIXNUMs but can grow to arbitrary size. Most languages do not +support such a feature. Try typing in a number like +923423423842342978897483749274897492834223. This is in many +ways similar to a fixnum, but it is much bigger than the average +FIXNUM, so it has a special name -- BIGNUM. Any number bigger +than about 34359738367 is called a BIGNUM. Try typing in some +bignums. +.try +LISTS + + You can also have collections of objects. The main such +type is called the LIST (it is actually constructed out of a +more primitive structure called the CONS (short for 'construct') +or PAIR (because it's a pairing of two objects). We will get to +this shortly). LISTs are designated in their printed +representation by parentheses. All the objects in a list need +not be of the same type. Hence you can have nice homogeneous +lists like (3 4 5 6) which is a list of fixnums or you can have +lists of mixed types like (A B 3.0 7 C). + + You can even have lists of lists. For example, + ((3 4 5 6) (A B 3.0 7 C)) +is a list 2 long whose elements are the two lists that we used +for examples of lists in the previous paragraph. + + Try typing in some lists. Remember to use the single-quote mark +to inhibit evaluation of your lists as in '(A B C) or '(3 4 5). +.try +Figuring Out The Type Of Something + + Lisp has a function which will tell you what the type of an +object is. It is called TYPEP. To give you a feel for its use, here +are some examples of various inputs and what they will return: + + (TYPEP '3) ==> FIXNUM + (TYPEP 'A) ==> SYMBOL + (TYPEP '(A B C)) ==> LIST + +For the last of these, perhaps a better thing to return would be CONS +or PAIR, since that's what we call the primitive object from which a +LIST is made up. + +Run through a few trials with TYPEP so you get the feel of it. +We'll see in later lessons that it can be a very powerful tool +in building programs work on varying kinds of input. +.try +There is a special kind of list called the empty list. It has +the unique feature that it is both an atom and a list. This is +because it is a list, but a very small one -- so small that you +can't get any smaller -- so it has the unique honor of being an +honorary atom. (In Maclisp, TYPEP will return SYMBOL for this +object's type, but that is prone to be different in different +dialects of Lisp.) + +Various Lisps have different syntax restrictions on the empty +list. In Maclisp, the tokens NIL and () are exactly equivalent +and both denote the empty list. + +Try typing in () and NIL and see what Lisp types back. +.try +.next DOT diff --git a/src/teach/lesson.output b/src/teach/lesson.output new file mode 100755 index 00000000..5b9dc4af --- /dev/null +++ b/src/teach/lesson.output @@ -0,0 +1,132 @@ +.comment -*- Mode:TEXT; -*- +.comment this lesson and its associate (INPUT) describe basic Lisp I/O. +.document OUTPUT - A description of some of the basic Lisp output functions. +.tag OUTPUT +Lesson OUTPUT, Version 2 Kent M. Pitman, 5/26/79 + revised by Victoria Pigman 9/1/82 + + Lisp has several functions for doing different kinds of output. +To output an object in Lisp-readable form, the basic function is PRIN1. +(That is, they print in a from that Lisp can understand.) +For example, + (PRIN1 'FOO) +will type FOO on your console. +PRIN1's first arg (it has another optional arg but you don't want to +worry about it now) is the thing to print. +.try +To print more than one thing you must either print a list or make two +calls to PRIN1. For example: +.eval +(setq a 'foo b 'bar) + + (SETQ A 'FOO) + (SETQ B 'BAR) + (PRIN1 (LIST A B)) + +or + + (PROGN (PRIN1 A) (PRIN1 B)) + +The effects of each are slightly different. (Note - if PROGN is strange +to you, there is a lesson on it.) +.try +The function PRINT is nearly the same as PRIN1, but it spaces things +apart from each other by typing a carriage return, then doing PRIN1 of +the form and then typing a space. + +You should do these things and observe the differences... + + (PRINT A) + (PROGN (PRIN1 A) (PRIN1 B)) + (PROGN (PRIN1 A) (PRINT B)) + (PROGN (PRINT A) (PRIN1 B)) + (PROGN (PRINT A) (PRINT B)) +.try +Note that PRIN1 and PRINT both print things in LISP READABLE FORM (That is, +they print in a from that Lisp can understand.) +Compare the results of: + + (PRINT 'A/.B) + +with the results of + + (PRINT '|A.B|) +.try +Did they come out the same? What if you wanted to print that configuration +without the vertical bars showing up? You'd use PRINC. PRINC is just like +PRIN1 but prints in HUMAN READABLE FORM. Here's a couple to try: + + (PRINC 'FOO) + (PRIN1 'FOO) + + (PRINC '|This is a test.|) + (PRIN1 '|This is a test.|) +.try +You may also just want to output single characters. One way to do this is +by doing + + (PRINC 'A) + +for instance (which prints an A). But another way to do it is to use the +function TYO. TYO takes a FIXNUM (integer) as an argument and prints the +ascii character whose value is that character. So + + (TYO 65) + +will print an "A" ... +.try +There is also a function for printing a carriage return. It is called +TERPRI. To see it work try this: + + (PROGN (PRINC 'A) (PRINC 'B)) + (PROGN (PRINC 'A) (TERPRI) (PRINC 'B)) +.try +Note that now that we know about TERPRI, PRINC, and PRIN1 we realize +we didn't need PRINT after all. It could have been defined by doing + +.pp +(DEFUN MYPRINT (X) (TERPRI) (PRIN1 X) (PRINC " ")) + +Try typing in this function definition and then compare its effects with +those of PRINT. +.try +By the way, many people initially find it confusing that when they type +(PRINT ) they see the printed and then they see +a T after it. Be aware that the T is not there because of anything PRINT +is doing - it's there because everything in Lisp returns values to their +caller. If PRINT were called from a program, that program would get back the +T, but since it's being called from the terminal, the terminal gets back +the T. + +As you recall, when you do (+ 5 5) you see 10 on your terminal without +a print request at all. This is because the 10 is "returned" to the terminal. +So when you do (* (+ 5 5) 5) you see only the 50 printed - the 10 is returned +to the * operator. + +So when you do (PRINT 'FOO) and you see: + +(PRINT 'FOO) +FOO +T + +don't be too surprised. Lisp is just returning to the terminal the last +value it had ahold of. + +Try doing (PROGN (PRINT 'FOO) (+ 5 5)) and see if you can figure +out what's going on. +.try +Now for one last useful thing... + +There's even a function that will tell you how wide a thing will print. +FLATC tells you how wide PRINC will print something. FLATSIZE tells you how +wide PRIN1 will print it. Example: + + (FLATC 'FOO) => 3 because PRINC prints it as "FOO" - 3 chars + (FLATSIZE 'FOO) is also 3. + + (FLATC '|This is a test.|)=> 15 because PRINC doesn't print the + vertical bars. + (FLATSIZE '|This is a test.|)=> 17 because PRIN1 does print vertical + bars around the text. +.try +.next INPUT diff --git a/src/teach/lesson.prog b/src/teach/lesson.prog new file mode 100755 index 00000000..82e1bfce --- /dev/null +++ b/src/teach/lesson.prog @@ -0,0 +1,190 @@ +.comment -*- Mode:TEXT; -*- +.comment all the PROG constructs +.document PROG - Description of the functions PROG, PROG2, and PROGN. +.tag PROG +Lesson PROG, Version 2 Kent M. Pitman, 5/25/79 + revised by Victoria Pigman, 9/3/82 + +--- PROGN --- + +(PROGN ... ) + +evaluates each
in sequence, returning the value of the last form. + +PROGN's uses are primarily historical. In Pure Lisp, many forms allowed +only one Lisp form in a certain position. For example, LAMBDA's could +evaluate exactly one Lisp form in their binding context - as in: + + ((LAMBDA ) ... ) + +rather than the more modern flavor of: + + ((LAMBDA ... ) ) + +In such a situation, PROGN was useful because it allowed the person to make +the a PROGN which contained all of the forms he wanted to evaluate: + + ((LAMBDA (PROGN ... )) + ... ) + +In fact, things like the body of a lambda-operator are today called implicit +PROGN's because they act exactly like a PROGN, evaluating the forms from left +to right and returning the value which is returned by the last form in the +sequence. + +Some uses of PROGN which are still valid today are: + +[1] 'Sneaking in' a statement where there wasn't room for one. + For example: + + (SETQ A (PROGN (PRINT '(I AM NOW SETQING A TO 5)) + 5)) + + which will behave very much the same as: + + (PRINT '(I AM NOW SETQING A TO 5)) + (SETQ A 5) + +[2] 'Hiding return values' + When evaluating a lot of things in a sequence, it may be the case + that you don't care to see the return values of some expression. + Doing + + (PRINC 'FOO) + (PRINC 'BAR) + + in the interpreter is not satisfactory for printing FOOBAR because + the evaluator takes off and prints the "FOO" probably before you get + the second form typed in - and even if it didn't, you'd get the return + value from the first form printed in between. By doing + + (PROGN (PRINC 'FOO) (PRINC 'BAR)) + + you can achieve the desired effect. +.pause +--- PROG2 --- + +(PROG2 ... ) + +This statement is tricky, but sometimes useful. As a good rule, don't ever +TRY to find uses for it. One of these days when you get experienced you will +suddenly develop a need for it and can come back and learn it. What it does, +however, is to evaluate through in order, but +remembering the value of and returning that. + + Examples: + + (PROG2 (SETQ A 4) (LIST A A) (SETQ A 5)) + +will return + + (4 4) + +but A will be set to 5 when it is through executing. + + (PROG2 () (CAR A) (SETQ A (CDR A))) + +will return the CAR of A, but will side-effect on A by removing setting it to +its CDR. +.try +If you wanted to implement a push-down stack in Lisp, for instance, this is +one possible way... + +.eval-print +(DEFUN INIT-STACK () (SETQ STACK-POINTER NIL)) + +.eval-print +(DEFUN PUSH-STACK (X) (SETQ STACK-POINTER (CONS X STACK-POINTER))) + +.eval-print +(DEFUN POP-STACK () + (PROG2 () ; Ignore first argument + (CAR STACK-POINTER) ; Return top of stack + (SETQ STACK-POINTER ; Pop stack + (CDR STACK-POINTER)))) + +Then watch the following: + Input: (INIT-STACK) + Output: NIL + + Input: (PUSH-STACK 'FOO) + Output: (FOO) + + Input: (PUSH-STACK 'BAR) + Output: (BAR FOO) + + Input: (PUSH-STACK 'BAZ) + Output: (BAZ BAR FOO) + + Input: (POP-STACK) + Output: BAZ + + Input: (POP-STACK) + Output: BAR + + Input: (PUSH-STACK 'MORE) + Output: (MORE FOO) + +and so on... Try it for yourself with the following warnings... + +Do not define functions called PUSH or POP because there are Lisp built-in +functions by that name which do something in the way of PUSHing and POPping +but in a different way and you will break your Lisp if you redefine them +randomly! + +The functions INIT-STACK, PUSH-STACK and POP-STACK are now defined in your +environment. Experiment on your own now. (And don't forget to call +(INIT-STACK) before you start or you'll find our STACK-POINTER variable is an +unbound variable.) +.try + +--- PROG --- + +(PROG ) + +This is a very hairy offshoot of PROGN which is much more powerful but at the +cost of readability in most cases. The user is STRONGLY discouraged from using +this, since there is almost always a more readable way of doing the same thing. + + is a list of variable names which will all be locally set +to NIL at the beginning of the PROG. + + is a sequence of statements and tags. Any atom in the list is a tag, or +label. Any non-atom is a form to be evaluated. + +Tags can be used as references in a GO statement. They are not evaluated, but +rather flow of control is continued at the statement just after the tag. + +Additionally, the RETURN function may be called from any point inside of a +PROG form. The RETURN function takes exactly one argument, which is the value +to be returned as the value of the innermost PROG which lexically encloses the +RETURN statement. What this means is that when a RETURN is encountered in the +middle of executing a PROG, the argument to RETURN is evaluated and then that +value is returned by the PROG, and the rest of the body of the PROG (if any) +is not executed. Clear? Probably not, but don't worry about it now. Try some +simple examples of your own to try to figure this out. Here's an example +of a simple use of PROG: + +(PROG (A) + (SETQ A 0.) + LOOP + (PRINT A) + (SETQ A (1+ A)) + (COND ((LESSP A 3) (GO LOOP))) + (RETURN 'DONE)) + +This program will print out 0, 1, and 2 and then return the atom DONE. If all +of the forms in a PROG are executed successfully and no RETURN statement is +seen, the PROG will "fall out the bottom", returning NIL. + +Note also that the above form is very hard to read because it contains GO +statements. GO statements are looked down upon strongly by most programmers. +Maclisp also provides a DO statement for doing looping which can accomplish +the same action in a much more elegant way. + +NOTE: ESPECIALLY if you are a Fortran programmer, avoid using PROG since +it will probably allow you to sink back into the ease of your old [bad] +programming habits instead of exploring some of the more elegant programming +constructs which Lisp has to offer. +.try +.next DO diff --git a/src/teach/lesson.setq b/src/teach/lesson.setq new file mode 100755 index 00000000..6ee500e9 --- /dev/null +++ b/src/teach/lesson.setq @@ -0,0 +1,48 @@ +.comment -*- Mode:TEXT; -*- +.comment all about SETQ +.document SETQ - How to use the SETQ function to give variables values. +.tag SETQ +Lesson SETQ, Version 2 Modified by Victoria Pigman 9/1/82 + +There is a magic function "SETQ" which gives things values. Unlike QUOTE, it +takes its arguments two at a time. Like QUOTE, it doesn't evaluate its first +argument. However, it does evaluate its second argument... to see what it +does, here are a few things you can try. However you should also try to come +up with a few of your own. + + FOO ; will give you an error message...try to predict what else will! + 'foo + (setq foo 'foo) ; note that the first argument (the + foo ; thing being SETQ'd) is not quoted. + 'foo ; This is because SETQ is a magic + (setq foo 'bar) ; function. Most other functions are + foo ; not like that. + 'foo + bar + (setq bar foo) + bar + 'foo + (setq foo '(foo bar stuff (now then))) + foo + bar + +If you get an error message, don't panic, just keep trying. +.try +Note which ones gave you error messages-- the ones you mis-typed and the ones +where a variable didn't have any value. + +SETQ is actually a rather confusion causing function which is best used in a +limited fashion. One reason SETQ causes confusion is because it has an effect +which is global, that is, effective everywhere. A SETQ can have an effect in +a piece of code quite unintentionally, perhaps a piece of code in an entirely +different file. This can, and very often does, lead to very obscure and hard to +find bugs. It also makes the program very hard to read if some atom is set to +some value in one place and that information is used in another place. In +general, it is advisable to only SETQ a variable in one place, or at least in +as few places as possible, unless you are doing something like: + + (SETQ FOO (CONS 'FROB FOO)) + +which is not so bad since it doesn't destroy the old value, merely adds to it. +This still can cause confusion in places, though. +.next COND diff --git a/src/teach/lesson.trace b/src/teach/lesson.trace new file mode 100755 index 00000000..632ca8b2 --- /dev/null +++ b/src/teach/lesson.trace @@ -0,0 +1,68 @@ +.comment -*- Mode:TEXT; -*- +.document TRACE - How to use the Lisp TRACE package to debug your programs. +.tag TRACE +Lesson TRACE, Version 2 Kent M. Pitman, 3/28/79 + revised by Victoria Pigman, 9/1/82 + +This is an advanced lesson and should be saved for when you already know +a fair amount about the basics of what is going on. + +Monitoring calls to a function in Maclisp is accomplished through the TRACE +function. For example, suppose you want to know every time a function is +called, what args it is called on and what it returns. Just saying + + (TRACE ... ) + +will trace each of through . The 's are not evaluated. +For an example, consider the following function which counts the number of +atoms in a list: + +.eval-print +(DEFUN COUNT-ATOMS (X) + (COND ((NULL X) 0.) + ((ATOM X) 1.) + ((ATOM (CAR X)) + (+ 1. (COUNT-ATOMS (CDR X)))) + (T + (+ (COUNT-ATOMS (CAR X)) + (COUNT-ATOMS (CDR X)))))) + + +We have defined the function COUNT-ATOMS for you, so you don't have to type it +in again. If you aren't sure how it works, or some of the cases confuse you, +you should try doing + + (TRACE COUNT-ATOMS) + +and then run the function on some of the following test cases... + + (COUNT-ATOMS '(A B C)) + + (COUNT-ATOMS '(A (B C) D)) + + (COUNT-ATOMS '(A NIL B)) +.try +When you are done tracing a function, you can make it stop printing out all +that long-winded stuff by using the untrace function. Its syntax is + + (UNTRACE ...) + +so you would want to do + + (UNTRACE COUNT-ATOMS) + +to undo your trace of our function above. If you forget which functions have +been traced, you can type + + (TRACE) + +and it will return a list of all the functions currently being traced. Typing: + + (UNTRACE) + +with no args will untrace all traced functions. These can save a bit of typing +sometimes. + +Study the output from the TRACE carefully until you understand what is going +on. It can be very useful in helping to debug complex programs. +.eof diff --git a/src/teach/macro.29 b/src/teach/macro.29 new file mode 100755 index 00000000..22fbbddf --- /dev/null +++ b/src/teach/macro.29 @@ -0,0 +1,99 @@ +;;; -*- Mode:LISP; -*- + +;;; Macro support for the world + +(declare (special *in-more-break*)) + +;;; CATCH-**MORE** +;;; Catch a throw to flush output after a **MORE**. + +(defmacro catch-**more** (&body body) + `(*catch '*can-flush-more* + (let ((*can-flush-more* t)) + (declare (special *can-flush-more*)) + ,@body))) + +;;; DONT-CATCH-**MORE** + +(defmacro dont-catch-**more** (&body body) + `(let ((*can-flush-more* nil)) + (declare (special *can-flush-more*)) + ,@body)) + +;;; Top level place to go when have problems. + +(defmacro catch-complaints (&body body) + `(*catch 'complaint-handler + (let ((*complaint-handler* t)) + (declare (special *complaint-handler*)) + ,@body))) + +;;; Use system's old obarray + +(defmacro with-saved-obarray (&body body) + `(let ((obarray (or (get 'obarray 'saved-obarray) obarray))) + ,@body)) + +;;; File hacking if on TOPS-20 +(eval-when (eval compile load) + (cond ((status feature TOPS-20) + (putprop 'teach '(ps kmp/.teach) 'ppn) + (putprop 'teach '(ps kmp/.teach) 'ppn)))) + +;;; Loading in of system files + +(defmacro load-module (name &optional (when '(eval load))) + (let ((inside `(cond ((not (get ',name 'version)) + (load '((teach) ,name)))))) + (cond ((or (equal when '(eval load)) + (equal when '(load eval))) + inside) + (t `(eval-when ,when ,inside))))) + +;;;; Interrupt character functions. + +(defmacro define-interrupt-handler (name &body body) + (let ((stream-var (gensym)) + (char-var (gensym))) + `(progn 'compile + (defun ,name (,stream-var ,char-var) + (declare (special *complaint-handler*)) + (clear-input ,stream-var) + (program-record "User typed ~@:C (~S).~%" ,char-var ',name) + (cond ((not *disallow-interrupts*) + (let ((*disallow-interrupts* t)) + (nointerrupt nil) + (catch-complaints + (catch-**more** ,@body)) + (print '*) + (terpri) + (if *complaint-handler* ;maybe quietly return... + (complain)))) + (*in-more-break* nil) + (t + (recorded-output "~2&Don't type ~@:C when I'm busy~2%" + ,char-var))))))) + + +;;; (WHEN-ABNORMAL-EXIT exp form1 form2 form3 ...) +;;; +;;; Executes exp, returning its value. +;;; If an abnormal exit is done from exp, form1, form2, ... are executed. + +(defmacro when-abnormal-exit (exp &body abnormal-exit-forms) + (let ((var (gensym))) + `(let ((,var t)) + (unwind-protect (prog1 ,exp (setq ,var nil)) + (cond (,var ,@abnormal-exit-forms)))))) + +(defmacro cautiously-incrementing-filepos (file &body body) + `(let ((old-filepos (filepos ,file))) + (when-abnormal-exit (progn ,@body) + (filepos ,file old-filepos)))) + +;;; Local Modes:; +;;; Mode:LISP; +;;; Lisp WHEN-ABNORMAL-EXIT Indent:1; +;;; Lisp CAUTIOUSLY-INCREMENTING-FILEPOS:1; +;;; End:; + diff --git a/src/teach/more.19 b/src/teach/more.19 new file mode 100755 index 0000000000000000000000000000000000000000..5abbe71c62d5682efb7fa97680f06972b1362e3a GIT binary patch literal 1595 zcmd^8%Wm5+5bV|ZiiL~9lmPxfg|sJceuMVv#YW!fff|jy5{e{eZAerYgS^|IxV?^#^?_A-?!zL&2A4Lvy8OdFj>QT zv%AUh${(4e#}=Q)BUHNUh2(h#K%{0htO$|fAZ?$6b3>koq?$L6%s^2wMH}gDOFM0N z0ZPdHj0zRQ^k6vqF@h2G3W_3T6hN#)xQqRi7RqsBeD6{zOy9vLFbtsv{P1s6azzJ-$>6kl*VM*y4NAro&<(OY< z^sYi(gMf*_>>8w#MzRM8rY=aFYv?|iOFlpaZ|{viAj9NTz$R{_!u^P9atzng`K%|p z`y}Uyo<;ahZ(fqM@vip{;`;HL(qHdTVVD@!EL>~!5mwJuAj*kPMgg{G6)yXj_ZRt} zO1?z>S}P}%7wRF=J_|M6d83l+k!Bdesg&jJC+fwi#CeRI=MAz&0+wVy^c-%tSJyY- zH2&DJDF1U)UG)GGB(py;$A(-v9sI-7;_aKib{bH~Q0n-{AKfOhMfG literal 0 HcmV?d00001 diff --git a/src/teach/no.8 b/src/teach/no.8 new file mode 100644 index 00000000..2a739a45 --- /dev/null +++ b/src/teach/no.8 @@ -0,0 +1,103 @@ +; -*- MIDAS -*- +Title NO -- refuse luser asking for LISP teacher help + +x=0 +a=1 +b=2 +c=3 +d=4 +e=5 + +t=10 +tt=11 +sp=17 + +clic=15 +tyoc=16 + +argi==1000,,0 +cnti==5000,,0 + +pdllen==100 + +define syscal ops,stuff + .call [setz ? sixbit /ops/ ? stuff ((setz))] +termin + +define type chan,&string + move t,[440700,,[asciz string]] + movei tt,<.length string> + syscal siot,[argi chan ? t ? tt] + .lose %lssys +termin + +call=pushj sp, +ret=popj sp, + +go: move sp,[-pdllen,,pdl] ;init the PDL + .suset [.roption,,a] ;check out the option stuff + tlnn a,%opcmd ;do we have JCL? + jrst info + .break 12,[..rjcl,,jclbuf] ;read the JCL + movei a,6 ;at most 6 characters + move b,[440700,,jclbuf] ;input BP + move d,[440600,,e] ;output BP +rd6: ildb c,b ;get the character + caig c,40 ;is it the end? + jrst gotten ; yes, that's it! + caige c,140 ;convert to 6bit + subi c,40 + idpb c,d ;and deposit result + sojg a,rd6 ;and get another, if needed +gotten: jumpe e,info ;nothing? Tell him what to do + syscal open,[cnti .uao ? argi clic + [sixbit /CLI/] + e + [sixbit /LISP/]] + jrst gone ; he's not there! + + call ptunam + type clic,\ +(PRINC '|I am unable to assist you, hopefully someone else/ +will be able to./ +| tyo) +(no-help '\ + call ptunam + .iot clic,[")] + .close clic, + .logout 1, + + +ptunam: .suset [.runame,,b] ;get our UNAME to send along + type clic,/ |/ ;separate from sixbit JNAME and delimit +put6: setz a, + lshc a,6 ;get a 6bit char + addi a,40 ;convert to ASCII + .iot clic,a ;send it + jumpn b,put6 ;if there's more, keep sending + .iot clic,["|] ;mark end of the name +cpopj: ret ;and return + +info: call ttyopn + type tyoc,/CNo. Tell person's LISP job that you are unable to help. + +Just type :NO , and it will send a message to the person's LISP +telling it that you are unable to help him, or ask any more people. You will +be perpetually bugged if you don't use this command or the :YES command! +/ + .logout 1, + + +gone: call ttyopn + type tyoc,/AThat person doesn't have a :TEACH;LISP !!!! +/ + .logout 1, + +ttyopn: syscal open,[cnti .uao\%tjdis ? argi tyoc ? [sixbit /TTY/]] + .lose %lsfil + ret + +jclbuf: block 100 + -1 +pdl: block pdllen + end go diff --git a/src/teach/record.71 b/src/teach/record.71 new file mode 100755 index 00000000..91a7d42a --- /dev/null +++ b/src/teach/record.71 @@ -0,0 +1,149 @@ +;;; -*- Mode:LISP; -*- + +(herald RECORD) + +;;; Create protocol file for user. Each time the user uses teach-lisp +;;; add a new record (or start the file, if it's the user's first time). +;;; +;;; Each record should start with a notice of the date and what version +;;; of teach-lisp was used to invoke this recording session. +;;; PROGRAM-RECORD includes certain things the program says to itself. + +(declare (*expr alha-userid time:print-current-time) + (*lexpr sysread) + (special *default-script-filename* + *protocol-filename*)) + + +(defvar *protocol-file* nil) +(defvar *script-file* nil) +(defvar *files-to-write-to* nil) ;ncons of same + +;;; Base setup +(eval-when (eval compile load) + (setq base 10. ibase 10.)) + +;;; IOTA snarfing +(eval-when (eval compile) + (cond ((not (status feature iota)) + (load '((liblsp) iota fasl))))) + +;;; One time code to make sure this file exists for us. + +(defun set-up-prot-file () + (cond ((not (probef *protocol-filename*)) + (iota ((stream *protocol-filename* '(out ascii dsk block))) + (format stream + "~%;;; -*- Mode:TEXT; -*-~ + ~%;;;Stuff that the user said is preceded by `==>'~ + ~%;;;Stuff that the program said is unadulterated.~2%" + )))) + (setq *protocol-file* (open *protocol-filename* '(append ascii dsk block))) + (setq *files-to-write-to* (ncons *protocol-file*)) + (format *protocol-file* + "~%;;;XTEACH.~A Record of user session for ~A~ + ~%;;;Created ~A by ~A~2%" + (or (get 'teach 'version) 0) + (status userid) + (time:print-current-time nil) + (status uname))) + +(defun program-record (&rest stuff) + (if *script-file* + (progn + (format *script-file* "~&") + (lexpr-funcall #'format *script-file* stuff) + (format *script-file* "~&") + (force-output *script-file*))) + (if *protocol-file* + (progn + (format *protocol-file* "~&") + (lexpr-funcall #'format *protocol-file* stuff) + (format *protocol-file* "~&") + (force-output *protocol-file*)))) + +(defun recorded-read (&rest stuff) + (if *script-file* (format *script-file* "~&==> ")) + (if *protocol-file* (format *protocol-file* "~&==> ")) + (let ((echofiles *files-to-write-to*)) + (lexpr-funcall #'read stuff))) + +(defun recorded-sysread (&rest stuff) + (if *script-file* (format *script-file* "~&==> ")) + (if *protocol-file* (format *protocol-file* "~&==> ")) + (let ((echofiles *files-to-write-to*)) + (lexpr-funcall #'sysread stuff))) + +(defun recorded-output (&rest stuff) + (lexpr-funcall #'program-record stuff) + (lexpr-funcall #'output stuff)) + +(defun recorded-print (thing) + (program-record "~S" thing) + (output "~&~S" thing)) + + +;;; To be run if the user wants a script file of this session. +;;; Takes an optional argument of the file to script to. +;;; If user doesn't supply a file name, use the default script file. +;;; Cases: +;;; 1. file doesn't exist. +;;; 2. file exists and is script file. +;;; 3. file exists and is not script file. + +(defun script (&optional filename) + (let ((script-filename (if filename + (mergef filename `((* ,(status homedir)))) + (mergef `((* ,(status homedir))) + *default-script-filename*)))) + (cond ((not (probef script-filename)) + (setq script-filename + (iota ((stream script-filename 'out)) + (truename stream))) + (recorded-output "~&Creating script file ~A for you.~%" + (namestring script-filename))) + ((or (script-file? script-filename) + (not (version-file script-filename))) + (setq script-filename + (iota ((stream script-filename 'in)) + (truename stream))) + (recorded-output "~&Appending to file ~A for you.~%" + (namestring script-filename))) + (t + (recorded-output "~&~A is not a script file, so I'm creating a new ~ + ~%version of that file for you.~%" + (namestring script-filename)) + (setq script-filename + (iota ((stream script-filename 'out)) + (truename stream))))) + (setq *script-file* (open script-filename '(append ascii dsk block))) + (setq *files-to-write-to* (cons *script-file* *files-to-write-to*)) + (format *script-file* "~&(COMMENT TEACH-LISP SCRIPT FILE FOR ~A ON ~A)~2%" + (status userid) + (time:print-current-time nil)))) + +(defun version-file (name) + (let ((name (namelist name))) + (or (eq (caddr name) '>) + (let* ((true-name (truename (iota ((stream name 'in)) stream))) + (second (caddr true-name))) + (do ((chars (exploden second) (cdr chars))) + ((null chars) t) + (if (or (< (car chars) #/0) (> (car chars) #/9)) (return nil))))))) + +(defun script-file? (filename) + (iota ((stream filename 'in)) + (let* ((cons-of-read (errset (sysread stream) nil)) + (x (if cons-of-read (car cons-of-read) nil))) + (and (not (atom x)) + (eq (pop x) 'COMMENT) + (not (atom x)) + (eq (pop x) 'TEACH-LISP) + (not (atom x)) + (eq (pop x) 'SCRIPT))))) + +(defun stop-script () + (setq *files-to-write-to* (delq *script-file* *files-to-write-to*)) + (close *script-file*) + (setq *script-file* nil) + (recorded-output "~&Closing script file.~%")) diff --git a/src/teach/start.2 b/src/teach/start.2 new file mode 100755 index 00000000..dc75e533 --- /dev/null +++ b/src/teach/start.2 @@ -0,0 +1,18 @@ +(comment) ;magic + +;;; File hacking if on TOPS-20 +(cond ((status feature TOPS-20) + (putprop 'teach '(ps kmp/.teach) 'ppn))) + +(let ((f (open '((teach) global)))) + ;;stop reading this file (save disk channels) + ;; get list of global symbols from file + (load (get 'format 'autoload)) + (read f) ;intern those symbols + (close f) + (do ((i 0 (1+ i))) ((= i 128.)) (ascii i)) ;intern all chars + (let ((obarray (*array nil 'obarray obarray))) ;copy of system obarray + (putprop 'obarray obarray 'saved-obarray) + (setq gc-overflow nil) + (load '((teach) teach)) + '*)) diff --git a/src/teach/tags.3 b/src/teach/tags.3 new file mode 100755 index 00000000..f6f844e0 --- /dev/null +++ b/src/teach/tags.3 @@ -0,0 +1,325 @@ +DSK: TEACH; APROPOS > +00208,LISP +(defun obarrayp¸20 +(defun apropos¹16 +(defun apropos-match±273 +(defun apropos-display±436 +(defun apropos-sym-matches?±827 +(defun apropos-sym-matches-here?²125 + +DSK: TEACH; COMPLAIN > +00092,LISP +(defvar *complaint-handler*·3 +(defun complain³00 + +DSK: TEACH; DATABASE > +00319,LISP +(defvar *user-status-information*±012 +(defun load-props±038 +(defun save-props±446 +(defun prop²084 +(defun set-prop²302 +(defun rem-prop²421 +(defun explanation-has-been-seen²650 +(defun seen-explanation?²792 +(defun lesson-has-been-seen²989 +(defun seen-lesson?³136 + +DSK: TEACH; ERRHAN > +01852,LISP +(defvar *symbol-started-with-colon-flag*·77 +(defvar *illegal-functional-notation-flag*¸26 +(defvar *special-quit-atom-flag*¸65 +(defvar *special-quit-atom-list*¹04 +(defvar *special-lesson-atom-flag*¹54 +(defvar *special-lesson-atom-list*¹95 +(defvar *errors-handled*±125 +(defstruct (error-handled :conc-name :named)±256 +(defmacro define-explanation±329 +(defun short-desc-error-handled±625 +(defun long-desc-error-handled±721 +(defun error-desc-error-handled±817 +(defun name-error-handled±908 +(define-explanation random-lossage²051 +(define-explanation bad-go-tag²580 +(define-explanation io-lossage²731 +(define-explanation wrong-type-args²884 +(define-explanation wrong-num-args´142 +(define-explanation undefined-functionµ953 +(define-explanation unbound-variable¶865 +(defmacro define-error-handler¸074 +(defun num-wanted¸620 +(define-error-handler wrong-num-args-handler¸861 +(define-error-handler random-lossage-handler¹865 +(define-error-handler wrong-type-args-handler±0344 +(define-error-handler io-lossage-handler±0808 +(define-error-handler bad-go-tag-handler±1268 +(define-error-handler undefined-function-handler±1891 +(defun check-for-odd-symbol±3020 +(defun weird-first-char±4287 +(defun maybe-messed-up-arithmetic-call±5255 +(defmacro define-dialect-variant±6538 +(defun dialect-variant±6653 +(define-error-handler unbound-variable-handler±7149 +(defun special-lesson-atom-handler±7980 +(defun special-quit-atom-handler±9224 +(defun colon-symbol²0509 +(defun comma-check²1433 +(defun illegal-functional-notation-check²1583 +(defun eval-handler²3671 +(defun diagnose-quoted-function²3891 +(defun explain-dont-quote-functions²4411 +(defun explain-put-quote-outside²4948 +(defun diagnose-random-functional-form²5620 +(defun redefined-^G-handler²6251 + +DSK: TEACH; ERRHEL > +00419,LISP +(defun print-menu²017 +(defun menu²450 +(defun choice³664 +(defun active-menu-loop³774 +(defun active-menu³979 +(defun print-error-desc´279 +(defun describe-error´391 +(defun explain´755 +(defun explain?µ034 +(defun query-explainµ242 +(defun find-error-context·433 +(defmacro error-reporter·990 +(defun interesting-stack-frame?¸056 +(defun declare-error-reporter¸311 + +DSK: TEACH; EXLIST > +00387,LISP +(defun examine-list-doc¶97 +(defun examine-list-arg-default±534 +(defun examine-list²202 +(defun continue-display³295 +(defun examine-normal-list³495 +(defun good-list³857 +(defun make-from-list³968 +(defun print-lists´303 +(defun print-dottedµ421 +(defun print-dotted-workerµ811 +(defun print-conses¶003 +(defun print-conses-worker¶147 + +DSK: TEACH; GLOBAL > +00037,LISP + +DSK: TEACH; INIT > +00865,LISP +(setq base³56 +(defun alpha-numeric?·62 +(defun alpha-userid¹62 +(defvar *default-lesson-filename*±176 +(defvar *default-script-filename*±232 +(defvar *list-of-lessons-filename*±373 +(defvar *ITS-list-of-list-of-lessons-filenames*±446 +(defvar *TOPS-20-list-of-lessons-filename*±518 +(setq fail-act±585 +(setq unbnd-vrbl±634 +(setq undf-fnctn±683 +(setq wrng-type-arg±737 +(setq wrng-no-args±784 +(setq unseen-go-tag±832 +(setq io-lossage±875 +(setq eval±978 +(setq quit-disable³176 +(defvar *tty-spec-info*³316 +(setq display-tyo³558 +(setq gc-overflow³675 +(setq *rset-trap³716 +(setq tty-return-msg³742 +(define-dialect-variant define³935 +(define-dialect-variant defq³974 +(define-dialect-variant df´010 +(define-dialect-variant de´064 +(define-dialect-variant def´102 +(setq *help-wait-time*´137 + +DSK: TEACH; IO > +00276,LISP +(defun string-length³69 +(defun char-n³99 +(defun diagnose´45 +(defun bugµ10 +(defun quiet-bug·10 +(defun output¸23 +(defun query¸90 +(defun clear-screen±011 +(defun fresh-line±053 +(defun sysread±189 +(defun defined-function?±313 + +DSK: TEACH; LESSN > +02009,LISP +(defvar *disallow-interrupts*±000 +(defvar *lesson-file*±028 +(defvar *lesson-name*±056 +(defvar *lesson-exit-handler*±092 +(defvar *lesson-information*±395 +(define-interrupt-handler abort-lesson-handler±451 +(define-interrupt-handler read-lesson-section-handler±525 +(define-interrupt-handler read-previous-lesson-section-handler±615 +(define-interrupt-handler repeat-lesson-section-handler±707 +(defmacro catch-lesson-exit±793 +(defun exit-lesson±918 +(defmacro lesson-function±985 +(defmacro define-lesson-function²059 +(defun add-lesson-information²185 +(defun get-lesson-information²513 +(defun ass²589 +(defun get-optional-label²737 +(defun get-name²892 +(defun get-position²931 +(defun read-optional-label²980 +(defun get-list-of-lessons³462 +(defun full-lesson-name´018 +(defun find-special-function-in-file´216 +(defun set-up-lesson-descriptionsµ041 +(defun describe-lessonµ597 +(defun in-lesson?µ660 +(defmacro lessonµ772 +(defun *lessonµ873 +(defun start-lesson¶855 +(defun open-lesson·286 +(defun trimmed-lesson-information¸290 +(defun repeat-lesson-section¸415 +(defun read-previous-lesson-section¸799 +(defun set-lesson-section-to¹235 +(defun want-lesson?¹843 +(defun kill-lesson±0193 +(defun abort-lesson±0395 +(defun end-of-lesson-file±0512 +(defvar *muzzled*±0668 +(defun read-lesson-section±0750 +(define-lesson-function if±1989 +(define-lesson-function end-if±2117 +(define-lesson-function eval±2186 +(defun read-verbosely±2364 +(define-lesson-function eval-print±2863 +(define-lesson-function pp±2968 +(define-lesson-function try±3108 +(define-lesson-function pause±3301 +(define-lesson-function tag±3482 +(define-lesson-function comment±3594 +(define-lesson-function document±3703 +(define-lesson-function eof±3807 +(define-lesson-function next±4180 +(defun get-apropriate-next-lesson±4698 +(defun get-next-next-lesson±5196 +(defun get-a-new-lesson±5664 +(define-lesson-function required±5880 + +DSK: TEACH; MACRO > +00319,LISP +(defmacro catch-**more**²00 +(defmacro dont-catch-**more**´00 +(defmacro catch-complaintsµ84 +(defmacro with-saved-obarray·95 +(defmacro load-module±134 +(defmacro define-interrupt-handler±462 +(defmacro when-abnormal-exit²377 +(defmacro cautiously-incrementing-filepos²604 + +DSK: TEACH; MORE > +00171,LISP +(defvar *can-flush-more*±51 +(defvar *in-more-break*±81 +(defun **more**²05 +(defun maybe-**more**´52 +(defun surely-**more**±174 + +DSK: TEACH; RECORD > +00394,LISP +(defvar *protocol-file*µ70 +(defvar *script-file*µ98 +(defvar *files-to-write-to*¶32 +(defun set-up-prot-file¹40 +(defun program-record±617 +(defun recorded-read²070 +(defun recorded-sysread²301 +(defun recorded-output²534 +(defun recorded-print²650 +(defun script³067 +(defun version-file´342 +(defun script-file?´685 +(defun stop-scriptµ013 + +DSK: TEACH; START > +00036,LISP + +DSK: TEACH; TEACH > +00808,LISP +(defvar *novice-flag*·51 +(setq prinendline±236 +(defun gc-overflow-handler±519 +(defun novicep²142 +(defvar *second-time-around*²320 +(defvar ***²338 +(defvar **²356 +(defvar +++²374 +(defvar ++²392 +(defvar *display-terminal*²425 +(defvar *terminal-horizontal-size*²466 +(defvar *terminal-vertical-size*²505 +(defvar *lessons-known*²535 +(defun find-terminal-characteristics²580 +(defun welcome-message²917 +(defun help³501 +(defun teach-lisp-top-level³612 +(defvar *recursive?*´060 +(defun breakloop´085 +(defun dump´720 +(defvar *database-new-filename*µ005 +(defvar *database-old-filename*µ043 +(defvar *database-temp-file*µ078 +(defvar *database-temp-filename*µ117 +(defun alpha-numeric?µ238 +(defun alpha-useridµ438 +(defun init-userµ559 + +DSK: TEACH; TEACH DUMP +00039,LISP + +DSK: TEACH; TREEPR > +01010,LISP +(defvar *old-list*²02 +(defvar *form-map*²27 +(defvar *sfa*²47 +(defvar *error-print-flag*²80 +(defun display-list-doc³12 +(defun display-list-no-arg¹77 +(defun display-list±675 +(defun plot-mistake²723 +(defun abort-make-display²896 +(defun make-display-array³047 +(defun vertical-dimension³417 +(defun horizontal-dimension³486 +(defun call-form-map³547 +(defun store-form-map³611 +(defun plot³681 +(defun downp´083 +(defun display´589 +(defun arrayprint´777 +(defmacro dimensµ235 +(defmacro y-coordµ282 +(defmacro x-coordµ329 +(defun sfa-handlerµ377 +(defun sfa-output¶591 +(defun sfa-cursorpos¶670 +(defun sfa-cursor-down-and-back¶734 +(defun print-vertical-bar¶815 +(defun print-horizontal-arrow¶870 +(defun print-cell-top¶987 +(defun print-nil·160 +(defun print-vertical-arrow·318 +(defun print-tree·627 +(defun print-single-cell¸093 +(defun print-cons¸306 +(defun print-which-cdr¸543 +(defun print-cdr¸667 +(defun fix-atom-name¸939 + \ No newline at end of file diff --git a/src/teach/tdump.2 b/src/teach/tdump.2 new file mode 100755 index 00000000..b3dcf5d8 --- /dev/null +++ b/src/teach/tdump.2 @@ -0,0 +1,14 @@ +title TDUMP Dumper for revised TEACH-LISP +tdump: .value [ asciz \..safe/0 +:--Dump out a new TEACH;TS XLISP-- +:if more 0 +(:(Yes)jcl TEACH;TEACH DUMP +l SYS;TS LISP +0g +) +:else +(: (No) +) +:vp \ ] +.logout 1, +end tdump diff --git a/src/teach/teach.159 b/src/teach/teach.159 new file mode 100755 index 00000000..0758658d --- /dev/null +++ b/src/teach/teach.159 @@ -0,0 +1,221 @@ +;;; -*- Mode:LISP -*- + +(herald TEACH) + +(load (get (car (status macro #/`)) 'autoload)) ;get BACKQ support LOADED + +;;; File hacking if on TOPS-20 +(eval-when (eval compile load) + (cond ((status feature TOPS-20) + (putprop 'teach '(ps kmp/.teach) 'ppn)))) + +;;; Macro support +(eval-when (eval compile) + (load '((teach) macro))) + +;;; Declarations +(declare (*lexpr fresh-line + program-record + query + recorded-output + recorded-read + sysread) + (*expr clear-screen + load-props + novicep + recorded-print + set-up-prot-file + bug) + (special *protocol-filename* + *ITS-list-of-list-of-lessons-filenames* + *TOPS-20-list-of-lessons-filename*)) + +(defvar *novice-flag* nil) ;currently unused, but may come in handy. + +;;; Base setup +(eval-when (eval compile load) + (setq base 10. ibase 10.)) + +;;; IOTA snarfing +(eval-when (eval compile) + (cond ((not (status feature iota)) + (load '((liblsp) iota fasl))))) + +;;; Time package +(cond ((not (get 'time 'version)) + (load '((liblsp) time)))) + +;;; Pretty grinding stuff for format (from ...) + +(cond ((not (get 'gprint 'version)) + (load '((liblsp) gprint)))) + +(setq prinendline nil) + +(cond ((not (get 'n 'format-ctl-one-arg)) + (defun (n format-ctl-one-arg) (obj args) + (apply (cond (colon-flag 'Gprintc) (t 'gprint1)) + (list* obj standard-output nil args))))) + + +;;; GC-OVERFLOW set in user system to this function. + +(defun gc-overflow-handler (nil) t) + +(load-module APROPOS) +(load-module DATABASE) +(load-module ERRHEL) +(load-module ERRHAN) +(load-module EXLIST) +(load-module COMPLAIN (EVAL LOAD COMPILE)) +(load-module IO) +(load-module LESSN) +(load-module MORE) +(load-module RECORD) +(load-module TREEPR) + +;; if the user has nver used this program before, find out if +;; he's ever used Maclisp. if not, consider him a novice and pamper him. +;; at present, this isn't used for anything and is turned off (it should +;; be invoked from toplevel in the function teach-lisp-top-level), but we +;; may want to take advantage of it later. + +(defun novicep () + (if *novice-flag* + (if (not (query "Is this your first time using Maclisp?")) + (setq *novice-flag* nil)))) + +;;; Top-level function +(defvar *second-time-around* nil) +(defvar *** '***) +(defvar ** '**) +(defvar +++ '+++) +(defvar ++ '++) +(defvar *display-terminal* nil) +(defvar *terminal-horizontal-size* nil) +(defvar *terminal-vertical-size* nil) +(defvar *lessons-known* nil) + +(defun find-terminal-characteristics () + (setq *display-terminal* + (if (memq 'cursorpos (status filem tyo)) t)) + (let ((tsize (status ttysize))) + (setq *terminal-vertical-size* (cdr tsize)) + (cond (*display-terminal* (setq *terminal-horizontal-size* + (min (car tsize) 24.))) + (t (setq *terminal-horizontal-size* 100))))) + +(defun welcome-message () + (output + "~2&Welcome to the wonderful world of TEACH-LISP. Just type forms at me and +I'll pretend I'm a real Maclisp and deal with them, except I'm nicer and +occasionally I can offer some assistance when Maclisp would just snarl at you. + +To get a list of the lessons I have available along with a short description +of each, type + (LESSON) +To start a particular lesson, type + (LESSON ) +If you need further instructions, or if this is your first time using this +program, type + (LESSON INFO) + +To leave this program, type + (QUIT)~2%")) + +(defun help () + (recorded-output "Sorry, these feature has not yet been implemented.~%")) + +(defun teach-lisp-top-level () + (cond + (*second-time-around* (fresh-line)) + (t (clear-screen) + (output "~&Hold on a sec while I set everything up for you...~%") + (find-terminal-characteristics) + (init-user) + (set-up-prot-file) + (load-props) +;; turned off for now +; (novicep) + (output "~&There we are. Now then...~%") + (welcome-message) + (setq *second-time-around* t))) + (breakloop nil)) + +(defvar *recursive?* nil) + +(defun breakloop (*recursive?*) + (do ((*** ***) + (** **) + (* *) + (+++ +++ ++) + (++ ++ +) + (+ + -) + (-)) + (nil) + (dont-catch-**more** + (fresh-line) + (setq - (recorded-read)) + (cond (*recursive?* + (cond ((eq - P) (return nil)) + ((and (not (atom -)) + (eq (car -) 'RETURN) + (not (atom (cdr -))) + (null (cddr -))) + (return (catch-complaints (eval (cadr -)))))))) + (catch-complaints + (setq * (prog1 (eval -) + (setq *** **) + (setq ** * ))) + (catch-**more** + (recorded-print *) + (fresh-line)))))) + +(defun dump (&optional (filename '#.(mergef '(ts xlisp) (truename infile)))) + (with-saved-obarray + (load-module init)) + (sstatus flush t) + (gc) + (cond ((status feature tops-20) (suspend)) + (t (suspend ":KILL " filename))) + (teach-lisp-top-level)) + +(defvar *database-new-filename* nil) +(defvar *database-old-filename* nil) +(defvar *database-temp-file* nil) +(defvar *database-temp-filename* nil) + +;;; Functions used to change TOPS-20 userid's to get rid of all +;;; non-alphanumerics. + +(defun alpha-numeric? (char) + (or (and (not (< char #/0)) + (not (> char #/9))) + (and (not (< char #/A)) + (not (> char #/Z))) + (and (not (< char #/a)) + (not (> char #/z))))) + +(defun alpha-userid (name) + (implode (mapcan #'(lambda (c) (if (alpha-numeric? c) (ncons c))) + (exploden name)))) + +(defun init-user () + (let ((user (cond ((status feature its) (status userid)) + (t (alpha-userid (status userid))))) + (home-dir (status hsname))) + (setq *database-old-filename* `((,home-dir) ,user tdb)) + (setq *database-new-filename* + (caseq (status filesys) + ((ITS) `((,home-dir) ,user tdb)) + ((DEC20) `((,home-dir) ,user tdb -1)) + (t (bug "Unknown file system")))) + (setq *database-temp-filename* + (mergef `(_TEACH ,user) *database-new-filename*)) + (setq *protocol-filename* `((,home-dir) ,user tprot)))) + + +;;; Local Modes:; +;;; Mode:LISP; +;;; Comment Column:50; +;;; End:; diff --git a/src/teach/teach.dump b/src/teach/teach.dump new file mode 100755 index 00000000..949dd466 --- /dev/null +++ b/src/teach/teach.dump @@ -0,0 +1,5 @@ +(comment) ;magic +(progn (close (prog1 infile (inpush -1))) + (load '((teach) teach init)) + (funcall (let ((obarray (get 'obarray 'saved-obarray))) + (intern "DUMP")))) diff --git a/src/teach/teach.init b/src/teach/teach.init new file mode 100644 index 00000000..6a452c18 --- /dev/null +++ b/src/teach/teach.init @@ -0,0 +1 @@ +() diff --git a/src/teach/teach.midas b/src/teach/teach.midas new file mode 100755 index 00000000..2ff23b4f --- /dev/null +++ b/src/teach/teach.midas @@ -0,0 +1,27 @@ +title TEACH - Lisp Teacher + +a=:1 +b=:2 + +ttyo=:3 + +define syscal op,args +.call [setz ? sixbit /op/ ? args ((setz))] +termin + +define type &string + movei a,<.length string> + move b,[440700,,[ascii string]] + syscal SIOT,[%climm,,ttyo ? b ? a] + .lose %lsfil +termin + +teach: syscal OPEN,[ %clbit,,.uao\%tjdis ? %climm,,ttyo ;open TTY for output + [sixbit /TTY/]] + .lose %lsfil + type "ATeach-Lisp has been redone. Please sayA + :STUDNT;XTEACHA Aand runA + (LESSON INFO)A Afor help on how to use it.A" + .logout 1, + +end teach diff --git a/src/teach/treepr.62 b/src/teach/treepr.62 new file mode 100755 index 00000000..c8858ce5 --- /dev/null +++ b/src/teach/treepr.62 @@ -0,0 +1,341 @@ +-*- Mode:LISP; -*- + +(herald TREEPR) + +(declare (special *terminal-horizontal-size* + *terminal-vertical-size*) + (*expr clear-screen) + (*lexpr output recorded-read query)) + +(defvar *old-list* nil) +(defvar *form-map* nil) +(defvar *sfa* nil) +(defvar *error-print-flag* nil) + +(defun display-list-doc () + (output + "~2&The function /"DISPLAY-LIST/" is used to display the tree representation +of a list. If it is given an argument, it takes the value of that argument and +displays it for you. If no argument is given, it will offer to redisplay the +last argument you gave to DISPLAY-LIST (this option is selected by typing NIL +at that point) or it will accept a new list to display.~%")) + +;;; *FORM-MAP* is left set from the last time this was invoked, +;;; so if DISPLAY-LIST is called with no args and it's not the +;;; first time it's been called, the last list shown can be reshown. + + +(declare (*lexpr display-list)) + +(defun display-list-no-arg () + (cond ((and *old-list* *form-map* + (query "The last list you looked at was:~ + ~2% ~N~ + ~2%Shall I redisplay it for you?" + *old-list*)) + (clear-screen) + (display)) + (t (output "~&Type in a list: ") + (let ((list (recorded-read))) + (cond ((memq list '(? help)) + (if (query "That's not a list! Want help?") + (display-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.~%") + (display-list (cadr list))) + (t + (display-list list))))))) + + +(defun display-list (&optional (form nil form?)) + (cond ((not form?) + (display-list-no-arg)) + ((not form) + (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 form) + (cond ((memq form '(? help)) + (if (query "That's not a list! Want help?") + (display-list-doc))) + (t (output "~&~S is not a list!~%" form)))) + ((eq (car form) 'quote) + (output + "~2&Don't bother to quote it. That makes it look messy...~ + ~%I'll pretend you didn't use quote.~%") + (display-list (cadr form))) + ((make-display-array form t) + (clear-screen) + (display)) + (t form))) + + +;;; Figure out how much space printing the input will take and return NIL if +;;; it's too big for the terminal. *ERROR-PRINT-FLAG* says whether this program +;;; should take care of error messages or if the calling program will. + +(defun plot-mistake (message) + (if *error-print-flag* + (progn (output "~2&I'm afraid that won't fit on your terminal.~%") + (output message))) + nil) + +(defun abort-make-display (&rest stuff) + (setq *form-map* nil) + (lexpr-funcall #'plot-mistake stuff) + (*throw '*make-display-array-tag* nil)) + +(defun make-display-array (form *error-print-flag*) + (*catch '*make-display-array-tag* + (setq *form-map* + (let ((*form-map* + (*array nil t + (// *terminal-horizontal-size* 5.) + (// *terminal-vertical-size* 12.)))) + (plot form 0 0 *error-print-flag*) + (setq *old-list* form) + *form-map*)))) + + +;;; Selector functions for *FORM-MAP* + +(defun vertical-dimension () + (caddr (arraydims *form-map*))) + +(defun horizontal-dimension () + (cadr (arraydims *form-map*))) + +(defun call-form-map (x y) + (arraycall t *form-map* x y)) + +(defun store-form-map (x y val) + (store (arraycall t *form-map* x y) val)) + +(defun plot (form x y *error-print-flag*) + (if (= y (vertical-dimension)) + (abort-make-display "try something that isn't so long.~%")) + (store-form-map x y form) + (cond ((atom (cdr form)) nil) + (t (plot (cdr form) x (1+ y) *error-print-flag*))) + (cond ((atom (car form)) nil) + (t (plot (car form) + (downp (car form) (1+ x) y *error-print-flag*) + y + *error-print-flag*)))) + +(defun downp (form x y *error-print-flag*) + (if (= x (horizontal-dimension)) + (abort-make-display "try something with fewer nested parentheses.~%")) + (do ((f form (cdr f)) + (j y (1+ j))) + ((atom f) x) + (if (= j (vertical-dimension)) + (abort-make-display "try something with shorter lists in it.~%")) + (if (call-form-map x j) + (progn (store-form-map x y 0.) + (return (downp form (1+ x) y *error-print-flag*)))))) + + +;;; Main routine for printing *FORM-MAP* + +(defun display () + (let ((*sfa*)) + (setq *sfa* (sfa-create 'sfa-handler 3 'foo)) + (sfa-call *sfa* 'init ()) + (arrayprint) + (close *sfa*) + (call-form-map 0 0))) + +(defun arrayprint () + (let ((*error-print-flag* nil) + (width (vertical-dimension)) + (length (horizontal-dimension))) + (do ((i 0 (1+ i))) + ((or *error-print-flag* (= i length))) + (setq *error-print-flag* t) + (do ((j 0 (1+ j))) + ((= j width)) + (cond ((null (call-form-map i j)) nil) + (t (setq *error-print-flag* nil) + (sfa-cursorpos (* 5 i) (* 12. j)) + (print-cons (call-form-map i j) + (* 5 i) (* 12. j)))))))) + +(defmacro dimens () + `(sfa-get self 0.)) + +(defmacro y-coord () + `(sfa-get self 1.)) + +(defmacro x-coord () + `(sfa-get self 2.)) + +(defun sfa-handler (self op data) + (caseq op (which-operations '(init cursorpos close tyo)) + (init (setf (dimens) (array nil fixnum + *terminal-horizontal-size* + (1- *terminal-vertical-size*))) + (setf (y-coord) 0.) + (setf (x-coord) 0.)) + (cursorpos (cond ((equal data '(b)) + (setf (x-coord) (1- (x-coord)))) + ((equal data '(d)) + (setf (y-coord) (1+ (y-coord)))) + (t (setf (y-coord) (car data)) + (setf (x-coord) (cadr data))))) + (tyo (store (arraycall fixnum (dimens) + (y-coord) (x-coord)) + data) + (setf (x-coord) (1+ (x-coord)))) + (close (let ((width (caddr (arraydims (dimens)))) + (length (cadr (arraydims (dimens)))) + (c nil) + (*error-print-flag* nil)) + (do ((i 0 (1+ i))) + ((or (= i length) *error-print-flag*)) + (setq *error-print-flag* t) + (do ((j 0 (1+ j))) + ((= j width)) + (setq c (arraycall fixnum + (dimens) + i j)) + (cond ((zerop c) (tyo #\space tyo)) + (t (setq *error-print-flag* nil) + (tyo c tyo)))) + (terpri)))))) + + +;;; Functions for writing to the sfa and for printing standard pieces +;;; of a list. + +(defun sfa-output (&rest stuff) + (lexpr-funcall #'format *sfa* stuff)) + +(defun sfa-cursorpos (x y) (cursorpos x y *sfa*)) + +(defun sfa-cursor-down-and-back () + (cursorpos 'd *sfa*) + (cursorpos 'b *sfa*)) + +(defun print-vertical-bar () (sfa-output "/|")) + +(defun print-horizontal-arrow () (sfa-output " --+-->")) + +;;; PRINT-CELL-TOP outputs the following: +;;; +;;; |---|---| + +(defun print-cell-top () (sfa-output"/|---/|---/|")) + +;;; PRINT-NIL outputs the following: +;;; +;;; / | +;;; assuming the front of the NIL cell has already been printed. + +(defun print-nil () (sfa-output " // /|")) + +;;; PRINT-VERTICAL-ARROW outputs the following: +;;; +;;; | +;;; | +;;; | +;;; | +;;; v + +(defun print-vertical-arrow () + (sfa-output " /|") + (do ((i 0 (+ i 1))) + ((= i 3)) + (sfa-cursor-down-and-back) + (sfa-output "/|")) + (sfa-cursor-down-and-back) + (sfa-output "v")) + +;;; PRINT-TREE outputs the following: +;;; +;;; |---|---| +;;; | | | +;;; |---|---| +;;; | +;;; v + +(defun print-tree (x y) + (print-cell-top) + (sfa-cursorpos (+ x 2) y) + (print-cell-top) + (sfa-cursorpos (+ x 3) (+ y 2)) + (print-vertical-bar) + (sfa-cursorpos (+ x 4) (+ y 2)) + (sfa-output "v") + (sfa-cursorpos (+ x 1) y) + (sfa-output "/| /| /|")) + +;;; PRINT-SINGLE-CELL outputs the following: +;;; +;;; |---|---| +;;; | A | +;;; |---|---| +;;; +;;; with the assumption that fix-atom-name has appropriately truncated +;;; or padded A. + +(defun print-single-cell (a x y) + (print-cell-top) + (sfa-cursorpos (+ x 2) y) + (print-cell-top) + (sfa-cursorpos (+ x 1) y) + (print-vertical-bar) + (sfa-output (fix-atom-name a)) + (print-vertical-bar)) + + +(defun print-cons (form i j) + (cond ((numberp form) (print-vertical-arrow)) + ((atom (car form)) + (print-single-cell (car form) i j) + (print-which-cdr (cdr form))) + (t (print-tree i j) + (print-which-cdr (cdr form))))) + +(defun print-which-cdr (a) + (cond ((null a) + (print-nil)) + ((atom a) + (print-cdr a)) + (t (print-horizontal-arrow)))) + + +(defun print-cdr (a) + (sfa-output (fix-atom-name a)) + (print-vertical-bar)) + + +;;; Takes an atom and makes it exactly 3 chars long. This means that if +;;; the atom is longer than 3 chars, it is truncated. Otherwise, 1 or 2 +;;; " "'s are added to it. + +(defun fix-atom-name (x) + (implode + (do ((l (explodec x) (cdr l)) + (nl () (cons (car l) nl)) + (i 0. (1+ i))) + ((> i 2.) + (if l (output "~&[Note that your long atom names have been ~ + truncated for prettier display.]~2%")) + (nreverse nl)) + (and (null l) + (return (cond ((= i 2.) + (cons " " (nreverse nl))) + (t (cons " " + (nreverse (cons " " nl)))))))))) + + +;;; Local Modes:; +;;; Mode:LISP; +;;; Comment Column:50; +;;; End:; diff --git a/src/teach/yes.13 b/src/teach/yes.13 new file mode 100644 index 00000000..8ad138a9 --- /dev/null +++ b/src/teach/yes.13 @@ -0,0 +1,101 @@ +; -*- MIDAS -*- +Title YES -- reply to luser asking for LISP teacher help + +x=0 +a=1 +b=2 +c=3 +d=4 +e=5 + +t=10 +tt=11 +sp=17 + +clic=15 +tyoc=16 + +argi==1000,,0 +cnti==5000,,0 + +pdllen==100 + +define syscal ops,stuff + .call [setz ? sixbit /ops/ ? stuff ((setz))] +termin + +define type chan,&string + move t,[440700,,[asciz string]] + movei tt,<.length string> + syscal siot,[argi chan ? t ? tt] + .lose %lssys +termin + +call=pushj sp, +ret=popj sp, + +go: move sp,[-pdllen,,pdl] ;init the PDL + .suset [.roption,,a] ;check out the option stuff + tlnn a,%opcmd ;do we have JCL? + jrst info + .break 12,[..rjcl,,jclbuf] ;read the JCL + movei a,6 ;at most 6 characters + move b,[440700,,jclbuf] ;input BP + move d,[440600,,e] ;output BP +rd6: ildb c,b ;get the character + caig c,40 ;is it the end? + jrst gotten ; yes, that's it! + caige c,140 ;convert to 6bit + subi c,40 + idpb c,d ;and deposit result + sojg a,rd6 ;and get another, if needed +gotten: jumpe e,info ;nothing? Tell him what to do + syscal open,[cnti .uao ? argi clic + [sixbit /CLI/] + e + [sixbit /LISP/]] + jrst gone ; he's not there! + + call ptunam + type clic,\ (alarmclock 'time nil) +(setq help-wanted nil) +(princ '|I have received your request, I'll be contacting you shortly./ +| tyo) +\ + .close clic, + .logout 1, + +ptunam: .suset [.runame,,b] ;get our UNAME to send along + type clic,/ |/ ;separate from sixbit JNAME and delimit +put6: setz a, + lshc a,6 ;get a 6bit char + addi a,40 ;convert to ASCII + .iot clic,a ;send it + jumpn b,put6 ;if there's more, keep sending + .iot clic,["|] ;mark end of the name +cpopj: ret ;and return + +info: call ttyopn + type tyoc,/CYes. Tell person's LISP job that you will help him. + +Just type :YES , and it will send a message to the person's LISP +telling it that you will aid him, and that it doesn't need to ask you again, +or ask any more people. You will be perpetually bugged if you don't use this +command! +/ + .logout 1, + + +gone: call ttyopn + type tyoc,/AThat person doesn't have a :TEACH;LISP !!!! +/ + .logout 1, + +ttyopn: syscal open,[cnti .uao\%tjdis ? argi tyoc ? [sixbit /TTY/]] + .lose %lsfil + ret + +jclbuf: block 100 + -1 +pdl: block pdllen + end go