@global dynlib_defined;

/*
Prototype implementation of a library system for l1.

To define a library create a new file and start with the following:

@dynlib(name, //must be the file's name minus its .cqct extension
  [ (import1, lib1.f1), (import2, lib1.f2), (import3, lib2.f1), ... ],
  [ export1, export2, ... ]
{
  //in this scope, import1 will be bound as a local variable to the export 
  //named f1 of the library named lib1 (the system will search the load path 
  //for lib1.cqct). lib1.cqct must contain an @library(lib1 ... ) { ... }.

  //We must define export1, export2, etc in this scope.
}

All library bindings are resolved lazily at run time. Recursive dependencies
are allowed. 

*/

if (dynlib_defined == nil)
{
@global __dynlib_exports,pathto;

dynlib_defined = 1;

//__dynlib_exports is a map from library identifies (cids) to a map from
//function identifies (also cids) to generation functions. 
//The generation function keyed by a given library cid and function cid will
//will return the function with that name from that library when called.
//This is not meant for general use.
__dynlib_exports = [:];

//pathto returns the first full path to a file with the provided name
//found while searching the load path. The below macros depend upon
//the existence of such a function. 
@define pathto(f) {
  @local i,paths,len;
  paths = loadpath();
  len = length(paths);
  for(i=0;i<len;++i) {
    @local fp;
    fp = sprintfa("%s/%s",paths[i],f);
    if (access(fp,"r"))
      return fp;
  }
  return nil;
}

@defstx @dynlib(name,imports,exports) body {
  @local libname, new_body, new_locals;

  //ensure a proper name
  switch(name) {
  @match #id(v):
    libname = v;
    break;
  default: error("library name %a not an id",name);
  }

  //this function will generate and return code that checks to see if the 
  //provided library has been loaded. If not, the code will then dynamically 
  //search the load path for a .cqct file with the given name. If such a file 
  //is not found, it generates and error. When the file is found, it is mapped 
  //in and eval'ed. 
  @defloc gen_libload_stx(lib) {
    return #`{
      if (__dynlib_exports[#,(lib)] == nil) {
        @local l,fp;
        fp = pathto(sprintfa("%a.cqct",#,(lib)));
        if (fp == nil) error("could not find library: %a",#,(lib));
        l = mapfile(fp);
        eval(l);
        if (__dynlib_exports[#,(lib)] == nil) 
          error("library %a does not export itself (no @library?)",
              #,(lib));
      }
    };
  }

  //new_body collects the body of the syntax for this macro returns.
  //the first thing we need to have done is to register that this library
  //exists by setting it's hash table in the __dynlib_exports. 
  new_body = [ #`{ __dynlib_exports[#,(#val(libname))] = [:]; } ];
  //new_locals is the set of local variables specific to this library.
  new_locals = [];

  //parse the import list...
  switch(imports) {
    @match #list(x): 
      imports = x; break;
    default: error("library %a imports not a list\n",libname);
  };
  //for each import entry we will add an appropriate local variable, and
  //add a statement to the body of the code that sets that local variable to
  //a lazy function. The lazy function will, when called, return the 
  //appropriate value from the given library after redefining the local 
  //variable to that function.
  foreach(@lambda(en) {
    @local s,fn;
    //parse (fn, lib.fn)
    switch(en) {
      @match #comma(x,y):
        fn = x;
        switch(fn) {
        @match #id(d): fn = d; break;
        default: error("Bad import entry: %a\n",en);
        };
        switch(y) {
          @match #dot(#id(lname),#id(lfn)):
            //store the id in the list of locals
            append(new_locals,#id(fn));
            //create a lazy-loading function that will fetch that symbol
            //from the named library when the function is run.
            s = #`{
              #,(#id(fn)) = @lambda(args...) {
                //load the appropriate library if necessary.
                #,(gen_libload_stx(lname));
                //get the generation function from __dynlib_exports
                #,(#id(fn)) = 
                    __dynlib_exports[ #,(lname) ][ #,(lfn) ];
                if ( #,(#id(fn)) == nil ) 
                  error("%a depends non-existent %a.%a",
                    #,(libname), #,(#val(lname)), #,(#val(lfn))  );
                //call the generation function, setting the current function
                //to the returned value (from here on out, all calls to this
                //function will dispatch directly to the imported function)
                #,(#id(fn)) = #,(#id(fn))();
                if ( #,(#id(fn)) == nil ) 
                  error("%a depends non-existent %a.%a",
                    #,(libname), #,(#val(lname)), #,(#val(lfn))  );
                //call and return the resulting function with the supplied args
                return apply(#,(#id(fn)),args);
              };
            };
            //add these lazy function definitions to the body
            append(new_body,s);
            break;
          default: error("library %a could not parse imports\n",libname);
        }
        break;
      default: error("library %a could not parse imports\n",libname);
    }
  },Ztolist(imports));

  //exports are simplier: we simply need to add a local variable and an
  //entry in the __dynlib_exports variable.
  switch(exports) {
    @match #list(x): 
      exports = x; break;
    default: error("library %a exports field is not a list\n",libname);
  };
  foreach(@lambda(en) {
    @local s;
    append(new_locals,en);
    switch(en) {
    @match #id(x): en = x; break;
    default: error("Error parsing export %a in %a\n",en,libname);
    }
    s = #`{
      __dynlib_exports[#,(#val(libname))] [#,(en)] = 
          @lambda() { return #,(#id(en)); };
    };
    append(new_body,s);
  },Ztolist(exports));

  //we'd been building new_locals as a cqct list, but it needs to be a Zlist
  new_locals = apply(Zlist,new_locals);

  //finally, we append the actual definition of the library
  append(new_body,body);

  //we'd been building new_body as a cqct list, but it needs to be a Zlist
  new_body = apply(Zlist,new_body);
  
  return #[#scope(#block(new_locals,new_body))];
}

}