Rename MAKE-FULL-FILENAME to makeFullFilename.

16 files changed, 57 insertions, 51 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index ea72ec70..f3578ea3 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2013-05-27  Gabriel Dos Reis  <gdr@integrable-solutions.net>
+
+	* interp/nlib.lisp (MAKE-INPUT-FILENAME): Move to sys-utility.boot.
+	* boot/ast.boot (bfIS1): Handle Lisp keywords.
+
 2013-05-26  Gabriel Dos Reis  <gdr@integrable-solutions.net>
 
 	* interp/nlib.lisp (GET-DIRECTORY-LIST): Move to sys-utility.boot.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 6410b524..dfffa58a 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -761,6 +761,7 @@ bfIS1(tu,lhs,rhs) ==
   rhs = true => ['EQ,lhs,rhs]
   bfString? rhs => bfAND [['STRINGP,lhs],["STRING=",lhs,rhs]]
   bfChar? rhs or integer? rhs => ['EQL,lhs,rhs]
+  inert? rhs => ['EQ,lhs,rhs]
   rhs isnt [.,:.] => ['PROGN,bfLetForm(rhs,lhs),'T]
   rhs.op is 'QUOTE =>
     [.,a] := rhs
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 94f3cce2..a51ee1c2 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1124,6 +1124,7 @@
           ((|bfString?| |rhs|)
            (|bfAND| (LIST (LIST 'STRINGP |lhs|) (LIST 'STRING= |lhs| |rhs|))))
           ((OR (|bfChar?| |rhs|) (INTEGERP |rhs|)) (LIST 'EQL |lhs| |rhs|))
+          ((KEYWORDP |rhs|) (LIST 'EQ |lhs| |rhs|))
           ((NOT (CONSP |rhs|)) (LIST 'PROGN (|bfLetForm| |rhs| |lhs|) 'T))
           ((EQ (CAR |rhs|) 'QUOTE) (SETQ |a| (CADR |rhs|))
            (COND ((SYMBOLP |a|) (LIST 'EQ |lhs| |rhs|))
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index b606644b..3c0dd848 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -225,14 +225,16 @@
              (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 '|genvar| 'GENVAR) (LIST '|inert?| 'KEYWORDP)
+             (LIST '|integer?| 'INTEGERP) (LIST 'LAST '|last|)
+             (LIST '|list| 'LIST) (LIST '|listEq?| 'EQUAL)
              (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)
-             (LIST '|property| 'GET) (LIST '|readInteger| 'PARSE-INTEGER)
+             (LIST '|mergeFilePaths| 'MERGE-PATHNAMES) (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) (LIST '|property| 'GET)
+             (LIST '|readInteger| 'PARSE-INTEGER)
              (LIST '|readLispFromString| 'READ-FROM-STRING)
              (LIST '|readOnly?| 'CONSTANTP) (LIST '|removeDuplicates| 'REMDUP)
              (LIST '|rest| 'CDR) (LIST '|sameObject?| 'EQ)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index c8b29ebb..fa340275 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -298,6 +298,7 @@ for i in [ _
   ["functionSymbol?", "FBOUNDP"] , _
   ["gensym",    "GENSYM"]  , _
   ["genvar",    "GENVAR"]  , _
+  ["inert?",  "KEYWORDP"] , _
   ["integer?","INTEGERP"]  , _
   ["LAST",        "last"] , _
   ["list",        "LIST"]  , _
diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot
index be4fcd06..eaa43873 100644
--- a/src/interp/cparse.boot
+++ b/src/interp/cparse.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -1104,7 +1104,7 @@ _/RQ_,LIB(:x) ==
 
 
 _/RF_-1 x ==
-  ifile := MAKE_-INPUT_-FILENAME $editFile
+  ifile := makeInputFilename $editFile
   lfile := nil
   type := PATHNAME_-TYPE ifile
   type = '"boot" =>
diff --git a/src/interp/database.boot b/src/interp/database.boot
index fc13f773..d63d0f44 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -709,7 +709,7 @@ dropPrefix(fn) ==
 --moved to util.lisp
 --++loadExposureGroupData() ==
 --++  egFile := ['INTERP,'EXPOSED]
---++--  null MAKE_-INPUT_-FILENAME(egFile) =>
+--++--  null makeInputFilename(egFile) =>
 --++--    throwKeyedMsg("S2IL0003",[namestring egFile])
 --++  stream:= DEFIOSTREAM(['(MODE . INPUT),['FILE,:egFile]],80,0)
 --++  $globalExposureGroupAlist := nil
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 057caf98..e97cc1fc 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2012, Gabriel Dos Reis.
+;; Copyright (C) 2007-2013, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -209,7 +209,7 @@
           ;;%% next form is used because $FINDFILE seems to screw up
           ;;%% sometimes. The stream is opened and closed several times
           ;;%% in case the filemode has changed during editing.
-          (SETQ EDINFILE (make-input-filename INFILE))
+          (SETQ EDINFILE (|makeInputFilename| INFILE))
           (SETQ INPUTSTREAM (DEFSTREAM EDINFILE 'INPUT))
           (|sayBrightly|
             (LIST  "   editing file" '|%b| (|namestring| EDINFILE) '|%d|))
@@ -233,7 +233,7 @@
                  (RETURN NIL)))
           ;; next is done in case the diskmode changed
           (SHUT INPUTSTREAM) ))
-        (SETQ INFILE (make-input-filename INFILE))
+        (SETQ INFILE (|makeInputFilename| INFILE))
         (MAKEPROP /FN 'DEFLOC
                   (CONS RECNO INFILE))
         (SETQ oft (|object2Identifier| (UPCASE (|pathnameType| INFILE))))
@@ -311,7 +311,7 @@
 (DEFUN /LOCATE (FN KEY INFILE INITRECNO)
        (PROG (FT RECNO KEYLENGTH LN)
         (if (AND (NOT (eq 'FROMWRITEUPDATE (|pathnameName| INFILE)))
-                    (NOT (make-input-filename INFILE)))
+                    (NOT (|makeInputFilename| INFILE)))
             (RETURN NIL))
         (SETQ FT (UPCASE (|object2Identifier| (|pathnameType| INFILE))))
         (SETQ KEYLENGTH (LENGTH KEY))
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index ebd70a47..46e817cb 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2012, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -1016,7 +1016,7 @@ newHelpSpad2Cmd args ==
   -- see if new help file exists
 
   narg := PNAME arg
-  null (helpFile := MAKE_-INPUT_-FILENAME [narg,'HELPSPAD,'_*]) => nil
+  null (helpFile := makeInputFilename [narg,'HELPSPAD,'_*]) => nil
 
   $useFullScreenHelp =>
     editFile helpFile
@@ -1280,7 +1280,7 @@ initHist() ==
   newFile := histFileName()
   -- see if history directory is writable
   histFileErase oldFile
-  if MAKE_-INPUT_-FILENAME newFile then $REPLACE(oldFile,newFile)
+  if makeInputFilename newFile then $REPLACE(oldFile,newFile)
   $HiFiAccess:= true
   initHistList()
 
@@ -1528,7 +1528,7 @@ saveHistory(fn) ==
   $seen: local := hashTable 'EQ
   not $HiFiAccess => sayKeyedMsg("S2IH0016",nil)
   not $useInternalHistoryTable and
-    null MAKE_-INPUT_-FILENAME histFileName() => sayKeyedMsg("S2IH0022",nil)
+    null makeInputFilename histFileName() => sayKeyedMsg("S2IH0022",nil)
   null fn => 
     throwKeyedMsg("S2IH0037", nil)
   savefile := makeHistFileName(fn)
@@ -1554,7 +1554,7 @@ restoreHistory(fn) ==
   else if fn is [fn'] and ident?(fn') then fn' := fn'
        else throwKeyedMsg("S2IH0023",[fn'])
   restfile := makeHistFileName(fn')
-  null MAKE_-INPUT_-FILENAME restfile =>
+  null makeInputFilename restfile =>
     sayKeyedMsg("S2IH0024",[namestring(restfile)]) -- no history file
  
   -- if clear is changed to be undoable, this should be a reset-clear
@@ -2664,7 +2664,7 @@ workfilesSpad2Cmd args ==
     for file in flist repeat
       fl := pathname [file,type1,'"*"]
       deleteFlag => SETQ($sourceFiles,remove($sourceFiles,fl))
-      null (MAKE_-INPUT_-FILENAME fl) => sayKeyedMsg("S2IZ0035",[namestring fl])
+      null (makeInputFilename fl) => sayKeyedMsg("S2IZ0035",[namestring fl])
       updateSourceFiles fl
   SAY " "
   centerAndHighlight(" User-specified work files ",$LINELENGTH,specialChar 'hbar)
diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot
index a1982eb9..081826ac 100644
--- a/src/interp/i-toplev.boot
+++ b/src/interp/i-toplev.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2011, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -113,7 +113,7 @@ start(:l) ==
 readSpadProfileIfThere() ==
   -- reads SPADPROF INPUT if it exists
   file := ['_.axiom,'input]
-  MAKE_-INPUT_-FILENAME file =>
+  makeInputFilename file =>
     $editFile := file
     _/RQ ()
   nil
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index b2bbffe2..feaa8cef 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -453,7 +453,7 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,fal,fn) ==
   res
  
 compileDocumentation(ctor,libName) ==
-  filename := MAKE_-INPUT_-FILENAME(libName,$spadLibFT)
+  filename := makeInputFilename(libName,$spadLibFT)
   $FCOPY(filename,[libName,'DOCLB])
   stream := RDEFIOSTREAM [['FILE,libName,'DOCLB],['MODE, :'O]]
   lisplibWrite('"documentation",finalizeDocumentation ctor,stream)
diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp
index 8a9a2e99..6122111a 100644
--- a/src/interp/nlib.lisp
+++ b/src/interp/nlib.lisp
@@ -44,8 +44,7 @@
         (fullname nil)
         (indextable nil))
         (cond ((equal (elt (string mode) 0) #\I)
-               ;;(setq fullname (make-input-filename (cdr file) 'LISPLIB))
-               (setq fullname (make-input-filename (cdr file) 'NIL))
+               (setq fullname (|makeInputFilename| (cdr file) 'NIL))
                (setq stream (|openIndexFileIfPresent| fullname))
                (if (null stream)
                    (if missing-file-error-flag
@@ -133,10 +132,7 @@
 ;; (RKEYIDS filearg) -- interned version of keys
 (defun rkeyids (&rest filearg)
   (mapcar #'intern (mapcar #'car (|getIndexTable|
-                                  (make-input-filename filearg 'NIL)))))
-;;(defun rkeyids (&rest filearg)
-;;  (mapcar #'intern (mapcar #'car (|getIndexTable|
-;;                                (make-input-filename filearg 'LISPLIB)))))
+                                  (|makeInputFilename| filearg 'NIL)))))
 
 ;; (RWRITE cvec item rstream)
 (defun rwrite (key item rstream)
@@ -241,25 +237,11 @@
   (putindextable ctable filearg))
 
 
-(defun make-input-filename (filearg &optional (filetype nil))
-   (let*
-     ((filename  (|makeFilename| filearg filetype))
-      (dirname (pathname-directory filename))
-      (ft (pathname-type filename))
-      (dirs (|getDirectoryList| ft))
-      (newfn nil))   
-    (if (or (null dirname) (eqcar dirname :relative))
-        (dolist (dir dirs (|probeReadableFile| filename))
-	  (setq newfn (concatenate 'string dir filename))
-	  (when (|probeReadableFile| newfn)
-	    (return newfn)))
-      (|probeReadableFile| filename))))
-
 (defun $findfile (filespec filetypelist)
   (let ((file-name (if (consp filespec) (car filespec) filespec))
         (file-type (if (consp filespec) (cadr filespec) nil)))
     (if file-type (push file-type filetypelist))
-    (some #'(lambda (ft) (make-input-filename file-name ft))
+    (some #'(lambda (ft) (|makeInputFilename| file-name ft))
           filetypelist)))
 
 ;;(defun move-file (namestring1 namestring2)
diff --git a/src/interp/pathname.boot b/src/interp/pathname.boot
index 1a3bc6b3..15a8d88f 100644
--- a/src/interp/pathname.boot
+++ b/src/interp/pathname.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -76,7 +76,7 @@ pathnameDirectory p ==
 isExistingFile f ==
 --  p := pathname f
   --member(p,$existingFiles) => true
-  if MAKE_-INPUT_-FILENAME f
+  if makeInputFilename f
     then
       --$existingFiles := [p,:$existingFiles]
       true
@@ -130,7 +130,7 @@ newMKINFILENAM(infile) ==
  
 getFunctionSourceFile fun ==
   null (f := getFunctionSourceFile1 fun) => nil
-  if MAKE_-INPUT_-FILENAME(f) then updateSourceFiles f
+  if makeInputFilename(f) then updateSourceFiles f
   f
  
 getFunctionSourceFile1 fun ==
@@ -149,6 +149,6 @@ getFunctionSourceFile1 fun ==
 updateSourceFiles p ==
   p := pathname p
   p := pathname [pathnameName p, pathnameType p, '"*"]
-  if MAKE_-INPUT_-FILENAME p and pathnameTypeId p in '(BOOT LISP META) then
+  if makeInputFilename p and pathnameTypeId p in '(BOOT LISP META) then
     $sourceFiles := insert(p, $sourceFiles)
   p
diff --git a/src/interp/sys-os.boot b/src/interp/sys-os.boot
index a9a54d17..b79eff84 100644
--- a/src/interp/sys-os.boot
+++ b/src/interp/sys-os.boot
@@ -50,7 +50,10 @@ loadSystemRuntimeCore()
 --% File System Support
 
 ++ Current working directory
-import oa__getcwd: () -> string for getWorkingDirectory
+import oa__getcwd: () -> string for doGetWorkingDirectory
+
+getWorkingDirectory() ==
+  ensureTrailingSlash doGetWorkingDirectory()
 
 ++ change current working directory.
 import oa__chdir: string -> int for changeDirectory
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index a29779e9..e0cece17 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -1,3 +1,5 @@
+)eval TRACE bfIS1
+
 -- Copyright (C) 2007-2013 Gabriel Dos Reis.
 -- All rights reserved.
 --
@@ -460,3 +462,12 @@ getDirectoryList ft ==
     [home,:$DIRECTORY_-LIST]
   stringMember?(here,dirs) => dirs
   [here,:dirs]
+
+makeInputFilename(filearg,filetype == nil) ==
+  filename := makeFilename(filearg,filetype)
+  dirname := filePathDirectory filename
+  dirname = nil or dirname is [KEYWORD::RELATIVE,:.] =>
+    or/[probeReadableFile strconc(dir,filename)
+         for dir in getDirectoryList filePathType filename]
+           or probeReadableFile filename
+  probeReadableFile filename
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 28602764..40bd2bd5 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2012, Gabriel Dos Reis.
+;; Copyright (C) 2007-2013, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -925,7 +925,7 @@
  (declare (ignore recnum))
    (cond ((numberp filespec) (make-synonym-stream '*standard-input*))
          ((null filespec) (error "not handled yet"))
-         (t (open (make-input-filename filespec)
+         (t (open (|makeInputFilename| filespec)
                   :direction :input :if-does-not-exist nil))))
 
 (defun MAKE-OUTSTREAM (filespec &optional (width nil) (recnum 0))
@@ -956,7 +956,7 @@
         (let ((strm (case mode
                           ((OUTPUT O) (open (|makeFilename| filename)
                                             :direction :output))
-                          ((INPUT I) (open (make-input-filename filename)
+                          ((INPUT I) (open (|makeInputFilename| filename)
                                            :direction :input)))))
           (if (and (numberp char-position) (> char-position 0))
               (file-position strm char-position))