(FILECREATED "17-Mar-86 14:38:13" {PHYLUM}<VANMELLE>LISP>COMPARESOURCES.;10 24091
changes to: (FNS \CS.COMPARE.MASTERS COMPARESOURCES)
previous date: "13-Mar-86 17:17:44" {PHYLUM}<VANMELLE>LISP>COMPARESOURCES.;9)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT COMPARESOURCESCOMS)
(RPAQQ COMPARESOURCESCOMS
((FNS COMPARESOURCES \CS.COMPARE.MASTERS \CS.COMPARE.TYPES \CS.SORT.DECLARES \CS.SORT.DECLARE1
\CS.FILTER.GARBAGE EQLDIFFERENCE)
(FNS \CS.ISVARFORM \CS.COMPARE.VARS \CS.ISMACROFORM \CS.ISRECFORM \CS.ISCOURIERFORM
\CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES \CS.ISPROPFORM \CS.PROP.NAME \CS.COMPARE.PROPS
\CS.ISADDVARFORM \CS.COMPARE.ADDVARS \CS.ISFPKGCOMFORM \CS.COMPARE.FPKGCOMS)
(VARS COMPARESOURCETYPES DEFAULT.DECLARE.TAGS)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS CSTYPE)
(GLOBALVARS COMPARESOURCETYPES CLISPRECORDTYPES MACROPROPS NOSPELLFLG
DEFAULT.DECLARE.TAGS))))
(DEFINEQ
(COMPARESOURCES
[LAMBDA (FILEX FILEY EXAMINE DW?) (* bvm:
"17-Mar-86 14:38")
(DECLARE (SPECVARS FILEX FILEY EXAMINE DIFFERENCES))
(PROG (DIFFERENCES BODYX BODYY DECLAREX DECLAREY)
[SETQ FILEX (OR (FINDFILE FILEX T)
(RETURN (printout T FILEX " not found" T]
[SETQ FILEY (OR (FINDFILE FILEY T)
(RETURN (printout T FILEY " not found" T]
(SETQ BODYX (\CS.FILTER.GARBAGE (READFILE FILEX)))
(SETQ BODYY (\CS.FILTER.GARBAGE (READFILE FILEY)))
(printout T "Comparing " FILEX " and " FILEY ":" T T)
[SETQ DECLAREX (for EXPR in BODYX collect EXPR when (EQ (CAR EXPR)
(QUOTE DECLARE:]
(SETQ BODYX (EQLDIFFERENCE BODYX DECLAREX))
[SETQ DECLAREY (for EXPR in BODYY collect EXPR when (EQ (CAR EXPR)
(QUOTE DECLARE:]
(SETQ BODYY (EQLDIFFERENCE BODYY DECLAREY))
(\CS.COMPARE.MASTERS BODYX BODYY DW?)
(* * Done with the non-DECLARE: expressions.
Now sort what's left according to when it is eval'ed so that we can
hopefully further reduce the amount of stuff to compare)
(SETQ BODYX (\CS.SORT.DECLARES DECLAREX))
(SETQ BODYY (\CS.SORT.DECLARES DECLAREY))
[SETQ BODYX (APPEND BODYX (for Y in BODYY collect (LIST (CAR Y))
unless (SASSOC (CAR Y)
BODYX] (* Add placeholders for
any declaration types in
Y not in X to simplify
what follows)
[for X in BODYX bind Y TYPE do (SETQ Y (SASSOC (CAR X)
BODYY))
(SETQ TYPE (CAR X))
[SETQ X (LDIFFERENCE (CDR X)
(PROG1 (CDR Y)
(SETQ Y (LDIFFERENCE (CDR Y)
X]
(COND
((OR X Y)
(printout T T "------" [CONS (QUOTE DECLARE:)
(APPEND (EQLDIFFERENCE
TYPE
DEFAULT.DECLARE.TAGS
)
(QUOTE (--]
" forms------" T) (* REVERSE because
\CS.SORT.DECLARES
delivered expressions in
reverse order)
(\CS.COMPARE.MASTERS (REVERSE X)
(REVERSE Y)
DW?]
(TERPRI T)
(RETURN (REVERSE DIFFERENCES])
(\CS.COMPARE.MASTERS
[LAMBDA (BODYX BODYY DW?) (* bvm:
"17-Mar-86 14:32")
(LET (FNSX FNSY YTHING XTHING PRED DIFS Y TMP)
(DECLARE (USEDFREE DIFFERENCES))
[SETQ FNSX (for EXPR in BODYX collect EXPR when (EQ (CAR EXPR)
(QUOTE DEFINEQ]
(SETQ BODYX (EQLDIFFERENCE BODYX FNSX))
(SETQ FNSX (for BOD in FNSX join (CDR BOD)))
[SETQ FNSY (for EXPR in BODYY collect EXPR when (EQ (CAR EXPR)
(QUOTE DEFINEQ]
(SETQ BODYY (EQLDIFFERENCE BODYY FNSY))
(SETQ FNSY (for BOD in FNSY join (CDR BOD)))
[COND
((OR FNSX FNSY)
(printout T "---Functions: " T)
[COND
(DW? (RESETVARS ((NOSPELLFLG T))
(for X in FNSX when (SETQ Y (ASSOC (CAR X)
FNSY))
do (* Only bother
dwimifying the ones that
look different)
(DWIMIFY (CADR X)
T)
(DWIMIFY (CADR Y)
T]
(COND
((SETQ DIFS (\CS.COMPARE.TYPES FNSX FNSY NIL [FUNCTION (LAMBDA (X Y)
(COMPARELISTS (CADR X)
(CADR Y]
(FUNCTION CAR)))
(push DIFFERENCES (CONS (QUOTE FNS)
DIFS]
[for TYPE in COMPARESOURCETYPES
do (SETQ PRED (fetch (CSTYPE PREDFN) of TYPE))
(SETQ XTHING (for X in BODYX collect X when (SPREADAPPLY* PRED X)))
(SETQ YTHING (for X in BODYY collect X when (SPREADAPPLY* PRED X)))
(SETQ BODYX (EQLDIFFERENCE BODYX XTHING))
(SETQ BODYY (EQLDIFFERENCE BODYY YTHING))
(COND
([SETQ DIFS (\CS.COMPARE.TYPES XTHING YTHING
(OR (fetch (CSTYPE TITLE) of TYPE)
(L-CASE (MKSTRING (fetch (CSTYPE FPKGTYPE) of TYPE))
T))
(fetch (CSTYPE COMPAREFN) of TYPE)
(OR (fetch (CSTYPE IDFN) of TYPE)
(FUNCTION CADR]
(SETQ TYPE (fetch (CSTYPE FPKGTYPE) of TYPE))
(COND
((SETQ TMP (ASSOC TYPE DIFFERENCES))
(NCONC TMP DIFS))
(T (push DIFFERENCES (CONS TYPE DIFS]
[SETQ BODYY (LDIFFERENCE BODYY (PROG1 BODYX (SETQ BODYX (LDIFFERENCE BODYX BODYY]
(COND
((OR BODYX BODYY)
(printout T T "---Expressions:" T)
(LET ((COMMENTX 0)
(COMMENTY 0)
EXTRAS) (* Remove comments)
[SETQ BODYX (for X in BODYX collect X unless (COND
((EQ (CAR X)
COMMENTFLG)
(add COMMENTX 1)
T]
[SETQ BODYY (for Y in BODYY collect Y unless (COND
((EQ (CAR Y)
COMMENTFLG)
(add COMMENTY 1)
T]
(COND
((OR (NEQ COMMENTX 0)
(NEQ COMMENTY 0))
(printout T .I1 COMMENTX " comments -> " .I1 COMMENTY " comments." T T)))
[COND
((SETQ EXTRAS (COND
(BODYX (COND
(BODYY (COMPARELISTS BODYX BODYY)
NIL)
(T (printout T "These are not on " FILEY)
BODYX)))
(BODYY (printout T "These are not on " FILEX)
BODYY)))
(printout T ":" T)
(for X in EXTRAS do (LVLPRINT X T 2 3]
[COND
((AND (OR BODYX BODYY)
(OR (EQ EXAMINE T)
(EQMEMB (QUOTE MISC)
EXAMINE)))
(EDITE (LIST BODYX BODYY]
(OR (ASSOC (QUOTE Other)
DIFFERENCES)
(push DIFFERENCES (LIST (QUOTE Other)
(QUOTE --])
(\CS.COMPARE.TYPES
[LAMBDA (XTHING YTHING TITLE COMPAREFN IDFN)
(DECLARE (USEDFREE FILEX FILEY EXAMINE)) (* bvm:
"13-Mar-86 17:03")
(COND
((AND (OR XTHING YTHING)
(PROGN [SETQ XTHING (LDIFFERENCE XTHING (PROG1 YTHING (SETQ YTHING (LDIFFERENCE YTHING
XTHING]
(OR XTHING YTHING)))
(LET (X Y RESULT NAME)
(AND TITLE (printout T T "---" TITLE ":" T T))
(for TAIL on XTHING do [SETQ NAME (SPREADAPPLY* IDFN (SETQ X (CAR TAIL]
[COND
[[NOT (SETQ Y (find Y in YTHING
suchthat (EQUAL (SPREADAPPLY* IDFN Y)
NAME]
(printout T NAME " is not on " FILEY T)
(COND
((OR (EQ EXAMINE T)
(EQMEMB (QUOTE NEW)
EXAMINE))
(EDITE X]
(T (printout T NAME ": " T)
(COND
(COMPAREFN (SPREADAPPLY* COMPAREFN X Y))
(T (COMPARELISTS X Y)))
(TERPRI T)
[COND
((OR (EQ EXAMINE T)
(EQMEMB (QUOTE OLD)
EXAMINE))
(EDITE (LIST X Y]
(RPLACA (FMEMB Y YTHING]
(RPLACA TAIL)
(push RESULT NAME))
(for Y in (LDIFFERENCE YTHING XTHING) do (printout T (SETQ NAME (SPREADAPPLY* IDFN Y))
" is not on " FILEX T)
(COND
((OR (EQ EXAMINE T)
(EQMEMB (QUOTE NEW)
EXAMINE))
(EDITE Y)))
(push RESULT NAME))
RESULT])
(\CS.SORT.DECLARES
[LAMBDA (DECLS) (* bvm: "15-Nov-85 18:58")
(* * Sorts DECLS, a list of (DECLARE: --) expressions, into a set of declarations by tag, returning a list of
entries of the form (tags . expressions))
(LET (RESULT)
(DECLARE (SPECVARS RESULT))
(for DEC in DECLS do (\CS.SORT.DECLARE1 DEC DEFAULT.DECLARE.TAGS))
RESULT])
(\CS.SORT.DECLARE1
[LAMBDA (DEC TAGLST) (* bvm: "15-Nov-85 19:09")
(DECLARE (USEDFREE RESULT))
(* * Process one DECLARE: expression, partitioning it into subdeclarations put on RESULT assuming that the default
tags in effect by the time you get here are in TAGLST)
(for TAIL on (CDR DEC) bind CURRENT TAG COMPLEMENT
do (COND
[(NLISTP (SETQ TAG (CAR TAIL))) (* Canonicalize tag)
(SELECTQ TAG
(DOEVAL@LOAD (SETQQ TAG EVAL@LOAD))
(DOEVAL@COMPILE (SETQQ TAG EVAL@COMPILE))
(DOCOPY (SETQQ TAG COPY))
NIL)
(COND
((NOT (MEMB TAG TAGLST))
[SETQ TAGLST (COND
[(STRPOS (QUOTE WHEN)
TAG) (* These take an extra expression)
(APPEND TAGLST (LIST TAG (CAR (SETQ TAIL (CDR TAIL]
((FMEMB (SETQ COMPLEMENT (SELECTQ TAG
(COPY (QUOTE DONTCOPY))
(DONTCOPY (QUOTE COPY))
(EVAL@COMPILE (QUOTE
DONTEVAL@COMPILE))
(DONTEVAL@COMPILE (QUOTE
EVAL@COMPILE))
(EVAL@LOAD (QUOTE DONTEVAL@LOAD))
(DONTEVAL@LOAD (QUOTE EVAL@LOAD))
(FIRST (QUOTE NOTFIRST))
(NOTFIRST (QUOTE FIRST))
NIL))
TAGLST)
(SUBST TAG COMPLEMENT TAGLST))
(T (APPEND TAGLST (LIST TAG]
(SETQ CURRENT NIL]
((EQ (CAR TAG)
(QUOTE DECLARE:)) (* Process embedded declaration)
(\CS.SORT.DECLARE1 TAG TAGLST))
(T (* Stick this expression on the entry for the tags
that tell when to eval it)
[COND
([AND (NOT CURRENT)
(NOT (SETQ CURRENT (SASSOC TAGLST RESULT]
(SETQ RESULT (NCONC1 RESULT (SETQ CURRENT (LIST TAGLST]
(push (CDR CURRENT)
TAG])
(\CS.FILTER.GARBAGE
[LAMBDA (FILECONTENTS) (* bvm: " 7-Nov-85 17:02")
(for X in FILECONTENTS collect X unless (OR (EQ (CAR X)
(QUOTE FILECREATED))
(AND (EQ (CAR X)
(QUOTE DECLARE:))
(EQ (CADR X)
(QUOTE DONTCOPY))
(LISTP (CADDR X))
(OR (FMEMB (QUOTE COPYRIGHT)
(CADDR X))
(FMEMB (QUOTE FILEMAP)
(CADDR X])
(EQLDIFFERENCE
[LAMBDA (X Y) (* bvm:
"13-Mar-86 17:05")
(* * Collect members of X not on Y. Like LDIFFERENCE but uses EQ test)
(for E in X collect E unless (MEMB E Y])
)
(DEFINEQ
(\CS.ISVARFORM
[LAMBDA (X) (* bvm: "25-Sep-85 12:05")
(SELECTQ (CAR X)
((RPAQ RPAQQ RPAQ?)
T)
NIL])
(\CS.COMPARE.VARS
[LAMBDA (X Y) (* bvm:
"13-Mar-86 15:56")
(* * Compares two variable setting forms)
(COND
((EQ (CAR X)
(CAR Y)) (* Same type of setting
fn)
(COMPARELISTS (CADDR X)
(CADDR Y)))
(T (LET [[XVAL (COND
((EQ (CAR X)
(QUOTE RPAQQ))
(KWOTE (CADDR X)))
(T (CADDR X]
(YVAL (COND
((EQ (CAR Y)
(QUOTE RPAQQ))
(KWOTE (CADDR Y)))
(T (CADDR Y]
(COND
((EQUAL XVAL YVAL) (* Same value, different
setter)
(printout T (COND
((EQ (CAR X)
(QUOTE RPAQ?))
(QUOTE INITVARS))
(T (QUOTE VARS)))
" -> "
(COND
((EQ (CAR Y)
(QUOTE RPAQ?))
(QUOTE INITVARS))
(T (QUOTE VARS)))
T))
(T (COMPARELISTS XVAL YVAL])
(\CS.ISMACROFORM
[LAMBDA (X) (* bvm: "25-Sep-85 12:19")
(SELECTQ (CAR X)
(DEFMACRO T)
(PUTPROPS (FMEMB (CADDR X)
MACROPROPS))
NIL])
(\CS.ISRECFORM
[LAMBDA (X) (* bvm: "25-Sep-85 12:20")
(FMEMB (CAR X)
CLISPRECORDTYPES])
(\CS.ISCOURIERFORM
[LAMBDA (X) (* bvm:
"13-Mar-86 16:21")
(EQ (CAR X)
(QUOTE COURIERPROGRAM])
(\CS.ISTEMPLATEFORM
[LAMBDA (X) (* bvm:
"13-Mar-86 16:20")
(EQ (CAR X)
(QUOTE SETTEMPLATE])
(\CS.COMPARE.TEMPLATES
[LAMBDA (X Y) (* bvm:
"13-Mar-86 16:23")
(* * Templates usually look like (SETTEMPLATE
(QUOTE FN) (QUOTE TEMPLATE)))
(COND
[(AND (EQUAL (CADR X)
(CADR Y))
(EQ (CAR (CADDR X))
(QUOTE QUOTE))
(EQ (CAR (CADDR Y))
(QUOTE QUOTE)))
(COMPARELISTS (CADR (CADDR X))
(CADR (CADDR Y]
(T (COMPARELISTS X Y])
(\CS.ISPROPFORM
[LAMBDA (X) (* bvm:
"13-Mar-86 16:34")
(* * (PUTPROPS SYMBOL PROP VALUE))
(AND (EQ (CAR X)
(QUOTE PUTPROPS))
(NULL (CDDDDR X])
(\CS.PROP.NAME
[LAMBDA (X) (* bvm:
"13-Mar-86 16:29")
(* * The "Name" of a property is its atom/value pair)
(LIST (CADR X)
(CADDR X])
(\CS.COMPARE.PROPS
[LAMBDA (X Y) (* bvm:
"13-Mar-86 16:29")
(* * Compare the values)
(COMPARELISTS (CADDDR X)
(CADDDR Y])
(\CS.ISADDVARFORM
[LAMBDA (X) (* bvm:
"13-Mar-86 16:40")
(EQ (CAR X)
(QUOTE ADDTOVAR])
(\CS.COMPARE.ADDVARS
[LAMBDA (X Y) (* bvm:
"13-Mar-86 16:41")
(* * (ADDTOVAR ListName . values))
(COMPARELISTS (CDDR X)
(CDDR Y])
(\CS.ISFPKGCOMFORM
[LAMBDA (X) (* bvm:
"13-Mar-86 16:50")
(* * (PUTDEF (QUOTE name) (QUOTE FILEPKGCOMS)
(QUOTE stuff)))
(AND (EQ (CAR X)
(QUOTE PUTDEF))
(EQUAL (CADDR X)
(QUOTE (QUOTE FILEPKGCOMS])
(\CS.COMPARE.FPKGCOMS
[LAMBDA (X Y) (* bvm:
"13-Mar-86 16:46")
(* * (PUTDEF (QUOTE name) (QUOTE FILEPKGCOMS)
(QUOTE stuff)))
(COMPARELISTS (CADR (CADDDR X))
(CADR (CADDDR Y])
)
(RPAQQ COMPARESOURCETYPES ((VARS \CS.ISVARFORM \CS.COMPARE.VARS)
(MACROS \CS.ISMACROFORM)
(RECORDS \CS.ISRECFORM)
(PROPS \CS.ISPROPFORM \CS.COMPARE.PROPS \CS.PROP.NAME "Properties")
(ADDVARS \CS.ISADDVARFORM \CS.COMPARE.ADDVARS CADR "Additions to lists")
(TEMPLATES \CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES CADADR)
(COURIERPROGRAMS \CS.ISCOURIERFORM)
(FILEPKGCOMS \CS.ISFPKGCOMFORM \CS.COMPARE.FPKGCOMS CADADR)))
(RPAQQ DEFAULT.DECLARE.TAGS (EVAL@LOAD DONTEVAL@COMPILE COPY NOTFIRST))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD CSTYPE (FPKGTYPE PREDFN COMPAREFN IDFN TITLE))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS COMPARESOURCETYPES CLISPRECORDTYPES MACROPROPS NOSPELLFLG DEFAULT.DECLARE.TAGS)
)
)
(PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1059 17223 (COMPARESOURCES 1069 . 5033) (\CS.COMPARE.MASTERS 5035 . 10903) (
\CS.COMPARE.TYPES 10905 . 13776) (\CS.SORT.DECLARES 13778 . 14238) (\CS.SORT.DECLARE1 14240 . 16294) (
\CS.FILTER.GARBAGE 16296 . 16855) (EQLDIFFERENCE 16857 . 17221)) (17224 23066 (\CS.ISVARFORM 17234 .
17426) (\CS.COMPARE.VARS 17428 . 19141) (\CS.ISMACROFORM 19143 . 19386) (\CS.ISRECFORM 19388 . 19548)
(\CS.ISCOURIERFORM 19550 . 19804) (\CS.ISTEMPLATEFORM 19806 . 20058) (\CS.COMPARE.TEMPLATES 20060 .
20688) (\CS.ISPROPFORM 20690 . 21037) (\CS.PROP.NAME 21039 . 21365) (\CS.COMPARE.PROPS 21367 . 21680)
(\CS.ISADDVARFORM 21682 . 21929) (\CS.COMPARE.ADDVARS 21931 . 22252) (\CS.ISFPKGCOMFORM 22254 . 22684)
(\CS.COMPARE.FPKGCOMS 22686 . 23064)))))
STOP