;;;; -*- mode:lisp;coding:utf-8 -*- ;;;;************************************************************************** ;;;;FILE: environment.lisp ;;;;LANGUAGE: Common-Lisp ;;;;SYSTEM: Common-Lisp ;;;;USER-INTERFACE: NONE ;;;;DESCRIPTION ;;;; ;;;; Lisp OS Environments. ;;;; ;;;;AUTHORS ;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com> ;;;;MODIFICATIONS ;;;; 2013-11-30 <PJB> Added this header. ;;;;BUGS ;;;;LEGAL ;;;; AGPL3 ;;;; ;;;; Copyright Pascal J. Bourguignon 2013 - 2013 ;;;; ;;;; This program is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU Affero General Public License as published by ;;;; the Free Software Foundation, either version 3 of the License, or ;;;; (at your option) any later version. ;;;; ;;;; This program is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; GNU Affero General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU Affero General Public License ;;;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;;;************************************************************************** (defpackage "COM.INFORMATIMAGO.COMMON-LISP.LISPOS.ENVIRONMENT" (:use "COMMON-LISP" "COM.INFORMATIMAGO.COMMON-LISP.LISPOS.PACKAGE") (:shadowing-import-from "COM.INFORMATIMAGO.COMMON-LISP.LISPOS.PACKAGE" . ("SYMBOL" "SYMBOLP" "MAKE-SYMBOL" "SYMBOL-NAME" "SYMBOL-PACKAGE" "SYMBOL-VALUE" "SYMBOL-FUNCTION" "SYMBOL-PLIST" "BOUNDP" "FBOUNDP" "KEYWORD" "KEYWORDP" "PACKAGE" "PACKAGEP" "MAKE-PACKAGE" "FIND-PACKAGE" "DELETE-PACKAGE" "FIND-SYMBOL" "IMPORT" "INTERN" "SHADOW" "SHADOWING-IMPORT" "EXPORT" "UNEXPORT" "UNINTERN" "USE-PACKAGE" "UNUSE-PACKAGE" "PACKAGE-NAME" "PACKAGE-NICKNAMES" "PACKAGE-USE-LIST" "PACKAGE-USED-BY-LIST" "PACKAGE-SHADOWING-SYMBOLS" "LIST-ALL-PACKAGES" "FIND-ALL-SYMBOLS" "RENAME-PACKAGE" "*PACKAGE*" "WITH-PACKAGE-ITERATOR" "DO-SYMBOLS" "DO-EXTERNAL-SYMBOLS" "DO-ALL-SYMBOLS" "DEFPACKAGE" "IN-PACKAGE" "PACKAGE-ERROR" "PACKAGE-ERROR-PACKAGE")) (:export "FIND-ENVIRONMENT" "FIND-PACKAGE" "FIND-SYMBOL" "UPDATE-READTABLE" "*ENVIRONMENT*") (:documentation " Author: Pascal J. Bourguignon <pjb@informatimago.com> Copyright: 2013 Pascal J. Bourguignon License: AGPL3 ")) (in-package "COM.INFORMATIMAGO.COMMON-LISP.LISPOS.ENVIRONMENT") #| Provisional syntax ======================= To help with experiments and discussions, I would like to establish the following syntaxes to name environments, and packages and symbols within environments. ENVNAME:::PACKAGE:SYMBOL reads as the symbol PACKAGE:SYMBOL in the environment ENVNAME. It should be equivalent to reading: PACKAGE:SYMBOL when the ENVIRONMENT package is the system environment package, and ENVIRONMENT:*ENVIRONMENT* is bound to the non-NIL result of (ENVIRONMENT:FIND-ENVIRONMENT "ENVNAME") The symbol should be exported from the package, otherwise a "no such external symbol" error should occur. But as long as the readtable used to read it (ie. COMMON-LISP:*READTABLE*, in the current environment ENVIRONMENT:*ENVIRONMENT*) allows reading this syntax, ENVNAME:::PACKAGE:SYMBOL reads as the denoted symbol even if the system environment package is not available in the current environment. ENVNAME, PACKAGE and SYMBOL are read subject to the current readtable case and escape mechanisms. Note: considering that an environment could contain a different lisp than COMMON-LISP, perhaps we could ignore the external symbol constraint, and consider this syntax to be equivalent to the following. ENVNAME:::PACKAGE::SYMBOL reads as the symbol PACKAGE::SYMBOL in the environment ENVNAME. Similar discussion as above, only the symbol doesn't needs to be exported. ENVNAME:::THING ENVNAME::::THING Invalid read syntax. I find no obviously clear rule about what package to find the symbols in, given that an environment may not contain the COMMON-LISP package. #E"ENVNAME" reads as the result of: (or (environment:find-environment "ENVNAME") (error "No such environment")) even when the system environment package is not available in the current environment, as logn as current the readtable provides this reader dispatching macro. #E"ENVNAME:::PACKAGE" reads as the result of: (or (environment:find-package "PACKAGE" (or (environment:find-environment "ENVNAME") (error "No such environment"))) (error "No such package")) even when the system environment package is not available in the current environment, as logn as current the readtable provides this reader dispatching macro. #E"ENVNAME:::PACKAGE::SYMBOL" reads as the result of: (or (environment:find-symbol "SYMBOL" (or (environment:find-package "PACKAGE" (or (environment:find-environment "ENVNAME") (error "No such environment"))) (error "No such package"))) (error "No such symbol")) even when the system environment package is not available in the current environment, as long as current the readtable provides this reader dispatching macro. Note: ENVIRONMENT:FIND-SYMBOL, ENVIRONMENT:FIND-PACKAGE and ENVIRONMENT:FIND-ENVIRONMENT return NIL when no object with the given name exist, like COMMON-LISP:FIND-SYMBOL and COMMON-LISP:FIND-PACKAGE do. Informally, ENVNAME::: can be used to designate the #E"ENVNAME" environment and ENVNAME:::PACKAGE can be used to designate the #E"ENVNAME:::PACKAGE" package, but since COMMON-LISP packages don't have a reader syntax, we don't implement one for ENVNAME:::PACKAGE. Given the (current?) rejection of ENVNAME:::THING and ENVNAME::::THING, it would be possible to use ":" (or "::") instead of ":::" to separate the environment name from the package name: ENV:PKG:ESYM ENV:PKG::ISYM by avoiding the informal ENVNAME::: and ENVNAME:::PACKAGE. But I feel it safer to establish the use of ::: for environments, since implementations could provide a semantic for A:B:C or A::B::C. |# #| (coerce (loop for i from 32 to 126 collect (code-char i)) 'string) " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" "\\" "|" ":" (specials "!$%&*+-./<=>?@[]^_{}~") (letters "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz") (digits "0123456789") (initial (or letters specials)) (follow (or letters digits specials)) (initial (rep follow) ":::" ) environment:*environment* sysenv |# ;;; Utilities (deftype string-designator () (or string symbol character)) (deftype package-designator () (or package string symbol)) (defun map-into-hash-table (sequence &key (key (function identity)) (value (function identity)) (test (function eql)) (size nil sizep) (rehash-size nil rehash-size-p) (rehash-threshold nil rehash-threshold-p)) " Creates a new hash-table, filled with the associations obtained by applying the function KEY and the function VALUE on each element of the SEQUENCE. The other key parameter are passed to MAKE-HASH-TABLE. " (let ((table (apply (function make-hash-table) :test test (append (when sizep (list :size size)) (when rehash-size-p (list :rehash-size rehash-size)) (when rehash-threshold-p (list :rehash-threshold rehash-threshold)))))) (map nil (lambda (element) (setf (gethash (funcall key element) table) (funcall value element))) sequence) table)) ;;; Environment (defvar *environment-counter* 0) (defclass environment () ((name :initarg :name :initform (error "An environment must have a name") :reader environment-name) (parent :initarg :parent :initform nil :reader environment-parent :documentation "The parent environment, for sub-environments.") (environments :initarg :environments :initform nil :type (or null hash-table) :reader environment-environments :documentation "Children or sub- environments.") (packages :initarg :packages :initform (make-hash-table :test (function equal)) :reader environment-packages) #+not-implemented-yet (special-bindings :initarg :special-bindings :initform (make-hash-table :test (function eq)) :reader environment-special-bindings :documentation "Global dynamic bindings.") #+not-implemented-yet (lexical-bindings :initarg :lexical-bindings :initform (make-hash-table :test (function eq)) :reader environment-lexical-bindings :documentation "Global lexical bindings such as symbol-macros.") #+not-implemented-yet (function-bindings :initarg :function-bindings :initform (make-hash-table :test (function eq)) :reader environment-function-bindings :documentation "Function, macros, special operators."))) (defmethod copy-environment ((original environment) name &key (parent (environment-parent original)) (deep-copy-environments nil) (deep-copy-packages nil)) " Create a new environment named NAME which must be unique amongst the sub-environments of the PARENT. If DEEP-COPY-ENVIRONMENTS is true, then also recursively make copies of the sub-environments. If DEEP-COPY-PACKAGES is true, then copy the packages, else import them into the new environment. " (check-type name string) (check-type parent environment) (assert (not (find-environment name parent)) () "The name of the new environment ~S must be unique amongst ~S" name (mapcar (function environment-name) (environment-children parent))) (let ((copy (make-instance 'environment :name name :parent parent :environments (if deep-copy-environments (copy-package-table (environment-packages original)) (copy-hash-table (environment-packages original))) :packages (if deep-copy-packages (copy-package-table (environment-packages original)) (copy-hash-table (environment-packages original)))))) copy)) (defvar *private-packages* '() "A list of low-level packages that should be hidden from the environments.") (defvar *root-environment* (make-instance 'environment :name "" :packages (map-into-hash-table (set-difference (copy-list (cl:list-all-packages)) *private-packages*) :test (function equal) :key (function package-name) :value (function identity)))) (defvar *environment* (copy-environment :name "ROOT" :parent *root-environment* :deep-copy-environments t :deep-copy-packages t)) (defun find-environment (name &optional (parent *environment*)) (check-type name string-designator) (check-type parent environment) (and (environment-environments parent) (gethash (string name) (environment-environments parent)))) (defun find-package (name &optional (parent *environment*)) (check-type name string-designator) (check-type parent environment) (and (environment-packages parent) (gethash (string name) (environment-packages parent)))) (defun find-symbol (name &optional package) (let ((package (or package (and (find-package "COMMON-LISP") (find-symbol "*PACKAGE*" (find-package "COMMON-LISP")) (symbol-value (find-symbol "*PACKAGE*" (find-package "COMMON-LISP"))))))) (check-type name string-designator) (check-type parent package) (cl:find-symbol (string name) package))) ;; It'll be easier with an environment:package class wrapping cl:package. (defun delete-package (pkg) (check-type pkg package-designator) ) (defun package-name (package) ) #| abc:::def:ghi abc:::def::ghi |abc def|:::def:ghi abc\ def:::ghi:jkl 123abc:::def:ghi |#