;;; -*- Mode:Common-Lisp; Fonts: cptfont; Base:10 -*-

Logfile of changes to release-1-0 (i.e., evolution of release-1-1):

02/08/90 SNePS-2.1 CHANGE SET #1 (SHAPIRO)

File: sneps21.nlint.englex; englex.lisp
Function: addy
Change: 
(cond ((lexic (reverse (concatenate 'string "y" l))))
      ((y l))
      (t (lexic (reverse (concatenate 'string "ye" l)))))
To:
(cond ((lexic (concatenate 'string l "y")))
      ((y l))
      (t (lexic (concatenate 'string l "ey"))))
Because: To be less baroque.

File: sneps21.sneps.fns; path.lisp
Function: path-infer-1
Change: 
(otherwise
   (path-infer node (cons 'compose path)))
To: 
(otherwise
   (path-infer-1 node (cons 'compose path) followed-paths))
Because: Wrong format of returned result in otherwise case.

================== END OF SNePS-2.1 CHANGE SET #1 ===================



02/08/90 SNEPS-2.1 CHANGE SET #2 (HANS)

File: sneps21.sneps; export.lisp
Change:
(shadowing-import '(|#| ^ ^^ |=| |*| % |!| $ ? |&| + - |>| _ assert build  describe
			full-describe dump surface erase silent-erase resetnet
			find findassert findconstant findpattern findbase findvariable
			list-nodes list-hypotheses describe-context set-context define
			add-to-context remove-from-context list-context-names set-default-context
			define-path undefine-path fwd-infer exit stack sneps demo outnet innet intext
			lispeval lisp clear-infer nodes assertions relations)
	(find-package 'snepsul))
To:
(shadowing-import '(|#| ^ ^^ |=| |*| % |!| $ ? |&| + - |>| _ assert build  describe
			full-describe dump surface erase silent-erase resetnet
			find findassert findconstant findpattern findbase findvariable
			list-nodes list-hypotheses describe-context set-context define undefine
			add-to-context remove-from-context list-context-names set-default-context
			define-path undefine-path fwd-infer exit stack sneps demo outnet innet intext
			lispeval lisp clear-infer nodes assertions relations)
	(find-package 'snepsul))
Because: Import undefine into SNEPSUL package

File: sneps21.sneps.fns; relfns.lisp
Function: undefine
Change:
(defmacro undefine (&rest rsf)
  (declare (special rsf))
  (let ()
    (terpri)
    (princ "Relations Undefined: ")
    (mapcar #'(lambda (r)
		(undefine.r r)
		(princ r)
		(princ '| |)
		(finish-output))
            (mklst.rs (rseval rsf)))
    (terpri)
    (terpri)
    (values)))
To:
(defmacro undefine (&rest rsf)
  (format t "~%Relations undefined: ~{~a ~}~%"
	  (mapcar #'(lambda (r)
		      (undefine.r r) r)
		  (mklst.rs (rseval rsf))))
  (values))
Because: Get rid of unnecessary special declaration (gave problems on Symbolics)
         and streamline function a little bit.

File: sneps21.sneps.fns; outnet.lisp
Add: 
(defvar *variables-to-save* '(variables relations defaultct)
  "Variables whose values have to be explicitly reestablished during an innet")
Before: definition of outsysvars
Because: insysvars has to know how many variables it has to restore, and because
         these variables may change, they should be defined somewhere.
         defaultct was not saved by old version.

Function: outsysvars
Change:
(defun outsysvars (outunit)
  (declare (special outunit))
  (mapcar #'(lambda (sv)
	      (declare (special sv))
	      (Print.sv sv outunit))
	  '(variables relations)))
To:
(defun outsysvars (outunit)
  (declare (special outunit))
  (mapcar #'(lambda (sv)
	      (Print.sv sv outunit))
	  *variables-to-save*))
Because: Use *variables-to-save* and get rid of unnecessary special decl.

File: sneps21.sneps.fns; innet.lisp
Function: insysvars 
Change:
(defun insysvars (inunit)
  (read.sv inunit) ; variables
  (read.sv inunit) ; relations
  )
To:
(defun insysvars (inunit)
  (dotimes (i (length *variables-to-save*))
  (read.sv inunit)))
Because: Read exactly as many variables as saved by outnet (see above).


File: sneps21.sneps.fns; infixfns.lisp
Function: +
Delete: (declare (special ns-ns))
Because: Unnecessary. Gave warinings on Symbolics.

Delete:
(setq +
      '(apply 'unlolst (append (listfile read.i) '(read.t))))
After: definition of +
Because: not used.

Function: &
Delete: (declare (special ns-ns))
Because: See +

Function: -
Delete: (declare (special ns-ns))
Because: See +

Function: >
Delete: (declare (special rs-sv))
Because: See +

Function: _
Delete: (declare (special ns-rs))
Because: See +


File: sneps21.sneps.fns; svfns.lisp
Function: *
Delete: (declare (special id))
Because: see +

Delete: (setf * '(= + & - exceptrels.ns anyrels.n > _ ! exclamationop))
After: Definition of *
Because: not used.


File: sneps21.sneps.fns; buildfns.lisp
Function: Assert nodes
Change: (declare (special snepsul-exp))
To: (declare (special snepsul-exp crntct))
Because: Some macros-expansions use crntct (warning otherwise).

File: sneps21.snepslog.recognizer; recognizer.lisp
Function: wff->m 
Change:
(defun wff->m (wff)
  (intern  (string-append "M" (string-trim "WFwf" (symbol-name (first (flistify wff)))))
	   'snepsul))
To:
(defun wff->m (wff)
  (intern  (format nil "M~a" (string-trim "WFwf" (symbol-name (first (flistify wff)))))
	   'snepsul))
Because: string-append is not a CommonLisp function

Function: make-relation.2 
Change:
(let ((counter 0)
	(relation-arc-name (string-append " Rel "
					  (symbol-name relation)))
        (arguments-prefix  (string-append "Rel-arg#" (symbol-name relation)))
	argument-arcs
	relation-arc)
    (setq argument-arcs (mapcar #'(lambda (node)
				    (declare (ignore node))
				    (intern (string-append arguments-prefix
							   (princ-to-string (incf counter)))
					    'snepsul))
				arguments)
	  relation-arc (intern relation-arc-name 'snepsul))
    (mapc #'define-if-not-yet-defined (cons relation-arc argument-arcs))
    (associate-arcs relation-arc argument-arcs)
    (cons action (intercalate (cons relation-arc argument-arcs)
			      (cons relation arguments))))
To:
(let ((counter 0)
      (relation-arc-name (format nil " Rel ~a" (symbol-name relation)))
      (arguments-prefix  (format nil "Rel-arg#~a" (symbol-name relation)))
      argument-arcs
      relation-arc)
  (setq argument-arcs (mapcar #'(lambda (node)
				  (declare (ignore node))
				  (intern (format nil "~a~a" arguments-prefix (incf counter))
					  'snepsul))
			      arguments)
	relation-arc (intern relation-arc-name 'snepsul))
  (mapc #'define-if-not-yet-defined (cons relation-arc argument-arcs))
  (associate-arcs relation-arc argument-arcs)
  (cons action (intercalate (cons relation-arc argument-arcs)
			    (cons relation arguments))))
Because: see above.


File: sneps21.snepslog.generator; generator.lisp
Function: m->wff 
Change:
(defun m->wff (node)
  "Returns the node's short name (a string)"
  (cond ((eq :mol (sneps:node-type node)) 
	 (string-append "WFF" (subseq (symbol-name (sneps:node-na node)) 1)))
	(t (string-trim '(#\!) (symbol-name (sneps:node-na node))))))
To:
(defun m->wff (node)
  "Returns the node's short name (a string)"
  (cond ((eq :mol (sneps:node-type node)) 
	 (format nil "WFF~a" (subseq (symbol-name (sneps:node-na node)) 1)))
	(t (string-trim '(#\!) (symbol-name (sneps:node-na node))))))

File: sneps21.nlint.parser; parser.lisp
Delete: 
(defvar *input-redirect-stream* nil "Stream for redirected input.")
Before: definition of *terminating-punctuation-flag* 
Because: defined twice.

======================  END OF SNePS-2.1 CHANGE SET #2  ===============


02/21/90 SNEPS-2.1 CHANGE SET #3 (SHAPIRO)

File: sneps21.nlint.parser; parser.lisp
Function: internal-parse 
Change: (if *config*
	  (flatten (internal-getr '*)))
To: (when *config*
	(if *parse-trees*
	    (internal-getr '*)
	    (flatten (internal-getr '*))))
Because: Take care of empty parse tree

======================  END OF SNePS-2.1 CHANGE SET #2  ===============


02/21/90 SNEPS-2.1 CHANGE SET #4 (Hans)

File: sneps21.sneps.fns; intext.lisp
Delete: (setq intext 'nil)
After: definition of intext
Because: not used

File: sneps21.snepslog; commands.lisp
Add: final newline
Because: otherwise KCL bombs during read

File: sneps21.snepslog.generator; generator.atn
State: generate-snepslog-complete-description
Change: (neq :base (sneps:node-type (getr *)))
To: (not (eq :base (sneps:node-type (getr *))))
Because: NEQ is not Common-Lisp

File: sneps21.nlint.parser; parser.lisp
Change:
(eval-when (eval compile load)
  (defconstant user::*parser-package-name* 'parser
    "Name of the parser package."))

(in-package user::*parser-package-name*)
To:
(in-package 'parser)

(defconstant user::*parser-package-name* 'parser
    "Name of the parser package.")
Because: Gave headaches to various lisps

File: sneps21.nlint.parser; parser.lisp
Function: internal-sendr
Change:
(defun internal-sendr (register &rest forms)
  (if forms
      (progn
	(locally (special *config*))
	(set-sendr-actions
	  (cons (cons register (setup-forms (mapcar #'evaluate-form forms)))
		(remove-if #'(lambda (x) (equal register (car x)))
			   (get-sendr-actions)))))
      (progn
	(locally (special *config*))
	(set-sendr-actions
	  (cons (cons register (internal-getr register)) 
		(remove-if #'(lambda (x) (equal register (car x)))
			   (get-sendr-actions)))))))
To:
(defun internal-sendr (register &rest forms)
  (if forms
      (set-sendr-actions
	(cons (cons register (setup-forms (mapcar #'evaluate-form forms)))
	      (remove-if #'(lambda (x) (equal register (car x)))
			 (get-sendr-actions))))
      (set-sendr-actions
	(cons (cons register (internal-getr register)) 
	      (remove-if #'(lambda (x) (equal register (car x)))
			 (get-sendr-actions))))))
Because: Illegal and unnecessary declaration

======================  END OF SNePS-2.1 CHANGE SET #4  ===============

02/27/90 SNEPS-2.1 CHANGE SET #5 (Hans)

File: sneps21.nlint.englex; englex.lisp
Function: is-sub-str
Change:
(defun is-sub-str (sub-str word &optional (from-end-p nil)) 
  "is-sub-str - args: sub-str word &optional from-end-p
   Checks if sub-str is either an initial or final sub-string of word"
  (prog ()
  (return (search sub-str word :from-end from-end-p 
	:test #'(lambda (x y) (if (equal x '#\@) t 
				 (if (not (char-equal x y)) (return nil) t)))))))
To:
;; New version that respects that the test function used in SEARCH
;; should not have any side effects because the implementation is
;; free to map over sequence2 in any way it wants. (hc, Feb-27-90)
(defun is-sub-str (sub-str word &optional (from-end-p nil)) 
    "Checks if SUB-STR is either an initial or final (if FROM-END-P
is non-NIL) sub-string of WORD. @ counts as wildcard that matches
any character in WORD."
    (let ((sub-str-length (length sub-str))
	  (word-length (length word)))
      (and (<= sub-str-length word-length)
	   (search sub-str word
		   :test #'(lambda (x y)
			     ;; Hard to believe but Allegro
			     ;; uses y for sequence-1
			     (or (char-equal x #\@)
				 (char-equal y #\@)
				 (char-equal x y)))
		   :start2 (cond (from-end-p
				  (- word-length sub-str-length))
				 (t 0))
		   :end2 (cond (from-end-p word-length)
			       (t sub-str-length))))))
Because: see comment

File: sneps21.nlint.parser; parser.lisp
Function: convertline
Change:
(defun convertline (textline &key ((:punctuation puncts)
				   '(#\! #\. #\, #\? #\" #\' #\` #\; #\\ #\# #\^ #\(
				     #\) #\{ #\}))
		                  ((:trim-chars trimchars) '(#\Space #\Tab #\Newline))
				  ((:item-type itemtype) 'string))
  (declare (type string textline))
  "Converts a string into a list of atoms enclosed in |'s. Takes two keyword arguments 
   specifying the special punctuation charcters and the characters to trim the string 
   of, respectively."
  (do* ((line (member-if-not #'(lambda (x) (char= x #\Space)) (map 'list 'identity textline))
	      (member-if-not #'(lambda (x) (char= x #\Space)) line))
	(terminators (cons #\Space puncts))
	(result-list ())
	(c)
	(endpos nil))
       ((null line) (nreverse result-list))
    (setq c (car line)
	  line (cdr line)
	  endpos (position-if #'(lambda (x) (member x terminators)) line))
    (if (member c puncts)
	(setq result-list (cons (list-to-type itemtype (list c)) result-list))
	(if (not (member c trimchars))
	    (setq result-list
		  (cons
		    (list-to-type itemtype (cons c (subseq line 0 (cond (endpos endpos)))))
		    result-list)
		  line (member-if #'(lambda (x) (member x terminators)) line))))))
To:
;; New version that does not use type-coercion and is a bit more
;; straight forward than the original one. There were problems 
;; in Lucid-CL in some special cases. (hc, Feb-27-90)
(defun convertline (line &key (punct-chars ",:;.!?()[]{}'`\"/\\#^|")
		              (white-space '(#\space #\tab #\newline))
			      (item-type 'string))
  "Converts LINE (a string) into a list of strings (or atoms enclosed in |'s
if ITEM-TYPE is atom), where each item corresponds to a word or a punctuation
character. Words in LINE are delimited by WHITE-SPACE or PUNCT-CHARS."
    (mapcar
     (case item-type
       (string #'symbol-name)
       (t #'identity))
     (read-from-string
      (with-output-to-string (s)
	(let ((state :white-space))
	  (format s "(")
	  (map nil #'(lambda (char &aux echar)
		       ;; Deal with special case that char = |
		       (cond ((char-equal char #\|) (setq echar "\\|"))
			     (t (setq echar char)))
		       (cond ((lisp:find char punct-chars :test #'char-equal)
			      (case state
				((:white-space :punctuation)
				 (format s " |~a|" echar))
				(:word (format s "| |~a|" echar)))
			      (setq state :punctuation))
			     ((lisp:find char white-space :test #'char-equal)
			      (case state
				(:whitespace :do-nothing)
				(:word (format s "| "))
				(:punctuation (format s " ")))
			      (setq state :white-space))
			     (t (case state
				  ((:white-space :punctuation)
				   (format s " |~a" echar))
				  (:word (format s "~a" echar)))
				(setq state :word))))
	       (format nil "~a " line))
	  (format s ")"))))))
Because: see comment

======================  END OF SNePS-2.1 CHANGE SET #5  ===============

04/03/90 SNEPS-2.1 CHANGE SET #6 (Shapiro, Hans)

File: sneps21.nlint.parser;parser.lisp
Function: parse
Change: (nstring-downcase (car inp) :end 1)
To: (setq inp (cons (string-downcase (first inp) :end 1) (rest inp)))
Because: nstring-downcase was refusing to side-effect inp
And: (t (break
	  "ENTER LISP READ-EVAL-PRINT LOOP.  EVALUATE (CONTINUE) TO CONTINUE."))
To: (t (parser-print "~% Enter Lisp Read/Eval/Print loop. Type ^^ to continue~%")
       (sneps:pseudolisp))
Because: BREAK continuation is handled implementation dependent by various lisps.
And: (equal (car inp) '"^")
To:  (member (car inp) '("^" "^^") :test #'equal)
Because: Make it consistent with sneps pseudolisp invocation (-> MANUAL!!)

Function: arc-break 
Change:
(defmacro arc-break (&rest message)
  `(progn
     (break ,@message)
     t))
To:
(defmacro arc-break (&rest message)
  `(progn
     (parser-print ,@message)
     (sneps:pseudolisp "break-arc> ")
     t))
Because: BREAK continuation is handled implementation dependent by various lisps.
         Use new prompt because of improved pseudolisp

Add:
(defun wrap-break-around-test (test break-message)
  "Takes a TEST form and wraps arc-break around it such that the break
will be performed after the test has been evaluated. The result of the
test will be returned by the wrapped test."
  (let ((test-form (if (and (atom test)
			    (not (eq test t)))
		       `(getr ,test)
		       test))
	(break-form `(arc-break ,@break-message)))
    `(prog1 ,test-form
	    ,break-form)))

(defun is-wrapped (test)
  "Checkes whether TEST form has a break wrapped around it"
  (and (consp test)
       (eq (first test) 'prog1)
       (consp (third test))
       (eq (first (third test)) 'arc-break)))

(defun unwrap-test (wrapped-test)
  "Unwraps WRAPPED-TEST if it is wrapped with arc-break. NoOp otherwise."
  (if (is-wrapped wrapped-test)
      (second wrapped-test)
      wrapped-test))
Before: definition of BREAK-ARC
Because: More transparent wrapping of test forms (used in modified (UN)BREAK-ARC)

Function: break-arc
Change:
(case (car arc)
  ((cat jump pop push to tst vir wrd)
   (replace-item 3 arc
		 (list 'lisp::and (if (and (atom (third arc)) (not (eq (third arc) t)))
				      (list 'getr (third arc))
				      (third arc)) `(arc-break ,@break-message))))
  ((call rcall)
   (replace-item 4 arc
		 (list 'lisp::and (if (and (atom (fourth arc)) (not (eq (fourth arc) t)))
				      (list 'getr (fourth arc))
				      (fourth arc)) `(arc-break ,@break-message)))))
To:
(case (car arc)
  ((cat jump pop push to tst vir wrd)
   (replace-item 3 arc
		 (wrap-break-around-test
		   (third arc) break-message)))
  ((call rcall)
   (replace-item 4 arc
		 (wrap-break-around-test
		   (fourth arc) break-message))))
Because: Now arc-break will be performed right after the test has been evaluated 
         regardless of what value the test returned.

Function: unbreak-arc
Change:
(case (car arc)
  ((cat jump pop push to tst vir wrd)
   (replace-item 3 arc (second (third arc))))
  ((call rcall)
   (replace-item 4 arc (second (fourth arc)))))
To:
(case (car arc)
  ((cat jump pop push to tst vir wrd)
   (replace-item 3 arc (unwrap-test (third arc))))
  ((call rcall)
   (replace-item 4 arc (unwrap-test (fourth arc)))))
Because: new break policy (see above)

File: sneps21.sneps.fns; snepstop.lisp
Function: pseudolisp
Change:
(defun pseudolisp ()
  (declare (special user-top-level inunit))
  (terpri)
  (setq user-top-level 'pseudolisp)
  (princ "--> ")
  (do ((fm (sneps-read-fn) (sneps-read-fn)))	; note no errset yet
      ((eq fm '^^))
    (pseudolisp-printeval fm)
    (princ "--> "))
  (setq user-top-level 'sneps)
  (terpri)
  (values))
To:
(defun pseudolisp (&optional (prompt "--> ")
		             (exit-commands '("^^" "continue" "resume")))
  (declare (special user-top-level inunit outunit))
  (let ((*package* *package*)
	(inunit (cond ((and (boundp 'inunit) (streamp inunit))
		       inunit)
		      (t *standard-input*)))
	(outunit (cond ((and (boundp 'outunit) (streamp outunit))
			outunit)
		      (t *standard-output*))))
    (terpri outunit)
    (setq user-top-level 'pseudolisp)
    (princ prompt outunit)
    (do ((fm (sneps-read-fn) (sneps-read-fn)))	; note no errset yet
	((and (symbolp fm)
	      (member (symbol-name fm) exit-commands
		      :test #'string-equal)))
      (pseudolisp-printeval fm)
      (princ prompt outunit))
    (setq user-top-level 'sneps)
    (terpri outunit)
    (values)))
Because: Bind *package* locally so in-package commands won't be dangerous
         after return. Check for symbol-name equality (^^) to avoid package
         problems when people try to get out of pseudolisp. Add arguments
         prompt and exit-commands to allow customization by callers. Use
         outunit as output-stream (use standard streams if sneps-io units
         are unbound.

Function: pseudolisp1 
Change:
(defun pseudolisp1 ()
  (declare (special user-top-level inunit))
    (terpri)
    (setq user-top-level 'pseudolisp1)
    (princ "--> ")
    (pseudolisp-printeval (sneps-read-fn))
    (setq user-top-level 'sneps)
    (terpri)
    (values))
To:
(defun pseudolisp1 (&optional (prompt "--> "))
  (declare (special user-top-level inunit outunit))
  (let ((*package* *package*)
	(inunit (cond ((and (boundp 'inunit) (streamp inunit))
		       inunit)
		      (t *standard-input*)))
	(outunit (cond ((and (boundp 'outunit) (streamp outunit))
			outunit)
		      (t *standard-output*))))
    (terpri outunit)
    (setq user-top-level 'pseudolisp1)
    (princ prompt outunit)
    (pseudolisp-printeval (sneps-read-fn))
    (setq user-top-level 'sneps)
    (terpri outunit)
    (values)))
Because: see pseudolisp 

Function: pseudolisp-printeval 
Change:
(defun pseudolisp-printeval (form)
    (prin1 (eval form))
    (terpri))
To:
(defun pseudolisp-printeval (form)
  (declare (special outunit))
  (let ((outunit (cond ((and (boundp 'outunit) (streamp outunit))
			outunit)
		      (t *standard-output*))))
    (format outunit "~{~&~s~}~%"
	    (multiple-value-list
	      (eval form)))))
Because: Use outunit as output-stream and take care of 
         proper multiple value printing

File: sneps21.sneps; exports.lisp
Change:
(defvar *initial-relations*
	'(&ant ant arg forall cq dcq default emax emin etot exists fname 
	   max min pevb thresh threshmax context))
To:
(defvar *initial-relations*
	'(&ant ant arg forall cq dcq default emax emin etot exists fname 
	   max min pevb thresh threshmax context r))
Because: make R a initial-relation (used by SNePSLOG)
And:
(export '(pathfrom checkpath evalsnd protect-eval
	  node-fcableset node-type node-freevars node-perm node-p node-na node-snepslog
	  copy-assertion-state.n slight-surface sneps-error surface
	  is.r new.r isdn.r set.sv value.sv isnew.svs 
	  new.fcs insert.fcs others.fcs relation.fcs do.fcs
	  down.fcs relationset.fcs downfcs.pbi))
To:
(export '(pathfrom checkpath evalsnd protect-eval pseudolisp
	  node-fcableset node-type node-freevars node-perm node-p node-na node-snepslog
	  copy-assertion-state.n slight-surface sneps-error surface
	  is.r new.r isdn.r set.sv value.sv isnew.svs 
	  new.fcs insert.fcs others.fcs relation.fcs do.fcs
	  down.fcs relationset.fcs downfcs.pbi))
Because:  pseudolisp is used by parser:parse

File: sneps21.nlint.parser; exports.lisp
Change:
(eval-when (compile load eval)
  (in-package 'parser))
To:
(in-package 'parser)
Because: redundant, gives warnings in Lucid-CL
And:
(export '(*config* *trace-level* *parse-trees* *all-parses*
	  *terminating-punctuation-flag*  break-arc unbreak-arc
	  *input-redirect-stream* *lexentry* *atn-arcs-hashtable*
	  setr getr sendr liftr current-configuration
	  buildq lexin parse atnin talk getarcs putarc  geta addr
	  overlap disjoint nullr endofsentence addl flatten parser-print
	  atnreadln convertline list-to-type
	  hold to jump cat vir wrd rcall call tst group push pop lex I understand
	  that))
To:
(export '(*config* *trace-level* *parse-trees* *all-parses*
	  *terminating-punctuation-flag*  break-arc unbreak-arc
	  *input-redirect-stream* *lexentry* *atn-arcs-hashtable*
	  setr getr sendr liftr current-configuration packageless-equal
	  buildq lexin parse atnin talk getarcs putarc  geta addr
	  overlap disjoint nullr endofsentence addl flatten parser-print
	  atnreadln convertline list-to-type
	  hold to jump cat vir wrd rcall call tst group push pop lex I understand
	  that))
Because:  packageless-equal advertised in manual
And:
(import '(*trace-level* putarc getarcs overlap disjoint
			endofsentence buildq pconcat
			geta addr addl setr sendr liftr getr nullr
			hold to jump cat vir wrd rcall tst group
			atnin definenet parse lex I understand that)
	(find-package 'snepsul))
To:
(import '( *trace-level* putarc getarcs overlap disjoint
	  endofsentence buildq pconcat
	  geta addr addl setr sendr liftr getr nullr
	  hold to jump cat vir wrd rcall tst group
	  atnin definenet parse lex I understand that
	  break-arc unbreak-arc current-configuration
	  *all-parses* *parse-trees* *terminating-punctuation-flag*
	  packageless-equal)
	(find-package 'snepsul))
Because: Various advertised stuff from parser package that should be
         available in SNePSUL

File: sneps21.nlint.englex; exports.lisp
Add:
(export '(ctgy adj v multi-start multi-rest num pprt presp
	  presprt tense stative p future futr ftr fut sing
	  singular plur pl plural p1 firstperson person1 p2
	  secondperson person2 p3 decl int ynq interrogative
	  interrog ques question intrg imp imper imperative
	  impr command request req inf infinitive infin root
	  gnd gerund ing grnd non-prog progr prgr prg progress
	  progressive non-perf perf pft prft prfct perfect perfective
	  active pass passive affirmative neg nega negative negated
	  will shall can must may))
And:
;;;   Import this feature-mania into the SNePSUL package

(import '(ctgy adj v multi-start multi-rest num pprt presp
	  presprt tense stative p future futr ftr fut sing
	  singular plur pl plural p1 firstperson person1 p2
	  secondperson person2 p3 decl int ynq interrogative
	  interrog ques question intrg imp imper imperative
	  impr command request req inf infinitive infin root
	  gnd gerund ing grnd non-prog progr prgr prg progress
	  progressive non-perf perf pft prft prfct perfect perfective
	  active pass passive affirmative neg nega negative negated
	  will shall can must may)
	(find-package 'snepsul))
Because: All these features might creep up as symbols somewhere during
         parsing and hence should be SNePSUL symbols because they are
         advertised as toplevel symbols.

======================  END OF SNePS-2.1 CHANGE SET #6  ===============


09/19/90 SNEPS-2.1 CHANGE SET #7 (CHOI, HANS)

New file: sneps21.snip.fns; num-quant-rule.lisp
Because: New process type for numerical quantifiers (choi)

New file: sneps21.snip.fns; num-quant.lisp
Because: Numerical quantifier functions (choi)

File: sneps21.snip; imports.lisp
Add:
(defvar *NUM-QUANT-POS-INSTANCES*)
(defvar *NUM-QUANT-NEG-INSTANCES*)
After:
(defvar *NEG-FOUND*)
Because: New registers for numerical quantifier process (choi)

File: sneps21.snip.fns; make.lisp
Function: make-num-quant
Change:
(defun make-num-quant (n)
  (multi:new 'rule                   ; NAME:
        'num-quantifier              ; TYPE:
        n                            ; NODE:
        (new.iset)                   ; KNOWN-INSTANCES:
        (new.repset)                 ; REPORTS:
        (new.chset)                  ; REQUESTS:
        (new.feedset)                ; INCOMING-CHANNELS:
        (new.chset)                  ; OUTGOING-CHANNELS:
        (new.cqchset)                ; RULE-USE-CHANNELS:
	(new.ichset)                 ; INTRODUCTION-CHANNELS:
        (new.repset)                 ; PENDING-FORWARD-INFERENCES:
        nil                          ; PRIORITY:
        'rule-handler.num-quant      ; RULE-HANDLER:
        'usability-test.num-quant))  ; USABILITY-TEST:
To:
(defun make-num-quant (n)
  (multi:new 'num-quant.rule
        'num-quantifier              ; TYPE:
        n                            ; NODE:
        (new.iset)                   ; KNOWN-INSTANCES:
	nil                          ; NUM-QUANT-POS-INSTANCES:
	nil                          ; NUM-QUANT-NEG-INSTANCES:
        (new.repset)                 ; REPORTS:
        (new.chset)                  ; REQUESTS:
        (new.feedset)                ; INCOMING-CHANNELS:
        (new.chset)                  ; OUTGOING-CHANNELS:
        (new.cqchset)                ; RULE-USE-CHANNELS:
	(new.ichset)                 ; INTRODUCTION-CHANNELS:
        (new.repset)                 ; PENDING-FORWARD-INFERENCES:
        nil                          ; PRIORITY:
        'rule-handler.num-quant      ; RULE-HANDLER:
        'usability-test.num-quant))  ; USABILITY-TEST:
Because: Handling of numerical quantifier (choi)

File: sneps21.snip.fns; rule-reports.lisp
Function: process-one-report.rule
Change:
(defun process-one-report.rule (report)
  (let ((ant-to-rule (is-ant-to-rule.rep report))
	(cq-to-rule (is-cq-to-rule.rep report)))
    (cond ((and cq-to-rule ant-to-rule)
	   (process-one-special-report.rule report))
	  (ant-to-rule (process-one-ant-report.rule report))
	  (cq-to-rule (process-one-introduction-report.rule report))
	  (t (process-one-instance-report.rule report)))))
To:
(defun process-one-report.rule (report)
  (let ((ant-to-rule (is-ant-to-rule.rep report))
	(cq-to-rule (is-cq-to-rule.rep report)))
    (cond ((or ant-to-rule 
	       (and cq-to-rule (eq *TYPE* 'NUM-QUANTIFIER)))
	   (process-one-ant-report.rule report))
	  ((and cq-to-rule ant-to-rule)
	   (process-one-special-report.rule report))
	  (cq-to-rule (process-one-introduction-report.rule report))
	  (t (process-one-instance-report.rule report)))))
Because: Handling of numerical quantifier (choi)

File: sneps21.snip.fns; rule-requests.lisp
Function: process-rule-use-request.rule 
Change: (cqch (install-rule-use-channel request ants))
To: (cqch (install-rule-use-channel
	    request (union.ns ants (if (eq *TYPE* 'NUM-QUANTIFIER)
				       (nodeset.n *NODE* 'cq)
				       nil))))
Because: Handling of numerical quantifier (choi)

File: sneps21.snip.fns; rule-finfers.lisp
Function: process-one-forward-inference.rule 
Change: (is-ant-to-rule.rep report)
To: (or (is-ant-to-rule.rep report)
	(and (eq *TYPE* 'NUM-QUANTIFIER)
	     (is-cq-to-rule.rep report)))
Because: Handling of numerical quantifier (choi)

Function: set-up-rule-use-channels 
Change: 
(let ((ants (antecedents *NODE* cq))
      (chsub (restrict-binding-to-pat subst cq)))
  (setq *RULE-USE-CHANNELS*
	(insert.cqchset
	  (make.cqch (make.ch chsub (new.sbst) ct cq 'open) ants
		     (makeone.ruis (make.rui chsub 0 0 (nodeset-to-fnodeset ants) nil)))
	  *RULE-USE-CHANNELS*))
  )
To:
(let* ((ants (antecedents *NODE* cq))
       (rui-ants (union.ns ants (if (eq *TYPE* 'NUM-QUANTIFIER) 
				    (nodeset.n *NODE* 'sneps::cq) nil)))
       (chsub (restrict-binding-to-pat subst cq)))
  (setq *RULE-USE-CHANNELS*
	(insert.cqchset
	  (make.cqch (make.ch chsub (new.sbst) ct cq 'open) rui-ants
		     (makeone.ruis (make.rui chsub 0 0 (nodeset-to-fnodeset rui-ants) nil)))
	  *RULE-USE-CHANNELS*))
  )
Because: Handling of numerical quantifier (choi)

File: sneps21.snip.fns; nrn-requests.lisp
Function: send-request 
Add:
(when (eq (regfetch pr '*NAME*) 'NUM-QUANT.RULE)
  (let ((new-sbst 
	  (compl.Set (subst.restr restr)
		     (restrict.sbst (subst.restr restr)
				    (quantified-vars.n (regfetch pr '*NODE*))))))
    
    (setq restr (make.restr new-sbst))
    (setq req (make.ch new-sbst
		       (switch.ch req)
		       (context.ch req)
		       (destination.ch req)
		       (valve.ch req)))))
After:
(setq pr (activation.n n))
Because: Handling of numerical quantifier (choi)

File: sneps21.match.fns; match.lisp
Function: checkrulecompatability 
Change:
((ti (node-to-number.n (car (nodeset.n tnode 'emin))))
 (tj (node-to-number.n (car (nodeset.n tnode 'emax))))
 (tn (sneps:cardinality.ns (nodeset.n tnode 'etot)))
 (si (node-to-number.n (car (nodeset.n snode 'emin))))
 (sj (node-to-number.n (car (nodeset.n snode 'emax))))
 (sn (sneps:cardinality.ns (nodeset.n snode 'etot))))
To:
((ti (if (nodeset.n tnode 'emin) 
	 (node-to-number.n (car (nodeset.n tnode 'emin)))
	 0))
 (tj (if (nodeset.n tnode 'emax)
	 (node-to-number.n (car (nodeset.n tnode 'emax)))
	 0))
 (tn (sneps:cardinality.ns (nodeset.n tnode 'etot)))
 (si (if (nodeset.n snode 'emin)
	 (node-to-number.n (car (nodeset.n snode 'emin)))
	 0))
 (sj (if (nodeset.n snode 'emax)
	 (node-to-number.n (car (nodeset.n snode 'emax)))
	 0))
 (sn (sneps:cardinality.ns (nodeset.n snode 'etot))))
In: cond-clause that handles numerical quant. (is-num-quant.n snode)
Because: Handling of numerical quantifier (choi)

File: sneps21.sneps.fns; builldfns.lisp
Function: assert-nodes
Change:
(defun assert-nodes (snepsul-exp ctname)
  (declare (special snepsul-exp crntct))
  (values (apply
	    #'append
	    (mapcar #'(lambda (n)
			(cond ((ismol.n n)
			       (set.sv 'assertions
				       (insert.ns n (value.sv 'assertions)))
			       (assert.n n ctname))
			      (t (sneps-error
				   (format nil "cannot assert non-molecular node ~a" n)
				   'assert 'assert))))
		    (nseval snepsul-exp)))
	  ctname))
To:
(defun assert-nodes (snepsul-exp ctname)
  (declare (special snepsul-exp crntct))
  (let ((result (new.ns)))
    (do.ns (n (nseval snepsul-exp))
      (cond ((ismol.n n)
     	     (assert.n n ctname)
	     (set.sv 'assertions (insert.ns n (value.sv 'assertions)))
	     (setq result (insert.ns n result)))
	    (t (sneps-error
		(format nil "cannot assert non-molecular node ~a" n)
		'assert 'assert))))
    (values result ctname)))
Because: Old version bombed when snepsul-exp returned a set with more than
         one node (append 'm23 'm24)...

File: sneps21.sneps.ds; context2.lisp
Function: descrcontext 
Change: 
(defmacro descrcontext (ct)
  "Lists the description of the <context> `ct'"
  `(list
     (list 'assertions
	   (mapcar #'(lambda (hyp)
		       (snip:slight-describe-or-surface hyp nil))
		   (context-hyps ,ct)))
     (list 'restriction 
	   (mapcar #'(lambda (c)
		       (mapcar #'(lambda (hyp)
				   (snip:slight-describe-or-surface hyp nil))
			       (context-hyps c)))
		   (context-restriction ,ct)))
     (list 'named (context-names ,ct))))
To:
(defmacro descrcontext (ct)
  "Lists the description of the <context> `ct'"
  `(list
     (list 'assertions
	   (mapcar #'(lambda (hyp)
		       (format nil "~a" hyp nil))
		   (context-hyps ,ct)))
     (list 'restriction 
	   (mapcar #'(lambda (c)
		       (mapcar #'(lambda (hyp)
				   (format nil "~a" hyp))
			       (context-hyps c)))
		   (context-restriction ,ct)))
     (list 'named (context-names ,ct))))
Because: Do not use snip:slight-describe-or-surface because this just returns t
         if *infertrace* is nil, rather produce string directly (which is I guess
         intended anyway). This was the culprit of the (t t t t t...) lists produced
         by describe-context.

File: sneps21.sneps.ds; util.lisp
Add new macro:
(defmacro initialized-p (variable)
  "Returns nonNIL if VARIABLE is bound and has a nonNIL value."
  `(and (boundp ',variable)
	(not (eq ,variable :unbound)) 
	,variable))
After: definition of loopmessage 
Because: Can be used in various places where variables (such as *atn-arcs-hashtable*)
         have to be checked for proper initialization. This should also handle some
         differences in how various Lisps handle DEFVAR (i.e., a value of :unbound
         leaves a var unbound on explorers but sets it to :unbound in other Lisps).

File: sneps21.sneps; exports.lisp
Change:
(export '(pathfrom checkpath evalsnd protect-eval pseudolisp
To:
(export '(pathfrom checkpath evalsnd protect-eval pseudolisp initialized-p
Because: New utility function, see above
And:
(export '(pathfrom checkpath evalsnd protect-eval pseudolisp initialized-p
	  node-fcableset node-type node-freevars node-perm node-p node-na node-snepslog
	  copy-assertion-state.n slight-surface sneps-error surface
	  is.r new.r isdn.r set.sv value.sv isnew.svs 
	  new.fcs insert.fcs others.fcs relation.fcs do.fcs
	  down.fcs relationset.fcs downfcs.pbi))
To:
(export '(pathfrom checkpath evalsnd protect-eval pseudolisp initialized-p
	  node-fcableset node-type node-freevars node-perm node-p node-na node-snepslog
	  copy-assertion-state.n slight-surface sneps-error surface
	  is.r new.r isdn.r set.sv value.sv isnew.svs 
	  new.fcs insert.fcs delete.fcs others.fcs relation.fcs do.fcs
	  down.fcs relationset.fcs downfcs.pbi))
Because: New function needed for setnodeset.n (see below).

File: sneps21.sneps.fns; dd.lisp
Function: surface
Change:
(defmacro surface (&rest snepsul-exp)
  "Hands its argument node set to the generation grammar starting in state G."
  `(let* ((parser::*trace-level* -1)
	  (parser::*all-parses* nil)
	  (response))
     (if (not (boundp 'englex::*lexicon*))
	 (talk 0 "~%~% Warning no lexicon is loaded. You should load a lexicon via: (lexin \"<lexicon-filename>\")~% Before using SURFACE.~%"))
     (if (not (boundp 'parser::*atn-arcs-hashtable*))
	 (error "~%~% Warning no ATN grammar is loaded. You must load a grammar via: (atnin \"<atn-grammar-filename>\")~% Before using SURFACE.~%"))
     (setq response (parser::flatten (parser::internal-parse (nseval ',snepsul-exp) 'snepsul::G)))
     (when response
       (format t  (concatenate 'string
			       "~%"
			       (string-trim `(,(code-char 40) ,(code-char 41))
					    (princ-to-string response))
			       ".~%")))
     (values)))
To:
(defmacro surface (&rest snepsul-exp)
  "Hands its argument node set to the generation grammar starting in state G."
  `(let* ((parser:*trace-level* -1)
	  (parser:*all-parses* nil)
	  (response nil))
     (if (not (initialized-p englex:*lexicon*))
	 (talk 0 "~%~% Warning no lexicon is loaded. You should load a lexicon via ~
                    ~% (lexin \"<lexicon-filename>\") before using SURFACE.~%"))
     (if (not (initialized-p parser:*atn-arcs-hashtable*))
	 (error "No ATN grammar is loaded. You must load a grammar via ~
               ~%         (atnin \"<atn-grammar-filename>\") before using SURFACE.~%"))
     (setq response (parser:flatten (parser::internal-parse (nseval ',snepsul-exp) 'snepsul::G)))
     (when response
       (format t  (concatenate 'string
			       "~%"
			       (string-trim `(,(code-char 40) ,(code-char 41))
					    (princ-to-string response))
			       ".~%")))
     (values)))
Because: Get rid of illegal ((response)) declaration, and change (boundp ...) tests
         to (initialized-p ..) tests according to new policy + utility. Also get rid
         of various unnecessary :: and make messages a bit prettier.

File: sneps21.snip.fns; deduce.lisp
Function: deduce*
Change:
    (multip (dequeue:insert-rear pr (dequeue:new)) (dequeue:new))
    (terpri)
    (terpri)
    *DEDUCTION-RESULTS*
To:
    (multip (dequeue:insert-rear pr (dequeue:new)) (dequeue:new))
;;    (terpri)
;;    (terpri)
    *DEDUCTION-RESULTS*
Because: Theses terpri's produced excessive blank lines in SNACTOR demos.

File: sneps21.sneps.ds; fcableset.lisp
Add:
; =============================================================================
;
; delete.fcs
; ----------
;
;       arguments    : r   - <relation>
;                      fcs - <flat cable set>
;
;       returns      : <flat cable set>
;
;       description  : Deletes the R cable in the flat cable set FCS and returns a
;                      copy of the modified cable set.
;
;       written      : hc 6/7/90
;
(defun delete.fcs (r fcs)
  "Deletes the R cable in the flat cable set FCS and returns a
copy of the modified cable set."
  (let ((position (position r fcs :test #'(lambda (x y)
					    (iseq.r x y)))))
    (cond (position
	   (append (subseq fcs 0 position)
		   (subseq fcs (lisp:+ position 2))))
	  (t fcs))))
After: definition of insert.fcs
Because: needed in setnodeset.n, see below


File: sneps21.sneps.ds; node2.lisp
Function: node
Change:
(defun node (ident)
  ((lambda (symb-ident)
     (or (get symb-ident '=snode)
	 ;; If node is all lowercase letters created by a grammar.
	 (get (intern (nstring-downcase (princ-to-string symb-ident))) '=snode)
	 ;; If node is capitalized as created by a grammar.
	 (get (intern (string-capitalize (princ-to-string symb-ident))) '=snode)))
   (if (numberp ident) (un-ize ident) ident)))
To:
(defun node (ident)
  ;; This is a kludge: On the TI-Explorers GET also takes a list instead
  ;; of a symbol. SNePSLOG uses that in various places, and until it
  ;; gets cleaned up we catch that case here. (hc, 10/1/90)
  (when (consp ident) (setq ident (first ident)))
  ((lambda (symb-ident)
     (or (get symb-ident '=snode)
	 ;; If node is all lowercase letters created by a grammar.
	 ;; Intern into SNEPSUL not SNEPS (hc, 10/1/90)
	 (get (intern (format nil "~(~a~)" symb-ident) 'snepsul) '=snode)
	 ;; If node is capitalized as created by a grammar.
	 ;; Intern into SNEPSUL not SNEPS (hc, 10/1/90)
	 (get (intern (format nil "~:(~a~)" symb-ident) 'snepsul) '=snode)
	 ))
   ;; Guarantees that symb-ident is a symbol.
   (cond ((node-p ident)
	  ;; Already a node, just return it (hc 6/14/90)
	  (return-from node ident))
         ((numberp ident) (un-ize ident))
	 ((symbolp ident) ident)
	 ;; Also allow strings, nodes and maybe other junk (hc 6/7/90)
	 ((stringp ident) (intern ident 'snepsul))
	 ;; This case should always bomb!
	 (t ident))))
Because: See comments.

Function: 
Change:
(defmacro setnodeset.n (n r ns)
  `((lambda (fcs)
      (if (null (car ,ns)) (setf (node-fcableset ,n) 
				 (remove ,r 
					 (remove (nodeset.n ,n ,r) fcs :start (position ,r fcs)
						                       :count 1)))
	  (setf (node-fcableset ,n)
		(replace.fcs ,r ,ns fcs))))
    (node-fcableset ,n)))
To:
(defmacro setnodeset.n (n r ns)
  `(setf (node-fcableset ,n)
         (cond ((isnew.ns ,ns)
	        (delete.fcs ,r (node-fcableset ,n)))
	       (t (replace.fcs ,r ,ns (node-fcableset ,n))))))
Because: Problems when :start was NIL

File: sneps21.nlint.parser; parser.lisp
Function: convertline
Change:
(defun convertline (line &key (punct-chars ",:;.!?()[]{}'`\"/\\#^|")
		              (white-space '(#\space #\tab #\newline))
			      (item-type 'string))
  "Converts LINE (a string) into a list of strings (or atoms enclosed in |'s
if ITEM-TYPE is atom), where each item corresponds to a word or a punctuation
character. Words in LINE are delimited by WHITE-SPACE or PUNCT-CHARS."
    (mapcar
     (case item-type
       (string #'symbol-name)
       (t #'identity))
     (read-from-string
      (with-output-to-string (s)
	(let ((state :white-space))
	  (format s "(")
	  (map nil #'(lambda (char &aux echar)
		       ;; Deal with special case that char = |
		       (cond ((char-equal char #\|) (setq echar "\\|"))
			     (t (setq echar char)))
		       (cond ((lisp:find char punct-chars :test #'char-equal)
			      (case state
				((:white-space :punctuation)
				 (format s " |~a|" echar))
				(:word (format s "| |~a|" echar)))
			      (setq state :punctuation))
			     ((lisp:find char white-space :test #'char-equal)
			      (case state
				(:whitespace :do-nothing)
				(:word (format s "| "))
				(:punctuation (format s " ")))
			      (setq state :white-space))
			     (t (case state
				  ((:white-space :punctuation)
				   (format s " |~a" echar))
				  (:word (format s "~a" echar)))
				(setq state :word))))
	       (format nil "~a " line))
	  (format s ")"))))))
To:
(defun convertline (line &key (punct-chars ",:;.!?()[]{}'`/#^|")
		              (white-space '(#\space #\tab #\newline))
			      (quote-chars "\"")
			      (escape-chars "\\")
			      (item-type 'string))
  "Converts LINE (a string) into a list of strings (or atoms enclosed in |'s
if ITEM-TYPE is atom), where each item corresponds to a word or a punctuation
character. Words in LINE are delimited by WHITE-SPACE or PUNCT-CHARS.
Within QUOTE-CHARS all characters are treated like normal characters.
ESCAPE-CHARS escape the special meaning of the next character."
    (mapcar
     (case item-type
       (string #'symbol-name)
       (t #'identity))
     (read-from-string
      (with-output-to-string (s)
	(let ((state :white-space)
	      (escape nil))
	  (format s "(")
	  (map nil #'(lambda (char &aux echar)
		       ;; Deal with special case that char = |
		       (cond ((char-equal char #\|) (setq echar "\\|"))
			     (t (setq echar char)))
		       (cond (escape
			      (format s "~a" echar)
			      (setq escape nil))
			     ((lisp:find char escape-chars :test #'char-equal)
			      (setq escape t))
			     ((lisp:find char quote-chars :test #'char-equal)
			      (case state
				((:white-space :punctuation)
				 (format s " |~a| |" echar)
				 (setq state :quotation))
				(:word (format s "| |~a| |" echar)
				       (setq state :quotation))
				(:quotation (format s "| |~a|" echar)
					    (setq state :white-space)))
			      )
			     ((lisp:find char punct-chars :test #'char-equal)
			      (case state
				((:white-space :punctuation)
				 (format s " |~a|" echar)
				 (setq state :punctuation))
				(:word (format s "| |~a|" echar)
				       (setq state :punctuation))
				(:quotation (format s "~a" echar))))
			     ((lisp:find char white-space :test #'char-equal)
			      (case state
				(:whitespace :do-nothing)
				(:word (format s "| ")
				       (setq state :white-space))
				(:punctuation (format s " ")
					      (setq state :white-space))
				(:quotation (format s "~a" echar))))
			     (t (case state
				  ((:white-space :punctuation)
				   (format s " |~a" echar)
				   (setq state :word))
				  (:word (format s "~a" echar))
				  (:quotation (format s "~a" echar))))))
				
	       (format nil "~a " line))
	  (format s ")"))))))
Because: Now has additional quotation feature. Within quotation characters all other
         special characters are treated like normal chars. Needed for getting quoted
         strings into the parser input string.

Function: parse
Change:
    (if (not (boundp 'englex::*lexicon*))
	(talk 0 "~%~% Warning no lexicon is loaded. You should load a lexicon via: (lexin \"<lexicon-filename>\")~% Before running the ATN parser.~%"))
    
    (if (not (boundp '*atn-arcs-hashtable*))
	(error "~%~% Warning no ATN grammar is loaded. You must load a grammar via: (atnin \"<atn-grammar-filename>\")~% Before running the ATN parser.~%"))
To:
     (if (not (sneps:initialized-p englex:*lexicon*))
	 (talk 0 "~%~% Warning no lexicon is loaded. You should load a lexicon via ~
                    ~% (lexin \"<lexicon-filename>\") before using SURFACE.~%"))
     (if (not (sneps:initialized-p parser:*atn-arcs-hashtable*))
	 (error "No ATN grammar is loaded. You must load a grammar via ~
               ~%         (atnin \"<atn-grammar-filename>\") before using SURFACE.~%"))
Because: use initialized-p, prettier messages. 
Change: (and (boundp '*terminating-punctuation-flag*)
		 *terminating-punctuation-flag*)
To: (sneps:initialized-p *terminating-punctuation-flag*)
Because: use initialized-p.

File: sneps21.match.fns; match.lisp
Function: here
Add:
  ;; Kludge to overcome some match problem that I haven't figured
  ;; out yet (hc, Feb.22, 90)
  (unless (and (sneps:node-p t1)
	       (sneps:node-p t2))
    (throw 'unifytrap nil))
At: beginning of function
Because: see comment. Once in a while t1 and t2 are not nodes but 'loop
         (which could be a trick by the original algo., i.e., just handle
          loop as a special logical constant - who knows!!!)

File: sneps21.snip.fns; remark.lisp
Function: slight-describe-or-surface 
(defun slight-describe-or-surface (node &optional (stream sneps:outunit))
  (declare (special *infertrace*))
  (cond ((null *infertrace*))
	((surface-trace-p *infertrace*)
	 (funcall #'sneps:slight-surface node stream))
	(t (format stream "~A" node))))
To:
(defun slight-describe-or-surface (node &optional (stream sneps:outunit))
  (declare (special *infertrace*))
  (cond ;;((null *infertrace*))
	((surface-trace-p *infertrace*)
	 (funcall #'sneps:slight-surface node stream))
	(t (format stream "~A" node))))
Because: This case doesn't make sense and it forbids the use of this fn for
         various cases where it is usefule (e.g., in descrcontext). Let's try
         this for a while and see what happens.

Function: slight-describe-or-surface.ns 
Change:
(defun slight-describe-or-surface.ns (nodeset &optional (stream sneps:outunit))
  (format stream
	  "~{ ~A~}"
	  (mapcar #'(lambda (node)
		      (slight-describe-or-surface node nil))
		  nodeset)))
To:
(defun slight-describe-or-surface.ns (nodeset &optional (stream sneps:outunit))
   (let ((descrs 
	  (mapcar #'(lambda (node)
		      (slight-describe-or-surface node nil))
		  nodeset)))       
     (format stream
	     "(~A~{ ~A~})" (first descrs) (rest descrs))))
Because: Just to handle the singleton set differently from the general case
         (no blank needed for singletons, I needed that somwhere for SNePSLOG)

Function: describe-or-surface 
Change:
(defun describe-or-surface (node &optional (stream sneps:outunit))
  (declare (special *infertrace*))
  (let ((sneps:outunit stream))
    (if (surface-trace-p *infertrace*)
	(format stream "~A" (with-output-to-string (sneps:outunit)
			      (eval (list #'sneps:surface node))))
	(format stream "~A" (describe-one-node node nil)))))
To:
(defun describe-or-surface (node &optional (stream sneps:outunit))
  (declare (special *infertrace*))
  (let ((sneps:outunit stream))
    (if (surface-trace-p *infertrace*)
	(format stream "~A" (with-output-to-string (sneps:outunit)
			      (eval `(sneps:surface ',node))))
	(format stream "~A" (describe-one-node node nil)))))
Because: ((function surface) node) does not make sense in Lisp.

File: sneps21.snebr; snepshandler.lisp
Function: SNEPS-CONTR-HANDLER 
Change: 
  (format sneps:outunit
	  "~%~%~T A contradiction was detected within context ~A.~
                   ~%~T The contradiction involves the node you want to assert:~
                   ~%~T~T~T ~S ~
                   ~%~T and the previously existing node:~
                   ~%~T~T~T ~S"
	  sneps:crntct (describe.n newnode) (describe.n contrnd))
To:
  (format sneps:outunit
	  "~%~%~T A contradiction was detected within context ~A.~
                   ~%~T The contradiction involves the node you want to assert:~
                   ~%~T~T~T ~A ~
                   ~%~T and the previously existing node:~
                   ~%~T~T~T ~A"
	  sneps:crntct (snip:describe-or-surface newnode nil)
	  (snip:describe-or-surface contrnd nil))
Because: display nodes properly according to the interface used (e.g., in SNePSLOG)

Function: OPTIONS-IN-MAKE-CONSISTENT-1 
Change:
  (format sneps:outunit
	  "~T   In order to make the context consistent you must delete some hypotheses~
	   ~%~T from the set ~A ~
	   ~%~T You are now entering a package that will enable you to delete some~
	   ~%~T hypotheses from this set.~
	   ~%~T Do you need guidance about how to use the package?"
	  inc-hyps)
To:
  (format sneps:outunit
	  "~T   In order to make the context consistent you must delete some hypotheses~
	   ~%~T from the set ~A ~
	   ~%~T You are now entering a package that will enable you to delete some~
	   ~%~T hypotheses from this set.~
	   ~%~T Do you need guidance about how to use the package?"
	  (snip:slight-describe-or-surface.ns inc-hyps nil))
Because: see above

Function: INSPECT-HYP 
Change:
  (format sneps:outunit
	  "~%~T What do you want to do with hypothesis ~A?~
	   ~%~T [d]iscard from the context, [k]eep in the context,~
	   ~%~T [u]ndecided, [q]uit this package ~
	   ~%~T (please type d, k, u or q)"
	  curnt-hyp))
To:
  (format sneps:outunit
	  "~%~T What do you want to do with hypothesis ~A?~
	   ~%~T [d]iscard from the context, [k]eep in the context,~
	   ~%~T [u]ndecided, [q]uit this package ~
	   ~%~T (please type d, k, u or q)"
	  (snip:slight-describe-or-surface curnt-hyp nil))
Because: see above 

Function: CONSEQUENCES-OF-THIS-HYP 
Change:
  (format sneps:outunit "Do you want to take a look at hypothesis ~A?" h)
  (if (user-says-yes)
    (format sneps:outunit "~A" (snip:describe-one-node h nil))
    (format sneps:outunit "~%"))
To:
  (format sneps:outunit "Do you want to take a look at hypothesis ~A?"
	  (snip:slight-describe-or-surface h nil))
  (if (user-says-yes)
    (snip:describe-or-surface h sneps:outunit)
    (format sneps:outunit "~%"))
Because: see above 

Function: CONSEQUENCES-OF-THIS-HYP-1 
Change:
 (format sneps:outunit "~%~T No nodes depend on hypothesis ~A.~%" h))
To:
 (format sneps:outunit "~%~T No nodes depend on hypothesis ~A.~%"
	 (snip:slight-describe-or-surface h nil))
Change:
     (format sneps:outunit
	     "~%~T There are ~A nodes depending on hypothesis ~A:~
                    ~%~T~T ~A. ~
                    ~%~T Do you want to look at [a]ll of them, ~
                         [s]ome of them, or [n]one? ~
                    ~%~T (please type a, s or n)"
	     (cardinality.ns depend) h depend)
To:
     (format sneps:outunit
	     "~%~T There are ~A nodes depending on hypothesis ~A:~
                    ~%~T~T ~A. ~
                    ~%~T Do you want to look at [a]ll of them, ~
                         [s]ome of them, or [n]one? ~
                    ~%~T (please type a, s or n)"
	     (cardinality.ns depend) (snip:slight-describe-or-surface h nil)
	     (snip:slight-describe-or-surface.ns depend nil))
Because: see above 

Function: SHOW-NODES 
Change: 
    (format sneps:outunit "~%~T About to describe node ~A " (choose.ns ndlst))
    (format sneps:outunit "~A" (snip:describe-one-node (choose.ns ndlst) nil))
To:
    (format sneps:outunit "~%~T About to describe node ~A " (choose.ns ndlst))
    (snip:describe-or-surface (choose.ns ndlst) sneps:outunit)
Because: see above 

Function: SHOW-SOME-NODES 
Change:
     (format sneps:outunit
	     "~T   Which node do you want to have described?~
                   ~%~T Note: it should belong to the list ~A"
	     lhyps)
To:
     (format sneps:outunit
	     "~T   Which node do you want to have described?~
                   ~%~T Note: it should belong to the list ~A"
	     (snip:slight-describe-or-surface.ns lhyps nil))
Change:
       (cond
	 ((member (node nd) lhyps)
	  (format sneps:outunit "~A" (snip:describe-one-node (node nd) nil))
	  (format sneps:outunit "~%"))
	 (t (setq nd nil)))
To:    (cond
	 ((member (node nd) lhyps) (snip:describe-or-surface (node nd) sneps:outunit)
	  (format sneps:outunit "~%"))
	 (t (setq nd nil)))
Change: (format sneps:outunit
		   "~T Do you want to examine more nodes from ~
                                  the list ~A?"
		   lhyps)
To:     (format sneps:outunit
		   "~T Do you want to examine more nodes from ~
                                  the list ~A?"
		   (snip:slight-describe-or-surface.ns lhyps nil))
Change: (format sneps:outunit
		   "~T Oops... the node you typed doesn't belong to~
			         ~%~T ~A ~%"
		   lhyps)
To:     (format sneps:outunit
		   "~T Oops... the node you typed doesn't belong to~
			         ~%~T ~A ~%"
		   (snip:slight-describe-or-surface.ns lhyps nil))
Because: see above.


File: sneps21.snebr; sniphandler.lisp
Function: SNIP-CONTR-HANDLER 
Change:
    (format sneps:outunit
	    "~%~%~T A contradiction was detected within context ~A.~
                   ~%~T The contradiction involves the newly derived node:~
                   ~%~T~T~T ~S ~
                   ~%~T and the previously existing node:~
                   ~%~T~T~T ~S"
	    snip:crntctname (snip:describe-one-node newnode nil)
	    (snip:describe-one-node contrnd nil))
To:
    (format sneps:outunit
	    "~%~%~T A contradiction was detected within context ~A.~
                   ~%~T The contradiction involves the newly derived node:~
                   ~%~T~T~T ~A ~
                   ~%~T and the previously existing node:~
                   ~%~T~T~T ~A"
	    snip:crntctname (snip:describe-or-surface newnode nil)
	    (snip:describe-or-surface contrnd nil))
Because: see above.

Function: INFORM-USER 
Change:
	(format sneps:outunit "~%~T~T~T ~S"
		(union.ns (context-hyps newsupp) (context-hyps contrsupp)))
To:
	(format sneps:outunit "~%~T~T~T ~A"
		(snip:slight-describe-or-surface.ns
		 (union.ns (context-hyps newsupp) (context-hyps contrsupp)) nil))
Because: see above.

File: sneps21.snepslog; commands.lisp
Various changes, see header of file:
;; Changes (hc Mar-12-90)
;;  - New function get-def.command that eliminates package problems
;;    with new commands by using the symbol name and interning the
;;    string into the SNEPSLOG package
;;  - Add 'freshline' to execute-snepslog.command to get consistent
;;    newline after output, and add special variable command.string
;;    so ^ and % can use the right readtables.
;;  - change ^ and % to use the right readtables (this should be done
;;    more elegantely, I just hacked the reader code)
;;  - Use with-open-file in demo so aborts won't leave files open.

File: sneps21.snepslog; reader.lisp
Various changes, see header of file:
;; Changes (hc Feb-27-90, Mar-12-90)
;;  - Introduce variable line.terminator to allow adaption to
;;    various lisp implementations
;;  - add clause (escape.char? read.char) to read-string
;;    to allow continuation lines (they already were possible
;;    by doing ;\  )
;;  - make comment reading more intelligent (allow empty lines,
;;    expressions starting with comments, inside comments...)
;;  - allow aligned printing of read expressions (good for demo).
;;  - don't close on eof in snepslog-read anymore because demo
;;    uses with-open-file now.
;;  - Change read-string to remember and return position of first character
;;    of a real command (i.e., not whitespace or comment)
;;  - Change snepslog-read, snepslog-read-from-string(list) to take account
;;    of start.of.real.input, so a proper input substring can be given
;;    to execute-snepslog.command to allow use of proper readtables in
;;    ^ and % commands.

File: sneps21.snepslog; utilities.lisp
Various changes, see header of file:
;; Changes (hc Mar-12-90)
;;  - determine reset.functions dynamically, otherwise there are problems
;;    with recursive calls (e.g., as done by demo), i.e., on return from
;;    the demo invocation of snepslog functions such as surface are
;;    resetted to original sneps definitions.

File: sneps21.sneps; exports.lisp
Change:
(export '(new.cts isnew.cts ismemb.cts choose.cts others.cts makeone.cts union.cts
	  insert.cts cardinality.cts remove.cts issubset.cts repeat name.ct
	  value.sv isassert.n context-hyps context-restriction 
	  fullbuildcontext compl.ns
	  node-asupport node default-defaultct all-hyps
	  new.c relation.c nodeset.c
	  hyp der ext snip assertion crntct
	  is.ct iseq.ct isinconsis.ct issubset.ct
	  cts make.cts do.cts compl.cts isnew.ctcs is.ctcs 
	  new.ctcs insert.ctcs others.ctcs ot.ctcs contextset.ctcs
	  getcontextset.ctcs filter.ctcs ctcs-to-cts ctcs-to-ots
	  getsndescr processcontextdescr
	  getcontext nodeaccess update-contexts buildcontext
	  mark-inconsistent updateall newjust context-names
	  ))
To:
(export '(new.cts isnew.cts ismemb.cts choose.cts others.cts makeone.cts union.cts
	  insert.cts cardinality.cts remove.cts issubset.cts repeat name.ct
	  value.sv isassert.n context-hyps context-restriction 
	  fullbuildcontext compl.ns
	  node-asupport node default-defaultct all-hyps
	  new.c relation.c nodeset.c
	  hyp der ext assertion restriction named snip crntct
	  is.ct iseq.ct isinconsis.ct issubset.ct
	  cts make.cts do.cts compl.cts isnew.ctcs is.ctcs 
	  new.ctcs insert.ctcs others.ctcs ot.ctcs contextset.ctcs
	  getcontextset.ctcs filter.ctcs ctcs-to-cts ctcs-to-ots
	  getsndescr processcontextdescr
	  getcontext nodeaccess update-contexts buildcontext
	  mark-inconsistent updateall newjust context-names
	  ))
Because: Need 'restriction' and 'named' in SNEPSUL package (for full-describe)
Change:
(shadowing-import '(|#| ^ ^^ |=| |*| % |!| $ ? |&| + - |>| _ assert build  describe
			full-describe dump surface erase silent-erase resetnet
			find findassert findconstant findpattern findbase findvariable
			list-nodes list-hypotheses describe-context set-context define undefine
			add-to-context remove-from-context list-context-names set-default-context
			define-path undefine-path fwd-infer exit stack sneps demo outnet innet intext
			lispeval lisp clear-infer nodes assertions relations)
	(find-package 'snepsul))
To:
(shadowing-import '(|#| ^ ^^ |=| |*| % |!| $ ? |&| + - |>| _ assert build  describe
			full-describe dump surface erase silent-erase resetnet
			find findassert findconstant findpattern findbase findvariable
			list-nodes list-hypotheses describe-context set-context define undefine
			add-to-context remove-from-context list-context-names set-default-context
			define-path undefine-path fwd-infer exit stack sneps demo outnet innet intext
			lispeval lisp clear-infer nodes assertions relations
			hyp der ext assertion restriction named)
	(find-package 'snepsul))
Because: see above (full-describe, i.e., descrcontext)

File: sneps21.sneps.ds; context2.lisp
Function: descrcontext 
Change: 
(defmacro descrcontext (ct)
  "Lists the description of the <context> `ct'"
  `(list
     (list 'assertions
	   (mapcar #'(lambda (hyp)
		       (format nil "~a" hyp nil))
		   (context-hyps ,ct)))
     (list 'restriction 
	   (mapcar #'(lambda (c)
		       (mapcar #'(lambda (hyp)
				   (format nil "~a" hyp))
			       (context-hyps c)))
		   (context-restriction ,ct)))
     (list 'named (context-names ,ct))))
To:
(defmacro descrcontext (ct)
  "Lists the description of the <context> `ct'"
  `(list
     (list 'assertions
	   (mapcar #'(lambda (hyp)
		       (snip:slight-describe-or-surface hyp nil))
		   (context-hyps ,ct)))
     (list 'restriction 
	   (mapcar #'(lambda (c)
		       (mapcar #'(lambda (hyp)
				   (snip:slight-describe-or-surface hyp nil))
			       (context-hyps c)))
		   (context-restriction ,ct)))
     (list 'named (context-names ,ct))))
Because: I.e., change it back (see change-log farther up). Changed snip:slight-describe-or-surface 
         so it won't return t anymore when *infertrace* is nil.

File: sneps21.sneps.fns; dd.lisp
Function: pp-nodetree
Change: (write nodetree :pretty t)
To: (write nodetree :pretty t :escape nil)
Because: so 'surfaced' strings will be printed as normal symbols (e.g., in full-describe).

======================  End OF SNePS-2.1 CHANGE SET #6  ===============


10/1/90 SNEPS-2.1 CHANGE SET #7 (Nuno)

File: sneps21.snip.fns; and-ent.lisp
Function: rule-handler.&-ent 
Change:
        (unless-remarkedp.rui
	  rui (remark '"~%Since" (makeone.ns *NODE*) restr))
	(do.ns (ant ants)
	  (remark '"and" (makeone.ns ant) restr))
	(unless-remarkedp.rui
	  rui (remark '"I infer" (makeone.ns (destination.ch ch)) restr))
To:
        (unless-remarkedp.rui
	  rui (remark '"~%Since" (makeone.ns *NODE*) restr)
	  (do.ns (ant ants)
	    (remark '"and" (makeone.ns ant) restr))
	  rui (remark '"I infer" (makeone.ns (destination.ch ch)) restr))
Because: Because of first remark and semantics of unless-remarkedp.rui
         it never said "I infer".

File: sneps21.snip.fns; support.lisp
Remove: all ";                     ESTA FUNCAO E PARA SAIR DAQUI !!!!!!!!!!!!!!!!!!!!!!"
        comments, i.e., "This function belongs somewhere else"
Because: Nuno doesn't want to see it anymore

======================  End OF SNePS-2.1 CHANGE SET #7  ===============

10/16/90 SNEPS-2.1 CHANGE SET #8 (Hans)

Lusardi's new Englex:
---------------------

The complete change-log is in 
    sybil: /u6/rstaff/snerg/src/Sneps21/LusardiEnglex/log-of-changes
File: sneps21.nlint.englex; englex.lisp
Change: whole englex.lisp file
To: New LUSARDI Englex
Because: Should do lots of interesting new things.


======================  End OF SNePS-2.1 CHANGE SET #8  ===============