Changeset 9946


Ignore:
Timestamp:
09/08/05 16:14:55 (16 years ago)
Author:
piso
Message:

Logical pathnames: work in progress (tested).

Location:
trunk/j/src/org/armedbear/lisp
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/Autoload.java

    r9911 r9946  
    33 *
    44 * Copyright (C) 2003-2005 Peter Graves
    5  * $Id: Autoload.java,v 1.238 2005-08-24 16:30:14 piso Exp $
     5 * $Id: Autoload.java,v 1.239 2005-09-08 16:10:50 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    378378        autoload("list-all-packages", "PackageFunctions");
    379379        autoload("listen", "listen");
    380         autoload("load-logical-pathname-translations", "LogicalPathname");
    381380        autoload("log", "MathFunctions");
    382381        autoload("logand", "logand");
     
    386385        autoload("logcount", "logcount");
    387386        autoload("logeqv", "logeqv");
    388         autoload("logical-pathname", "LogicalPathname");
    389         autoload("logical-pathname-translations", "LogicalPathname");
    390387        autoload("logior", "logior");
    391388        autoload("lognand", "lognand");
     
    500497        autoload(PACKAGE_SYS, "%make-hash-table", "HashTableFunctions");
    501498        autoload(PACKAGE_SYS, "%make-hash-table", "HashTableFunctions");
     499        autoload(PACKAGE_SYS, "%make-logical-pathname", "LogicalPathname", true);
    502500        autoload(PACKAGE_SYS, "%make-server-socket", "make_server_socket");
    503501        autoload(PACKAGE_SYS, "%make-socket", "make_socket");
     
    521519        autoload(PACKAGE_SYS, "%set-generic-function-name", "StandardGenericFunction", true);
    522520        autoload(PACKAGE_SYS, "%set-gf-required-args", "StandardGenericFunction", true);
    523         autoload(PACKAGE_SYS, "%set-logical-pathname-translations", "LogicalPathname");
    524521        autoload(PACKAGE_SYS, "%set-method-fast-function", "StandardMethod", true);
    525522        autoload(PACKAGE_SYS, "%set-method-function", "StandardMethod", true);
  • trunk/j/src/org/armedbear/lisp/LogicalPathname.java

    r9079 r9946  
    22 * LogicalPathname.java
    33 *
    4  * Copyright (C) 2004 Peter Graves
    5  * $Id: LogicalPathname.java,v 1.7 2005-05-06 20:13:25 piso Exp $
     4 * Copyright (C) 2004-2005 Peter Graves
     5 * $Id: LogicalPathname.java,v 1.8 2005-09-08 16:03:01 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2828    private static final HashMap map = new HashMap();
    2929
    30     private LogicalPathname()
     30    public LogicalPathname(String host, String rest) throws ConditionThrowable
    3131    {
    32         // "The device component of a logical pathname is always :unspecific;
    33         // no other component of a logical pathname can be :unspecific."
     32        this.host = new SimpleString(host);
     33
     34        // "The device component of a logical pathname is always :UNSPECIFIC;
     35        // no other component of a logical pathname can be :UNSPECIFIC."
    3436        device = Keyword.UNSPECIFIC;
     37
     38        int semi = rest.lastIndexOf(';');
     39        if (semi >= 0) {
     40            // FIXME directory
     41            rest = rest.substring(semi + 1);
     42        }
     43
     44        int dot = rest.indexOf('.');
     45        if (dot >= 0) {
     46            String n = rest.substring(0, dot);
     47            if (n.equals("*"))
     48                name = Keyword.WILD;
     49            else
     50                name = new SimpleString(n.toUpperCase());
     51            rest = rest.substring(dot + 1);
     52            dot = rest.indexOf('.');
     53            if (dot >= 0) {
     54                String t = rest.substring(0, dot);
     55                if (t.equals("*"))
     56                    type = Keyword.WILD;
     57                else
     58                    type = new SimpleString(t.toUpperCase());
     59                // What's left is the version.
     60                String v = rest.substring(dot + 1);
     61                if (v.equals("*"))
     62                    version = Keyword.WILD;
     63                else if (v.equals("NEWEST") || v.equals("newest"))
     64                    version = Keyword.NEWEST;
     65                else
     66                    version = PACKAGE_CL.intern("PARSE-INTEGER").execute(new SimpleString(v));
     67            } else {
     68                String t = rest;
     69                if (t.equals("*"))
     70                    type = Keyword.WILD;
     71                else
     72                    type = new SimpleString(t.toUpperCase());
     73            }
     74        } else {
     75            String n = rest;
     76            if (n.equals("*"))
     77                name = Keyword.WILD;
     78            else
     79                name = new SimpleString(n.toUpperCase());
     80        }
    3581    }
    3682
     
    54100    }
    55101
    56     // ### %set-logical-pathname-translations
    57     // %set-logical-pathname-translations host new-translations => newval
    58     private static final Primitive _SET_LOGICAL_PATHNAME_TRANSLATIONS =
    59         new Primitive("%set-logical-pathname-translations", PACKAGE_SYS, false,
    60                        "host new-translations")
     102    public String writeToString() throws ConditionThrowable
    61103    {
    62         public LispObject execute(LispObject first, LispObject second)
     104        final LispThread thread = LispThread.currentThread();
     105        boolean printReadably = (_PRINT_READABLY_.symbolValue(thread) != NIL);
     106        boolean printEscape = (_PRINT_ESCAPE_.symbolValue(thread) != NIL);
     107        FastStringBuffer sb = new FastStringBuffer();
     108        if (printReadably || printEscape)
     109            sb.append("#P\"");
     110        sb.append(host.getStringValue());
     111        sb.append(':');
     112        // FIXME directory
     113        sb.append(name.getStringValue());
     114        if (type != NIL) {
     115            sb.append('.');
     116            if (type == Keyword.WILD)
     117                sb.append('*');
     118            else
     119                sb.append(type.getStringValue());
     120        }
     121        if (version.integerp()) {
     122            sb.append('.');
     123            int base = Fixnum.getValue(_PRINT_BASE_.symbolValue(thread));
     124            if (version instanceof Fixnum)
     125                sb.append(Integer.toString(((Fixnum)version).value, base).toUpperCase());
     126            else if (version instanceof Bignum)
     127                sb.append(((Bignum)version).value.toString(base).toUpperCase());
     128        } else if (version == Keyword.WILD) {
     129            sb.append('*');
     130        }
     131        if (printReadably || printEscape)
     132            sb.append('"');
     133        return sb.toString();
     134    }
     135
     136    // ### %make-logical-pathname namestring => logical-pathname
     137    private static final Primitive _MAKE_LOGICAL_PATHNAME =
     138        new Primitive("%make-logical-pathname", PACKAGE_SYS, true,
     139                      "namestring")
     140    {
     141        public LispObject execute(LispObject arg)
    63142            throws ConditionThrowable
    64143        {
    65             String host = first.getStringValue().toUpperCase();
    66             map.put(host, NIL); // FIXME
    67             return NIL;
    68         }
    69     };
    70 
    71     // ### logical-pathname-translations host => translations
    72     private static final Primitive LOGICAL_PATHNAME_TRANSLATIONS =
    73         new Primitive("logical-pathname-translations", "host")
    74     {
    75         public LispObject execute(LispObject arg) throws ConditionThrowable
    76         {
    77             return NIL;
    78         }
    79     };
    80 
    81     // ### load-logical-pathname-translations host => just-loaded
    82     private static final Primitive LOAD_LOGICAL_PATHNAME_TRANSLATIONS =
    83         new Primitive("load-logical-pathname-translations", "host")
    84     {
    85         public LispObject execute(LispObject arg) throws ConditionThrowable
    86         {
    87             String host = arg.getStringValue().toUpperCase();
    88             if (map.get(host) != null)
    89                 return NIL;
    90             return signal(new LispError("LOAD-LOGICAL-PATHNAME-TRANSLATIONS is not implemented."));
    91         }
    92     };
    93 
    94     // ### logical-pathname pathspec => logical-pathname
    95     private static final Primitive LOGICAL_PATHNAME =
    96         new Primitive("logical-pathname", "pathspec")
    97     {
    98         public LispObject execute(LispObject arg) throws ConditionThrowable
    99         {
    100             if (arg instanceof LogicalPathname)
    101                 return arg;
    102             if (arg instanceof AbstractString) {
    103                 String s = arg.getStringValue();
    104                 int index = s.indexOf(':');
    105                 if (index >= 0) {
    106                     String host = s.substring(0, index).toUpperCase();
    107                     LogicalPathname p = new LogicalPathname();
    108                     p.host = new SimpleString(host);
    109                     return p;
    110                 }
    111                 return NIL;
     144            // Check for a logical pathname host.
     145            String s = arg.getStringValue();
     146            String h = getHostString(s);
     147            if (h != null && Pathname.LOGICAL_PATHNAME_TRANSLATIONS.get(new SimpleString(h)) != null) {
     148                // A defined logical pathname host.
     149                return new LogicalPathname(h, s.substring(s.indexOf(':') + 1));
    112150            }
    113             if (arg instanceof Stream)
    114                 return NIL;
    115             return signal(new TypeError(arg,
    116                                         list4(Symbol.OR, Symbol.LOGICAL_PATHNAME,
    117                                               Symbol.STRING, Symbol.STREAM)));
     151            return signal(new TypeError("Logical namestring does not specify a host: \"" + s + '"'));
    118152        }
    119153    };
  • trunk/j/src/org/armedbear/lisp/Pathname.java

    r9783 r9946  
    33 *
    44 * Copyright (C) 2003-2005 Peter Graves
    5  * $Id: Pathname.java,v 1.81 2005-08-04 14:32:41 piso Exp $
     5 * $Id: Pathname.java,v 1.82 2005-09-08 16:02:29 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    3434    protected LispObject name = NIL;
    3535
    36     // A string, NIL, :wild or :unspecific.
     36    // A string, NIL, :WILD or :UNSPECIFIC.
    3737    protected LispObject type = NIL;
    3838
     
    178178    }
    179179
    180     private static final LispObject parseDirectory(String d)
     180    protected static final LispObject parseDirectory(String d)
    181181        throws ConditionThrowable
    182182    {
     
    257257        if (!validateDirectory(directory, false))
    258258            return null;
    259         StringBuffer sb = new StringBuffer(getDirectoryNamestring());
     259        FastStringBuffer sb = new FastStringBuffer();
     260        if (host != NIL) {
     261            Debug.assertTrue(host instanceof AbstractString);
     262            sb.append(host.getStringValue());
     263            sb.append(':');
     264        }
     265        sb.append(getDirectoryNamestring());
    260266        if (name instanceof AbstractString)
    261267            sb.append(name.getStringValue());
     
    465471    }
    466472
    467     public static Pathname parseNamestring(String namestring)
     473    // A logical host is represented as the string that names it.
     474    // (defvar *logical-pathname-translations* (make-hash-table :test 'equal))
     475    public static EqualHashTable LOGICAL_PATHNAME_TRANSLATIONS =
     476        new EqualHashTable(64, NIL, NIL);
     477
     478    private static final Symbol _LOGICAL_PATHNAME_TRANSLATIONS_ =
     479        exportSpecial("*LOGICAL-PATHNAME-TRANSLATIONS*", PACKAGE_SYS,
     480                      LOGICAL_PATHNAME_TRANSLATIONS);
     481
     482    public static Pathname parseNamestring(String s)
    468483        throws ConditionThrowable
    469484    {
    470         return new Pathname(namestring);
     485        return new Pathname(s);
     486    }
     487
     488    private static Pathname parseNamestring(AbstractString namestring)
     489        throws ConditionThrowable
     490    {
     491        // Check for a logical pathname host.
     492        String s = namestring.getStringValue();
     493        String h = getHostString(s);
     494        if (h != null && LOGICAL_PATHNAME_TRANSLATIONS.get(new SimpleString(h)) != null) {
     495            // A defined logical pathname host.
     496            return new LogicalPathname(h, s.substring(s.indexOf(':') + 1));
     497        }
     498        return new Pathname(s);
     499    }
     500
     501    // "one or more uppercase letters, digits, and hyphens"
     502    protected static String getHostString(String s)
     503    {
     504        int colon = s.indexOf(':');
     505        if (colon >= 0)
     506            return s.substring(0, colon).toUpperCase();
     507        else
     508            return null;
    471509    }
    472510
     
    474512        throws ConditionThrowable
    475513    {
    476         if (arg instanceof LogicalPathname)
    477             signal(new LispError("Bad place for a logical pathname."));
    478514        if (arg instanceof Pathname)
    479515            return (Pathname) arg;
    480516        if (arg instanceof AbstractString)
    481             return new Pathname(arg.getStringValue());
     517            return parseNamestring((AbstractString)arg);
    482518        if (arg instanceof FileStream)
    483519            return ((FileStream)arg).getPathname();
    484         signal(new TypeError(arg, list4(Symbol.OR, Symbol.PATHNAME,
    485                                         Symbol.STRING, Symbol.FILE_STREAM)));
     520        signalTypeError(arg, list4(Symbol.OR, Symbol.PATHNAME,
     521                                   Symbol.STRING, Symbol.FILE_STREAM));
    486522        // Not reached.
    487523        return null;
     
    492528    {
    493529        if (arg != Keyword.COMMON && arg != Keyword.LOCAL)
    494             signal(new TypeError(arg, list3(Symbol.MEMBER, Keyword.COMMON,
    495                                             Keyword.LOCAL)));
     530            signalTypeError(arg, list3(Symbol.MEMBER, Keyword.COMMON,
     531                                       Keyword.LOCAL));
    496532    }
    497533
     
    593629    };
    594630
    595     // ### pathname
    596     // pathname pathspec => pathname
     631    // ### pathname pathspec => pathname
    597632    private static final Primitive PATHNAME =
    598633        new Primitive("pathname", "pathspec")
     
    616651    };
    617652
     653    // Used by the #p reader.
    618654    public static final Pathname makePathname(LispObject args)
    619655        throws ConditionThrowable
     
    843879    }
    844880
     881    // ### %wild-pathname-p
    845882    private static final Primitive _WILD_PATHNAME_P =
    846883        new Primitive("%wild-pathname-p", PACKAGE_SYS, false)
  • trunk/j/src/org/armedbear/lisp/autoloads.lisp

    r9736 r9946  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: autoloads.lisp,v 1.193 2005-07-27 02:33:09 piso Exp $
     4;;; $Id: autoloads.lisp,v 1.194 2005-09-08 16:09:05 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    7171(autoload '(mismatch search))
    7272(autoload 'make-string)
    73 (autoload '(pathname-host pathname-device pathname-directory pathname-name
    74             pathname-type wild-pathname-p translate-pathname)
    75           "pathnames")
    7673(autoload 'directory "directory")
    7774(autoload '(signum round ffloor fceiling fround rationalize gcd isqrt
     
    155152(autoload '(write-byte read-byte) "byte-io")
    156153(autoload-macro 'with-open-file)
    157 (autoload 'translate-logical-pathname)
    158 (autoload 'parse-namestring)
     154(autoload '(pathname-host pathname-device pathname-directory pathname-name
     155            pathname-type wild-pathname-p translate-pathname
     156            logical-pathname-translations translate-logical-pathname
     157            load-logical-pathname-translations logical-pathname
     158            parse-namestring)
     159          "pathnames")
    159160(autoload 'make-string-output-stream)
    160161(autoload 'find-all-symbols)
  • trunk/j/src/org/armedbear/lisp/directory.lisp

    r5655 r9946  
    11;;; directory.lisp
    22;;;
    3 ;;; Copyright (C) 2004 Peter Graves
    4 ;;; $Id: directory.lisp,v 1.2 2004-02-02 01:06:33 piso Exp $
     3;;; Copyright (C) 2004-2005 Peter Graves
     4;;; $Id: directory.lisp,v 1.3 2005-09-08 16:14:55 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    1818;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    1919
    20 (in-package "SYSTEM")
     20(in-package #:system)
    2121
    2222(defun directory (pathname &key)
     23  (when (typep pathname 'logical-pathname)
     24    (error "Bad place for a logical pathname."))
    2325  (let ((merged-pathname (merge-pathnames pathname)))
    2426    (if (wild-pathname-p merged-pathname)
  • trunk/j/src/org/armedbear/lisp/pathnames.lisp

    r9419 r9946  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: pathnames.lisp,v 1.9 2005-06-17 15:41:06 piso Exp $
     4;;; $Id: pathnames.lisp,v 1.10 2005-09-08 16:05:46 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    4141  (declare (ignore args)) ; FIXME
    4242  (error "TRANSLATE-PATHNAME is not implemented."))
     43
     44(defun canonicalize-logical-hostname (host)
     45  (string-upcase host))
     46
     47(defun logical-pathname-translations (host)
     48  (gethash-2op-1ret (canonicalize-logical-hostname host)
     49                    *logical-pathname-translations*))
     50
     51(defun %set-logical-pathname-translations (host new-translations)
     52  (setf (gethash (canonicalize-logical-hostname host)
     53                 *logical-pathname-translations*)
     54        new-translations))
     55
     56(defsetf logical-pathname-translations %set-logical-pathname-translations)
     57
     58(defun translate-logical-pathname (pathname &key)
     59  (typecase pathname
     60    (logical-pathname
     61     ;; FIXME
     62     nil)
     63    (pathname pathname)
     64    (t (translate-logical-pathname (pathname pathname)))))
     65
     66(defun load-logical-pathname-translations (host)
     67  (declare (type string host))
     68  (multiple-value-bind (ignore found)
     69      (gethash (canonicalize-logical-hostname host)
     70               *logical-pathname-translations*)
     71    (declare (ignore ignore))
     72    (unless found
     73      (error "The logical host ~S was not found." host))))
     74
     75(defun logical-pathname (pathspec)
     76  (typecase pathspec
     77    (logical-pathname pathspec)
     78    (string
     79     (%make-logical-pathname pathspec))
     80    (stream
     81     (let ((result (pathname pathspec)))
     82       (if (typep result 'logical-pathname)
     83           result
     84           (error 'simple-type-error
     85                  :datum result
     86                  :expected-type 'logical-pathname))))
     87    (t
     88     (error 'type-error
     89            :datum pathspec
     90            :expected-type '(or logical-pathname string stream)))))
     91
     92(defun parse-namestring (thing
     93                         &optional host default-pathname
     94                         &key (start 0) end junk-allowed)
     95  (declare (ignore host default-pathname junk-allowed)) ; FIXME
     96  (typecase thing
     97    (stream
     98     (values (pathname thing) start))
     99    (pathname
     100     (values thing start))
     101    (string
     102     (unless end
     103       (setf end (length thing)))
     104     (values (pathname (subseq thing start end))
     105             end))
     106    (t
     107     (error 'type-error
     108            :format-control "~S cannot be converted to a pathname."
     109            :format-arguments (list thing)))))
Note: See TracChangeset for help on using the changeset viewer.