GSOC | Extending Common Lisp support

[Charles Turner]

On 17 June 2012 19:35, Helmut Eller <eller.helmut@gmail.com> wrote:
> * Charles Turner [2012-06-17 15:06] writes:
>> So then what
>> would export's first parameter be?
>
> The result of (intern "A" "TEST")

Thanks Per & Helmut. I've wasted quite a bit of time having confused
external representations with internal ones, which given last years
project, is rather weird... Ignoring the egregious printer problems, I
have the behaviour I want now:

#|kawa:1|# (make-package 'temp :use nil)
#,(namespace "TEMP")
#|kawa:2|# (use-package 'temp)
t
#|kawa:3|# (intern "TEMP-SYM" 'temp)
{TEMP}:TEMP-SYM ()
#|kawa:4|# (find-symbol "TEMP-SYM")
() ()
#|kawa:5|# (find-symbol "TEMP-SYM" 'temp)
{TEMP}:TEMP-SYM :internal
#|kawa:6|# (multiple-value-bind (s w) (find-symbol "TEMP-SYM" 'temp)
(export s 'temp))
t
#|kawa:7|# (find-symbol "TEMP-SYM")
TEMP-SYM :inherited

I've attached the relevant bits involved in the above example. EXPORT
is currently a bit of monster and may be wrong (but passes test
cases!), I tried to account for the various exceptional situations
mentioned in the hyper spec as well as I could understand them.

>> The symbol 'a whose hashCode would
>> match 'a in test, but not say in an 'a in cl-user?
>
> The hashcode of a symbol should be independent of the package it belongs
> to.  Interning/uninterning symbols or renaming/deleting packages should
> not have any effect on the symbols hashcode.

Of course. Apologies for the confusion!

Charles.
-------------- next part --------------
//This file contains the methods INTERN, FIND-SYMBOL and EXPORT of
//LispPackage

  public static Values intern(String name, LispPackage pkg)
  {
    Values v = pkg.findSymbol(name);
    if (v.get(1) != CommonLisp.FALSE)
    {
      return v;
    }
    else
    {
      Symbol s = Symbol.make(pkg, name);
      s.setNamespace(pkg);
      if (pkg == KeywordNamespace)
      {
        Environment.getCurrent().put(s, s);
        pkg.exported.add(s);
      }
      else
      {
        pkg.add(s);
      }
      return new Values(new Object[] {s, CommonLisp.FALSE});
    }
  }

  public Values findSymbol (Object name)
  {
    String sname;
    
    if (name instanceof Symbol)
      // reader hack. FIXME
      sname = ((Symbol) name).getName().toUpperCase();
    else
      sname = (String) name;
    
    Symbol sym = exported.lookup(sname);
    if (sym != null)
    {
      return new Values(new Object[]
          {
            sym, Keyword.make("external")
          });
    }
    
    sym = lookupInternal(sname, sname.hashCode());
    if (sym != null)
    {
      return new Values(new Object[]
          {
            sym, Keyword.make("internal")
          });
    }    
    
    NamespaceUse U = imported;
    while (U != null)
    {      
      sym = U.imported.exported.lookup(sname);
      
      if (sym != null)
      {
        return new Values(new Object[]
            {
              sym, Keyword.make("inherited")
            });
      }
      
      U = U.nextImported;
    }
    
    return new Values(new Object[]
        {
          CommonLisp.FALSE, CommonLisp.FALSE
        });
  }

  /**
   * Export a list of symbols from a package, checking for conflicts.
   * @param syms the list of symbols to export.
   * @param pkg the package to export the symbols from.
   */
  public static void exportPkg (LList syms, LispPackage pkg)
  {
    Stack<Symbol> validSyms = new Stack<Symbol>();
    Iterator symiter = syms.getIterator();
    Symbol s;
    Values v;

    while (symiter.hasNext())
    {
      s = (Symbol) symiter.next();
      v = pkg.findSymbol(s.getName());
      if (v.get(1) != CommonLisp.FALSE
          && !validSyms.contains(s))
      {
        validSyms.push(s);
      }
    }

    NamespaceUse usedBy = pkg.imported;
    symiter = syms.getIterator();

    while (symiter.hasNext())
    {
      s = (Symbol) symiter.next();
      String sname = s.getName();
      while (usedBy != null)
      {
        v = usedBy.imported.findSymbol(sname);
        if (v.get(1) != CommonLisp.FALSE
            && v.get(0) != s
            && !usedBy.imported.shadowingSymbols.contains(v.get(0)))
        {
          // name conflict in usedBy.imported! Correctable, ask user
          // which name to nuke.
          signal("Name conflict from package " + usedBy.imported + "on symbol" +
                 s);
        }
        usedBy = usedBy.nextImported;
      }
    }

    // Check that all symbols are accessible. If not, ask to import them.
    Stack<Symbol> missing = new Stack<Symbol>();
    // syms accessible in the inheritance chain, but not in this package
    Stack<Symbol> imports = new Stack<Symbol>(); 

    symiter = syms.getIterator();
    while (symiter.hasNext())
    {
      s = (Symbol) symiter.next();
      v = pkg.findSymbol(s.getName());
      if ((v.get(1) == CommonLisp.FALSE) &&
          (!(v.get(0).hashCode() == s.hashCode())))
      {
        missing.push(s);
      }
      else if (v.get(1) == KeywordNamespace.valueOf("inherited"))
      {
        imports.push(s);
      }
    }
    
    if (!missing.isEmpty())
    {
      // correctable error, ask user if they want ot import these
      // missing symbols into the package
      signal("The following symbols are missing: " + missing.toString());
    }
    
    while (!imports.isEmpty())
    {
      pkg.exported.add(imports.pop());
    }
    
    //!! There's a problem here. For a start we should be going thru the
    // list of valid symbols... Second, we should probably be removing the
    // namespace prefix.
    
    while (!validSyms.isEmpty())
    {
      s = validSyms.pop();
      pkg.remove(s); // remove internal
      pkg.exported.add(s); // add to external
    }
  }