github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-27 01:19:42 +00:00
Code Issues Projects Releases Wiki Activity

phase 0 of GATHER-INFO is setup for rest

Browse Source
This commit is contained in:
Larry Masinter
2022-01-12 15:06:10 -08:00
parent fadf81012b
commit 5445a12b7e
2 changed files with 49 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

105
internal/library/MEDLEY-UTILS
View File

@@ -1,43 +1,41 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "25-Oct-2021 14:54:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;14| 9472
(FILECREATED "26-Dec-2021 18:58:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;2| 9049
|changes| |to:| (VARS MEDLEY-UTILSCOMS)
(FNS GATHER-INFO)
:CHANGES-TO (FNS GATHER-INFO)
|previous| |date:| "23-Oct-2021 14:53:16"
|{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;2|)
:PREVIOUS-DATE "25-Oct-2021 14:54:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;1|
)
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
(RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
(VARS MEDLEY-FIX-DIRS)
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
(VARS MEDLEY-FIX-DIRS)
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
(DEFINEQ
(GATHER-INFO
(LAMBDA (PHASE) (* \;
 "Edited 24-Oct-2021 09:43 by larry")
 "Edited 26-Dec-2021 18:56 by larry")
(* \;
 "Edited 24-Oct-2021 09:43 by larry")
(SELECTQ PHASE
(ALL (SETQ SYSFILES (UNION SYSFILES FILELST))
(SETQ FILELST NIL)
(FILESLOAD (SOURCE)
SYSEDIT)
(|for| I |from| 1 |to| 4 |do| (GATHER-INFO I)))
(1 (SETQ LOADEDFILES (|for| X |in| LOADEDFILELST |collect| (FILENAMEFIELD
X
'NAME)))
(ALL (|for| I |from| 0 |to| 4 |do| (GATHER-INFO I)))
(0 (SETQ SYSFILES (UNION SYSFILES FILELST))
(SETQ FILELST NIL)
(FILESLOAD (SOURCE)
SYSEDIT))
(1 (SETQ LOADEDFILES (|for| X |in| LOADEDFILELST |collect| (FILENAMEFIELD X 'NAME)))
(FILESLOAD FILESETS)
(SETQ ALLFILESETSFILES (|for| X |in| FILESETS |join| (APPEND (EVAL X))))
(SETQ SOURCES (|for| X |in| (DIRECTORY (MEDLEYDIR "sources" "*.*;" T))
|when| (NOT (MEMB (FILENAMEFIELD X 'EXTENSION)
'(LCOM DFASL TEDIT TXT)))
'(LCOM DFASL TEDIT TXT)))
|collect| (FILENAMEFIELD X 'NAME))))
(-1 (PRINTOUT T " loaded files not in SYSFILES or FILELST: "
(|for| X |in| LOADEDFILES |when| (NOT (OR (FMEMB X SYSFILES)
(FMEMB X FILELST)))
|collect| X)
(FMEMB X FILELST))) |collect| X)
T)
(PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND ALLFILESETSFILES
LOADEDFILES))
@@ -52,50 +50,45 @@
DEFD))
(|for| X |in| DEFINEDFNS |when| (CCODEP X)
|do| (LET ((Y (PUTPROP X 'CCC (CALLSCCODE X))))
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY)
|as| VAL |in| Y
|do| (|for| S |in| VAL
|do| (PUTPROP S REV (CONS X (GETPROP S REV)))))))
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY)
|as| VAL |in| Y |do| (|for| S |in| VAL
|do| (PUTPROP S REV (CONS X (GETPROP S REV)))))))
(SETQ CALLEDFNS NIL)
(MAPATOMS (FUNCTION (LAMBDA (X)
(|if| (AND (NOT (GETD X))
(GETPROP X 'CALLED-BY))
(GETPROP X 'CALLED-BY))
|then| (CL:PUSH X CALLEDFNS))))))
(-2 (PRINTOUT T "Functions called and not defined" CALLEDFNS T))
(3 (|for| X |in| SYSFILES
|do|
(LOAD X 'PROP)
(PUTPROP X 'CONTENT (READFILE X))
(|for| EXR |in| (GETPROP X 'CONTENT)
|do| (SELECTQ (CAR EXR)
(DEFINEQ (|for| DFN |in| (CDR EXR)
|do| (|if| (EQUAL (CADR DFN)
(GETPROP (CAR DFN)
'EXPR))
|then| (PRINTOUT T (CAR DFN)
" ")
(PUTPROP (CAR DFN)
'EXPR
(CADR DFN))
|else| (PRINTOUT T (CAR DFN)
"* "))))
NIL)))
(SETQ ALLCONTENT (|for| X |in| SYSFILES |collect| (CONS X (GETPROP
X
'CONTENT))))
|do| (LOAD X 'PROP)
(PUTPROP X 'CONTENT (READFILE X))
(|for| EXR |in| (GETPROP X 'CONTENT)
|do| (SELECTQ (CAR EXR)
(DEFINEQ (|for| DFN |in| (CDR EXR)
|do| (|if| (EQUAL (CADR DFN)
(GETPROP (CAR DFN)
'EXPR))
|then| (PRINTOUT T (CAR DFN)
" ")
(PUTPROP (CAR DFN)
'EXPR
(CADR DFN))
|else| (PRINTOUT T (CAR DFN)
"* "))))
NIL)))
(SETQ ALLCONTENT (|for| X |in| SYSFILES |collect| (CONS X (GETPROP X 'CONTENT))))
(* \; " don't edit with SEDIT")
(LET (DUPS)
(|for| X |in| SYSFILES
|do| (|for| FN |in| (FILEFNSLST X)
|do| (|if| (GETPROP FN 'WHEREIS)
|then| (NCONC1 (GETPROP FN 'WHEREIS)
X)
(OR (FMEMB FN DUPS)
(SETQ DUPS (CONS FN DUPS)))
|else| (PUTPROP FN 'WHEREIS (LIST X)))))
|do| (|if| (GETPROP FN 'WHEREIS)
|then| (NCONC1 (GETPROP FN 'WHEREIS)
X)
(OR (FMEMB FN DUPS)
(SETQ DUPS (CONS FN DUPS)))
|else| (PUTPROP FN 'WHEREIS (LIST X)))))
(SETQ DUPFNS DUPS))
(SETQ NO-SOURCE (|for| X |in| DEFINEDFNS |when| (NOT (GETPROP X 'EXPR))
|collect| X)))
(SETQ NO-SOURCE (|for| X |in| DEFINEDFNS |when| (NOT (GETPROP X 'EXPR)) |collect| X)))
(-3 (PRINTOUT T "Functions compiled but no expr" NO-SOURCE T)
(PRINTOUT T "Functions on more than one file: " DUPFNS T))
(4 (PRINTOUT T T "STARTING MASTERSCOPE PHASE ON " (DATE)
@@ -104,7 +97,7 @@
SYSEDIT)
(|for| X |in| SYSFILES |do| (MSNOTICEFILE X))
(|for| X |in| SYSFILES |do| (PRINTOUT T T "Analyzing " X T)
(MASTERSCOPE `(ANALYZE ON ,(KWOTE X)))))
(MASTERSCOPE `(ANALYZE ON ,(KWOTE X)))))
(-4 "No queries yet")
(HELP))))
@@ -124,7 +117,7 @@
)
(RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal/library" "greetfiles"
"docs>Documentation Tools"))
"docs>Documentation Tools"))
(DEFINEQ
(MAKE-EXPORTS-ALL
@@ -157,6 +150,6 @@
(DRIBBLE))))
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (618 7420 (GATHER-INFO 628 . 6522) (MEDLEY-FIX-LINKS 6524 . 7047) (MEDLEY-FIX-DATES 7049
. 7418)) (7578 9449 (MAKE-EXPORTS-ALL 7588 . 8604) (MAKE-WHEREIS-HASH 8606 . 9447)))))
(FILEMAP (NIL (553 7001 (GATHER-INFO 563 . 6103) (MEDLEY-FIX-LINKS 6105 . 6628) (MEDLEY-FIX-DATES 6630
. 6999)) (7155 9026 (MAKE-EXPORTS-ALL 7165 . 8181) (MAKE-WHEREIS-HASH 8183 . 9024)))))
STOP

BIN
internal/library/MEDLEY-UTILS.LCOM
View File

Binary file not shown.