CodeMirror: Dylan mode

Dylan mode

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;

MIME types defined: text/x-dylan.