Added environment.lisp

Pascal J. Bourguignon [2013-10-27 21:21]
Added environment.lisp
Filename
.gitignore
environment.lisp
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..dc4a17a
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,4 @@
+*.[ao]
+*~
+.#*
+#*#
diff --git a/environment.lisp b/environment.lisp
new file mode 100644
index 0000000..a952906
--- /dev/null
+++ b/environment.lisp
@@ -0,0 +1,347 @@
+
+#|
+
+
+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
+
+|#
+
+(defpackage "ENVIRONMENT"
+  (:nicknames "SYSTEM-ENVIRONMENT" "SYSENV")
+  (:use "COMMON-LISP")
+  (:shadow "FIND-PACKAGE" "FIND-SYMBOL")
+  (: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 "ENVIRONMENT")
+
+;;; 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
+
+|#
ViewGit