aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap/translator.clisp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2012-06-01 23:42:32 +0000
committerdos-reis <gdr@axiomatics.org>2012-06-01 23:42:32 +0000
commitbdfdb1d8cb7cd0640450879d7327de07034f4ba7 (patch)
tree71bd58951657042feedf2d58ce28a073da37eb0b /src/boot/strap/translator.clisp
parent967f23ac31a0833c680ba4144c28e27bae8c7ee1 (diff)
downloadopen-axiom-bdfdb1d8cb7cd0640450879d7327de07034f4ba7.tar.gz
* boot/translator.boot: Remove DEFUSE, $booDefined,
$bootDefinedTwice, $bootUsed, $lispWordTable, shoeDfu, shoeReport, shoeDefUse, defuse, defuse1, defSeparate, unfluidlist, defusebuiltin, bootOut, CLESSP, SSORT, bootOutLines, XREF, shoeXref, shoeXreport.
Diffstat (limited to 'src/boot/strap/translator.clisp')
-rw-r--r--src/boot/strap/translator.clisp350
1 files changed, 0 insertions, 350 deletions
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