GSOC | Extending Common Lisp support

[Charles Turner]

I've attached some bits and pieces related to my work so far with
packages. It's all very raw and nonconforming in lots of different
ways. It "works" in the trivial sense that I can create new package
and move into them, but I haven't yet tested symbol resolution much,
other than writing a SYMBOL-PACKAGE function, that current check the
symbol's namesace, and if that's empty returns the value of *PACKAGE*.

One problem I'm having with thread locations is their return value of
#!null. Is there a clean way of having it by default return nil that
anyone knows of? Not actually sure if I should be using a thread
location, but it might be useful to be able to specify a default
package on the command line, like we do in the pretty printer with
out:print-circle.

Charles.
-------------- next part --------------
(defun find-package (name)
  (invoke-static gnu.mapping.Namespace 'valueOfNoCreate name))

(defun find-package-or-error (name)
  (or (find-package name)
      (error "This name does not designate a package:" name)))

(defun make-package (name &key nicknames use)
  (invoke-static gnu.kawa.lispexpr.LispPackage 'makeLispPackage
		 name nicknames use))

(defun in-package (name)
  (setq *package* (find-package-or-error name)))

(defvar *keyword-package* (find-package "KEYWORD"))
(defvar *cl-package* (find-package "COMMON-LISP"))
(defvar *cl-user-package* (make-package "COMMON-LISP-USER"
					:nicknames '("CL-USER")
					:use '("COMMON-LISP")))

(setq *package* (find-pacakge *cl-user-package*))

Index: gnu/kawa/lispexpr/LispPackage.java
===================================================================
--- gnu/kawa/lispexpr/LispPackage.java	(revision 7247)
+++ gnu/kawa/lispexpr/LispPackage.java	(working copy)
@@ -1,19 +1,39 @@
 package gnu.kawa.lispexpr;
-import gnu.mapping.*;
-import gnu.lists.*;
+import gnu.lists.LList;
+import gnu.lists.Pair;
+import gnu.mapping.Namespace;
+import gnu.mapping.Symbol;
+import gnu.mapping.ThreadLocation;
 
-/** Implementa A Common Lisp "package" value.
+/** Implement a Common Lisp "package" value.
  * Far from complete. */
 
 public class LispPackage extends Namespace
 {
   /** The set of exported symbols.
-   * This is on of the packages in importing.
+   * This is one of the packages in importing.
    */
   Namespace exported;
+  
+  private static final Object masterLock = new Object();
 
   LList shadowingSymbols = LList.Empty;
+  public static final Namespace CLNamespace = valueOf("COMMON-LISP");
+  public static final Namespace KeywordNamespace = valueOf("KEYWORD");
 
+  static
+  {
+    nsTable.put("CL", CLNamespace);
+  }
+  
+  // Possibly use for *PACKAGE*
+  public static LispPackage currentPackage;
+  
+  public static void setCurrentPackage (LispPackage newpack)
+  {
+    LispPackage.currentPackage = newpack;
+  }
+
   /** Namespaces that this Namespace imports or uses.
    * These are the <code>imported</code> fields of the
    * <code>NamespaceUse</code>, chained using <code>nextImported</code> fields.
@@ -22,10 +42,54 @@
   /** Namespaces that import/use this namespace.
    * The CommonLisp "used-by" list. */
   NamespaceUse importing;
-
-  /*
-  public static void use (Namespace importing, Namespace imported)
+  
+  public static LispPackage makeLispPackage (String name, LList nicks, LList used) {
+    LispPackage newpack = (LispPackage) LispPackage.valueOf(name);
+    
+    addNickNames(newpack, nicks);
+    
+    for (Object usePkg : used) {
+      Namespace useNamespace = valueOfNoCreate((String) usePkg);
+      if (useNamespace != null) {
+        // bit dodgy just blindly using a namespace here...
+        use(newpack, (LispPackage) useNamespace); // maybe move sync code out of the loop
+      } else {
+        throw new RuntimeException("The name " + usePkg + " does not designate any package");
+      }
+    }
+    
+    return newpack;
+  }
+  
+  /**
+   * Look up the package given in the {@link Namespace} map.
+   * 
+   * This method creates a new Lisp package in the namespace if it does not
+   * already exist.
+   * 
+   * @param name The name of the package to look up.
+   * @return The {@link LispPackage} named by {@code name} or null if a
+   *   {@link Namespace} is already named by {@code name} but is not a
+   *   lisp package.
+   */
+  public static Namespace valueOf (String name)
   {
+    if (name == null)
+      name = "";
+    synchronized (nsTable)
+      {
+	Namespace ns = (Namespace) nsTable.get(name);
+	if (ns != null)
+	  return ns;
+	ns = new LispPackage ();
+	ns.setName(name.intern());
+	Namespace.nsTable.put(name, ns);
+	return ns;
+      }
+  }
+  
+  public static void use (LispPackage importing, LispPackage imported)
+  {
     synchronized (masterLock)
       {
 	// FIXME check conflicts.
@@ -36,8 +100,23 @@
 	importing.imported = use;
       }
   }
-  */
+  
+  public static Namespace getDefault ()
+  {
+    return CLNamespace;
+  }
+  
+  public static void addNickNames (Namespace name, LList nicks) {
+    synchronized (nsTable)
+    {
+      for (Object nick : nicks)
+      {
+        nsTable.put((String) nick, name);
+      }
+    }
+  }
 
+  @Override
   public Symbol lookup(String name, int hash, boolean create)
   {
     Symbol sym = exported.lookup(name, hash, false);
@@ -51,7 +130,7 @@
     for (NamespaceUse used = imported;  used != null;
 	 used = used.nextImported)
       {
-	sym = lookup(name, hash, false);
+	sym = used.imported.lookup(name, hash, false);
 	if (sym != null)
 	  return sym;
       }
@@ -136,7 +215,6 @@
   public void shadowingImport (Symbol symbol)
   {
     String name = symbol.getName();
-    int hash = name.hashCode();
     Symbol old = lookupPresent(name, name.hashCode(), false);
     if (old != null && old != symbol)
       unintern(old);