From bdfdb1d8cb7cd0640450879d7327de07034f4ba7 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Fri, 1 Jun 2012 23:42:32 +0000 Subject: * boot/translator.boot: Remove DEFUSE, $booDefined, $bootDefinedTwice, $bootUsed, $lispWordTable, shoeDfu, shoeReport, shoeDefUse, defuse, defuse1, defSeparate, unfluidlist, defusebuiltin, bootOut, CLESSP, SSORT, bootOutLines, XREF, shoeXref, shoeXreport. --- src/boot/strap/translator.clisp | 350 ---------------------------------------- 1 file changed, 350 deletions(-) (limited to 'src/boot/strap/translator.clisp') diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index a5d81629..e14dc923 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -781,356 +781,6 @@ (COND ((SETQ |n| (|stringSuffix?| |str| |s|)) (|subString| |s| 0 |n|)) (T |s|)))) -(DEFUN DEFUSE (|fn|) - (LET* (|a|) - (UNWIND-PROTECT - (PROGN - (SETQ |a| (|inputTextFile| (CONCAT |fn| ".boot"))) - (|shoeDfu| |a| |fn|)) - (|closeStream| |a|)))) - -(DEFPARAMETER |$bootDefined| NIL) - -(DEFPARAMETER |$bootDefinedTwice| NIL) - -(DEFPARAMETER |$bootUsed| NIL) - -(DEFPARAMETER |$lispWordTable| NIL) - -(DEFUN |shoeDfu| (|a| |fn|) - (LET* (|stream|) - (COND ((NULL |a|) (|shoeNotFound| |fn|)) - (T - (LET ((|$lispWordTable| (|makeTable| #'EQ))) - (DECLARE (SPECIAL |$lispWordTable|)) - (PROGN - (DO-SYMBOLS (|i| (FIND-PACKAGE "LISP")) - (SETF (|tableValue| |$lispWordTable| |i|) T)) - (LET* ((|$bootDefined| (|makeTable| #'EQ)) - (|$bootUsed| (|makeTable| #'EQ)) - (|$bootDefinedTwice| NIL) - (|$bfClamming| NIL)) - (DECLARE - (SPECIAL |$bootDefined| |$bootUsed| |$bootDefinedTwice| - |$bfClamming|)) - (PROGN - (|shoeDefUse| (|shoeTransformStream| |a|)) - (UNWIND-PROTECT - (PROGN - (SETQ |stream| - (|outputTextFile| (CONCAT |fn| ".defuse"))) - (|shoeReport| |stream|)) - (|closeStream| |stream|)))))))))) - -(DEFUN |shoeReport| (|stream|) - (LET* (|b| |a|) - (DECLARE (SPECIAL |$bootUsed| |$bootDefinedTwice| |$bootDefined|)) - (PROGN - (|shoeFileLine| "DEFINED and not USED" |stream|) - (SETQ |a| - (WITH-HASH-TABLE-ITERATOR (#1=#:G732 |$bootDefined|) - (LET ((|bfVar#1| NIL) (|bfVar#2| NIL)) - (LOOP - (MULTIPLE-VALUE-BIND (#2=#:G733 |i| |b|) - (#1#) - (COND ((NOT #2#) (RETURN |bfVar#1|)) - (T - (AND (NOT |b|) - (COND - ((NULL |bfVar#1|) - (SETQ |bfVar#1| #3=(CONS |i| NIL)) - (SETQ |bfVar#2| |bfVar#1|)) - (T (RPLACD |bfVar#2| #3#) - (SETQ |bfVar#2| (CDR |bfVar#2|)))))))))))) - (|bootOut| (SSORT |a|) |stream|) - (|shoeFileLine| " " |stream|) - (|shoeFileLine| "DEFINED TWICE" |stream|) - (|bootOut| (SSORT |$bootDefinedTwice|) |stream|) - (|shoeFileLine| " " |stream|) - (|shoeFileLine| "USED and not DEFINED" |stream|) - (SETQ |a| - (WITH-HASH-TABLE-ITERATOR (#4=#:G734 |$bootUsed|) - (LET ((|bfVar#3| NIL) (|bfVar#4| NIL)) - (LOOP - (MULTIPLE-VALUE-BIND (#5=#:G735 |i| |b|) - (#4#) - (COND ((NOT #5#) (RETURN |bfVar#3|)) - (T - (AND (NOT |b|) - (COND - ((NULL |bfVar#3|) - (SETQ |bfVar#3| #6=(CONS |i| NIL)) - (SETQ |bfVar#4| |bfVar#3|)) - (T (RPLACD |bfVar#4| #6#) - (SETQ |bfVar#4| (CDR |bfVar#4|)))))))))))) - (LET ((|bfVar#5| (SSORT |a|)) (|i| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#5|)) (PROGN (SETQ |i| (CAR |bfVar#5|)) NIL)) - (RETURN NIL)) - (T (SETQ |b| (CONCAT (SYMBOL-NAME |i|) " is used in ")) - (|bootOutLines| (SSORT (|tableValue| |$bootUsed| |i|)) |stream| - |b|))) - (SETQ |bfVar#5| (CDR |bfVar#5|))))))) - -(DEFUN |shoeDefUse| (|s|) - (LOOP - (COND ((|bStreamPackageNull| |s|) (RETURN NIL)) - (T (|defuse| NIL (CAR |s|)) (SETQ |s| (CDR |s|)))))) - -(DEFUN |defuse| (|e| |x|) - (LET* (|niens| - |nee| - |LETTMP#1| - |exp| - |ISTMP#5| - |id| - |ISTMP#4| - |ISTMP#3| - |body| - |bv| - |ISTMP#2| - |name| - |ISTMP#1|) - (DECLARE (SPECIAL |$bootUsed| |$bootDefinedTwice| |$bootDefined| |$used|)) - (PROGN - (SETQ |x| (|stripm| |x| *PACKAGE* (FIND-PACKAGE "BOOTTRAN"))) - (SETQ |$used| NIL) - (SETQ |LETTMP#1| - (COND - ((AND (CONSP |x|) (EQ (CAR |x|) 'DEFUN) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |name| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (PROGN - (SETQ |bv| (CAR |ISTMP#2|)) - (SETQ |body| (CDR |ISTMP#2|)) - T)))))) - (LIST |name| (CONS 'LAMBDA (CONS |bv| |body|)))) - ((AND (CONSP |x|) (EQ (CAR |x|) 'DEFMACRO) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |name| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (PROGN - (SETQ |bv| (CAR |ISTMP#2|)) - (SETQ |body| (CDR |ISTMP#2|)) - T)))))) - (LIST |name| (CONS 'LAMBDA (CONS |bv| |body|)))) - ((AND (CONSP |x|) (EQ (CAR |x|) 'EVAL-WHEN) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN - (SETQ |ISTMP#3| (CAR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (EQ (CAR |ISTMP#3|) 'SETQ) - (PROGN - (SETQ |ISTMP#4| (CDR |ISTMP#3|)) - (AND (CONSP |ISTMP#4|) - (PROGN - (SETQ |id| (CAR |ISTMP#4|)) - (SETQ |ISTMP#5| (CDR |ISTMP#4|)) - (AND (CONSP |ISTMP#5|) - (NULL (CDR |ISTMP#5|)) - (PROGN - (SETQ |exp| (CAR |ISTMP#5|)) - T)))))))))))) - (LIST |id| |exp|)) - ((AND (CONSP |x|) (EQ (CAR |x|) 'SETQ) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |id| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |exp| (CAR |ISTMP#2|)) T)))))) - (LIST |id| |exp|)) - (T (LIST 'TOP-LEVEL |x|)))) - (SETQ |nee| (CAR |LETTMP#1|)) - (SETQ |niens| (CADR |LETTMP#1|)) - (COND - ((|tableValue| |$bootDefined| |nee|) - (SETQ |$bootDefinedTwice| - (COND ((EQ |nee| 'TOP-LEVEL) |$bootDefinedTwice|) - (T (CONS |nee| |$bootDefinedTwice|))))) - (T (SETF (|tableValue| |$bootDefined| |nee|) T))) - (|defuse1| |e| |niens|) - (LET ((|bfVar#1| |$used|) (|i| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL)) - (RETURN NIL)) - (T - (SETF (|tableValue| |$bootUsed| |i|) - (CONS |nee| (|tableValue| |$bootUsed| |i|))))) - (SETQ |bfVar#1| (CDR |bfVar#1|))))))) - -(DEFUN |defuse1| (|e| |y|) - (LET* (|ndol| |dol| |LETTMP#1| |b| |a| |ISTMP#1|) - (DECLARE (SPECIAL |$bootDefined| |$used|)) - (COND - ((NOT (CONSP |y|)) - (COND - ((SYMBOLP |y|) - (SETQ |$used| - (COND ((|symbolMember?| |y| |e|) |$used|) - ((|symbolMember?| |y| |$used|) |$used|) - ((|defusebuiltin| |y|) |$used|) - (T (UNION (LIST |y|) |$used|))))) - (T NIL))) - ((AND (CONSP |y|) (EQ (CAR |y|) 'LAMBDA) - (PROGN - (SETQ |ISTMP#1| (CDR |y|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |a| (CAR |ISTMP#1|)) - (SETQ |b| (CDR |ISTMP#1|)) - T)))) - (|defuse1| (|append| (|unfluidlist| |a|) |e|) |b|)) - ((AND (CONSP |y|) (EQ (CAR |y|) 'PROG) - (PROGN - (SETQ |ISTMP#1| (CDR |y|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |a| (CAR |ISTMP#1|)) - (SETQ |b| (CDR |ISTMP#1|)) - T)))) - (SETQ |LETTMP#1| (|defSeparate| |a|)) (SETQ |dol| (CAR |LETTMP#1|)) - (SETQ |ndol| (CADR |LETTMP#1|)) - (LET ((|bfVar#1| |dol|) (|i| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL)) - (RETURN NIL)) - (T (SETF (|tableValue| |$bootDefined| |i|) T))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))) - (|defuse1| (|append| |ndol| |e|) |b|)) - ((AND (CONSP |y|) (EQ (CAR |y|) 'QUOTE)) (SETQ |a| (CDR |y|)) NIL) - ((AND (CONSP |y|) (EQ (CAR |y|) '+LINE)) (SETQ |a| (CDR |y|)) NIL) - (T - (LET ((|bfVar#2| |y|) (|i| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#2|)) (PROGN (SETQ |i| (CAR |bfVar#2|)) NIL)) - (RETURN NIL)) - (T (|defuse1| |e| |i|))) - (SETQ |bfVar#2| (CDR |bfVar#2|)))))))) - -(DEFUN |defSeparate| (|x|) - (LET* (|x2| |x1| |LETTMP#1| |f|) - (COND ((NULL |x|) (LIST NIL NIL)) - (T (SETQ |f| (CAR |x|)) (SETQ |LETTMP#1| (|defSeparate| (CDR |x|))) - (SETQ |x1| (CAR |LETTMP#1|)) (SETQ |x2| (CADR |LETTMP#1|)) - (COND ((|bfBeginsDollar| |f|) (LIST (CONS |f| |x1|) |x2|)) - (T (LIST |x1| (CONS |f| |x2|)))))))) - -(DEFUN |unfluidlist| (|x|) - (LET* (|y| |ISTMP#1|) - (COND ((NULL |x|) NIL) ((NOT (CONSP |x|)) (LIST |x|)) - ((AND (CONSP |x|) (EQ (CAR |x|) '&REST) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |y| (CAR |ISTMP#1|)) T)))) - (LIST |y|)) - (T (CONS (CAR |x|) (|unfluidlist| (CDR |x|))))))) - -(DEFUN |defusebuiltin| (|x|) - (DECLARE (SPECIAL |$lispWordTable|)) - (|tableValue| |$lispWordTable| |x|)) - -(DEFUN |bootOut| (|l| |outfn|) - (LET ((|bfVar#1| |l|) (|i| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL)) - (RETURN NIL)) - (T (|shoeFileLine| (CONCAT " " (PNAME |i|)) |outfn|))) - (SETQ |bfVar#1| (CDR |bfVar#1|))))) - -(DEFUN CLESSP (|s1| |s2|) (NOT (SHOEGREATERP |s1| |s2|))) - -(DEFUN SSORT (|l|) (SORT |l| #'CLESSP)) - -(DEFUN |bootOutLines| (|l| |outfn| |s|) - (LET* (|a|) - (COND ((NULL |l|) (|shoeFileLine| |s| |outfn|)) - (T (SETQ |a| (PNAME (CAR |l|))) - (COND - ((< 70 (+ (LENGTH |s|) (LENGTH |a|))) (|shoeFileLine| |s| |outfn|) - (|bootOutLines| |l| |outfn| " ")) - (T (|bootOutLines| (CDR |l|) |outfn| (CONCAT |s| " " |a|)))))))) - -(DEFUN XREF (|fn|) - (LET* (|a|) - (UNWIND-PROTECT - (PROGN - (SETQ |a| (|inputTextFile| (CONCAT |fn| ".boot"))) - (|shoeXref| |a| |fn|)) - (|closeStream| |a|)))) - -(DEFUN |shoeXref| (|a| |fn|) - (LET* (|stream| |out|) - (COND ((NULL |a|) (|shoeNotFound| |fn|)) - (T - (LET ((|$lispWordTable| (|makeTable| #'EQ))) - (DECLARE (SPECIAL |$lispWordTable|)) - (PROGN - (DO-SYMBOLS (|i| (FIND-PACKAGE "LISP")) - (SETF (|tableValue| |$lispWordTable| |i|) T)) - (LET* ((|$bootDefined| (|makeTable| #'EQ)) - (|$bootUsed| (|makeTable| #'EQ)) - (|$bfClamming| NIL)) - (DECLARE (SPECIAL |$bootDefined| |$bootUsed| |$bfClamming|)) - (PROGN - (|shoeDefUse| (|shoeTransformStream| |a|)) - (SETQ |out| (CONCAT |fn| ".xref")) - (UNWIND-PROTECT - (PROGN - (SETQ |stream| (|outputTextFile| |out|)) - (|shoeXReport| |stream|) - |out|) - (|closeStream| |stream|)))))))))) - -(DEFUN |shoeXReport| (|stream|) - (LET* (|a| |c|) - (DECLARE (SPECIAL |$bootUsed|)) - (PROGN - (|shoeFileLine| "USED and where DEFINED" |stream|) - (SETQ |c| - (SSORT - (WITH-HASH-TABLE-ITERATOR (#1=#:G738 |$bootUsed|) - (LET ((|bfVar#1| NIL) (|bfVar#2| NIL)) - (LOOP - (MULTIPLE-VALUE-BIND (#2=#:G739 |k| #:G740) - (#1#) - (COND ((NOT #2#) (RETURN |bfVar#1|)) - ((NULL |bfVar#1|) (SETQ |bfVar#1| #3=(CONS |k| NIL)) - (SETQ |bfVar#2| |bfVar#1|)) - (T (RPLACD |bfVar#2| #3#) - (SETQ |bfVar#2| (CDR |bfVar#2|)))))))))) - (LET ((|bfVar#3| |c|) (|i| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#3|)) (PROGN (SETQ |i| (CAR |bfVar#3|)) NIL)) - (RETURN NIL)) - (T (SETQ |a| (CONCAT (SYMBOL-NAME |i|) " is used in ")) - (|bootOutLines| (SSORT (|tableValue| |$bootUsed| |i|)) |stream| - |a|))) - (SETQ |bfVar#3| (CDR |bfVar#3|))))))) - (DEFUN |shoeItem| (|str|) (LET* (|dq|) (PROGN -- cgit v1.2.3