aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap/translator.clisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/strap/translator.clisp')
-rw-r--r--src/boot/strap/translator.clisp1156
1 files changed, 1156 insertions, 0 deletions
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
new file mode 100644
index 00000000..0b849cfc
--- /dev/null
+++ b/src/boot/strap/translator.clisp
@@ -0,0 +1,1156 @@
+(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-translator"))
+
+(IMPORT-MODULE "includer")
+
+(IMPORT-MODULE "scanner")
+
+(IMPORT-MODULE "pile")
+
+(IMPORT-MODULE "parser")
+
+(IMPORT-MODULE "ast")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(DEFPARAMETER |$translatingOldBoot| NIL)
+
+(DEFUN |AxiomCore|::|%sysInit| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$translatingOldBoot|))
+ (RETURN
+ (COND
+ ((EQUAL (CDR (ASSOC (|Option| "boot") (|%systemOptions|)))
+ "old")
+ (SETQ |$translatingOldBoot| T))))))
+
+(DEFUN |setCurrentPackage| (|x|)
+ (PROG () (RETURN (SETQ *PACKAGE* |x|))))
+
+(DEFUN |shoeCOMPILE-FILE| (|lspFileName|)
+ (PROG () (RETURN (COMPILE-FILE |lspFileName|))))
+
+(DEFUN BOOTTOCL (|fn| |out|)
+ (PROG () (RETURN (BOOTTOCLLINES NIL |fn| |out|))))
+
+(DEFUN BOOTCLAM (|fn| |out|)
+ (PROG ()
+ (DECLARE (SPECIAL |$bfClamming|))
+ (RETURN
+ (PROGN (SETQ |$bfClamming| T) (BOOTCLAMLINES NIL |fn| |out|)))))
+
+(DEFUN BOOTCLAMLINES (|lines| |fn| |out|)
+ (PROG () (RETURN (BOOTTOCLLINES |lines| |fn| |out|))))
+
+(DEFUN BOOTTOCLLINES (|lines| |fn| |outfn|)
+ (PROG (|result| |infn| |callingPackage|)
+ (RETURN
+ (PROGN
+ (SETQ *READ-DEFAULT-FLOAT-FORMAT* 'DOUBLE-FLOAT)
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |result|
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeClLines| |a| |fn| |lines| |outfn|)))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |shoeClLines| (|a| |fn| |lines| |outfn|)
+ (PROG (|$GenVarCounter|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T (SETQ |$GenVarCounter| 0)
+ (|shoeOpenOutputFile| |stream| |outfn|
+ (PROGN
+ (LET ((|bfVar#1| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#1|)
+ (PROGN (SETQ |line| (CAR |bfVar#1|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#1| (CDR |bfVar#1|))))
+ (|shoeFileTrees| (|shoeTransformStream| |a|) |stream|)))
+ |outfn|)))))
+
+(DEFUN BOOTTOCLC (|fn| |out|)
+ (PROG () (RETURN (BOOTTOCLCLINES NIL |fn| |out|))))
+
+(DEFUN BOOTTOCLCLINES (|lines| |fn| |outfn|)
+ (PROG (|result| |infn| |callingPackage|)
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |result|
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeClCLines| |a| |fn| |lines| |outfn|)))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |shoeClCLines| (|a| |fn| |lines| |outfn|)
+ (PROG (|$GenVarCounter|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T (SETQ |$GenVarCounter| 0)
+ (|shoeOpenOutputFile| |stream| |outfn|
+ (PROGN
+ (LET ((|bfVar#2| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#2|)
+ (PROGN (SETQ |line| (CAR |bfVar#2|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#2| (CDR |bfVar#2|))))
+ (|shoeFileTrees|
+ (|shoeTransformToFile| |stream|
+ (|shoeInclude|
+ (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0))))
+ |stream|)))
+ |outfn|)))))
+
+(DEFUN BOOTTOMC (|fn|)
+ (PROG (|$GenVarCounter| |result| |infn| |callingPackage|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |result|
+ (|shoeOpenInputFile| |a| |infn| (|shoeMc| |a| |fn|)))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |shoeMc| (|a| |fn|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T (|shoePCompileTrees| (|shoeTransformStream| |a|))
+ (|shoeConsole| (CONCAT |fn| " COMPILED AND LOADED")))))))
+
+(DEFUN EVAL-BOOT-FILE (|fn|)
+ (PROG (|outfn| |infn| |b|)
+ (RETURN
+ (PROGN
+ (SETQ |b| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |outfn|
+ (CONCAT (|shoeRemovebootIfNec| |fn|) "."
+ *LISP-SOURCE-FILETYPE*))
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeClLines| |a| |infn| NIL |outfn|))
+ (|setCurrentPackage| |b|)
+ (LOAD |outfn|)))))
+
+(DEFUN BO (|fn|)
+ (PROG (|$GenVarCounter| |infn| |b|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |b| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (|shoeOpenInputFile| |a| |infn| (|shoeToConsole| |a| |fn|))
+ (|setCurrentPackage| |b|)))))
+
+(DEFUN BOCLAM (|fn|)
+ (PROG (|$bfClamming| |$GenVarCounter| |result| |infn|
+ |callingPackage|)
+ (DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |$bfClamming| T)
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |result|
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeToConsole| |a| |fn|)))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |shoeToConsole| (|a| |fn|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T
+ (|shoeConsoleTrees|
+ (|shoeTransformToConsole|
+ (|shoeInclude|
+ (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0))))))))))
+
+(DEFUN STOUT (|string|) (PROG () (RETURN (PSTOUT (LIST |string|)))))
+
+(DEFUN STEVAL (|string|)
+ (PROG (|$GenVarCounter| |result| |fn| |a| |callingPackage|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |a| (|shoeTransformString| (LIST |string|)))
+ (SETQ |result|
+ (COND
+ ((|bStreamPackageNull| |a|) NIL)
+ ('T
+ (PROGN
+ (SETQ |fn|
+ (|stripm| (CAR |a|) *PACKAGE*
+ (FIND-PACKAGE "BOOTTRAN")))
+ (EVAL |fn|)))))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN STTOMC (|string|)
+ (PROG (|$GenVarCounter| |result| |a| |callingPackage|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |a| (|shoeTransformString| (LIST |string|)))
+ (SETQ |result|
+ (COND
+ ((|bStreamPackageNull| |a|) NIL)
+ ('T (|shoePCompile| (CAR |a|)))))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |shoeCompileTrees| (|s|)
+ (PROG ()
+ (RETURN
+ (LOOP
+ (COND
+ ((|bStreamNull| |s|) (RETURN NIL))
+ ('T (PROGN (|shoeCompile| (CAR |s|)) (SETQ |s| (CDR |s|)))))))))
+
+(DEFUN |shoeCompile| (|fn|)
+ (PROG (|body| |bv| |ISTMP#2| |name| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((AND (CONSP |fn|) (EQ (CAR |fn|) 'DEFUN)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |fn|))
+ (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))))))
+ (COMPILE |name| (CONS 'LAMBDA (CONS |bv| |body|))))
+ ('T (EVAL |fn|))))))
+
+(DEFUN |shoeTransform| (|str|)
+ (PROG ()
+ (RETURN
+ (|bNext| #'|shoeTreeConstruct|
+ (|bNext| #'|shoePileInsert|
+ (|bNext| #'|shoeLineToks| |str|))))))
+
+(DEFUN |shoeTransformString| (|s|)
+ (PROG ()
+ (RETURN
+ (|shoeTransform|
+ (|shoeInclude| (|bAddLineNumber| |s| (|bIgen| 0)))))))
+
+(DEFUN |shoeTransformStream| (|s|)
+ (PROG () (RETURN (|shoeTransformString| (|bRgen| |s|)))))
+
+(DEFUN |shoeTransformToConsole| (|str|)
+ (PROG ()
+ (RETURN
+ (|bNext| #'|shoeConsoleItem|
+ (|bNext| #'|shoePileInsert|
+ (|bNext| #'|shoeLineToks| |str|))))))
+
+(DEFUN |shoeTransformToFile| (|fn| |str|)
+ (PROG ()
+ (RETURN
+ (|bFileNext| |fn|
+ (|bNext| #'|shoePileInsert| (|bNext| #'|shoeLineToks| |str|))))))
+
+(DEFUN |shoeConsoleItem| (|str|)
+ (PROG (|dq|)
+ (RETURN
+ (PROGN
+ (SETQ |dq| (CAR |str|))
+ (|shoeConsoleLines| (|shoeDQlines| |dq|))
+ (CONS (|shoeParseTrees| |dq|) (CDR |str|))))))
+
+(DEFUN |bFileNext| (|fn| |s|)
+ (PROG () (RETURN (|bDelay| #'|bFileNext1| (LIST |fn| |s|)))))
+
+(DEFUN |bFileNext1| (|fn| |s|)
+ (PROG (|dq|)
+ (RETURN
+ (COND
+ ((|bStreamNull| |s|) (LIST '|nullstream|))
+ ('T
+ (PROGN
+ (SETQ |dq| (CAR |s|))
+ (|shoeFileLines| (|shoeDQlines| |dq|) |fn|)
+ (|bAppend| (|shoeParseTrees| |dq|)
+ (|bFileNext| |fn| (CDR |s|)))))))))
+
+(DEFUN |shoeParseTrees| (|dq|)
+ (PROG (|toklist|)
+ (RETURN
+ (PROGN
+ (SETQ |toklist| (|dqToList| |dq|))
+ (COND ((NULL |toklist|) NIL) ('T (|shoeOutParse| |toklist|)))))))
+
+(DEFUN |shoeTreeConstruct| (|str|)
+ (PROG () (RETURN (CONS (|shoeParseTrees| (CAR |str|)) (CDR |str|)))))
+
+(DEFUN |shoeDQlines| (|dq|)
+ (PROG (|b| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (CDAAR (|shoeLastTokPosn| |dq|)))
+ (SETQ |b| (CDAAR (|shoeFirstTokPosn| |dq|)))
+ (|streamTake| (+ (- |a| |b|) 1)
+ (CAR (|shoeFirstTokPosn| |dq|)))))))
+
+(DEFUN |streamTake| (|n| |s|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((|bStreamNull| |s|) NIL)
+ ((EQL |n| 0) NIL)
+ ('T (CONS (CAR |s|) (|streamTake| (- |n| 1) (CDR |s|))))))))
+
+(DEFUN |shoeFileLines| (|lines| |fn|)
+ (PROG ()
+ (RETURN
+ (PROGN
+ (|shoeFileLine| " " |fn|)
+ (LET ((|bfVar#3| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#3|)
+ (PROGN (SETQ |line| (CAR |bfVar#3|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| (|shoeAddComment| |line|) |fn|)))
+ (SETQ |bfVar#3| (CDR |bfVar#3|))))
+ (|shoeFileLine| " " |fn|)))))
+
+(DEFUN |shoeConsoleLines| (|lines|)
+ (PROG ()
+ (RETURN
+ (PROGN
+ (|shoeConsole| " ")
+ (LET ((|bfVar#4| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#4|)
+ (PROGN (SETQ |line| (CAR |bfVar#4|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeConsole| (|shoeAddComment| |line|))))
+ (SETQ |bfVar#4| (CDR |bfVar#4|))))
+ (|shoeConsole| " ")))))
+
+(DEFUN |shoeFileLine| (|x| |stream|)
+ (PROG () (RETURN (PROGN (WRITE-LINE |x| |stream|) |x|))))
+
+(DEFUN |shoeFileTrees| (|s| |st|)
+ (PROG (|a|)
+ (RETURN
+ (LOOP
+ (COND
+ ((|bStreamNull| |s|) (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |a| (CAR |s|))
+ (COND
+ ((EQCAR |a| '+LINE) (|shoeFileLine| (CADR |a|) |st|))
+ ('T (REALLYPRETTYPRINT |a| |st|) (TERPRI |st|)))
+ (SETQ |s| (CDR |s|)))))))))
+
+(DEFUN |shoePPtoFile| (|x| |stream|)
+ (PROG () (RETURN (PROGN (SHOENOTPRETTYPRINT |x| |stream|) |x|))))
+
+(DEFUN |shoeConsoleTrees| (|s|)
+ (PROG (|fn|)
+ (RETURN
+ (LOOP
+ (COND
+ ((|bStreamPackageNull| |s|) (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |fn|
+ (|stripm| (CAR |s|) *PACKAGE*
+ (FIND-PACKAGE "BOOTTRAN")))
+ (REALLYPRETTYPRINT |fn|)
+ (SETQ |s| (CDR |s|)))))))))
+
+(DEFUN |shoeAddComment| (|l|)
+ (PROG () (RETURN (CONCAT "; " (CAR |l|)))))
+
+(DEFUN |genImportDeclaration| (|op| |sig|)
+ (PROG (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((NOT (AND (CONSP |sig|) (EQ (CAR |sig|) '|Signature|)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |sig|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |op'| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN
+ (SETQ |m| (CAR |ISTMP#2|))
+ #0='T)))))))
+ (|coreError| "invalid signature"))
+ ((NOT (AND (CONSP |m|) (EQ (CAR |m|) '|Mapping|)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |m|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |t| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN
+ (SETQ |s| (CAR |ISTMP#2|))
+ #0#)))))))
+ (|coreError| "invalid function type"))
+ ((|%hasFeature| :GCL)
+ (PROGN
+ (COND ((SYMBOLP |s|) (SETQ |s| (LIST |s|))))
+ (LIST 'DEFENTRY |op| |s| (LIST |t| (SYMBOL-NAME |op'|)))))
+ ('T
+ (|fatalError|
+ "import declaration not implemented for this Lisp"))))))
+
+(DEFUN |shoeOutParse| (|stream|)
+ (PROG (|$bpParenCount| |$bpCount| |$returns| |$typings| |$wheredefs|
+ |$op| |$ttok| |$stok| |$stack| |$inputStream| |found|)
+ (DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$returns| |$typings|
+ |$wheredefs| |$op| |$ttok| |$stok| |$stack|
+ |$inputStream|))
+ (RETURN
+ (PROGN
+ (SETQ |$inputStream| |stream|)
+ (SETQ |$stack| NIL)
+ (SETQ |$stok| NIL)
+ (SETQ |$ttok| NIL)
+ (SETQ |$op| NIL)
+ (SETQ |$wheredefs| NIL)
+ (SETQ |$typings| NIL)
+ (SETQ |$returns| NIL)
+ (SETQ |$bpCount| 0)
+ (SETQ |$bpParenCount| 0)
+ (|bpFirstTok|)
+ (SETQ |found| (CATCH 'TRAPPOINT (|bpOutItem|)))
+ (COND
+ ((EQ |found| 'TRAPPED) NIL)
+ ((NULL (|bStreamNull| |$inputStream|)) (|bpGeneralErrorHere|)
+ NIL)
+ ((NULL |$stack|) (|bpGeneralErrorHere|) NIL)
+ ('T (CAR |$stack|)))))))
+
+(DEFUN |bpOutItem| ()
+ (PROG (|bfVar#6| |bfVar#5| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
+ (RETURN
+ (PROGN
+ (OR (|bpComma|) (|bpTrap|))
+ (SETQ |b| (|bpPop1|))
+ (COND
+ ((EQCAR |b| 'TUPLE) (|bpPush| (CDR |b|)))
+ ((EQCAR |b| '+LINE) (|bpPush| (LIST |b|)))
+ ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |b|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |l| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN (SETQ |r| (CAR |ISTMP#2|)) 'T)))))
+ (IDENTP |l|))
+ (|bpPush| (LIST (LIST 'DEFPARAMETER |l| |r|))))
+ ('T
+ (PROGN
+ (SETQ |bfVar#5| |b|)
+ (SETQ |bfVar#6| (CDR |bfVar#5|))
+ (CASE (CAR |bfVar#5|)
+ (|Module|
+ (LET ((|m| (CAR |bfVar#6|)))
+ (|bpPush|
+ (LIST (|shoeCompileTimeEvaluation|
+ (LIST 'PROVIDE |m|))))))
+ (|Import|
+ (LET ((|m| (CAR |bfVar#6|)))
+ (|bpPush| (LIST (LIST 'IMPORT-MODULE |m|)))))
+ (|ImportSignature|
+ (LET ((|x| (CAR |bfVar#6|))
+ (|sig| (CADR |bfVar#6|)))
+ (|bpPush|
+ (LIST (|genImportDeclaration| |x| |sig|)))))
+ (|TypeAlias|
+ (LET ((|t| (CAR |bfVar#6|))
+ (|args| (CADR |bfVar#6|))
+ (|rhs| (CADDR |bfVar#6|)))
+ (|bpPush|
+ (LIST (LIST 'DEFTYPE |t| |args|
+ (LIST 'QUOTE |rhs|))))))
+ (|ConstantDefinition|
+ (LET ((|n| (CAR |bfVar#6|)) (|e| (CADR |bfVar#6|)))
+ (|bpPush| (LIST (LIST 'DEFCONSTANT |n| |e|)))))
+ (T (PROGN
+ (SETQ |b|
+ (|shoeCompTran|
+ (LIST 'LAMBDA (LIST '|x|) |b|)))
+ (|bpPush|
+ (LIST (|shoeEVALANDFILEACTQ| (CADDR |b|))))))))))))))
+
+(DEFUN |shoeAddbootIfNec| (|s|)
+ (PROG () (RETURN (|shoeAddStringIfNec| ".boot" |s|))))
+
+(DEFUN |shoeRemovebootIfNec| (|s|)
+ (PROG () (RETURN (|shoeRemoveStringIfNec| ".boot" |s|))))
+
+(DEFUN |shoeAddStringIfNec| (|str| |s|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (STRPOS |str| |s| 0 NIL))
+ (COND ((NULL |a|) (CONCAT |s| |str|)) ('T |s|))))))
+
+(DEFUN |shoeRemoveStringIfNec| (|str| |s|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (STRPOS |str| |s| 0 NIL))
+ (COND ((NULL |a|) |s|) ('T (SUBSTRING |s| 0 |a|)))))))
+
+(DEFUN DEFUSE (|fn|)
+ (PROG (|infn|)
+ (RETURN
+ (PROGN
+ (SETQ |infn| (CONCAT |fn| ".boot"))
+ (|shoeOpenInputFile| |a| |infn| (|shoeDfu| |a| |fn|))))))
+
+(DEFUN |shoeDfu| (|a| |fn|)
+ (PROG (|$bfClamming| |$GenVarCounter| |$bootDefinedTwice| |$bootUsed|
+ |$bootDefined| |$lispWordTable| |out|)
+ (DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|
+ |$bootDefinedTwice| |$bootUsed| |$bootDefined|
+ |$lispWordTable|))
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T (SETQ |$lispWordTable| (MAKE-HASHTABLE 'EQ))
+ (DO-SYMBOLS (|i| (FIND-PACKAGE 'LISP))
+ (HPUT |$lispWordTable| |i| T))
+ (SETQ |$bootDefined| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$bootUsed| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$bootDefinedTwice| NIL) (SETQ |$GenVarCounter| 0)
+ (SETQ |$bfClamming| NIL)
+ (|shoeDefUse| (|shoeTransformStream| |a|))
+ (SETQ |out| (CONCAT |fn| ".defuse"))
+ (|shoeOpenOutputFile| |stream| |out| (|shoeReport| |stream|))
+ |out|)))))
+
+(DEFUN |shoeReport| (|stream|)
+ (PROG (|b| |a|)
+ (DECLARE (SPECIAL |$bootDefinedTwice| |$bootUsed| |$bootDefined|))
+ (RETURN
+ (PROGN
+ (|shoeFileLine| "DEFINED and not USED" |stream|)
+ (SETQ |a|
+ (LET ((|bfVar#8| NIL) (|bfVar#7| (HKEYS |$bootDefined|))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#7|)
+ (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL))
+ (RETURN (NREVERSE |bfVar#8|)))
+ (#0='T
+ (AND (NULL (GETHASH |i| |$bootUsed|))
+ (SETQ |bfVar#8| (CONS |i| |bfVar#8|)))))
+ (SETQ |bfVar#7| (CDR |bfVar#7|)))))
+ (|bootOut| (SSORT |a|) |stream|)
+ (|shoeFileLine| " " |stream|)
+ (|shoeFileLine| "DEFINED TWICE" |stream|)
+ (|bootOut| (SSORT |$bootDefinedTwice|) |stream|)
+ (|shoeFileLine| " " |stream|)
+ (|shoeFileLine| "USED and not DEFINED" |stream|)
+ (SETQ |a|
+ (LET ((|bfVar#10| NIL) (|bfVar#9| (HKEYS |$bootUsed|))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#9|)
+ (PROGN (SETQ |i| (CAR |bfVar#9|)) NIL))
+ (RETURN (NREVERSE |bfVar#10|)))
+ (#0#
+ (AND (NULL (GETHASH |i| |$bootDefined|))
+ (SETQ |bfVar#10| (CONS |i| |bfVar#10|)))))
+ (SETQ |bfVar#9| (CDR |bfVar#9|)))))
+ (LET ((|bfVar#11| (SSORT |a|)) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#11|)
+ (PROGN (SETQ |i| (CAR |bfVar#11|)) NIL))
+ (RETURN NIL))
+ (#0#
+ (PROGN
+ (SETQ |b| (CONCAT (PNAME |i|) " is used in "))
+ (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
+ |stream| |b|))))
+ (SETQ |bfVar#11| (CDR |bfVar#11|))))))))
+
+(DEFUN |shoeDefUse| (|s|)
+ (PROG ()
+ (RETURN
+ (LOOP
+ (COND
+ ((|bStreamPackageNull| |s|) (RETURN NIL))
+ ('T (PROGN (|defuse| NIL (CAR |s|)) (SETQ |s| (CDR |s|)))))))))
+
+(DEFUN |defuse| (|e| |x|)
+ (PROG (|$used| |niens| |nee| |LETTMP#1| |exp| |ISTMP#5| |id|
+ |ISTMP#4| |ISTMP#3| |body| |bv| |ISTMP#2| |name|
+ |ISTMP#1|)
+ (DECLARE (SPECIAL |$bootUsed| |$used| |$bootDefinedTwice|
+ |$bootDefined|))
+ (RETURN
+ (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|))
+ #0='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|))
+ #0#))))))
+ (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|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (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|)
+ (EQ (CDR |ISTMP#5|) NIL)
+ (PROGN
+ (SETQ |exp|
+ (CAR |ISTMP#5|))
+ #0#))))))))))))
+ (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|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN
+ (SETQ |exp| (CAR |ISTMP#2|))
+ #0#))))))
+ (LIST |id| |exp|))
+ (#1='T (LIST 'TOP-LEVEL |x|))))
+ (SETQ |nee| (CAR |LETTMP#1|))
+ (SETQ |niens| (CADR |LETTMP#1|))
+ (COND
+ ((GETHASH |nee| |$bootDefined|)
+ (SETQ |$bootDefinedTwice|
+ (COND
+ ((EQ |nee| 'TOP-LEVEL) |$bootDefinedTwice|)
+ (#1# (CONS |nee| |$bootDefinedTwice|)))))
+ ('T (HPUT |$bootDefined| |nee| T)))
+ (|defuse1| |e| |niens|)
+ (LET ((|bfVar#12| |$used|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#12|)
+ (PROGN (SETQ |i| (CAR |bfVar#12|)) NIL))
+ (RETURN NIL))
+ ('T
+ (HPUT |$bootUsed| |i|
+ (CONS |nee| (GETHASH |i| |$bootUsed|)))))
+ (SETQ |bfVar#12| (CDR |bfVar#12|))))))))
+
+(DEFUN |defuse1| (|e| |y|)
+ (PROG (|ndol| |dol| |LETTMP#1| |b| |a| |ISTMP#1|)
+ (DECLARE (SPECIAL |$bootDefined| |$used|))
+ (RETURN
+ (COND
+ ((ATOM |y|)
+ (COND
+ ((IDENTP |y|)
+ (SETQ |$used|
+ (COND
+ ((MEMQ |y| |e|) |$used|)
+ ((MEMQ |y| |$used|) |$used|)
+ ((|defusebuiltin| |y|) |$used|)
+ (#0='T (UNION (LIST |y|) |$used|)))))
+ (#0# 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|))
+ #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|))
+ #1#))))
+ (PROGN
+ (SETQ |LETTMP#1| (|defSeparate| |a|))
+ (SETQ |dol| (CAR |LETTMP#1|))
+ (SETQ |ndol| (CADR |LETTMP#1|))
+ (LET ((|bfVar#13| |dol|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#13|)
+ (PROGN (SETQ |i| (CAR |bfVar#13|)) NIL))
+ (RETURN NIL))
+ (#2='T (HPUT |$bootDefined| |i| T)))
+ (SETQ |bfVar#13| (CDR |bfVar#13|))))
+ (|defuse1| (APPEND |ndol| |e|) |b|)))
+ ((AND (CONSP |y|) (EQ (CAR |y|) 'QUOTE)
+ (PROGN (SETQ |a| (CDR |y|)) #1#))
+ NIL)
+ ((AND (CONSP |y|) (EQ (CAR |y|) '+LINE)
+ (PROGN (SETQ |a| (CDR |y|)) #1#))
+ NIL)
+ (#0#
+ (LET ((|bfVar#14| |y|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#14|)
+ (PROGN (SETQ |i| (CAR |bfVar#14|)) NIL))
+ (RETURN NIL))
+ (#2# (|defuse1| |e| |i|)))
+ (SETQ |bfVar#14| (CDR |bfVar#14|)))))))))
+
+(DEFUN |defSeparate| (|x|)
+ (PROG (|x2| |x1| |LETTMP#1| |f|)
+ (RETURN
+ (COND
+ ((NULL |x|) (LIST NIL NIL))
+ (#0='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|))
+ (#0# (LIST |x1| (CONS |f| |x2|)))))))))
+
+(DEFUN |unfluidlist| (|x|)
+ (PROG (|y| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((NULL |x|) NIL)
+ ((ATOM |x|) (LIST |x|))
+ ((AND (CONSP |x|) (EQ (CAR |x|) '&REST)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |y| (CAR |ISTMP#1|)) 'T))))
+ (LIST |y|))
+ ('T (CONS (CAR |x|) (|unfluidlist| (CDR |x|))))))))
+
+(DEFUN |defusebuiltin| (|x|)
+ (PROG ()
+ (DECLARE (SPECIAL |$lispWordTable|))
+ (RETURN (GETHASH |x| |$lispWordTable|))))
+
+(DEFUN |bootOut| (|l| |outfn|)
+ (PROG ()
+ (RETURN
+ (LET ((|bfVar#15| |l|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#15|)
+ (PROGN (SETQ |i| (CAR |bfVar#15|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| (CONCAT " " (PNAME |i|)) |outfn|)))
+ (SETQ |bfVar#15| (CDR |bfVar#15|)))))))
+
+(DEFUN CLESSP (|s1| |s2|)
+ (PROG () (RETURN (NULL (SHOEGREATERP |s1| |s2|)))))
+
+(DEFUN SSORT (|l|) (PROG () (RETURN (SORT |l| #'CLESSP))))
+
+(DEFUN |bootOutLines| (|l| |outfn| |s|)
+ (PROG (|a|)
+ (RETURN
+ (COND
+ ((NULL |l|) (|shoeFileLine| |s| |outfn|))
+ (#0='T (SETQ |a| (PNAME (CAR |l|)))
+ (COND
+ ((< 70 (+ (LENGTH |s|) (LENGTH |a|)))
+ (|shoeFileLine| |s| |outfn|)
+ (|bootOutLines| |l| |outfn| " "))
+ (#0#
+ (|bootOutLines| (CDR |l|) |outfn| (CONCAT |s| " " |a|)))))))))
+
+(DEFUN XREF (|fn|)
+ (PROG (|infn|)
+ (RETURN
+ (PROGN
+ (SETQ |infn| (CONCAT |fn| ".boot"))
+ (|shoeOpenInputFile| |a| |infn| (|shoeXref| |a| |fn|))))))
+
+(DEFUN |shoeXref| (|a| |fn|)
+ (PROG (|$bfClamming| |$GenVarCounter| |$bootUsed| |$bootDefined|
+ |$lispWordTable| |out|)
+ (DECLARE (SPECIAL |$bfClamming| |$GenVarCounter| |$bootUsed|
+ |$bootDefined| |$lispWordTable|))
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T (SETQ |$lispWordTable| (MAKE-HASHTABLE 'EQ))
+ (DO-SYMBOLS (|i| (FIND-PACKAGE 'LISP))
+ (HPUT |$lispWordTable| |i| T))
+ (SETQ |$bootDefined| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$bootUsed| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$GenVarCounter| 0) (SETQ |$bfClamming| NIL)
+ (|shoeDefUse| (|shoeTransformStream| |a|))
+ (SETQ |out| (CONCAT |fn| ".xref"))
+ (|shoeOpenOutputFile| |stream| |out| (|shoeXReport| |stream|))
+ |out|)))))
+
+(DEFUN |shoeXReport| (|stream|)
+ (PROG (|a| |c|)
+ (DECLARE (SPECIAL |$bootUsed|))
+ (RETURN
+ (PROGN
+ (|shoeFileLine| "USED and where DEFINED" |stream|)
+ (SETQ |c| (SSORT (HKEYS |$bootUsed|)))
+ (LET ((|bfVar#16| |c|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#16|)
+ (PROGN (SETQ |i| (CAR |bfVar#16|)) NIL))
+ (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |a| (CONCAT (PNAME |i|) " is used in "))
+ (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
+ |stream| |a|))))
+ (SETQ |bfVar#16| (CDR |bfVar#16|))))))))
+
+(DEFUN FBO (|name| |fn|)
+ (PROG () (RETURN (|shoeGeneralFC| #'BO |name| |fn|))))
+
+(DEFUN FEV (|name| |fn|)
+ (PROG () (RETURN (|shoeGeneralFC| #'EVAL-BOOT-FILE |name| |fn|))))
+
+(DEFUN |shoeGeneralFC| (|f| |name| |fn|)
+ (PROG (|$GenVarCounter| |$bfClamming| |filename| |a| |infn|)
+ (DECLARE (SPECIAL |$GenVarCounter| |$bfClamming|))
+ (RETURN
+ (PROGN
+ (SETQ |$bfClamming| NIL)
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |a|
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeFindName2| |fn| |name| |a|)))
+ (SETQ |filename|
+ (COND
+ ((< 8 (LENGTH |name|)) (SUBSTRING |name| 0 8))
+ ('T |name|)))
+ (COND
+ (|a| (FUNCALL |f| (CONCAT "/tmp/" |filename|)))
+ ('T NIL))))))
+
+(DEFUN |shoeFindName2| (|fn| |name| |a|)
+ (PROG (|filename| |lines|)
+ (RETURN
+ (PROGN
+ (SETQ |lines| (|shoeFindLines| |fn| |name| |a|))
+ (COND
+ (|lines| (PROGN
+ (SETQ |filename|
+ (COND
+ ((< 8 (LENGTH |name|))
+ (SUBSTRING |name| 0 8))
+ ('T |name|)))
+ (SETQ |filename|
+ (CONCAT "/tmp/" |filename| ".boot"))
+ (|shoeOpenOutputFile| |stream| |filename|
+ (LET ((|bfVar#17| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#17|)
+ (PROGN
+ (SETQ |line| (CAR |bfVar#17|))
+ NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#17| (CDR |bfVar#17|)))))
+ T))
+ ('T NIL))))))
+
+(DEFUN |shoeTransform2| (|str|)
+ (PROG ()
+ (RETURN
+ (|bNext| #'|shoeItem|
+ (|streamTake| 1
+ (|bNext| #'|shoePileInsert|
+ (|bNext| #'|shoeLineToks| |str|)))))))
+
+(DEFUN |shoeItem| (|str|)
+ (PROG (|dq|)
+ (RETURN
+ (PROGN
+ (SETQ |dq| (CAR |str|))
+ (CONS (LIST (LET ((|bfVar#19| NIL)
+ (|bfVar#18| (|shoeDQlines| |dq|))
+ (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#18|)
+ (PROGN
+ (SETQ |line| (CAR |bfVar#18|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#19|)))
+ ('T
+ (SETQ |bfVar#19|
+ (CONS (CAR |line|) |bfVar#19|))))
+ (SETQ |bfVar#18| (CDR |bfVar#18|)))))
+ (CDR |str|))))))
+
+(DEFUN |stripm| (|x| |pk| |bt|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((ATOM |x|)
+ (COND
+ ((IDENTP |x|)
+ (COND
+ ((EQUAL (SYMBOL-PACKAGE |x|) |bt|)
+ (INTERN (PNAME |x|) |pk|))
+ (#0='T |x|)))
+ (#0# |x|)))
+ (#0#
+ (CONS (|stripm| (CAR |x|) |pk| |bt|)
+ (|stripm| (CDR |x|) |pk| |bt|)))))))
+
+(DEFUN |shoePCompile| (|fn|)
+ (PROG (|body| |bv| |ISTMP#2| |name| |ISTMP#1|)
+ (RETURN
+ (PROGN
+ (SETQ |fn| (|stripm| |fn| *PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
+ (COND
+ ((AND (CONSP |fn|) (EQ (CAR |fn|) 'DEFUN)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |fn|))
+ (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))))))
+ (COMPILE |name| (CONS 'LAMBDA (CONS |bv| |body|))))
+ ('T (EVAL |fn|)))))))
+
+(DEFUN FC (|name| |fn|)
+ (PROG (|$GenVarCounter| |infn|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeFindName| |fn| |name| |a|))))))
+
+(DEFUN |shoeFindName| (|fn| |name| |a|)
+ (PROG (|lines|)
+ (RETURN
+ (PROGN
+ (SETQ |lines| (|shoeFindLines| |fn| |name| |a|))
+ (|shoePCompileTrees| (|shoeTransformString| |lines|))))))
+
+(DEFUN |shoePCompileTrees| (|s|)
+ (PROG ()
+ (RETURN
+ (LOOP
+ (COND
+ ((|bStreamPackageNull| |s|) (RETURN NIL))
+ ('T
+ (PROGN
+ (REALLYPRETTYPRINT (|shoePCompile| (CAR |s|)))
+ (SETQ |s| (CDR |s|)))))))))
+
+(DEFUN |bStreamPackageNull| (|s|)
+ (PROG (|b| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |b| (|bStreamNull| |s|))
+ (|setCurrentPackage| |a|)
+ |b|))))
+
+(DEFUN PSTTOMC (|string|)
+ (PROG (|$GenVarCounter|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |$GenVarCounter| 0)
+ (|shoePCompileTrees| (|shoeTransformString| |string|))))))
+
+(DEFUN BOOTLOOP ()
+ (PROG (|stream| |b| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (READ-LINE))
+ (COND
+ ((EQL (LENGTH |a|) 0)
+ (PROGN
+ (WRITE-LINE "Boot Loop; to exit type ] ")
+ (BOOTLOOP)))
+ (#0='T
+ (PROGN
+ (SETQ |b| (|shoePrefix?| ")console" |a|))
+ (COND
+ (|b| (PROGN
+ (SETQ |stream| *TERMINAL-IO*)
+ (PSTTOMC (|bRgen| |stream|))
+ (BOOTLOOP)))
+ ((EQUAL (ELT |a| 0) (ELT "]" 0)) NIL)
+ (#0# (PROGN (PSTTOMC (LIST |a|)) (BOOTLOOP)))))))))))
+
+(DEFUN BOOTPO ()
+ (PROG (|stream| |b| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (READ-LINE))
+ (COND
+ ((EQL (LENGTH |a|) 0)
+ (PROGN (WRITE-LINE "Boot Loop; to exit type ] ") (BOOTPO)))
+ (#0='T
+ (PROGN
+ (SETQ |b| (|shoePrefix?| ")console" |a|))
+ (COND
+ (|b| (PROGN
+ (SETQ |stream| *TERMINAL-IO*)
+ (PSTOUT (|bRgen| |stream|))
+ (BOOTPO)))
+ ((EQUAL (ELT |a| 0) (ELT "]" 0)) NIL)
+ (#0# (PROGN (PSTOUT (LIST |a|)) (BOOTPO)))))))))))
+
+(DEFUN PSTOUT (|string|)
+ (PROG (|$GenVarCounter| |result| |callingPackage|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |result|
+ (|shoeConsoleTrees| (|shoeTransformString| |string|)))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |defaultBootToLispFile| (|file|)
+ (PROG () (RETURN (CONCAT (|shoeRemovebootIfNec| |file|) ".clisp"))))
+
+(DEFUN |translateBootFile| (|progname| |options| |file|)
+ (PROG (|outFile|)
+ (RETURN
+ (PROGN
+ (SETQ |outFile| (|getOutputPathname| |options|))
+ (BOOTTOCL |file| (ENOUGH-NAMESTRING |outFile|))))))
+
+(DEFUN |compileBootHandler| (|progname| |options| |file|)
+ (PROG (|objFile| |intFile|)
+ (RETURN
+ (PROGN
+ (SETQ |intFile|
+ (BOOTTOCL |file| (|defaultBootToLispFile| |file|)))
+ (COND
+ (|intFile|
+ (PROGN
+ (SETQ |objFile|
+ (|compileLispHandler| |progname| |options|
+ |intFile|))
+ (DELETE-FILE |intFile|)
+ |objFile|))
+ ('T NIL))))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+ (PROG ()
+ (RETURN
+ (|associateRequestWithFileType| (|Option| "translate") "boot"
+ #'|translateBootFile|))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+ (PROG ()
+ (RETURN
+ (|associateRequestWithFileType| (|Option| "compile") "boot"
+ #'|compileBootHandler|))))
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-03 10:56:19 +0000