(FILECREATED " 8-Feb-86 15:22:20" {DSK}<LISPFILES2>IMPROVEDDCOMS>FINDARITY.;1
 4568   

      changes to:  (VARS FINDARITYCOMS))


(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)

(PRETTYCOMPRINT FINDARITYCOMS)

(RPAQQ FINDARITYCOMS
 ((VARS (QP.MAX.STRING.LENGTH 250)) (ADDVARS (GLOBALVARS QP.MAX.STRING.LENGTH)) 
(FNS QP.END.OF.LINE QP.FIND.ARITY QP.FIND.ARITY.AUX QP.MOVE.OVER.STRING QP.TEDIT.ERROR.MESSAGE) (
MACROS QP.SKIP.OVER.CHAR.STRING)))

(RPAQQ QP.MAX.STRING.LENGTH
 250)

(ADDTOVAR GLOBALVARS
 QP.MAX.STRING.LENGTH)
(DEFINEQ

(QP.END.OF.LINE

(LAMBDA (STREAM) (UNTIL (OR (EOFP STREAM) (EQ (\BIN STREAM) 13)) DO T)))

(QP.FIND.ARITY

(LAMBDA (STREAM NAME) (LET ((ORI.POSITION (ADD1 (\TEXTGETFILEPTR STREAM))) (TEXT (TEXTOBJ STREAM)) (
FLAG (QP.MOVE.OVER.STRING STREAM NAME))) (if FLAG then (QP.TEDIT.ERROR.MESSAGE (LIST FLAG STREAM)) (
\SETUPGETCH ORI.POSITION TEXT) NIL else (QP.FIND.ARITY.AUX STREAM TEXT ORI.POSITION)))))

(QP.FIND.ARITY.AUX

(LAMBDA (STREAM TEXT ORI.POSITION) (LET ((COUNT 0) (PAREN.LEVEL 0) (ERR NIL) (ARITY.COUNTER 0) (STOP 
NIL) (CHAR.COUNT 0) (TMP.COUNT 0) (STOP.COUNT QP.MAX.STRING.LENGTH) (PREV.CHAR 0) (STOP.CHAR 0) CHAR) 
(WHILE (AND (ILESSP CHAR.COUNT STOP.COUNT) (NULL STOP) (NOT (EOFP STREAM))) DO (SETQ CHAR (\BIN STREAM
)) (SETQ CHAR.COUNT (ADD1 CHAR.COUNT)) (SELCHARQ CHAR (%. (SETQ STOP T)) ((%( %[ {) (SETQ PAREN.LEVEL 
(ADD1 PAREN.LEVEL))) ((%) %] }) (SETQ PAREN.LEVEL (SUB1 PAREN.LEVEL)) (if (EQ PAREN.LEVEL 0) then (
SETQ ARITY.COUNTER (ADD1 ARITY.COUNTER)))) (, (if (EQ PAREN.LEVEL 1) then (SETQ ARITY.COUNTER (ADD1 
ARITY.COUNTER)))) (: (if (EQ PAREN.LEVEL 0) then (if (EQ (\BIN STREAM) (CHARCODE -)) then (SETQ STOP T
) else (\BACKBIN STREAM)))) (%" (QP.SKIP.OVER.CHAR.STRING CHAR STREAM STOP.COUNT)) (' (if (AND (IGEQ 
PREV.CHAR (CHARCODE 0)) (ILEQ PREV.CHAR (CHARCODE 9))) then NIL else (QP.SKIP.OVER.CHAR.STRING CHAR 
STREAM STOP.COUNT))) (* (if (EQ PREV.CHAR (CHARCODE /)) then (SETQ CHAR (\BIN STREAM)) (SETQ TMP.COUNT
 0) (WHILE (AND (NOT (AND (EQ CHAR (CHARCODE /)) (EQ PREV.CHAR (CHARCODE *)))) (NOT (EOFP STREAM)) (
ILESSP TMP.COUNT STOP.COUNT)) (SETQ PREV.CHAR CHAR) (SETQ CHAR (\BIN STREAM)) (SETQ TMP.COUNT (ADD1 
TMP.COUNT))) (if (OR (EQ TMP.COUNT STOP.COUNT) (EOFP STREAM)) then (SETQ ERR (LIST 4 (SUB1 STOP.COUNT)
 STREAM)) (SETQ ARITY.COUNTER NIL) (SETQ STOP T)))) (%% (QP.END.OF.LINE STREAM)) (- (if (EQ 
PAREN.LEVEL 0) then (if (AND (NOT (EOFP STREAM)) (EQ (\BIN STREAM) (CHARCODE -))) then (if (AND (NOT (
EOFP STREAM)) (EQ (\BIN STREAM) (CHARCODE >))) then (SETQ ARITY.COUNTER (IPLUS ARITY.COUNTER 2)) (SETQ
 STOP T) else (\BACKBIN STREAM)) else (\BACKBIN STREAM)))) NIL) (SETQ PREV.CHAR CHAR)) (\SETUPGETCH 
ORI.POSITION TEXT) (if ERR then (QP.TEDIT.ERROR.MESSAGE ERR)) ARITY.COUNTER)))

(QP.MOVE.OVER.STRING

(LAMBDA (STREAM NAME) (LET ((ORI.POSITION (ADD1 (\TEXTGETFILEPTR STREAM))) (TEXT (TEXTOBJ STREAM)) (
COUNT 0) (ERROR NIL) (CHAR NIL)) (repeatwhile (AND (ILESSP COUNT (NCHARS NAME)) (NOT ERROR)) do (if (
NOT (EOFP STREAM)) then (SETQ CHAR (\BIN STREAM)) (SETQ COUNT (ADD1 COUNT)) else (\SETUPGETCH 
ORI.POSITION TEXT) (SETQ ERROR 1)) (if (NEQ CHAR (NTHCHARCODE NAME COUNT)) then (\SETUPGETCH 
ORI.POSITION TEXT) (SETQ ERROR 2))) ERROR)))

(QP.TEDIT.ERROR.MESSAGE

(LAMBDA (INPUT) (SELECTQ (CAR INPUT) (1 (TEDIT.PROMPTPRINT (CADR INPUT) 
"End of file encountered while looking for predicate name" T)) (2 (TEDIT.PROMPTPRINT (CADR INPUT) 
"This line does not start with the proper predicate" T)) (3 (TEDIT.PROMPTPRINT (CADDR INPUT) 
"String longer than " (CADR INPUT) " characters encountered." "Check for closing quotes" T)) (4 (
TEDIT.PROMPTPRINT (CADDR INPUT) "Comment longer than " (CADR INPUT) " characters encountered." 
"Check for closing */" T)) NIL)))
)
(DECLARE: EVAL@COMPILE 
(PUTPROPS QP.SKIP.OVER.CHAR.STRING MACRO (**MACROARG** (LET ((CHAR1 (CAR (NTH **MACROARG** 1))) (
STREAM (CAR (NTH **MACROARG** 2))) (STOP.COUNT (CAR (NTH **MACROARG** 3)))) (BQUOTE (PROGN (SETQ 
STOP.CHAR (\, CHAR1)) (SETQ PREV.CHAR (\, CHAR1)) (SETQ CHAR (\BIN (\, STREAM))) (SETQ TMP.COUNT 0) (
WHILE (AND (NEQ CHAR STOP.CHAR) (ILESSP TMP.COUNT (\, STOP.COUNT)) (NOT (EOFP (\, STREAM)))) DO (SETQ 
PREV.CHAR CHAR) (SETQ CHAR (\BIN (\, STREAM))) (SETQ TMP.COUNT (ADD1 TMP.COUNT))) (if (OR (EQ 
TMP.COUNT (\, STOP.COUNT)) (EOFP (\, STREAM))) then (SETQ ERR (LIST 3 (SUB1 (\, STOP.COUNT)) (\, 
STREAM))) (SETQ ARITY.COUNTER NIL) (SETQ STOP T)))))))
)
(PUTPROPS FINDARITY COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (571 3801 (QP.END.OF.LINE 581 . 673) (QP.FIND.ARITY 675 . 984) (QP.FIND.ARITY.AUX 986 . 
2813) (QP.MOVE.OVER.STRING 2815 . 3276) (QP.TEDIT.ERROR.MESSAGE 3278 . 3799)))))
STOP