1
0
mirror of https://github.com/PDP-10/its.git synced 2026-01-15 16:07:01 +00:00
PDP-10.its/src/teach/errhan.64
2018-10-28 16:47:17 -07:00

693 lines
25 KiB
Common Lisp
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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