(FILECREATED " 8-Feb-86 16:10:44" {DSK}<LISPFILES2>IMPROVEDDCOMS>APROPOS.;1 2088
changes to: (VARS APROPOSCOMS))
(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)
(PRETTYCOMPRINT APROPOSCOMS)
(RPAQQ APROPOSCOMS ((FNS QP.APROPOS QP.BACKTRACE QP.PREDICATES QP.WHERE)))
(DEFINEQ
(QP.APROPOS
(LAMBDA (NAME ARITY MODULE) (PROG (FLG HI LO) (if (AND NAME (NOT (LISTP NAME))) then (SETQ NAME (
MKSTRING NAME))) (if (AND MODULE (NOT (LISTP MODULE))) then (SETQ MODULE (MKSTRING MODULE))) (if (
LISTP ARITY) then (SETQ LO (CAR ARITY)) (SETQ HI (CDR ARITY)) elseif (SMALLP ARITY) then (SETQ LO (
SETQ HI ARITY)) else (SETQ LO 0) (SETQ HI 255)) (FOR X ← QP.FIRST.PREDICATE BY (\GETBASEPTR X 0) UNTIL
(ZEROP X) DO (PROGN (PRINT X) (SETQ FLG T)) WHEN (AND (GEQ (PROC.ARITY X) LO) (LEQ (PROC.ARITY X) HI)
(OR (NULL NAME) (AND (LISTP NAME) (MEMB (PROC.NAME X) NAME)) (STRPOS NAME (PROC.NAME X))) (OR (NULL
MODULE) (AND (LISTP MODULE) (MEMB (PROC.MODULE X) MODULE)) (STRPOS MODULE (PROC.MODULE X))))) (RETURN
FLG))))
(QP.BACKTRACE
(LAMBDA NIL (LET ((LIMIT (\ADDBASE QP.init.E 20))) (PRINT (QP.WHERE (get.24 P))) (PRINT (QP.WHERE (
get.24 CP))) (FOR E FROM (get.24 E) BY (\GETBASE E 0) WHILE (\BASELESSP LIMIT E) DO (PRINT (QP.WHERE (
\GETBASE E 2)))))))
(QP.PREDICATES
(LAMBDA NIL (FOR X ← QP.FIRST.PREDICATE BY (\GETBASEPTR X 0) UNTIL (ZEROP X) COLLECT X)))
(QP.WHERE
(LAMBDA (P) (PROG (X C K Q M N) (if (NULL P) then (SETQ P (get.24 P))) (SETQ X QP.FIRST.PREDICATE) (
SETQ M NIL) (until (ZEROP X) (SETQ C (PROC.CLAUSES X)) (if (AND (NOT (FIXP C)) (NEQ (\GETBASEBYTE C 0)
(QP.OP.CODE (QUOTE trap)))) then (SETQ K 0) (do (PROGN (SETQ K (ADD1 K)) (if (TYPENAMEP C (QUOTE
INDEX.BLOCK)) then (SETQ C (fetch (INDEX.BLOCK FIRST) of C))) (if (AND (\BASELESSP C P) (\BASELESSP M
C)) then (SETQ M C) (SETQ Q X) (SETQ N K)) (SETQ C (\GETBASEPTR C 0))) repeatuntil (EQ C
QP.FAILURE.CLAUSE))) (SETQ X (\GETBASEPTR X 0))) (RETURN (CONS N Q)))))
)
(PUTPROPS APROPOS COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (320 1998 (QP.APROPOS 330 . 1061) (QP.BACKTRACE 1063 . 1303) (QP.PREDICATES 1305 . 1413)
(QP.WHERE 1415 . 1996)))))
STOP