code-example/lib/dylan.js

Language code example.

"use strict";

Object.defineProperty(exports, "__esModule", {
  value: true
});
exports.default = void 0;
var code = "Module:       locators-internals\nSynopsis:     Abstract modeling of locations\nAuthor:       Andy Armstrong\nCopyright:    Original Code is Copyright (c) 1995-2004 Functional Objects, Inc.\n              All rights reserved.\nLicense:      See License.txt in this distribution for details.\nWarranty:     Distributed WITHOUT WARRANTY OF ANY KIND\n\ndefine open generic locator-server\n    (locator :: <locator>) => (server :: false-or(<server-locator>));\ndefine open generic locator-host\n    (locator :: <locator>) => (host :: false-or(<string>));\ndefine open generic locator-volume\n    (locator :: <locator>) => (volume :: false-or(<string>));\ndefine open generic locator-directory\n    (locator :: <locator>) => (directory :: false-or(<directory-locator>));\ndefine open generic locator-relative?\n    (locator :: <locator>) => (relative? :: <boolean>);\ndefine open generic locator-path\n    (locator :: <locator>) => (path :: <sequence>);\ndefine open generic locator-base\n    (locator :: <locator>) => (base :: false-or(<string>));\ndefine open generic locator-extension\n    (locator :: <locator>) => (extension :: false-or(<string>));\n\n/// Locator classes\n\ndefine open abstract class <directory-locator> (<physical-locator>)\nend class <directory-locator>;\n\ndefine open abstract class <file-locator> (<physical-locator>)\nend class <file-locator>;\n\ndefine method as\n    (class == <directory-locator>, string :: <string>)\n => (locator :: <directory-locator>)\n  as(<native-directory-locator>, string)\nend method as;\n\ndefine method make\n    (class == <directory-locator>,\n     #key server :: false-or(<server-locator>) = #f,\n          path :: <sequence> = #[],\n          relative? :: <boolean> = #f,\n          name :: false-or(<string>) = #f)\n => (locator :: <directory-locator>)\n  make(<native-directory-locator>,\n       server:    server,\n       path:      path,\n       relative?: relative?,\n       name:      name)\nend method make;\n\ndefine method as\n    (class == <file-locator>, string :: <string>)\n => (locator :: <file-locator>)\n  as(<native-file-locator>, string)\nend method as;\n\ndefine method make\n    (class == <file-locator>,\n     #key directory :: false-or(<directory-locator>) = #f,\n          base :: false-or(<string>) = #f,\n          extension :: false-or(<string>) = #f,\n          name :: false-or(<string>) = #f)\n => (locator :: <file-locator>)\n  make(<native-file-locator>,\n       directory: directory,\n       base:      base,\n       extension: extension,\n       name:      name)\nend method make;\n\n/// Locator coercion\n\n//---*** andrewa: This caching scheme doesn't work yet, so disable it.\ndefine constant $cache-locators?        = #f;\ndefine constant $cache-locator-strings? = #f;\n\ndefine constant $locator-to-string-cache = make(<object-table>, weak: #\"key\");\ndefine constant $string-to-locator-cache = make(<string-table>, weak: #\"value\");\n\ndefine open generic locator-as-string\n    (class :: subclass(<string>), locator :: <locator>)\n => (string :: <string>);\n\ndefine open generic string-as-locator\n    (class :: subclass(<locator>), string :: <string>)\n => (locator :: <locator>);\n\ndefine sealed sideways method as\n    (class :: subclass(<string>), locator :: <locator>)\n => (string :: <string>)\n  let string = element($locator-to-string-cache, locator, default: #f);\n  if (string)\n    as(class, string)\n  else\n    let string = locator-as-string(class, locator);\n    if ($cache-locator-strings?)\n      element($locator-to-string-cache, locator) := string;\n    else\n      string\n    end\n  end\nend method as;\n\ndefine sealed sideways method as\n    (class :: subclass(<locator>), string :: <string>)\n => (locator :: <locator>)\n  let locator = element($string-to-locator-cache, string, default: #f);\n  if (instance?(locator, class))\n    locator\n  else\n    let locator = string-as-locator(class, string);\n    if ($cache-locators?)\n      element($string-to-locator-cache, string) := locator;\n    else\n      locator\n    end\n  end\nend method as;\n\n/// Locator conditions\n\ndefine class <locator-error> (<format-string-condition>, <error>)\nend class <locator-error>;\n\ndefine function locator-error\n    (format-string :: <string>, #rest format-arguments)\n  error(make(<locator-error>, \n             format-string:    format-string,\n             format-arguments: format-arguments))\nend function locator-error;\n\n/// Useful locator protocols\n\ndefine open generic locator-test\n    (locator :: <directory-locator>) => (test :: <function>);\n\ndefine method locator-test\n    (locator :: <directory-locator>) => (test :: <function>)\n  \\=\nend method locator-test;\n\ndefine open generic locator-might-have-links?\n    (locator :: <directory-locator>) => (links? :: <boolean>);\n\ndefine method locator-might-have-links?\n    (locator :: <directory-locator>) => (links? :: singleton(#f))\n  #f\nend method locator-might-have-links?;\n\ndefine method locator-relative?\n    (locator :: <file-locator>) => (relative? :: <boolean>)\n  let directory = locator.locator-directory;\n  ~directory | directory.locator-relative?\nend method locator-relative?;\n\ndefine method current-directory-locator?\n    (locator :: <directory-locator>) => (current-directory? :: <boolean>)\n  locator.locator-relative?\n    & locator.locator-path = #[#\"self\"]\nend method current-directory-locator?;\n\ndefine method locator-directory\n    (locator :: <directory-locator>) => (parent :: false-or(<directory-locator>))\n  let path = locator.locator-path;\n  unless (empty?(path))\n    make(object-class(locator),\n         server:    locator.locator-server,\n         path:      copy-sequence(path, end: path.size - 1),\n         relative?: locator.locator-relative?)\n  end\nend method locator-directory;\n\n/// Simplify locator\n\ndefine open generic simplify-locator\n    (locator :: <physical-locator>)\n => (simplified-locator :: <physical-locator>);\n\ndefine method simplify-locator\n    (locator :: <directory-locator>)\n => (simplified-locator :: <directory-locator>)\n  let path = locator.locator-path;\n  let relative? = locator.locator-relative?;\n  let resolve-parent? = ~locator.locator-might-have-links?;\n  let simplified-path\n    = simplify-path(path, \n                    resolve-parent?: resolve-parent?,\n                    relative?: relative?);\n  if (path ~= simplified-path)\n    make(object-class(locator),\n         server:    locator.locator-server,\n         path:      simplified-path,\n         relative?: locator.locator-relative?)\n  else\n    locator\n  end\nend method simplify-locator;\n\ndefine method simplify-locator\n    (locator :: <file-locator>) => (simplified-locator :: <file-locator>)\n  let directory = locator.locator-directory;\n  let simplified-directory = directory & simplify-locator(directory);\n  if (directory ~= simplified-directory)\n    make(object-class(locator),\n         directory: simplified-directory,\n         base:      locator.locator-base,\n         extension: locator.locator-extension)\n  else\n    locator\n  end\nend method simplify-locator;\n\n/// Subdirectory locator\n\ndefine open generic subdirectory-locator\n    (locator :: <directory-locator>, #rest sub-path)\n => (subdirectory :: <directory-locator>);\n\ndefine method subdirectory-locator\n    (locator :: <directory-locator>, #rest sub-path)\n => (subdirectory :: <directory-locator>)\n  let old-path = locator.locator-path;\n  let new-path = concatenate-as(<simple-object-vector>, old-path, sub-path);\n  make(object-class(locator),\n       server:    locator.locator-server,\n       path:      new-path,\n       relative?: locator.locator-relative?)\nend method subdirectory-locator;\n\n/// Relative locator\n\ndefine open generic relative-locator\n    (locator :: <physical-locator>, from-locator :: <physical-locator>)\n => (relative-locator :: <physical-locator>);\n\ndefine method relative-locator\n    (locator :: <directory-locator>, from-locator :: <directory-locator>)\n => (relative-locator :: <directory-locator>)\n  let path = locator.locator-path;\n  let from-path = from-locator.locator-path;\n  case\n    ~locator.locator-relative? & from-locator.locator-relative? =>\n      locator-error\n        (\"Cannot find relative path of absolute locator %= from relative locator %=\",\n         locator, from-locator);\n    locator.locator-server ~= from-locator.locator-server =>\n      locator;\n    path = from-path =>\n      make(object-class(locator),\n           path: vector(#\"self\"),\n           relative?: #t);\n    otherwise =>\n      make(object-class(locator),\n           path: relative-path(path, from-path, test: locator.locator-test),\n           relative?: #t);\n  end\nend method relative-locator;\n\ndefine method relative-locator\n    (locator :: <file-locator>, from-directory :: <directory-locator>)\n => (relative-locator :: <file-locator>)\n  let directory = locator.locator-directory;\n  let relative-directory = directory & relative-locator(directory, from-directory);\n  if (relative-directory ~= directory)\n    simplify-locator\n      (make(object-class(locator),\n            directory: relative-directory,\n            base:      locator.locator-base,\n            extension: locator.locator-extension))\n  else\n    locator\n  end\nend method relative-locator;\n\ndefine method relative-locator\n    (locator :: <physical-locator>, from-locator :: <file-locator>)\n => (relative-locator :: <physical-locator>)\n  let from-directory = from-locator.locator-directory;\n  case\n    from-directory =>\n      relative-locator(locator, from-directory);\n    ~locator.locator-relative? =>\n      locator-error\n        (\"Cannot find relative path of absolute locator %= from relative locator %=\",\n         locator, from-locator);\n    otherwise =>\n      locator;\n  end\nend method relative-locator;\n\n/// Merge locators\n\ndefine open generic merge-locators\n    (locator :: <physical-locator>, from-locator :: <physical-locator>)\n => (merged-locator :: <physical-locator>);\n\n/// Merge locators\n\ndefine method merge-locators\n    (locator :: <directory-locator>, from-locator :: <directory-locator>)\n => (merged-locator :: <directory-locator>)\n  if (locator.locator-relative?)\n    let path = concatenate(from-locator.locator-path, locator.locator-path);\n    simplify-locator\n      (make(object-class(locator),\n            server:    from-locator.locator-server,\n            path:      path,\n            relative?: from-locator.locator-relative?))\n  else\n    locator\n  end\nend method merge-locators;\n\ndefine method merge-locators\n    (locator :: <file-locator>, from-locator :: <directory-locator>)\n => (merged-locator :: <file-locator>)\n  let directory = locator.locator-directory;\n  let merged-directory \n    = if (directory)\n        merge-locators(directory, from-locator)\n      else\n        simplify-locator(from-locator)\n      end;\n  if (merged-directory ~= directory)\n    make(object-class(locator),\n         directory: merged-directory,\n         base:      locator.locator-base,\n         extension: locator.locator-extension)\n  else\n    locator\n  end\nend method merge-locators;\n\ndefine method merge-locators\n    (locator :: <physical-locator>, from-locator :: <file-locator>)\n => (merged-locator :: <physical-locator>)\n  let from-directory = from-locator.locator-directory;\n  if (from-directory)\n    merge-locators(locator, from-directory)\n  else\n    locator\n  end\nend method merge-locators;\n\n/// Locator protocols\n\ndefine sideways method supports-open-locator?\n    (locator :: <file-locator>) => (openable? :: <boolean>)\n  ~locator.locator-relative?\nend method supports-open-locator?;\n\ndefine sideways method open-locator\n    (locator :: <file-locator>, #rest keywords, #key, #all-keys)\n => (stream :: <stream>)\n  apply(open-file-stream, locator, keywords)\nend method open-locator;\n\n";
var _default = code;
exports.default = _default;