github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-27 04:32:08 +00:00
Code Issues Releases Wiki Activity

Added TEACH;TS XLISP -- teaches lisp.

Browse Source 
Resolves #377.
This commit is contained in:
Eric Swenson
2018-10-28 11:17:06 -07:00
parent b94c7325d9
commit 3b77ee3320
47 changed files with 5946 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

64
src/teach/apropo.10 Executable file
View File

@@ -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))))

24
src/teach/compla.19 Executable file
View File

@@ -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:;

118
src/teach/databa.45 Executable file
View File

@@ -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:;

692
src/teach/errhan.64 Executable file
View File

@@ -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 <name>)/" 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: ~
~% (<function-name> <arg1> <arg2> ... <argN>). ~
~%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: ~
~% (<function-name> <arg1> <arg2> ... <argN>).~%"
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:;

261
src/teach/errhel.38 Executable file
View File

@@ -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 <items> <what-desc> &optional (<menu-name> 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 <item> <action>)
;; CHOICE takes an item and applies an action to it.
;; 3. (ACTIVE-MENU <items> <what-desc> <action>
;; &optional (<menu-name> nil))
;; ACTIVE-MENU does 1 and 2 for a single item.
;; 4. (ACTIVE-MENU-LOOP <items> <what-desc> <action>
;; &optional (<menu-name> 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 <items> <what-desc> &optional (<menu-name> 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:;

199
src/teach/exlist.83 Executable file
View File

@@ -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~
~% /"<something> . <something-else>/" ~
~%where <something> is the left hand side of the tree and <something-else>~
~%is the right hand side of the tree...~2%")
(print-dotted-worker x)
x)
(defun print-dotted-worker (x)
(cond ((atom x) (output "~S" x))
(t (output "(")
(print-dotted-worker (car x))
(output " . ")
(print-dotted-worker (cdr x))
(output ")"))))
(defun print-conses (x)
(output "~2&You could have formed the list with CONS by: ~
~2% ~N~2%"
(print-conses-worker x)))
(defun print-conses-worker (form)
(cond ((null form) nil)
((atom form) (list 'quote form))
(t (cons 'cons
(list (print-conses-worker (car form))
(print-conses-worker (cdr form)))))))
;;; Local Modes:;
;;; Mode:LISP;
;;; Comment Column:50;
;;; End:;

22
src/teach/global.15 Executable file
View File

@@ -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)

155
src/teach/init.41 Executable file
View File

@@ -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:;

56
src/teach/io.48 Executable file
View File

@@ -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:;

515
src/teach/lessn.130 Executable file
View File

@@ -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:
; (<stream> (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:;

89
src/teach/lesson.assq Executable file
View File

@@ -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

99
src/teach/lesson.cond Executable file
View File

@@ -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
"(<PREDICATE> <FORM-1> <FORM-2>...<FORM-N>)"
where <PREDICATE> 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

109
src/teach/lesson.defun Executable file
View File

@@ -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 <function-name> <bvl> <form1> <form2> ...)
This associates the lambda expression
(LAMBDA <bvl> <form1> <form2> ...)
with <function-name> in a way that Lisp's evaluator knows how to find when
you put <function-name> 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

182
src/teach/lesson.do Executable file
View File

@@ -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 <variable> <initial-value> <incremental-value> <exit-test> <body>)
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 <bindings> (<exit-test> <exit-body>) <main-body>)
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 <bindings>...
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) ...
<bindings> ::= ( <binding> <binding> ... )
<binding> ::= <variable> !
(<variable>) !
(<variable> <initial-value>) !
(<variable> <initial-value> <incremental-value>)
In other words, <bindings> is a list of elements. Each element represents
a binding (creation of a local variable).
If the <binding> 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 <binding> 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 <binding> 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 (<exit-test> <exit-body>) stuff.
<exit-test> 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 <exit-body> (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 <exit-test>
returns NIL, the <main-body> of the loop is entered.
Finally <main-body> 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 <exit-test>. Doing RETURN
does NOT cause <exit-body> 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

191
src/teach/lesson.dot Executable file
View File

@@ -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 <variable-name>)
it will describe the list-structure of the value of <variable-name>.
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

63
src/teach/lesson.eval Executable file
View File

@@ -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

102
src/teach/lesson.fib Executable file
View File

@@ -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 <ARGUMENTS>) 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

226
src/teach/lesson.info Executable file
View File

@@ -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 (<esc>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 <ctl>L and ^K means <ctl>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<cr> or just L<cr> (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

65
src/teach/lesson.input Executable file
View File

@@ -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

228
src/teach/lesson.intro Executable file
View File

@@ -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<cr> (or LISP<cr> -- 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 <something>), 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

143
src/teach/lesson.lambda Executable file
View File

@@ -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 <bvl> <form1> <form2> ... <formN>)
where <bvl> 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.'
<form1> ... <formN> 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 <bound-variable-list> <form1> <form2> ...)
<arg1> <arg2> ... )
where the number of <arg>'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, <arg1> ... <argN> 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

87
src/teach/lesson.lesson Executable file
View File

@@ -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

111
src/teach/lesson.memq Executable file
View File

@@ -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

177
src/teach/lesson.object Executable file
View File

@@ -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<rubout> 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 /<rubout>
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

132
src/teach/lesson.output Executable file
View File

@@ -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 <something>) they see the <something> 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

190
src/teach/lesson.prog Executable file
View File

@@ -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 <form1> <form2> <form3> ... <formN>)
evaluates each <form> 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 <bvl> <form>) <arg1> <arg2> ... <argN>)
rather than the more modern flavor of:
((LAMBDA <bvl> <form1> <form2> ... <formN>) <arg1> <arg2> <argN>)
In such a situation, PROGN was useful because it allowed the person to make
the <form> a PROGN which contained all of the forms he wanted to evaluate:
((LAMBDA <bvl> (PROGN <form1> <form2> ... <formN>))
<arg1> <arg2> ... <argN>)
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 <statement1> <statement2> ... <statementN>)
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 <statement1> through <statementN> in order, but
remembering the value of <statement2> 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 <bound-variable-list> <body>)
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.
<bound-variable-list> is a list of variable names which will all be locally set
to NIL at the beginning of the PROG.
<body> 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

48
src/teach/lesson.setq Executable file
View File

@@ -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

68
src/teach/lesson.trace Executable file
View File

@@ -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 <name1> <name2> ... <nameN>)
will trace each of <name1> through <nameN>. The <name>'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 <name1> <name2> ...)
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

99
src/teach/macro.29 Executable file
View File

@@ -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:;

BIN
src/teach/more.19 Executable file
View File

Binary file not shown.

103
src/teach/no.8 Normal file
View File

@@ -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 <uname><cr>, 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

149
src/teach/record.71 Executable file
View File

@@ -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.~%"))

18
src/teach/start.2 Executable file
View File

@@ -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))
'*))

325
src/teach/tags.3 Executable file
View File

@@ -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


14
src/teach/tdump.2 Executable file
View File

@@ -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

221
src/teach/teach.159 Executable file
View File

@@ -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 <name>)
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:;

5
src/teach/teach.dump Executable file
View File

@@ -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"))))

1
src/teach/teach.init Normal file
View File

@@ -0,0 +1 @@
()

27
src/teach/teach.midas Executable file
View File

@@ -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

341
src/teach/treepr.62 Executable file
View File

@@ -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:;

101
src/teach/yes.13 Normal file
View File

@@ -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 <uname><cr>, 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