(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "includer")

(IMPORT-MODULE "scanner")

(IMPORT-MODULE "pile")

(IMPORT-MODULE "parser")

(IMPORT-MODULE "ast")

(IN-PACKAGE "BOOTTRAN")

(PROVIDE "translator")

(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
  (EXPORT
   '(|evalBootFile| |directoryFromCommandLine| |loadNativeModule|
                    |loadSystemRuntimeCore| |compileBootHandler|
                    |string2BootTree| |genImportDeclaration| |retainFile?|)))

(DEFPARAMETER |$currentModuleName| NIL)

(DEFPARAMETER |$foreignLoadUnits| NIL)

(DEFPARAMETER |$foreignsDefsForCLisp| NIL)

(DEFUN |reallyPrettyPrint| (|x| &OPTIONAL (|st| *STANDARD-OUTPUT*))
  (PROGN (|prettyPrint| |x| |st|) (TERPRI |st|)))

(DEFUN |genModuleFinalization| (|stream|)
  (LET* (|init| |setFFS| |loadUnitsForm| |loadUnits|)
    (DECLARE
     (SPECIAL |$foreignsDefsForCLisp| |$currentModuleName| |$ffs|
      |$foreignLoadUnits|))
    (PROGN
     (SETQ |loadUnits|
             (LET ((|bfVar#2| NIL)
                   (|bfVar#3| NIL)
                   (|bfVar#1| |$foreignLoadUnits|)
                   (|x| NIL))
               (LOOP
                (COND
                 ((OR (NOT (CONSP |bfVar#1|))
                      (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL))
                  (RETURN |bfVar#2|))
                 ((NULL |bfVar#2|)
                  (SETQ |bfVar#2| #1=(CONS (SYMBOL-NAME |x|) NIL))
                  (SETQ |bfVar#3| |bfVar#2|))
                 (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
                (SETQ |bfVar#1| (CDR |bfVar#1|)))))
     (COND
      (|loadUnits|
       (SETQ |loadUnitsForm|
               (LIST 'MAP (|quote| '|loadNativeModule|) (|quote| |loadUnits|)))
       (|reallyPrettyPrint| (|atLoadOrExecutionTime| |loadUnitsForm|)
                            |stream|)))
     (COND ((NULL |$ffs|) NIL)
           ((NULL |$currentModuleName|)
            (|coreError| "current module has no name"))
           (T
            (SETQ |setFFS|
                    (LIST 'SETQ '|$dynamicForeignFunctions|
                          (LIST '|append!| (|quote| |$ffs|)
                                '|$dynamicForeignFunctions|)))
            (|reallyPrettyPrint| (|atLoadOrExecutionTime| |setFFS|) |stream|)
            (COND
             ((|%hasFeature| :CLISP)
              (COND ((NULL |$foreignsDefsForCLisp|) NIL)
                    (T
                     (SETQ |init|
                             (CONS 'PROGN
                                   (LET ((|bfVar#5| NIL)
                                         (|bfVar#6| NIL)
                                         (|bfVar#4| |$foreignsDefsForCLisp|)
                                         (|d| NIL))
                                     (LOOP
                                      (COND
                                       ((OR (NOT (CONSP |bfVar#4|))
                                            (PROGN
                                             (SETQ |d| (CAR |bfVar#4|))
                                             NIL))
                                        (RETURN |bfVar#5|))
                                       ((NULL |bfVar#5|)
                                        (SETQ |bfVar#5|
                                                #2=(CONS
                                                    (LIST 'EVAL (|quote| |d|))
                                                    NIL))
                                        (SETQ |bfVar#6| |bfVar#5|))
                                       (T (RPLACD |bfVar#6| #2#)
                                        (SETQ |bfVar#6| (CDR |bfVar#6|))))
                                      (SETQ |bfVar#4| (CDR |bfVar#4|))))))
                     (|reallyPrettyPrint| (|atLoadOrExecutionTime| |init|)
                                          |stream|))))
             (T NIL)))))))

(DEFUN |genOptimizeOptions| (|stream|)
  (|reallyPrettyPrint|
   (LIST 'PROCLAIM (|quote| (CONS 'OPTIMIZE |$LispOptimizeOptions|))) |stream|))

(DEFUN |%sysInit| ()
  (PROGN
   (SETQ *LOAD-VERBOSE* NIL)
   (COND
    ((|%hasFeature| :GCL)
     (SETF (SYMBOL-VALUE (|bfColonColon| 'COMPILER '*COMPILE-VERBOSE*)) NIL)
     (SETF (SYMBOL-VALUE
            (|bfColonColon| 'COMPILER 'SUPPRESS-COMPILER-WARNINGS*))
             NIL)
     (SETF (SYMBOL-VALUE (|bfColonColon| 'COMPILER 'SUPPRESS-COMPILER-NOTES*))
             T)))))

(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |setCurrentPackage|))

(DEFUN |setCurrentPackage| (|x|) (SETQ *PACKAGE* |x|))

(DECLAIM (FTYPE (FUNCTION (|%String|) |%Thing|) |shoeCOMPILE-FILE|))

(DEFUN |shoeCOMPILE-FILE| (|lspFileName|) (COMPILE-FILE |lspFileName|))

(DEFUN BOOTTOCL (|fn| |out|)
  (UNWIND-PROTECT
      (PROGN
       (|startCompileDuration|)
       (LET ((*PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
         (BOOTTOCLLINES NIL |fn| |out|)))
    (|endCompileDuration|)))

(DEFUN BOOTCLAM (|fn| |out|)
  (LET ((|$bfClamming| T))
    (DECLARE (SPECIAL |$bfClamming|))
    (BOOTCLAMLINES NIL |fn| |out|)))

(DEFUN BOOTCLAMLINES (|lines| |fn| |out|) (BOOTTOCLLINES |lines| |fn| |out|))

(DEFUN BOOTTOCLLINES (|lines| |fn| |outfn|)
  (LET* (|a|)
    (UNWIND-PROTECT
        (PROGN
         (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
         (|shoeClLines| |a| |fn| |lines| |outfn|))
      (|closeStream| |a|))))

(DEFUN |shoeClLines| (|a| |fn| |lines| |outfn|)
  (LET* (|stream|)
    (COND ((NULL |a|) (|shoeNotFound| |fn|))
          (T
           (UNWIND-PROTECT
               (PROGN
                (SETQ |stream| (|outputTextFile| |outfn|))
                (|genOptimizeOptions| |stream|)
                (LET ((|bfVar#1| |lines|) (|line| NIL))
                  (LOOP
                   (COND
                    ((OR (NOT (CONSP |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|)
                (|genModuleFinalization| |stream|)
                |outfn|)
             (|closeStream| |stream|))))))

(DEFUN BOOTTOCLC (|fn| |out|)
  (UNWIND-PROTECT
      (PROGN
       (|startCompileDuration|)
       (LET ((*PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
         (BOOTTOCLCLINES NIL |fn| |out|)))
    (|endCompileDuration|)))

(DEFUN BOOTTOCLCLINES (|lines| |fn| |outfn|)
  (LET* (|a|)
    (UNWIND-PROTECT
        (PROGN
         (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
         (|shoeClCLines| |a| |fn| |lines| |outfn|))
      (|closeStream| |a|))))

(DEFUN |shoeClCLines| (|a| |fn| |lines| |outfn|)
  (LET* (|stream|)
    (COND ((NULL |a|) (|shoeNotFound| |fn|))
          (T
           (UNWIND-PROTECT
               (PROGN
                (SETQ |stream| (|outputTextFile| |outfn|))
                (|genOptimizeOptions| |stream|)
                (LET ((|bfVar#1| |lines|) (|line| NIL))
                  (LOOP
                   (COND
                    ((OR (NOT (CONSP |bfVar#1|))
                         (PROGN (SETQ |line| (CAR |bfVar#1|)) NIL))
                     (RETURN NIL))
                    (T (|shoeFileLine| |line| |stream|)))
                   (SETQ |bfVar#1| (CDR |bfVar#1|))))
                (|shoeFileTrees|
                 (|shoeTransformToFile| |stream|
                                        (|shoeInclude|
                                         (|bAddLineNumber| (|bRgen| |a|)
                                                           (|bIgen| 0))))
                 |stream|)
                (|genModuleFinalization| |stream|)
                |outfn|)
             (|closeStream| |stream|))))))

(DECLAIM (FTYPE (FUNCTION (|%String|) |%Thing|) BOOTTOMC))

(DEFUN BOOTTOMC (|fn|)
  (LET* (|a| |callingPackage|)
    (PROGN
     (SETQ |callingPackage| *PACKAGE*)
     (IN-PACKAGE "BOOTTRAN")
     (UNWIND-PROTECT
         (PROGN
          (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
          (|shoeMc| |a| |fn|))
       (PROGN (|closeStream| |a|) (|setCurrentPackage| |callingPackage|))))))

(DEFUN |shoeMc| (|a| |fn|)
  (COND ((NULL |a|) (|shoeNotFound| |fn|))
        (T (|shoePCompileTrees| (|shoeTransformStream| |a|))
         (|shoeConsole| (CONCAT |fn| " COMPILED AND LOADED")))))

(DEFUN |evalBootFile| (|fn|)
  (LET* (|a| |outfn| |infn| |b|)
    (PROGN
     (SETQ |b| *PACKAGE*)
     (IN-PACKAGE "BOOTTRAN")
     (SETQ |infn| (|shoeAddbootIfNec| |fn|))
     (SETQ |outfn| (CONCAT (|shoeRemovebootIfNec| |fn|) "." "lisp"))
     (UNWIND-PROTECT
         (PROGN
          (SETQ |a| (|inputTextFile| |infn|))
          (|shoeClLines| |a| |infn| NIL |outfn|))
       (PROGN (|closeStream| |a|) (|setCurrentPackage| |b|)))
     (LOAD |outfn|))))

(DECLAIM (FTYPE (FUNCTION (|%String|) |%Thing|) BO))

(DEFUN BO (|fn|)
  (LET* (|a| |b|)
    (PROGN
     (SETQ |b| *PACKAGE*)
     (IN-PACKAGE "BOOTTRAN")
     (UNWIND-PROTECT
         (PROGN
          (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
          (|shoeToConsole| |a| |fn|))
       (PROGN (|closeStream| |a|) (|setCurrentPackage| |b|))))))

(DEFUN BOCLAM (|fn|)
  (LET* (|a| |callingPackage|)
    (PROGN
     (SETQ |callingPackage| *PACKAGE*)
     (IN-PACKAGE "BOOTTRAN")
     (LET ((|$bfClamming| T))
       (DECLARE (SPECIAL |$bfClamming|))
       (UNWIND-PROTECT
           (PROGN
            (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
            (|shoeToConsole| |a| |fn|))
         (PROGN (|closeStream| |a|) (|setCurrentPackage| |callingPackage|)))))))

(DEFUN |shoeToConsole| (|a| |fn|)
  (COND ((NULL |a|) (|shoeNotFound| |fn|))
        (T
         (|shoeConsoleTrees|
          (|shoeTransformToConsole|
           (|shoeInclude| (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0))))))))

(DEFUN STOUT (|string|) (PSTOUT (LIST |string|)))

(DEFUN |string2BootTree| (|string|)
  (LET* (|result| |a| |callingPackage|)
    (PROGN
     (SETQ |callingPackage| *PACKAGE*)
     (IN-PACKAGE "BOOTTRAN")
     (SETQ |a| (|shoeTransformString| (LIST |string|)))
     (SETQ |result|
             (COND ((|bStreamNull| |a|) NIL)
                   (T
                    (|stripm| (CAR |a|) |callingPackage|
                              (FIND-PACKAGE "BOOTTRAN")))))
     (|setCurrentPackage| |callingPackage|)
     |result|)))

(DEFUN STEVAL (|string|)
  (LET* (|result| |fn| |a| |callingPackage|)
    (PROGN
     (SETQ |callingPackage| *PACKAGE*)
     (IN-PACKAGE "BOOTTRAN")
     (SETQ |a| (|shoeTransformString| (LIST |string|)))
     (SETQ |result|
             (COND ((|bStreamNull| |a|) NIL)
                   (T
                    (SETQ |fn|
                            (|stripm| (CAR |a|) *PACKAGE*
                                      (FIND-PACKAGE "BOOTTRAN")))
                    (EVAL |fn|))))
     (|setCurrentPackage| |callingPackage|)
     |result|)))

(DEFUN STTOMC (|string|)
  (LET* (|result| |a| |callingPackage|)
    (PROGN
     (SETQ |callingPackage| *PACKAGE*)
     (IN-PACKAGE "BOOTTRAN")
     (SETQ |a| (|shoeTransformString| (LIST |string|)))
     (SETQ |result|
             (COND ((|bStreamNull| |a|) NIL) (T (|shoePCompile| (CAR |a|)))))
     (|setCurrentPackage| |callingPackage|)
     |result|)))

(DEFUN |shoeCompileTrees| (|s|)
  (LOOP
   (COND ((|bStreamNull| |s|) (RETURN NIL))
         (T (|shoeCompile| (CAR |s|)) (SETQ |s| (CDR |s|))))))

(DECLAIM (FTYPE (FUNCTION (|%Ast|) |%Thing|) |shoeCompile|))

(DEFUN |shoeCompile| (|fn|)
  (LET* (|body| |bv| |ISTMP#2| |name| |ISTMP#1|)
    (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|)
  (|bNext| #'|shoeTreeConstruct|
           (|bNext| #'|shoePileInsert| (|bNext| #'|shoeLineToks| |str|))))

(DEFUN |shoeTransformString| (|s|)
  (|shoeTransform| (|shoeInclude| (|bAddLineNumber| |s| (|bIgen| 0)))))

(DEFUN |shoeTransformStream| (|s|) (|shoeTransformString| (|bRgen| |s|)))

(DEFUN |shoeTransformToConsole| (|str|)
  (|bNext| #'|shoeConsoleItem|
           (|bNext| #'|shoePileInsert| (|bNext| #'|shoeLineToks| |str|))))

(DEFUN |shoeTransformToFile| (|fn| |str|)
  (|bFileNext| |fn|
               (|bNext| #'|shoePileInsert| (|bNext| #'|shoeLineToks| |str|))))

(DEFUN |shoeConsoleItem| (|str|)
  (LET* (|dq|)
    (PROGN
     (SETQ |dq| (CAR |str|))
     (|shoeConsoleLines| (|shoeDQlines| |dq|))
     (CONS (|shoeParseTrees| |dq|) (CDR |str|)))))

(DEFUN |bFileNext| (|fn| |s|) (|bDelay| #'|bFileNext1| (LIST |fn| |s|)))

(DEFUN |bFileNext1| (|fn| |s|)
  (LET* (|dq|)
    (COND ((|bStreamNull| |s|) (LIST '|nullstream|))
          (T (SETQ |dq| (CAR |s|)) (|shoeFileLines| (|shoeDQlines| |dq|) |fn|)
           (|bAppend| (|shoeParseTrees| |dq|) (|bFileNext| |fn| (CDR |s|)))))))

(DEFUN |shoeParseTrees| (|dq|)
  (LET* (|toklist|)
    (PROGN
     (SETQ |toklist| (|dqToList| |dq|))
     (COND ((NULL |toklist|) NIL) (T (|shoeOutParse| |toklist|))))))

(DEFUN |shoeTreeConstruct| (|str|)
  (CONS (|shoeParseTrees| (CAR |str|)) (CDR |str|)))

(DEFUN |shoeDQlines| (|dq|)
  (LET* (|b| |a|)
    (PROGN
     (SETQ |a| (CDAAR (|shoeLastTokPosn| |dq|)))
     (SETQ |b| (CDAAR (|shoeFirstTokPosn| |dq|)))
     (|streamTake| (+ (- |a| |b|) 1) (CAR (|shoeFirstTokPosn| |dq|))))))

(DEFUN |streamTake| (|n| |s|)
  (COND ((|bStreamNull| |s|) NIL) ((EQL |n| 0) NIL)
        (T (CONS (CAR |s|) (|streamTake| (- |n| 1) (CDR |s|))))))

(DEFUN |shoeFileLines| (|lines| |fn|)
  (PROGN
   (|shoeFileLine| " " |fn|)
   (LET ((|bfVar#1| |lines|) (|line| NIL))
     (LOOP
      (COND
       ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |line| (CAR |bfVar#1|)) NIL))
        (RETURN NIL))
       (T (|shoeFileLine| (|shoeAddComment| |line|) |fn|)))
      (SETQ |bfVar#1| (CDR |bfVar#1|))))
   (|shoeFileLine| " " |fn|)))

(DEFUN |shoeConsoleLines| (|lines|)
  (PROGN
   (|shoeConsole| " ")
   (LET ((|bfVar#1| |lines|) (|line| NIL))
     (LOOP
      (COND
       ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |line| (CAR |bfVar#1|)) NIL))
        (RETURN NIL))
       (T (|shoeConsole| (|shoeAddComment| |line|))))
      (SETQ |bfVar#1| (CDR |bfVar#1|))))
   (|shoeConsole| " ")))

(DEFUN |shoeFileLine| (|x| |stream|) (PROGN (WRITE-LINE |x| |stream|) |x|))

(DEFUN |shoeFileTrees| (|s| |st|)
  (LET* (|a|)
    (LOOP
     (COND ((|bStreamNull| |s|) (RETURN NIL))
           (T (SETQ |a| (CAR |s|))
            (COND
             ((AND (CONSP |a|) (EQ (CAR |a|) '+LINE))
              (|shoeFileLine| (CADR |a|) |st|))
             (T (|reallyPrettyPrint| |a| |st|) (TERPRI |st|)))
            (SETQ |s| (CDR |s|)))))))

(DEFUN |shoeConsoleTrees| (|s|)
  (LET* (|fn|)
    (LOOP
     (COND ((|bStreamPackageNull| |s|) (RETURN NIL))
           (T
            (SETQ |fn|
                    (|stripm| (CAR |s|) *PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
            (|reallyPrettyPrint| |fn|) (SETQ |s| (CDR |s|)))))))

(DEFUN |shoeAddComment| (|l|) (CONCAT "; " (CAR |l|)))

(DEFUN |shoeOutParse| (|toks|)
  (LET* (|found| |ps|)
    (PROGN
     (SETQ |ps| (|makeParserState| |toks|))
     (|bpFirstTok| |ps|)
     (SETQ |found|
             (LET ((#1=#:G379
                    (CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem| |ps|))))
               (COND
                ((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
                 (COND
                  ((EQUAL (CAR #2=(CDR #1#)) '(|BootParserException|))
                   (LET ((|e| (CDR #2#)))
                     |e|))
                  (T (THROW :OPEN-AXIOM-CATCH-POINT #1#))))
                (T #1#))))
     (COND ((EQ |found| 'TRAPPED) NIL)
           ((NOT (|bStreamNull| (|parserTokens| |ps|)))
            (|bpGeneralErrorHere| |ps|) NIL)
           ((NULL (|parserTrees| |ps|)) (|bpGeneralErrorHere| |ps|) NIL)
           (T (CAR (|parserTrees| |ps|)))))))

(DEFUN |genDeclaration| (|n| |t|)
  (LET* (|t'| |ISTMP#2| |vars| |ISTMP#1|)
    (COND
     ((AND (CONSP |t|) (EQ (CAR |t|) '|%Mapping|))
      (LIST 'DECLAIM (LIST 'FTYPE (|bfType| |t|) |n|)))
     ((AND (CONSP |t|) (EQ (CAR |t|) '|%Forall|)
           (PROGN
            (SETQ |ISTMP#1| (CDR |t|))
            (AND (CONSP |ISTMP#1|)
                 (PROGN
                  (SETQ |vars| (CAR |ISTMP#1|))
                  (SETQ |ISTMP#2| (CDR |ISTMP#1|))
                  (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                       (PROGN (SETQ |t'| (CAR |ISTMP#2|)) T))))))
      (COND ((NULL |vars|) (|genDeclaration| |n| |t'|))
            (T (COND ((SYMBOLP |vars|) (SETQ |vars| (LIST |vars|))))
             (|genDeclaration| |n|
                               (|applySubst|
                                (LET ((|bfVar#2| NIL)
                                      (|bfVar#3| NIL)
                                      (|bfVar#1| |vars|)
                                      (|v| NIL))
                                  (LOOP
                                   (COND
                                    ((OR (NOT (CONSP |bfVar#1|))
                                         (PROGN
                                          (SETQ |v| (CAR |bfVar#1|))
                                          NIL))
                                     (RETURN |bfVar#2|))
                                    ((NULL |bfVar#2|)
                                     (SETQ |bfVar#2|
                                             #1=(CONS (CONS |v| '*) NIL))
                                     (SETQ |bfVar#3| |bfVar#2|))
                                    (T (RPLACD |bfVar#3| #1#)
                                     (SETQ |bfVar#3| (CDR |bfVar#3|))))
                                   (SETQ |bfVar#1| (CDR |bfVar#1|))))
                                |t'|)))))
     (T (LIST 'DECLAIM (LIST 'TYPE (|bfType| |t|) |n|))))))

(DEFUN |translateSignatureDeclaration| (|d|)
  (CASE (CAR |d|)
    (|%Signature|
     (LET ((|n| (CADR |d|)) (|t| (CADDR |d|)))
       (|genDeclaration| |n| |t|)))
    (T (|coreError| "signature expected"))))

(DEFUN |translateToplevelExpression| (|expr|)
  (LET* (|expr'|)
    (PROGN
     (SETQ |expr'| (CDR (CDR (|shoeCompTran| (LIST 'LAMBDA NIL |expr|)))))
     (LET ((|bfVar#1| |expr'|) (|t| NIL))
       (LOOP
        (COND
         ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |t| (CAR |bfVar#1|)) NIL))
          (RETURN NIL))
         ((AND (CONSP |t|) (EQ (CAR |t|) 'DECLARE))
          (IDENTITY (RPLACA |t| 'DECLAIM))))
        (SETQ |bfVar#1| (CDR |bfVar#1|))))
     (COND ((< 1 (LENGTH |expr'|)) (CONS 'PROGN |expr'|)) (T (CAR |expr'|))))))

(DEFUN |inAllContexts| (|x|)
  (LIST 'EVAL-WHEN (LIST :COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) |x|))

(DEFUN |atLoadOrExecutionTime| (|x|)
  (LIST 'EVAL-WHEN (LIST :LOAD-TOPLEVEL :EXECUTE) |x|))

(DEFUN |exportNames| (|ns|)
  (COND ((NULL |ns|) NIL)
        (T (LIST (|inAllContexts| (LIST 'EXPORT (|quote| |ns|)))))))

(DEFUN |packageBody| (|x| |p|)
  (LET* (|z| |user| |ns| |ISTMP#3| |ISTMP#2| |ISTMP#1|)
    (BLOCK NIL
      (COND
       ((AND (CONSP |x|) (EQ (CAR |x|) '|%Import|)
             (PROGN
              (SETQ |ISTMP#1| (CDR |x|))
              (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
                   (PROGN
                    (SETQ |ISTMP#2| (CAR |ISTMP#1|))
                    (AND (CONSP |ISTMP#2|) (EQ (CAR |ISTMP#2|) '|%Namespace|)
                         (PROGN
                          (SETQ |ISTMP#3| (CDR |ISTMP#2|))
                          (AND (CONSP |ISTMP#3|) (NULL (CDR |ISTMP#3|))
                               (PROGN (SETQ |ns| (CAR |ISTMP#3|)) T))))))))
        (SETQ |user| (COND ((NULL |p|) NIL) (T (LIST (SYMBOL-NAME |p|)))))
        (COND
         ((EQ |ns| '|System|)
          (LIST 'COND
                (LIST (LIST '|%hasFeature| :COMMON-LISP)
                      (CONS 'USE-PACKAGE (CONS "COMMON-LISP" |user|)))
                (LIST 'T (CONS 'USE-PACKAGE (CONS "LISP" |user|)))))
         (T
          (SETQ |z|
                  (COND
                   ((AND (CONSP |ns|) (EQ (CAR |ns|) 'DOT)
                         (PROGN
                          (SETQ |ISTMP#1| (CDR |ns|))
                          (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) '|System|)
                               (PROGN
                                (SETQ |ISTMP#2| (CDR |ISTMP#1|))
                                (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                                     (EQ (CAR |ISTMP#2|) '|Foreign|))))))
                    (COND ((|%hasFeature| :SBCL) 'SB-ALIEN)
                          ((|%hasFeature| :ECL) 'FFI) (T (RETURN NIL))))
                   ((|ident?| |ns|) |ns|)
                   (T (|bfSpecificErrorHere| "invalid namespace"))))
          (CONS 'USE-PACKAGE (CONS (SYMBOL-NAME |z|) |user|)))))
       ((AND (CONSP |x|) (EQ (CAR |x|) 'PROGN))
        (CONS (CAR |x|)
              (LET ((|bfVar#2| NIL)
                    (|bfVar#3| NIL)
                    (|bfVar#1| (CDR |x|))
                    (|y| NIL))
                (LOOP
                 (COND
                  ((OR (NOT (CONSP |bfVar#1|))
                       (PROGN (SETQ |y| (CAR |bfVar#1|)) NIL))
                   (RETURN |bfVar#2|))
                  ((NULL |bfVar#2|)
                   (SETQ |bfVar#2| #1=(CONS (|packageBody| |y| |p|) NIL))
                   (SETQ |bfVar#3| |bfVar#2|))
                  (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
                 (SETQ |bfVar#1| (CDR |bfVar#1|))))))
       (T |x|)))))

(DEFUN |translateToplevel| (|ps| |b| |export?|)
  (LET* (|csts|
         |accessors|
         |fields|
         |lhs|
         |t|
         |ISTMP#2|
         |sig|
         |ns|
         |n|
         |ISTMP#1|
         |xs|)
    (DECLARE
     (SPECIAL |$activeNamespace| |$InteractiveMode| |$constantIdentifiers|
      |$foreignsDefsForCLisp| |$currentModuleName|))
    (COND ((NOT (CONSP |b|)) (LIST |b|))
          ((AND (CONSP |b|) (EQ (CAR |b|) 'TUPLE)) (SETQ |xs| (CDR |b|))
           (|coreError| "invalid AST"))
          (T
           (CASE (CAR |b|)
             (|%Signature|
              (LET ((|op| (CADR |b|)) (|t| (CADDR |b|)))
                (LIST (|genDeclaration| |op| |t|))))
             (|%Definition|
              (LET ((|op| (CADR |b|))
                    (|args| (CADDR |b|))
                    (|body| (CADDDR |b|)))
                (CDR
                 (|bfDef| (|parserLoadUnit| |ps|) |op| |args|
                          (|translateForm| |body|)))))
             (|%Module|
              (LET ((|m| (CADR |b|)) (|ns| (CADDR |b|)) (|ds| (CADDDR |b|)))
                (PROGN
                 (SETQ |$currentModuleName| |m|)
                 (SETQ |$foreignsDefsForCLisp| NIL)
                 (CONS (LIST 'PROVIDE (SYMBOL-NAME |m|))
                       (|append| (|exportNames| |ns|)
                                 (LET ((|bfVar#2| NIL)
                                       (|bfVar#3| NIL)
                                       (|bfVar#1| |ds|)
                                       (|d| NIL))
                                   (LOOP
                                    (COND
                                     ((OR (NOT (CONSP |bfVar#1|))
                                          (PROGN
                                           (SETQ |d| (CAR |bfVar#1|))
                                           NIL))
                                      (RETURN |bfVar#2|))
                                     ((NULL |bfVar#2|)
                                      (SETQ |bfVar#2|
                                              #1=(CONS
                                                  (CAR
                                                   (|translateToplevel| |ps|
                                                                        |d| T))
                                                  NIL))
                                      (SETQ |bfVar#3| |bfVar#2|))
                                     (T (RPLACD |bfVar#3| #1#)
                                      (SETQ |bfVar#3| (CDR |bfVar#3|))))
                                    (SETQ |bfVar#1| (CDR |bfVar#1|)))))))))
             (|%Import|
              (LET ((|m| (CADR |b|)))
                (COND
                 ((AND (CONSP |m|) (EQ (CAR |m|) '|%Namespace|)
                       (PROGN
                        (SETQ |ISTMP#1| (CDR |m|))
                        (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
                             (PROGN (SETQ |n| (CAR |ISTMP#1|)) T))))
                  (LIST (|inAllContexts| (|packageBody| |b| NIL))))
                 (T
                  (COND
                   ((NOT (STRING= (|getOptionValue| '|import|) "skip"))
                    (|bootImport| (SYMBOL-NAME |m|))))
                  (LIST (LIST 'IMPORT-MODULE (SYMBOL-NAME |m|)))))))
             (|%ImportSignature|
              (LET ((|x| (CADR |b|)) (|sig| (CADDR |b|)) (|dom| (CADDDR |b|)))
                (|genImportDeclaration| |x| |sig| |dom|)))
             (|%TypeAlias|
              (LET ((|lhs| (CADR |b|)) (|rhs| (CADDR |b|)))
                (LIST (|genTypeAlias| |lhs| |rhs|))))
             (|%ConstantDefinition|
              (LET ((|lhs| (CADR |b|)) (|rhs| (CADDR |b|)))
                (COND
                 ((AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Namespace|)
                       (PROGN
                        (SETQ |ISTMP#1| (CDR |lhs|))
                        (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
                             (PROGN (SETQ |ns| (CAR |ISTMP#1|)) T))))
                  (LIST (LIST 'DEFPACKAGE (SYMBOL-NAME |ns|))
                        (|inAllContexts| (|packageBody| |rhs| |ns|))))
                 (T (SETQ |sig| NIL)
                  (COND
                   ((AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Signature|)
                         (PROGN
                          (SETQ |ISTMP#1| (CDR |lhs|))
                          (AND (CONSP |ISTMP#1|)
                               (PROGN
                                (SETQ |n| (CAR |ISTMP#1|))
                                (SETQ |ISTMP#2| (CDR |ISTMP#1|))
                                (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                                     (PROGN (SETQ |t| (CAR |ISTMP#2|)) T))))))
                    (SETQ |sig| (|genDeclaration| |n| |t|)) (SETQ |lhs| |n|)))
                  (SETQ |$constantIdentifiers|
                          (CONS |lhs| |$constantIdentifiers|))
                  (LIST (LIST 'DEFCONSTANT |lhs| (|translateForm| |rhs|)))))))
             (|%Assignment|
              (LET ((|lhs| (CADR |b|)) (|rhs| (CADDR |b|)))
                (PROGN
                 (SETQ |sig| NIL)
                 (COND
                  ((AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Signature|)
                        (PROGN
                         (SETQ |ISTMP#1| (CDR |lhs|))
                         (AND (CONSP |ISTMP#1|)
                              (PROGN
                               (SETQ |n| (CAR |ISTMP#1|))
                               (SETQ |ISTMP#2| (CDR |ISTMP#1|))
                               (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                                    (PROGN (SETQ |t| (CAR |ISTMP#2|)) T))))))
                   (SETQ |sig| (|genDeclaration| |n| |t|)) (SETQ |lhs| |n|)))
                 (COND (|$InteractiveMode| (LIST (LIST 'SETF |lhs| |rhs|)))
                       (T
                        (LIST
                         (LIST 'DEFPARAMETER |lhs|
                               (|translateForm| |rhs|))))))))
             (|%Macro|
              (LET ((|op| (CADR |b|))
                    (|args| (CADDR |b|))
                    (|body| (CADDDR |b|)))
                (|bfMDef| (|parserLoadUnit| |ps|) |op| |args|
                          (|translateForm| |body|))))
             (|%Structure|
              (LET ((|t| (CADR |b|)) (|alts| (CADDR |b|)))
                (COND
                 ((AND (CONSP |alts|) (EQ (CAR |alts|) '|%Record|)
                       (PROGN
                        (SETQ |ISTMP#1| (CDR |alts|))
                        (AND (CONSP |ISTMP#1|)
                             (PROGN
                              (SETQ |fields| (CAR |ISTMP#1|))
                              (SETQ |ISTMP#2| (CDR |ISTMP#1|))
                              (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                                   (PROGN
                                    (SETQ |accessors| (CAR |ISTMP#2|))
                                    T))))))
                  (|bfRecordDef| (|parserLoadUnit| |ps|) |t| |fields|
                                 |accessors|))
                 ((AND (CONSP |alts|) (NULL (CDR |alts|))
                       (PROGN
                        (SETQ |ISTMP#1| (CAR |alts|))
                        (AND (CONSP |ISTMP#1|)
                             (EQ (CAR |ISTMP#1|) '|Enumeration|)
                             (PROGN (SETQ |csts| (CDR |ISTMP#1|)) T))))
                  (LIST (|bfEnum| |t| |csts|)))
                 (T
                  (LET ((|bfVar#5| NIL)
                        (|bfVar#6| NIL)
                        (|bfVar#4| |alts|)
                        (|alt| NIL))
                    (LOOP
                     (COND
                      ((OR (NOT (CONSP |bfVar#4|))
                           (PROGN (SETQ |alt| (CAR |bfVar#4|)) NIL))
                       (RETURN |bfVar#5|))
                      ((NULL |bfVar#5|)
                       (SETQ |bfVar#5|
                               #2=(CONS
                                   (|bfCreateDef| (|parserLoadUnit| |ps|)
                                                  |alt|)
                                   NIL))
                       (SETQ |bfVar#6| |bfVar#5|))
                      (T (RPLACD |bfVar#6| #2#)
                       (SETQ |bfVar#6| (CDR |bfVar#6|))))
                     (SETQ |bfVar#4| (CDR |bfVar#4|))))))))
             (|%Namespace|
              (LET ((|n| (CADR |b|)))
                (PROGN
                 (SETQ |$activeNamespace| (SYMBOL-NAME |n|))
                 (LIST (LIST 'IN-PACKAGE (SYMBOL-NAME |n|))))))
             (|%Lisp|
              (LET ((|s| (CADR |b|)))
                (|shoeReadLispString| |s| 0)))
             (T
              (LIST (|translateToplevelExpression| (|translateForm| |b|)))))))))

(DEFUN |shoeAddbootIfNec| (|s|)
  (LET* (|n2| |n1| |ext|)
    (PROGN
     (SETQ |ext| ".boot")
     (SETQ |n1| (- (LENGTH |ext|) 1))
     (SETQ |n2| (- (- (LENGTH |s|) |n1|) 1))
     (COND
      ((LET ((|bfVar#1| T) (|k| 0))
         (LOOP
          (COND ((> |k| |n1|) (RETURN |bfVar#1|))
                (T
                 (SETQ |bfVar#1|
                         (CHAR= (SCHAR |ext| |k|) (SCHAR |s| (+ |n2| |k|))))
                 (COND ((NOT |bfVar#1|) (RETURN NIL)))))
          (SETQ |k| (+ |k| 1))))
       |s|)
      (T (CONCAT |s| |ext|))))))

(DEFUN |shoeRemovebootIfNec| (|s|) (|shoeRemoveStringIfNec| ".boot" |s|))

(DEFUN |shoeRemoveStringIfNec| (|str| |s|)
  (LET* (|n|)
    (COND ((SETQ |n| (|stringSuffix?| |str| |s|)) (|subString| |s| 0 |n|))
          (T |s|))))

(DEFUN |shoeItem| (|str|)
  (LET* (|dq|)
    (PROGN
     (SETQ |dq| (CAR |str|))
     (CONS
      (LIST
       (LET ((|bfVar#2| NIL)
             (|bfVar#3| NIL)
             (|bfVar#1| (|shoeDQlines| |dq|))
             (|line| NIL))
         (LOOP
          (COND
           ((OR (NOT (CONSP |bfVar#1|))
                (PROGN (SETQ |line| (CAR |bfVar#1|)) NIL))
            (RETURN |bfVar#2|))
           ((NULL |bfVar#2|) (SETQ |bfVar#2| #1=(CONS (CAR |line|) NIL))
            (SETQ |bfVar#3| |bfVar#2|))
           (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
          (SETQ |bfVar#1| (CDR |bfVar#1|)))))
      (CDR |str|)))))

(DEFUN |stripm| (|x| |pk| |bt|)
  (COND
   ((NOT (CONSP |x|))
    (COND
     ((SYMBOLP |x|)
      (COND ((EQUAL (SYMBOL-PACKAGE |x|) |bt|) (INTERN (SYMBOL-NAME |x|) |pk|))
            (T |x|)))
     (T |x|)))
   (T (CONS (|stripm| (CAR |x|) |pk| |bt|) (|stripm| (CDR |x|) |pk| |bt|)))))

(DEFUN |shoePCompile| (|fn|)
  (LET* (|body| |bv| |ISTMP#2| |name| |ISTMP#1|)
    (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 |shoePCompileTrees| (|s|)
  (LOOP
   (COND ((|bStreamNull| |s|) (RETURN NIL))
         (T (|reallyPrettyPrint| (|shoePCompile| (CAR |s|)))
          (SETQ |s| (CDR |s|))))))

(DEFUN |bStreamPackageNull| (|s|)
  (LET ((*PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
    (|bStreamNull| |s|)))

(DEFUN PSTTOMC (|string|)
  (|shoePCompileTrees| (|shoeTransformString| |string|)))

(DEFUN BOOTLOOP ()
  (LET* (|stream| |a|)
    (DECLARE (SPECIAL |$stdio| |$stdin|))
    (PROGN
     (SETQ |a| (|readLine| |$stdin|))
     (COND
      ((EQL (LENGTH |a|) 0) (WRITE-LINE "Boot Loop; to exit type ] ")
       (BOOTLOOP))
      ((|shoePrefix?| ")console" |a|) (SETQ |stream| |$stdio|)
       (PSTTOMC (|bRgen| |stream|)) (BOOTLOOP))
      ((CHAR= (SCHAR |a| 0) (|char| '])) NIL)
      (T (PSTTOMC (LIST |a|)) (BOOTLOOP))))))

(DEFUN BOOTPO ()
  (LET* (|stream| |a|)
    (DECLARE (SPECIAL |$stdio| |$stdin|))
    (PROGN
     (SETQ |a| (|readLine| |$stdin|))
     (COND
      ((EQL (LENGTH |a|) 0) (WRITE-LINE "Boot Loop; to exit type ] ") (BOOTPO))
      ((|shoePrefix?| ")console" |a|) (SETQ |stream| |$stdio|)
       (PSTOUT (|bRgen| |stream|)) (BOOTPO))
      ((CHAR= (SCHAR |a| 0) (|char| '])) NIL)
      (T (PSTOUT (LIST |a|)) (BOOTPO))))))

(DEFUN PSTOUT (|string|)
  (LET ((*PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
    (|shoeConsoleTrees| (|shoeTransformString| |string|))))

(DEFUN |defaultBootToLispFile| (|file|)
  (CONCAT (|pathBasename| |file|) ".clisp"))

(DEFUN |getIntermediateLispFile| (|file| |options|)
  (LET* (|out|)
    (BLOCK NIL
      (PROGN
       (SETQ |out|
               (OR (|getOutputPathname| |options|)
                   (RETURN (|defaultBootToLispFile| |file|))))
       (CONCAT
        (|shoeRemoveStringIfNec| (CONCAT "." |$faslType|) (NAMESTRING |out|))
        ".clisp")))))

(DEFUN |translateBootFile| (|progname| |options| |file|)
  (LET* (|outFile|)
    (PROGN
     (SETQ |outFile|
             (OR (|getOutputPathname| |options|)
                 (|defaultBootToLispFile| |file|)))
     (BOOTTOCL |file| (ENOUGH-NAMESTRING |outFile|)))))

(DEFUN |retainFile?| (|ext|)
  (COND
   ((OR (MEMBER (|Option| '|all|) |$FilesToRetain|)
        (MEMBER (|Option| '|yes|) |$FilesToRetain|))
    T)
   ((MEMBER (|Option| '|no|) |$FilesToRetain|) NIL)
   (T (MEMBER (|Option| |ext|) |$FilesToRetain|))))

(DEFUN |compileBootHandler| (|progname| |options| |file|)
  (LET* (|objFile| |intFile|)
    (PROGN
     (SETQ |intFile|
             (BOOTTOCL |file| (|getIntermediateLispFile| |file| |options|)))
     (COND ((NOT (EQL (|errorCount|) 0)) NIL)
           (|intFile|
            (SETQ |objFile|
                    (|compileLispHandler| |progname| |options| |intFile|))
            (COND ((NOT (|retainFile?| '|lisp|)) (DELETE-FILE |intFile|)))
            |objFile|)
           (T NIL)))))

(|associateRequestWithFileType| (|Option| "translate") "boot"
                                #'|translateBootFile|)

(|associateRequestWithFileType| (|Option| "compile") "boot"
                                #'|compileBootHandler|)

(DEFUN |directoryFromCommandLine| (|opt|)
  (LET* (|dir|)
    (COND
     ((SETQ |dir| (ASSOC (|Option| |opt|) (|%systemOptions|)))
      (|ensureTrailingSlash| (CDR |dir|)))
     (T NIL))))

(DEFUN |loadNativeModule| (|m| &REST |dir|)
  (LET* (|LETTMP#1|)
    (PROGN
     (SETQ |m| (CONCAT |$NativeModulePrefix| |m| |$NativeModuleExt|))
     (COND
      (|dir| (SETQ |LETTMP#1| |dir|) (SETQ |dir| (CAR |LETTMP#1|))
       (SETQ |m| (CONCAT |dir| |m|))))
     (COND
      ((|%hasFeature| :SBCL)
       (FUNCALL (|bfColonColon| 'SB-ALIEN 'LOAD-SHARED-OBJECT) |m| :DONT-SAVE
                T))
      ((|%hasFeature| :CLISP)
       (EVAL (LIST (|bfColonColon| 'FFI 'DEFAULT-FOREIGN-LIBRARY) |m|)))
      ((|%hasFeature| :ECL)
       (EVAL (LIST (|bfColonColon| 'FFI 'LOAD-FOREIGN-LIBRARY) |m|)))
      ((|%hasFeature| :CLOZURE)
       (EVAL (LIST (|bfColonColon| 'CCL 'OPEN-SHARED-LIBRARY) |m|)))
      (T (|coreError| "don't know how to load a dynamically linked module"))))))

(DEFUN |loadSystemRuntimeCore| ()
  (LET* (|dir| |path|)
    (COND ((OR (|%hasFeature| :ECL) (|%hasFeature| :GCL)) NIL)
          (T
           (SETQ |dir|
                   (COND
                    ((SETQ |path| (|directoryFromCommandLine| "syslib"))
                     |path|)
                    (T (CONCAT (|systemRootDirectory|) "lib/"))))
           (|loadNativeModule| "open-axiom-core" |dir|)))))