Rename MAKE-FILENAME to makeFilename and re-implement in Boot.

5 files changed, 58 insertions, 62 deletions

diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index fdd34743..94f3cce2 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -3739,8 +3739,11 @@
                      |call|))))
      (LIST (LIST 'DEFUN |op| |parms| |call|)))))
 
+(DEFPARAMETER |$ffs| NIL)
+
 (DEFUN |genImportDeclaration| (|op| |sig|)
   (LET* (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|)
+    (DECLARE (SPECIAL |$ffs|))
     (COND
      ((NOT
        (AND (CONSP |sig|) (EQ (CAR |sig|) '|%Signature|)
@@ -3765,6 +3768,7 @@
                         (PROGN (SETQ |s| (CAR |ISTMP#2|)) T)))))))
       (|coreError| "invalid function type"))
      (T (COND ((AND |s| (SYMBOLP |s|)) (SETQ |s| (LIST |s|))))
+      (SETQ |$ffs| (CONS |op| |$ffs|))
       (COND
        ((|%hasFeature| :GCL) (|genGCLnativeTranslation| |op| |s| |t| |op'|))
        ((|%hasFeature| :SBCL) (|genSBCLnativeTranslation| |op| |s| |t| |op'|))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 985611d3..b6c95484 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -388,7 +388,7 @@
       (COND (|done| (RETURN NIL))
             (T
              (SETQ |found|
-                     (LET ((#1=#:G720
+                     (LET ((#1=#:G725
                             (CATCH :OPEN-AXIOM-CATCH-POINT
                               (APPLY |f| |ps| NIL))))
                        (COND
@@ -1371,7 +1371,7 @@
      (SETQ |op| (|enclosingFunction| (|parserLoadUnit| |ps|)))
      (SETQ |varno| (|parserGensymSequenceNumber| |ps|))
      (UNWIND-PROTECT
-         (LET ((#1=#:G721
+         (LET ((#1=#:G726
                 (CATCH :OPEN-AXIOM-CATCH-POINT
                   (PROGN
                    (SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) NIL)
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 4c088f8d..b606644b 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -84,10 +84,10 @@
   (LET* (|s|)
     (COND
      ((SETQ |s|
-              (WITH-HASH-TABLE-ITERATOR (#1=#:G719 |shoeKeyTable|)
+              (WITH-HASH-TABLE-ITERATOR (#1=#:G724 |shoeKeyTable|)
                 (LET ((|bfVar#1| NIL))
                   (LOOP
-                   (MULTIPLE-VALUE-BIND (#2=#:G720 |k| |v|)
+                   (MULTIPLE-VALUE-BIND (#2=#:G725 |k| |v|)
                        (#1#)
                      (COND ((NOT #2#) (RETURN |bfVar#1|))
                            (T
@@ -138,9 +138,9 @@
                  (COND ((> |i| 255) (RETURN NIL)) (T (SETF (ELT |a| |i|) |b|)))
                  (SETQ |i| (+ |i| 1))))
               |a|))
-     (WITH-HASH-TABLE-ITERATOR (#1=#:G721 |shoeKeyTable|)
+     (WITH-HASH-TABLE-ITERATOR (#1=#:G726 |shoeKeyTable|)
        (LOOP
-        (MULTIPLE-VALUE-BIND (#2=#:G722 |s| #:G723)
+        (MULTIPLE-VALUE-BIND (#2=#:G727 |s| #:G728)
             (#1#)
           (COND ((NOT #2#) (RETURN NIL)) (T (|shoeInsert| |s| |d|))))))
      |d|)))
@@ -154,9 +154,9 @@
      (LET ((|i| 0))
        (LOOP (COND ((> |i| 255) (RETURN NIL)) (T (SETF (SBIT |a| |i|) 0)))
              (SETQ |i| (+ |i| 1))))
-     (WITH-HASH-TABLE-ITERATOR (#1=#:G724 |shoeKeyTable|)
+     (WITH-HASH-TABLE-ITERATOR (#1=#:G729 |shoeKeyTable|)
        (LOOP
-        (MULTIPLE-VALUE-BIND (#2=#:G725 |k| #:G726)
+        (MULTIPLE-VALUE-BIND (#2=#:G730 |k| #:G731)
             (#1#)
           (COND ((NOT #2#) (RETURN NIL)) ((|shoeStartsId| (SCHAR |k| 0)) NIL)
                 (T (SETF (SBIT |a| (CHAR-CODE (SCHAR |k| 0))) 1))))))
@@ -216,13 +216,19 @@
              (LIST '|copyString| 'COPY-SEQ) (LIST '|copyVector| 'COPY-SEQ)
              (LIST '|croak| 'CROAK) (LIST '|digit?| 'DIGIT-CHAR-P)
              (LIST '|exit| 'EXIT) (LIST '|false| 'NIL) (LIST '|fifth| 'FIFTH)
-             (LIST '|first| 'CAR) (LIST '|float?| 'FLOATP)
+             (LIST '|first| 'CAR) (LIST '|filePath| 'PATHNAME)
+             (LIST '|filePath?| 'PATHNAMEP)
+             (LIST '|filePathDirectory| 'PATHNAME-DIRECTORY)
+             (LIST '|filePathName| 'PATHNAME-NAME)
+             (LIST '|filePathString| 'NAMESTRING)
+             (LIST '|filePathType| 'PATHNAME-TYPE) (LIST '|float?| 'FLOATP)
              (LIST '|flushOutput| 'FORCE-OUTPUT) (LIST '|fourth| 'CADDDR)
              (LIST '|freshLine| 'FRESH-LINE) (LIST '|function?| 'FUNCTIONP)
              (LIST '|functionSymbol?| 'FBOUNDP) (LIST '|gensym| 'GENSYM)
              (LIST '|genvar| 'GENVAR) (LIST '|integer?| 'INTEGERP)
              (LIST 'LAST '|last|) (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL)
-             (LIST '|lowerCase?| 'LOWER-CASE-P) (LIST '|makeSymbol| 'INTERN)
+             (LIST '|lowerCase?| 'LOWER-CASE-P)
+             (LIST '|makeFilePath| 'MAKE-PATHNAME) (LIST '|makeSymbol| 'INTERN)
              (LIST '|mkpf| 'MKPF) (LIST '|newVector| 'MAKE-ARRAY)
              (LIST '|nil| NIL) (LIST '|not| 'NOT) (LIST '|null| 'NULL)
              (LIST '|odd?| 'ODDP) (LIST '|or| 'OR) (LIST '|otherwise| 'T)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index c681da73..4cc7a1bb 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -26,63 +26,46 @@
   (PROGN (|prettyPrint| |x| |st|) (TERPRI |st|)))
 
 (DEFUN |genModuleFinalization| (|stream|)
-  (LET* (|init|)
-    (DECLARE (SPECIAL |$currentModuleName| |$foreignsDefsForCLisp|))
-    (COND
-     ((|%hasFeature| :CLISP)
-      (COND ((NULL |$foreignsDefsForCLisp|) NIL)
-            ((NULL |$currentModuleName|)
-             (|coreError| "current module has no name"))
-            (T
-             (SETQ |init|
-                     (LIST 'EVAL-WHEN (LIST :LOAD-TOPLEVEL :EXECUTE)
-                           (CONS 'PROGN
-                                 (CONS
-                                  (LIST 'MAPC (LIST 'FUNCTION 'FMAKUNBOUND)
-                                        (|quote|
-                                         (LET ((|bfVar#2| NIL)
-                                               (|bfVar#3| NIL)
-                                               (|bfVar#1|
-                                                |$foreignsDefsForCLisp|)
-                                               (|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 (CADR |d|) NIL))
-                                              (SETQ |bfVar#3| |bfVar#2|))
-                                             (T (RPLACD |bfVar#3| #1#)
-                                              (SETQ |bfVar#3|
-                                                      (CDR |bfVar#3|))))
-                                            (SETQ |bfVar#1|
-                                                    (CDR |bfVar#1|))))))
-                                  (LET ((|bfVar#5| NIL)
-                                        (|bfVar#6| NIL)
-                                        (|bfVar#4| |$foreignsDefsForCLisp|)
+  (LET* (|init| |setFFS|)
+    (DECLARE (SPECIAL |$foreignsDefsForCLisp| |$currentModuleName| |$ffs|))
+    (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#2| NIL)
+                                        (|bfVar#3| NIL)
+                                        (|bfVar#1| |$foreignsDefsForCLisp|)
                                         (|d| NIL))
                                     (LOOP
                                      (COND
-                                      ((OR (NOT (CONSP |bfVar#4|))
+                                      ((OR (NOT (CONSP |bfVar#1|))
                                            (PROGN
-                                            (SETQ |d| (CAR |bfVar#4|))
+                                            (SETQ |d| (CAR |bfVar#1|))
                                             NIL))
-                                       (RETURN |bfVar#5|))
-                                      ((NULL |bfVar#5|)
-                                       (SETQ |bfVar#5|
-                                               #2=(CONS
+                                       (RETURN |bfVar#2|))
+                                      ((NULL |bfVar#2|)
+                                       (SETQ |bfVar#2|
+                                               #1=(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| |init| |stream|))))
-     (T NIL))))
+                                       (SETQ |bfVar#3| |bfVar#2|))
+                                      (T (RPLACD |bfVar#3| #1#)
+                                       (SETQ |bfVar#3| (CDR |bfVar#3|))))
+                                     (SETQ |bfVar#1| (CDR |bfVar#1|))))))
+                    (|reallyPrettyPrint| (|atLoadOrExecutionTime| |init|)
+                                         |stream|))))
+            (T NIL))))))
 
 (DEFUN |genOptimizeOptions| (|stream|)
   (|reallyPrettyPrint|
@@ -433,7 +416,7 @@
      (SETQ |ps| (|makeParserState| |toks|))
      (|bpFirstTok| |ps|)
      (SETQ |found|
-             (LET ((#1=#:G729
+             (LET ((#1=#:G734
                     (CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem| |ps|))))
                (COND
                 ((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
@@ -512,6 +495,9 @@
 (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|)))))))
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 20efc228..2e303001 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -287,7 +287,7 @@
       ((NOT
         (AND (CONSP |l|) (PROGN (SETQ |p| (CAR |l|)) (SETQ |l| (CDR |l|)) T)))
        (RETURN NIL))
-      ((AND (CONSP |p|) (EQ (CAR |p|) |x|)) (RETURN |p|))))))
+      ((AND (CONSP |p|) (EQ |x| (CAR |p|))) (RETURN |p|))))))
 
 (DEFUN |substitute!| (|y| |x| |s|)
   (COND ((NULL |s|) NIL) ((EQ |x| |s|) |y|)