CodeMirror

 Module: locators-internals Synopsis: Abstract modeling of locations Author: Andy Armstrong Copyright: Original Code is Copyright (c) 1995-2004 Functional Objects, Inc. All rights reserved. License: See License.txt in this distribution for details.

            Warranty: Distributed WITHOUT WARRANTY OF ANY KIND define open generic locator-server (locator ::

            <locator>) => (server :: false-or(

                <server-locator>)); define open generic locator-host (locator ::

                    <locator>) => (host :: false-or(

                        <string>)); define open generic locator-volume (locator ::

                            <locator>) => (volume :: false-or(

                                <string>)); define open generic locator-directory (locator ::

                                    <locator>) => (directory :: false-or(

                                        <directory-locator>)); define open generic locator-relative? (locator ::

                                            <locator>) => (relative? ::

                                                <boolean>); define open generic locator-path (locator ::

                                                    <locator>) => (path ::

                                                        <sequence>); define open generic locator-base (locator ::

                                                            <locator>) => (base :: false-or(

                                                                <string>)); define open generic locator-extension (locator ::

                                                                    <locator>) => (extension :: false-or(

                                                                        <string>)); /// Locator classes define open abstract class

                                                                            <directory-locator> (

                                                                                <physical-locator>) end class

                                                                                    <directory-locator>; define open abstract class

                                                                                        <file-locator> (

                                                                                            <physical-locator>) end class

                                                                                                <file-locator>; define method as (class ==

                                                                                                    <directory-locator>, string ::

                                                                                                        <string>) => (locator ::

                                                                                                            <directory-locator>) as(

                                                                                                                <native-directory-locator>, string) end method as; define method make (class ==

                                                                                                                    <directory-locator>, #key server :: false-or(

                                                                                                                        <server-locator>) = #f, path ::

                                                                                                                            <sequence> = #[], relative? ::

                                                                                                                                <boolean> = #f, name :: false-or(

                                                                                                                                    <string>) = #f) => (locator ::

                                                                                                                                        <directory-locator>) make(

                                                                                                                                            <native-directory-locator>, server: server, path: path, relative?: relative?, name: name) end method make; define method as (class ==

                                                                                                                                                <file-locator>, string ::

                                                                                                                                                    <string>) => (locator ::

                                                                                                                                                        <file-locator>) as(

                                                                                                                                                            <native-file-locator>, string) end method as; define method make (class ==

                                                                                                                                                                <file-locator>, #key directory :: false-or(

                                                                                                                                                                    <directory-locator>) = #f, base :: false-or(

                                                                                                                                                                        <string>) = #f, extension :: false-or(

                                                                                                                                                                            <string>) = #f, name :: false-or(

                                                                                                                                                                                <string>) = #f) => (locator ::

                                                                                                                                                                                    <file-locator>) make(

                                                                                                                                                                                        <native-file-locator>, directory: directory, base: base, extension: extension, name: name)

                                                                                                                                                                                            end method make; /// Locator coercion //---*** andrewa: This caching

                                                                                                                                                                                            scheme doesn't work yet, so disable it. define constant $cache-locators?

                                                                                                                                                                                            = #f; define constant $cache-locator-strings? = #f; define constant

                                                                                                                                                                                            $locator-to-string-cache = make(

                                                                                                                                                                                            <object-table>, weak: #"key"); define constant $string-to-locator-cache = make(

                                                                                                                                                                                                <string-table>, weak: #"value"); define open generic locator-as-string (class

                                                                                                                                                                                                    :: subclass(

                                                                                                                                                                                                    <string>), locator ::

                                                                                                                                                                                                        <locator>) => (string ::

                                                                                                                                                                                                            <string>); define open generic string-as-locator (class

                                                                                                                                                                                                                :: subclass(

                                                                                                                                                                                                                <locator>), string ::

                                                                                                                                                                                                                    <string>) => (locator ::

                                                                                                                                                                                                                        <locator>); define sealed sideways method as

                                                                                                                                                                                                                            (class :: subclass(

                                                                                                                                                                                                                            <string>), locator ::

                                                                                                                                                                                                                                <locator>) => (string ::

                                                                                                                                                                                                                                    <string>) let string = element($locator-to-string-cache,

                                                                                                                                                                                                                                        locator, default: #f);

                                                                                                                                                                                                                                        if (string) as(class,

                                                                                                                                                                                                                                        string) else let string

                                                                                                                                                                                                                                        = locator-as-string(class,

                                                                                                                                                                                                                                        locator); if ($cache-locator-strings?)

                                                                                                                                                                                                                                        element($locator-to-string-cache,

                                                                                                                                                                                                                                        locator) := string;

                                                                                                                                                                                                                                        else string end end

                                                                                                                                                                                                                                        end method as; define

                                                                                                                                                                                                                                        sealed sideways method

                                                                                                                                                                                                                                        as (class :: subclass(

                                                                                                                                                                                                                                        <locator>), string ::

                                                                                                                                                                                                                                            <string>) => (locator ::

                                                                                                                                                                                                                                                <locator>) let locator

                                                                                                                                                                                                                                                    = element($string-to-locator-cache,

                                                                                                                                                                                                                                                    string,

                                                                                                                                                                                                                                                    default:

                                                                                                                                                                                                                                                    #f); if

                                                                                                                                                                                                                                                    (instance?(locator,

                                                                                                                                                                                                                                                    class))

                                                                                                                                                                                                                                                    locator

                                                                                                                                                                                                                                                    else let

                                                                                                                                                                                                                                                    locator

                                                                                                                                                                                                                                                    = string-as-locator(class,

                                                                                                                                                                                                                                                    string);

                                                                                                                                                                                                                                                    if ($cache-locators?)

                                                                                                                                                                                                                                                    element($string-to-locator-cache,

                                                                                                                                                                                                                                                    string)

                                                                                                                                                                                                                                                    := locator;

                                                                                                                                                                                                                                                    else locator

                                                                                                                                                                                                                                                    end end

                                                                                                                                                                                                                                                    end method

                                                                                                                                                                                                                                                    as; ///

                                                                                                                                                                                                                                                    Locator

                                                                                                                                                                                                                                                    conditions

                                                                                                                                                                                                                                                    define

                                                                                                                                                                                                                                                    class

                                                                                                                                                                                                                                                    <locator-error>

                                                                                                                                                                                                                                                    (

                                                                                                                                                                                                                                                        <format-string-condition>,

                                                                                                                                                                                                                                                            <error>)

                                                                                                                                                                                                                                                                end

                                                                                                                                                                                                                                                                class

                                                                                                                                                                                                                                                                <locator-error>;

                                                                                                                                                                                                                                                                    define

                                                                                                                                                                                                                                                                    function

                                                                                                                                                                                                                                                                    locator-error

                                                                                                                                                                                                                                                                    (format-string

                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                    <string>,

                                                                                                                                                                                                                                                                        #rest

                                                                                                                                                                                                                                                                        format-arguments)

                                                                                                                                                                                                                                                                        error(make(

                                                                                                                                                                                                                                                                        <locator-error>,

                                                                                                                                                                                                                                                                            format-string:

                                                                                                                                                                                                                                                                            format-string,

                                                                                                                                                                                                                                                                            format-arguments:

                                                                                                                                                                                                                                                                            format-arguments))

                                                                                                                                                                                                                                                                            end

                                                                                                                                                                                                                                                                            function

                                                                                                                                                                                                                                                                            locator-error;

                                                                                                                                                                                                                                                                            ///

                                                                                                                                                                                                                                                                            Useful

                                                                                                                                                                                                                                                                            locator

                                                                                                                                                                                                                                                                            protocols

                                                                                                                                                                                                                                                                            define

                                                                                                                                                                                                                                                                            open

                                                                                                                                                                                                                                                                            generic

                                                                                                                                                                                                                                                                            locator-test

                                                                                                                                                                                                                                                                            (locator

                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                            <directory-locator>)

                                                                                                                                                                                                                                                                                =>

                                                                                                                                                                                                                                                                                (test

                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                <function>);

                                                                                                                                                                                                                                                                                    define

                                                                                                                                                                                                                                                                                    method

                                                                                                                                                                                                                                                                                    locator-test

                                                                                                                                                                                                                                                                                    (locator

                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                    <directory-locator>)

                                                                                                                                                                                                                                                                                        =>

                                                                                                                                                                                                                                                                                        (test

                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                        <function>)

                                                                                                                                                                                                                                                                                            \=

                                                                                                                                                                                                                                                                                            end

                                                                                                                                                                                                                                                                                            method

                                                                                                                                                                                                                                                                                            locator-test;

                                                                                                                                                                                                                                                                                            define

                                                                                                                                                                                                                                                                                            open

                                                                                                                                                                                                                                                                                            generic

                                                                                                                                                                                                                                                                                            locator-might-have-links?

                                                                                                                                                                                                                                                                                            (locator

                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                            <directory-locator>)

                                                                                                                                                                                                                                                                                                =>

                                                                                                                                                                                                                                                                                                (links?

                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                <boolean>);

                                                                                                                                                                                                                                                                                                    define

                                                                                                                                                                                                                                                                                                    method

                                                                                                                                                                                                                                                                                                    locator-might-have-links?

                                                                                                                                                                                                                                                                                                    (locator

                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                    <directory-locator>)

                                                                                                                                                                                                                                                                                                        =>

                                                                                                                                                                                                                                                                                                        (links?

                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                        singleton(#f))

                                                                                                                                                                                                                                                                                                        #f

                                                                                                                                                                                                                                                                                                        end

                                                                                                                                                                                                                                                                                                        method

                                                                                                                                                                                                                                                                                                        locator-might-have-links?;

                                                                                                                                                                                                                                                                                                        define

                                                                                                                                                                                                                                                                                                        method

                                                                                                                                                                                                                                                                                                        locator-relative?

                                                                                                                                                                                                                                                                                                        (locator

                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                        <file-locator>)

                                                                                                                                                                                                                                                                                                            =>

                                                                                                                                                                                                                                                                                                            (relative?

                                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                                            <boolean>)

                                                                                                                                                                                                                                                                                                                let

                                                                                                                                                                                                                                                                                                                directory

                                                                                                                                                                                                                                                                                                                =

                                                                                                                                                                                                                                                                                                                locator.locator-directory;

                                                                                                                                                                                                                                                                                                                ~directory

                                                                                                                                                                                                                                                                                                                |

                                                                                                                                                                                                                                                                                                                directory.locator-relative?

                                                                                                                                                                                                                                                                                                                end

                                                                                                                                                                                                                                                                                                                method

                                                                                                                                                                                                                                                                                                                locator-relative?;

                                                                                                                                                                                                                                                                                                                define

                                                                                                                                                                                                                                                                                                                method

                                                                                                                                                                                                                                                                                                                current-directory-locator?

                                                                                                                                                                                                                                                                                                                (locator

                                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                                <directory-locator>)

                                                                                                                                                                                                                                                                                                                    =>

                                                                                                                                                                                                                                                                                                                    (current-directory?

                                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                                    <boolean>)

                                                                                                                                                                                                                                                                                                                        locator.locator-relative?

                                                                                                                                                                                                                                                                                                                        &

                                                                                                                                                                                                                                                                                                                        locator.locator-path

                                                                                                                                                                                                                                                                                                                        =

                                                                                                                                                                                                                                                                                                                        #[#"self"]

                                                                                                                                                                                                                                                                                                                        end

                                                                                                                                                                                                                                                                                                                        method

                                                                                                                                                                                                                                                                                                                        current-directory-locator?;

                                                                                                                                                                                                                                                                                                                        define

                                                                                                                                                                                                                                                                                                                        method

                                                                                                                                                                                                                                                                                                                        locator-directory

                                                                                                                                                                                                                                                                                                                        (locator

                                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                                        <directory-locator>)

                                                                                                                                                                                                                                                                                                                            =>

                                                                                                                                                                                                                                                                                                                            (parent

                                                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                                                            false-or(

                                                                                                                                                                                                                                                                                                                            <directory-locator>))

                                                                                                                                                                                                                                                                                                                                let

                                                                                                                                                                                                                                                                                                                                path

                                                                                                                                                                                                                                                                                                                                =

                                                                                                                                                                                                                                                                                                                                locator.locator-path;

                                                                                                                                                                                                                                                                                                                                unless

                                                                                                                                                                                                                                                                                                                                (empty?(path))

                                                                                                                                                                                                                                                                                                                                make(object-class(locator),

                                                                                                                                                                                                                                                                                                                                server:

                                                                                                                                                                                                                                                                                                                                locator.locator-server,

                                                                                                                                                                                                                                                                                                                                path:

                                                                                                                                                                                                                                                                                                                                copy-sequence(path,

                                                                                                                                                                                                                                                                                                                                end:

                                                                                                                                                                                                                                                                                                                                path.size

                                                                                                                                                                                                                                                                                                                                -

                                                                                                                                                                                                                                                                                                                                1),

                                                                                                                                                                                                                                                                                                                                relative?:

                                                                                                                                                                                                                                                                                                                                locator.locator-relative?)

                                                                                                                                                                                                                                                                                                                                end

                                                                                                                                                                                                                                                                                                                                end

                                                                                                                                                                                                                                                                                                                                method

                                                                                                                                                                                                                                                                                                                                locator-directory;

                                                                                                                                                                                                                                                                                                                                ///

                                                                                                                                                                                                                                                                                                                                Simplify

                                                                                                                                                                                                                                                                                                                                locator

                                                                                                                                                                                                                                                                                                                                define

                                                                                                                                                                                                                                                                                                                                open

                                                                                                                                                                                                                                                                                                                                generic

                                                                                                                                                                                                                                                                                                                                simplify-locator

                                                                                                                                                                                                                                                                                                                                (locator

                                                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                                                <physical-locator>)

                                                                                                                                                                                                                                                                                                                                    =>

                                                                                                                                                                                                                                                                                                                                    (simplified-locator

                                                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                                                    <physical-locator>);

                                                                                                                                                                                                                                                                                                                                        define

                                                                                                                                                                                                                                                                                                                                        method

                                                                                                                                                                                                                                                                                                                                        simplify-locator

                                                                                                                                                                                                                                                                                                                                        (locator

                                                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                                                        <directory-locator>)

                                                                                                                                                                                                                                                                                                                                            =>

                                                                                                                                                                                                                                                                                                                                            (simplified-locator

                                                                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                                                                            <directory-locator>)

                                                                                                                                                                                                                                                                                                                                                let

                                                                                                                                                                                                                                                                                                                                                path

                                                                                                                                                                                                                                                                                                                                                =

                                                                                                                                                                                                                                                                                                                                                locator.locator-path;

                                                                                                                                                                                                                                                                                                                                                let

                                                                                                                                                                                                                                                                                                                                                relative?

                                                                                                                                                                                                                                                                                                                                                =

                                                                                                                                                                                                                                                                                                                                                locator.locator-relative?;

                                                                                                                                                                                                                                                                                                                                                let

                                                                                                                                                                                                                                                                                                                                                resolve-parent?

                                                                                                                                                                                                                                                                                                                                                =

                                                                                                                                                                                                                                                                                                                                                ~locator.locator-might-have-links?;

                                                                                                                                                                                                                                                                                                                                                let

                                                                                                                                                                                                                                                                                                                                                simplified-path

                                                                                                                                                                                                                                                                                                                                                =

                                                                                                                                                                                                                                                                                                                                                simplify-path(path,

                                                                                                                                                                                                                                                                                                                                                resolve-parent?:

                                                                                                                                                                                                                                                                                                                                                resolve-parent?,

                                                                                                                                                                                                                                                                                                                                                relative?:

                                                                                                                                                                                                                                                                                                                                                relative?);

                                                                                                                                                                                                                                                                                                                                                if

                                                                                                                                                                                                                                                                                                                                                (path

                                                                                                                                                                                                                                                                                                                                                ~=

                                                                                                                                                                                                                                                                                                                                                simplified-path)

                                                                                                                                                                                                                                                                                                                                                make(object-class(locator),

                                                                                                                                                                                                                                                                                                                                                server:

                                                                                                                                                                                                                                                                                                                                                locator.locator-server,

                                                                                                                                                                                                                                                                                                                                                path:

                                                                                                                                                                                                                                                                                                                                                simplified-path,

                                                                                                                                                                                                                                                                                                                                                relative?:

                                                                                                                                                                                                                                                                                                                                                locator.locator-relative?)

                                                                                                                                                                                                                                                                                                                                                else

                                                                                                                                                                                                                                                                                                                                                locator

                                                                                                                                                                                                                                                                                                                                                end

                                                                                                                                                                                                                                                                                                                                                end

                                                                                                                                                                                                                                                                                                                                                method

                                                                                                                                                                                                                                                                                                                                                simplify-locator;

                                                                                                                                                                                                                                                                                                                                                define

                                                                                                                                                                                                                                                                                                                                                method

                                                                                                                                                                                                                                                                                                                                                simplify-locator

                                                                                                                                                                                                                                                                                                                                                (locator

                                                                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                                                                <file-locator>)

                                                                                                                                                                                                                                                                                                                                                    =>

                                                                                                                                                                                                                                                                                                                                                    (simplified-locator

                                                                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                                                                    <file-locator>)

                                                                                                                                                                                                                                                                                                                                                        let

                                                                                                                                                                                                                                                                                                                                                        directory

                                                                                                                                                                                                                                                                                                                                                        =

                                                                                                                                                                                                                                                                                                                                                        locator.locator-directory;

                                                                                                                                                                                                                                                                                                                                                        let

                                                                                                                                                                                                                                                                                                                                                        simplified-directory

                                                                                                                                                                                                                                                                                                                                                        =

                                                                                                                                                                                                                                                                                                                                                        directory

                                                                                                                                                                                                                                                                                                                                                        &

                                                                                                                                                                                                                                                                                                                                                        simplify-locator(directory);

                                                                                                                                                                                                                                                                                                                                                        if

                                                                                                                                                                                                                                                                                                                                                        (directory

                                                                                                                                                                                                                                                                                                                                                        ~=

                                                                                                                                                                                                                                                                                                                                                        simplified-directory)

                                                                                                                                                                                                                                                                                                                                                        make(object-class(locator),

                                                                                                                                                                                                                                                                                                                                                        directory:

                                                                                                                                                                                                                                                                                                                                                        simplified-directory,

                                                                                                                                                                                                                                                                                                                                                        base:

                                                                                                                                                                                                                                                                                                                                                        locator.locator-base,

                                                                                                                                                                                                                                                                                                                                                        extension:

                                                                                                                                                                                                                                                                                                                                                        locator.locator-extension)

                                                                                                                                                                                                                                                                                                                                                        else

                                                                                                                                                                                                                                                                                                                                                        locator

                                                                                                                                                                                                                                                                                                                                                        end

                                                                                                                                                                                                                                                                                                                                                        end

                                                                                                                                                                                                                                                                                                                                                        method

                                                                                                                                                                                                                                                                                                                                                        simplify-locator;

                                                                                                                                                                                                                                                                                                                                                        ///

                                                                                                                                                                                                                                                                                                                                                        Subdirectory

                                                                                                                                                                                                                                                                                                                                                        locator

                                                                                                                                                                                                                                                                                                                                                        define

                                                                                                                                                                                                                                                                                                                                                        open

                                                                                                                                                                                                                                                                                                                                                        generic

                                                                                                                                                                                                                                                                                                                                                        subdirectory-locator

                                                                                                                                                                                                                                                                                                                                                        (locator

                                                                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                                                                        <directory-locator>,

                                                                                                                                                                                                                                                                                                                                                            #rest

                                                                                                                                                                                                                                                                                                                                                            sub-path)

                                                                                                                                                                                                                                                                                                                                                            =>

                                                                                                                                                                                                                                                                                                                                                            (subdirectory

                                                                                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                                                                                            <directory-locator>);

                                                                                                                                                                                                                                                                                                                                                                define

                                                                                                                                                                                                                                                                                                                                                                method

                                                                                                                                                                                                                                                                                                                                                                subdirectory-locator

                                                                                                                                                                                                                                                                                                                                                                (locator

                                                                                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                                                                                <directory-locator>,

                                                                                                                                                                                                                                                                                                                                                                    #rest

                                                                                                                                                                                                                                                                                                                                                                    sub-path)

                                                                                                                                                                                                                                                                                                                                                                    =>

                                                                                                                                                                                                                                                                                                                                                                    (subdirectory

                                                                                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                                                                                    <directory-locator>)

                                                                                                                                                                                                                                                                                                                                                                        let

                                                                                                                                                                                                                                                                                                                                                                        old-path

                                                                                                                                                                                                                                                                                                                                                                        =

                                                                                                                                                                                                                                                                                                                                                                        locator.locator-path;

                                                                                                                                                                                                                                                                                                                                                                        let

                                                                                                                                                                                                                                                                                                                                                                        new-path

                                                                                                                                                                                                                                                                                                                                                                        =

                                                                                                                                                                                                                                                                                                                                                                        concatenate-as(

                                                                                                                                                                                                                                                                                                                                                                        <simple-object-vector>,

                                                                                                                                                                                                                                                                                                                                                                            old-path,

                                                                                                                                                                                                                                                                                                                                                                            sub-path);

                                                                                                                                                                                                                                                                                                                                                                            make(object-class(locator),

                                                                                                                                                                                                                                                                                                                                                                            server:

                                                                                                                                                                                                                                                                                                                                                                            locator.locator-server,

                                                                                                                                                                                                                                                                                                                                                                            path:

                                                                                                                                                                                                                                                                                                                                                                            new-path,

                                                                                                                                                                                                                                                                                                                                                                            relative?:

                                                                                                                                                                                                                                                                                                                                                                            locator.locator-relative?)

                                                                                                                                                                                                                                                                                                                                                                            end

                                                                                                                                                                                                                                                                                                                                                                            method

                                                                                                                                                                                                                                                                                                                                                                            subdirectory-locator;

                                                                                                                                                                                                                                                                                                                                                                            ///

                                                                                                                                                                                                                                                                                                                                                                            Relative

                                                                                                                                                                                                                                                                                                                                                                            locator

                                                                                                                                                                                                                                                                                                                                                                            define

                                                                                                                                                                                                                                                                                                                                                                            open

                                                                                                                                                                                                                                                                                                                                                                            generic

                                                                                                                                                                                                                                                                                                                                                                            relative-locator

                                                                                                                                                                                                                                                                                                                                                                            (locator

                                                                                                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                                                                                                            <physical-locator>,

                                                                                                                                                                                                                                                                                                                                                                                from-locator

                                                                                                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                                                                                                <physical-locator>)

                                                                                                                                                                                                                                                                                                                                                                                    =>

                                                                                                                                                                                                                                                                                                                                                                                    (relative-locator

                                                                                                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                                                                                                    <physical-locator>);

                                                                                                                                                                                                                                                                                                                                                                                        define

                                                                                                                                                                                                                                                                                                                                                                                        method

                                                                                                                                                                                                                                                                                                                                                                                        relative-locator

                                                                                                                                                                                                                                                                                                                                                                                        (locator

                                                                                                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                                                                                                        <directory-locator>,

                                                                                                                                                                                                                                                                                                                                                                                            from-locator

                                                                                                                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                                                                                                                            <directory-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                =>

                                                                                                                                                                                                                                                                                                                                                                                                (relative-locator

                                                                                                                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                                                                                                                <directory-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                    let

                                                                                                                                                                                                                                                                                                                                                                                                    path

                                                                                                                                                                                                                                                                                                                                                                                                    =

                                                                                                                                                                                                                                                                                                                                                                                                    locator.locator-path;

                                                                                                                                                                                                                                                                                                                                                                                                    let

                                                                                                                                                                                                                                                                                                                                                                                                    from-path

                                                                                                                                                                                                                                                                                                                                                                                                    =

                                                                                                                                                                                                                                                                                                                                                                                                    from-locator.locator-path;

                                                                                                                                                                                                                                                                                                                                                                                                    case

                                                                                                                                                                                                                                                                                                                                                                                                    ~locator.locator-relative?

                                                                                                                                                                                                                                                                                                                                                                                                    &

                                                                                                                                                                                                                                                                                                                                                                                                    from-locator.locator-relative?

                                                                                                                                                                                                                                                                                                                                                                                                    =>

                                                                                                                                                                                                                                                                                                                                                                                                    locator-error

                                                                                                                                                                                                                                                                                                                                                                                                    ("Cannot

                                                                                                                                                                                                                                                                                                                                                                                                    find

                                                                                                                                                                                                                                                                                                                                                                                                    relative

                                                                                                                                                                                                                                                                                                                                                                                                    path

                                                                                                                                                                                                                                                                                                                                                                                                    of

                                                                                                                                                                                                                                                                                                                                                                                                    absolute

                                                                                                                                                                                                                                                                                                                                                                                                    locator

                                                                                                                                                                                                                                                                                                                                                                                                    %=

                                                                                                                                                                                                                                                                                                                                                                                                    from

                                                                                                                                                                                                                                                                                                                                                                                                    relative

                                                                                                                                                                                                                                                                                                                                                                                                    locator

                                                                                                                                                                                                                                                                                                                                                                                                    %=",

                                                                                                                                                                                                                                                                                                                                                                                                    locator,

                                                                                                                                                                                                                                                                                                                                                                                                    from-locator);

                                                                                                                                                                                                                                                                                                                                                                                                    locator.locator-server

                                                                                                                                                                                                                                                                                                                                                                                                    ~=

                                                                                                                                                                                                                                                                                                                                                                                                    from-locator.locator-server

                                                                                                                                                                                                                                                                                                                                                                                                    =>

                                                                                                                                                                                                                                                                                                                                                                                                    locator;

                                                                                                                                                                                                                                                                                                                                                                                                    path

                                                                                                                                                                                                                                                                                                                                                                                                    =

                                                                                                                                                                                                                                                                                                                                                                                                    from-path

                                                                                                                                                                                                                                                                                                                                                                                                    =>

                                                                                                                                                                                                                                                                                                                                                                                                    make(object-class(locator),

                                                                                                                                                                                                                                                                                                                                                                                                    path:

                                                                                                                                                                                                                                                                                                                                                                                                    vector(#"self"),

                                                                                                                                                                                                                                                                                                                                                                                                    relative?:

                                                                                                                                                                                                                                                                                                                                                                                                    #t);

                                                                                                                                                                                                                                                                                                                                                                                                    otherwise

                                                                                                                                                                                                                                                                                                                                                                                                    =>

                                                                                                                                                                                                                                                                                                                                                                                                    make(object-class(locator),

                                                                                                                                                                                                                                                                                                                                                                                                    path:

                                                                                                                                                                                                                                                                                                                                                                                                    relative-path(path,

                                                                                                                                                                                                                                                                                                                                                                                                    from-path,

                                                                                                                                                                                                                                                                                                                                                                                                    test:

                                                                                                                                                                                                                                                                                                                                                                                                    locator.locator-test),

                                                                                                                                                                                                                                                                                                                                                                                                    relative?:

                                                                                                                                                                                                                                                                                                                                                                                                    #t);

                                                                                                                                                                                                                                                                                                                                                                                                    end

                                                                                                                                                                                                                                                                                                                                                                                                    end

                                                                                                                                                                                                                                                                                                                                                                                                    method

                                                                                                                                                                                                                                                                                                                                                                                                    relative-locator;

                                                                                                                                                                                                                                                                                                                                                                                                    define

                                                                                                                                                                                                                                                                                                                                                                                                    method

                                                                                                                                                                                                                                                                                                                                                                                                    relative-locator

                                                                                                                                                                                                                                                                                                                                                                                                    (locator

                                                                                                                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                                                                                                                    <file-locator>,

                                                                                                                                                                                                                                                                                                                                                                                                        from-directory

                                                                                                                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                                                                                                                        <directory-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                            =>

                                                                                                                                                                                                                                                                                                                                                                                                            (relative-locator

                                                                                                                                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                                                                                                                                            <file-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                                let

                                                                                                                                                                                                                                                                                                                                                                                                                directory

                                                                                                                                                                                                                                                                                                                                                                                                                =

                                                                                                                                                                                                                                                                                                                                                                                                                locator.locator-directory;

                                                                                                                                                                                                                                                                                                                                                                                                                let

                                                                                                                                                                                                                                                                                                                                                                                                                relative-directory

                                                                                                                                                                                                                                                                                                                                                                                                                =

                                                                                                                                                                                                                                                                                                                                                                                                                directory

                                                                                                                                                                                                                                                                                                                                                                                                                &

                                                                                                                                                                                                                                                                                                                                                                                                                relative-locator(directory,

                                                                                                                                                                                                                                                                                                                                                                                                                from-directory);

                                                                                                                                                                                                                                                                                                                                                                                                                if

                                                                                                                                                                                                                                                                                                                                                                                                                (relative-directory

                                                                                                                                                                                                                                                                                                                                                                                                                ~=

                                                                                                                                                                                                                                                                                                                                                                                                                directory)

                                                                                                                                                                                                                                                                                                                                                                                                                simplify-locator

                                                                                                                                                                                                                                                                                                                                                                                                                (make(object-class(locator),

                                                                                                                                                                                                                                                                                                                                                                                                                directory:

                                                                                                                                                                                                                                                                                                                                                                                                                relative-directory,

                                                                                                                                                                                                                                                                                                                                                                                                                base:

                                                                                                                                                                                                                                                                                                                                                                                                                locator.locator-base,

                                                                                                                                                                                                                                                                                                                                                                                                                extension:

                                                                                                                                                                                                                                                                                                                                                                                                                locator.locator-extension))

                                                                                                                                                                                                                                                                                                                                                                                                                else

                                                                                                                                                                                                                                                                                                                                                                                                                locator

                                                                                                                                                                                                                                                                                                                                                                                                                end

                                                                                                                                                                                                                                                                                                                                                                                                                end

                                                                                                                                                                                                                                                                                                                                                                                                                method

                                                                                                                                                                                                                                                                                                                                                                                                                relative-locator;

                                                                                                                                                                                                                                                                                                                                                                                                                define

                                                                                                                                                                                                                                                                                                                                                                                                                method

                                                                                                                                                                                                                                                                                                                                                                                                                relative-locator

                                                                                                                                                                                                                                                                                                                                                                                                                (locator

                                                                                                                                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                                                                                                                                <physical-locator>,

                                                                                                                                                                                                                                                                                                                                                                                                                    from-locator

                                                                                                                                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                                                                                                                                    <file-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                                        =>

                                                                                                                                                                                                                                                                                                                                                                                                                        (relative-locator

                                                                                                                                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                                                                                                                                        <physical-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                                            let

                                                                                                                                                                                                                                                                                                                                                                                                                            from-directory

                                                                                                                                                                                                                                                                                                                                                                                                                            =

                                                                                                                                                                                                                                                                                                                                                                                                                            from-locator.locator-directory;

                                                                                                                                                                                                                                                                                                                                                                                                                            case

                                                                                                                                                                                                                                                                                                                                                                                                                            from-directory

                                                                                                                                                                                                                                                                                                                                                                                                                            =>

                                                                                                                                                                                                                                                                                                                                                                                                                            relative-locator(locator,

                                                                                                                                                                                                                                                                                                                                                                                                                            from-directory);

                                                                                                                                                                                                                                                                                                                                                                                                                            ~locator.locator-relative?

                                                                                                                                                                                                                                                                                                                                                                                                                            =>

                                                                                                                                                                                                                                                                                                                                                                                                                            locator-error

                                                                                                                                                                                                                                                                                                                                                                                                                            ("Cannot

                                                                                                                                                                                                                                                                                                                                                                                                                            find

                                                                                                                                                                                                                                                                                                                                                                                                                            relative

                                                                                                                                                                                                                                                                                                                                                                                                                            path

                                                                                                                                                                                                                                                                                                                                                                                                                            of

                                                                                                                                                                                                                                                                                                                                                                                                                            absolute

                                                                                                                                                                                                                                                                                                                                                                                                                            locator

                                                                                                                                                                                                                                                                                                                                                                                                                            %=

                                                                                                                                                                                                                                                                                                                                                                                                                            from

                                                                                                                                                                                                                                                                                                                                                                                                                            relative

                                                                                                                                                                                                                                                                                                                                                                                                                            locator

                                                                                                                                                                                                                                                                                                                                                                                                                            %=",

                                                                                                                                                                                                                                                                                                                                                                                                                            locator,

                                                                                                                                                                                                                                                                                                                                                                                                                            from-locator);

                                                                                                                                                                                                                                                                                                                                                                                                                            otherwise

                                                                                                                                                                                                                                                                                                                                                                                                                            =>

                                                                                                                                                                                                                                                                                                                                                                                                                            locator;

                                                                                                                                                                                                                                                                                                                                                                                                                            end

                                                                                                                                                                                                                                                                                                                                                                                                                            end

                                                                                                                                                                                                                                                                                                                                                                                                                            method

                                                                                                                                                                                                                                                                                                                                                                                                                            relative-locator;

                                                                                                                                                                                                                                                                                                                                                                                                                            ///

                                                                                                                                                                                                                                                                                                                                                                                                                            Merge

                                                                                                                                                                                                                                                                                                                                                                                                                            locators

                                                                                                                                                                                                                                                                                                                                                                                                                            define

                                                                                                                                                                                                                                                                                                                                                                                                                            open

                                                                                                                                                                                                                                                                                                                                                                                                                            generic

                                                                                                                                                                                                                                                                                                                                                                                                                            merge-locators

                                                                                                                                                                                                                                                                                                                                                                                                                            (locator

                                                                                                                                                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                                                                                                                                                            <physical-locator>,

                                                                                                                                                                                                                                                                                                                                                                                                                                from-locator

                                                                                                                                                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                                                                                                                                                <physical-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                                                    =>

                                                                                                                                                                                                                                                                                                                                                                                                                                    (merged-locator

                                                                                                                                                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                                                                                                                                                    <physical-locator>);

                                                                                                                                                                                                                                                                                                                                                                                                                                        ///

                                                                                                                                                                                                                                                                                                                                                                                                                                        Merge

                                                                                                                                                                                                                                                                                                                                                                                                                                        locators

                                                                                                                                                                                                                                                                                                                                                                                                                                        define

                                                                                                                                                                                                                                                                                                                                                                                                                                        method

                                                                                                                                                                                                                                                                                                                                                                                                                                        merge-locators

                                                                                                                                                                                                                                                                                                                                                                                                                                        (locator

                                                                                                                                                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                                                                                                                                                        <directory-locator>,

                                                                                                                                                                                                                                                                                                                                                                                                                                            from-locator

                                                                                                                                                                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                                                                                                                                                                            <directory-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                                                                =>

                                                                                                                                                                                                                                                                                                                                                                                                                                                (merged-locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                                                                                                                                                                <directory-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                                                                    if

                                                                                                                                                                                                                                                                                                                                                                                                                                                    (locator.locator-relative?)

                                                                                                                                                                                                                                                                                                                                                                                                                                                    let

                                                                                                                                                                                                                                                                                                                                                                                                                                                    path

                                                                                                                                                                                                                                                                                                                                                                                                                                                    =

                                                                                                                                                                                                                                                                                                                                                                                                                                                    concatenate(from-locator.locator-path,

                                                                                                                                                                                                                                                                                                                                                                                                                                                    locator.locator-path);

                                                                                                                                                                                                                                                                                                                                                                                                                                                    simplify-locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                    (make(object-class(locator),

                                                                                                                                                                                                                                                                                                                                                                                                                                                    server:

                                                                                                                                                                                                                                                                                                                                                                                                                                                    from-locator.locator-server,

                                                                                                                                                                                                                                                                                                                                                                                                                                                    path:

                                                                                                                                                                                                                                                                                                                                                                                                                                                    path,

                                                                                                                                                                                                                                                                                                                                                                                                                                                    relative?:

                                                                                                                                                                                                                                                                                                                                                                                                                                                    from-locator.locator-relative?))

                                                                                                                                                                                                                                                                                                                                                                                                                                                    else

                                                                                                                                                                                                                                                                                                                                                                                                                                                    locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                    end

                                                                                                                                                                                                                                                                                                                                                                                                                                                    end

                                                                                                                                                                                                                                                                                                                                                                                                                                                    method

                                                                                                                                                                                                                                                                                                                                                                                                                                                    merge-locators;

                                                                                                                                                                                                                                                                                                                                                                                                                                                    define

                                                                                                                                                                                                                                                                                                                                                                                                                                                    method

                                                                                                                                                                                                                                                                                                                                                                                                                                                    merge-locators

                                                                                                                                                                                                                                                                                                                                                                                                                                                    (locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                                                                                                                                                                    <file-locator>,

                                                                                                                                                                                                                                                                                                                                                                                                                                                        from-locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                                                                                                                                                                        <directory-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                                                                            =>

                                                                                                                                                                                                                                                                                                                                                                                                                                                            (merged-locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                                                                                                                                                                                            <file-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                let

                                                                                                                                                                                                                                                                                                                                                                                                                                                                directory

                                                                                                                                                                                                                                                                                                                                                                                                                                                                =

                                                                                                                                                                                                                                                                                                                                                                                                                                                                locator.locator-directory;

                                                                                                                                                                                                                                                                                                                                                                                                                                                                let

                                                                                                                                                                                                                                                                                                                                                                                                                                                                merged-directory

                                                                                                                                                                                                                                                                                                                                                                                                                                                                =

                                                                                                                                                                                                                                                                                                                                                                                                                                                                if

                                                                                                                                                                                                                                                                                                                                                                                                                                                                (directory)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                merge-locators(directory,

                                                                                                                                                                                                                                                                                                                                                                                                                                                                from-locator)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                else

                                                                                                                                                                                                                                                                                                                                                                                                                                                                simplify-locator(from-locator)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                end;

                                                                                                                                                                                                                                                                                                                                                                                                                                                                if

                                                                                                                                                                                                                                                                                                                                                                                                                                                                (merged-directory

                                                                                                                                                                                                                                                                                                                                                                                                                                                                ~=

                                                                                                                                                                                                                                                                                                                                                                                                                                                                directory)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                make(object-class(locator),

                                                                                                                                                                                                                                                                                                                                                                                                                                                                directory:

                                                                                                                                                                                                                                                                                                                                                                                                                                                                merged-directory,

                                                                                                                                                                                                                                                                                                                                                                                                                                                                base:

                                                                                                                                                                                                                                                                                                                                                                                                                                                                locator.locator-base,

                                                                                                                                                                                                                                                                                                                                                                                                                                                                extension:

                                                                                                                                                                                                                                                                                                                                                                                                                                                                locator.locator-extension)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                else

                                                                                                                                                                                                                                                                                                                                                                                                                                                                locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                                end

                                                                                                                                                                                                                                                                                                                                                                                                                                                                end

                                                                                                                                                                                                                                                                                                                                                                                                                                                                method

                                                                                                                                                                                                                                                                                                                                                                                                                                                                merge-locators;

                                                                                                                                                                                                                                                                                                                                                                                                                                                                define

                                                                                                                                                                                                                                                                                                                                                                                                                                                                method

                                                                                                                                                                                                                                                                                                                                                                                                                                                                merge-locators

                                                                                                                                                                                                                                                                                                                                                                                                                                                                (locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                                                                                                                                                                                <physical-locator>,

                                                                                                                                                                                                                                                                                                                                                                                                                                                                    from-locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                                                                                                                                                                                    <file-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                        =>

                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (merged-locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                                                                                                                                                                                        <physical-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            let

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            from-directory

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            =

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            from-locator.locator-directory;

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            if

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (from-directory)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            merge-locators(locator,

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            from-directory)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            else

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            end

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            end

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            method

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            merge-locators;

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ///

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            Locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            protocols

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            define

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            sideways

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            method

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            supports-open-locator?

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            (locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ::

                                                                                                                                                                                                                                                                                                                                                                                                                                                                            <file-locator>)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                =>

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                (openable?

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ::

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                <boolean>)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ~locator.locator-relative?

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    end

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    method

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    supports-open-locator?;

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    define

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    sideways

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    method

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    open-locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    (locator

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ::

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    <file-locator>,

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        #rest

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        keywords,

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        #key,

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        #all-keys)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        =>

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        (stream

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ::

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        <stream>)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            apply(open-file-stream,

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            locator,

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            keywords)

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            end

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            method

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            open-locator;