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

4 files changed, 26 insertions, 37 deletions

diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp
index e94a77d9..7a69738f 100644
--- a/src/interp/nlib.lisp
+++ b/src/interp/nlib.lisp
@@ -50,8 +50,7 @@
                (if (null stream)
                    (if missing-file-error-flag
                        (ERROR (format nil "Library ~s doesn't exist"
-                              ;;(make-filename (cdr file) 'LISPLIB))
-                              (make-filename (cdr file) 'NIL)))
+                              (|makeFilename| (cdr file) 'NIL)))
                      NIL)
                (|makeLibstream| 'input fullname
                                 (get-index-table-from-stream stream)
@@ -183,7 +182,7 @@
 ;; filearg is filespec or 1, 2 or 3 ids
 ;; (RPACKFILE filearg)  -- compiles code files and converts to compressed format
 (defun rpackfile (filespec)
-  (setq filespec (make-filename filespec))
+  (setq filespec (|makeFilename| filespec))
   (if (string= (pathname-type filespec) "NRLIB")
       (recompile-lib-file-if-necessary 
        (concat (namestring filespec) "/code.lsp"))
@@ -242,37 +241,9 @@
            (mapcar #'string keys))
   (putindextable ctable filearg))
 
-;; cms file operations
-(defun make-filename (filearg &optional (filetype nil))
-  (let ((filetype (if (symbolp filetype) 
-                      (symbol-name filetype)
-                      filetype)))
-    (cond
-     ((pathnamep filearg) 
-      (cond ((pathname-type filearg) (namestring filearg))
-            (t (namestring (make-pathname :directory (pathname-directory filearg)
-                                          :name (pathname-name filearg)
-                                          :type filetype)))))
-     ;; Previously, given a filename containing "." and
-     ;; an extension this function would return filearg. MCD 23-8-95.
-     ((and (stringp filearg) (pathname-type filearg) (null filetype)) filearg)
-     ;;  ((and (stringp filearg)
-     ;;    (or (pathname-type filearg) (null filetype)))
-     ;;     filearg)
-     ((and (stringp filearg) (stringp filetype)
-           (pathname-type filearg) 
-           (string-equal (pathname-type filearg) filetype))
-      filearg)
-     ((consp filearg)
-      (make-filename (car filearg) (or (cadr filearg) filetype)))
-     (t (if (stringp filetype) (setq filetype (intern filetype "BOOT")))
-        (let ((ft (or (cdr (assoc filetype $filetype-table)) filetype)))
-          (if ft 
-              (concatenate 'string (string filearg) "." (string ft))
-              (string filearg)))))))
 
 (defun make-full-namestring (filearg &optional (filetype nil))
-  (namestring (merge-pathnames (make-filename filearg filetype))))
+  (namestring (merge-pathnames (|makeFilename| filearg filetype))))
 
 (defun get-directory-list (ft)
   (let ((cd (get-current-directory)))
@@ -288,7 +259,7 @@
 
 (defun make-input-filename (filearg &optional (filetype nil))
    (let*
-     ((filename  (make-filename filearg filetype))
+     ((filename  (|makeFilename| filearg filetype))
       (dirname (pathname-directory filename))
       (ft (pathname-type filename))
       (dirs (get-directory-list ft))
diff --git a/src/interp/pathname.boot b/src/interp/pathname.boot
index 3dece48d..1a3bc6b3 100644
--- a/src/interp/pathname.boot
+++ b/src/interp/pathname.boot
@@ -51,7 +51,7 @@ pathname p ==
   pathname? p => p
   p isnt [.,:.] => PATHNAME p
   if #p>2 then p:=[p.0,p.1]
-  PATHNAME apply(FUNCTION MAKE_-FILENAME, p)
+  PATHNAME apply(function makeFilename, p)
  
 namestring p == 
   null p => nil
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index d3a8c18d..6c7afa17 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -427,3 +427,21 @@ addCompilerOption(key,val) ==
     st := outputTextFile strconc(libDirname val,'"/code.lsp")
     $compilerOptions := [['COMPILER_-OUTPUT_-STREAM,:st],:$compilerOptions]
   nil
+
+makeFilename(filearg,filetype==nil) ==
+  if ident? filetype then
+    filetype := symbolName filetype
+  filePath? filearg => filePathString
+    filePathType filearg ~= nil => filearg
+    makeFilePath(directory <- filePathDirectory filearg,
+      name <- filePathName filearg, type <- filetype)
+  string? filearg and filePathType filearg ~= nil and filetype = nil => filearg
+  string? filearg and string? filetype and filePathType filearg ~= nil
+    and stringEq?(filePathType filearg,filetype) => filearg
+  filearg is [.,:.] =>
+    makeFilename(first filearg,second filearg or filetype)
+  if string? filetype then
+    filetype := makeSymbol filetype
+  ft := rest symbolAssoc(filetype,$FILETYPE_-TABLE) or filetype
+  ft = nil => toString filearg
+  strconc(toString filearg,'".",toString ft)
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index a6a0aa3a..28602764 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -932,7 +932,7 @@
  (declare (ignore width) (ignore recnum))
    (cond ((numberp filespec) (make-synonym-stream '*standard-output*))
          ((null filespec) (error "not handled yet"))
-         (t (open (make-filename filespec) :direction :output
+         (t (open (|makeFilename| filespec) :direction :output
 		  :if-exists :supersede))))
 
 (defun MAKE-APPENDSTREAM (filespec &optional (width nil) (recnum 0))
@@ -941,7 +941,7 @@
  (cond 
   ((numberp filespec) (make-synonym-stream '*standard-output*))
   ((null filespec) (error "make-appendstream: not handled yet"))
-  ('else (open (make-filename filespec) :direction :output
+  ('else (open (|makeFilename| filespec) :direction :output
           :if-exists :append :if-does-not-exist :create))))
 
 (defun DEFIOSTREAM (stream-alist buffer-size char-position)
@@ -954,7 +954,7 @@
 		((OUTPUT O) (make-synonym-stream '*standard-output*))
 		((INPUT I) (make-synonym-stream '*standard-input*)))
         (let ((strm (case mode
-                          ((OUTPUT O) (open (make-filename filename)
+                          ((OUTPUT O) (open (|makeFilename| filename)
                                             :direction :output))
                           ((INPUT I) (open (make-input-filename filename)
                                            :direction :input)))))