@global library_defined;

/*
Prototype implementation of a library system for l1.

To define a library create a new file and include the following lines:

@export(s1,s2,...)
where s1,s2,... are the symbols you with exported from this library

@import( args... )
where the elements of args may be either 
* a bare identifier, i.e.
  @import( lib1 )
  in which case all symbols exported by lib1 are imported into the given file
* a pair such as: (f1, lib1.f2)
  in which case the symbol f2 in lib1 will be visible in the current file as f1

Multiple import and export statements are allowed, however, they must exist 
outside of any complex statements. 

So, for instance, a library file "utils.cqct" might contain the following:

@export( strcmp );
@define strcmp(a,b) { ... }

The library file functions could then be used by another library

@import( (mystrcmp, utils.strcmp) );
mystrcmp("a","b"); //calls the strcmp function in utils

or they can be used in non-library cqct code with the @with_import macro:

@with_import( (mystrcmp, utils.strcmp) ) {
  x = mystrcmp("a","b"); //calls the strcmp function in utils
}

*/

if (library_defined == nil)
{
@global __library_exports;

library_defined = 1;

//__library_exports is a map from library identifies (cids) to a map from
//exported symbols (also cids) to the value of those exported symbols 
//defined by that library. 
//This is not meant for general use.
if (__library_exports == nil) //might not have been set in a macro
  __library_exports = [:];

//bare import statements are the sign of a problem -- let the user know
@defstx @import(args...) { 
  error("@import statements not allowed outside of libraries");
  return #[]; 
}

//by default, ignore export statments (XXX should this cause a warning?)
@defstx @export(args...) { return #[]; }

//this macro adds the provided path to the loadpath at macro expansion time.
@defstx @add_loadpath(path) {
  @local p,lp;
  p = compile(path)();
  lp = loadpath();
  append(lp,p);
  setloadpath(lp);
  return #`{ nil; };
}

//this macro allows some code to be run with bindings to some imported symbols 
@defstx @with_imports(imports...) body {
  @local new_body, new_locals, has_dot;

  if (__library_exports == nil) __library_exports = [:];

  @defloc 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;
  }

  @defloc check_and_load(lib) {
    @global __library_exports;
    //determine if that library has been loaded, if not, load it
    if (__library_exports[lib] == nil) {
      @local l,fp;
      fp = pathto(sprintfa("%s.cqct",lib));
      if (fp == nil) error("could not find library: %s.cqct",lib);
      l = mapfile(fp);
      eval(sprintfa("@library(%s) { %s }",lib,l));
      if (__library_exports[lib] == nil) 
        error("loading library %a", lib);
    }
    if (__library_exports[lib] == 'loading)
      error("Recursive dependency found in %s.cqct",lib);
  }

  has_dot = nil;
  @defloc mklibstr(lib) {
    switch(lib) {
      @match #div(x,y):
        x = mklibstr(x);
        y = mklibstr(y);
        return sprintfa("%s/%s",x,y);
      @match #dot(x,#id(y)): 
        has_dot = y;
        return mklibstr(x);
      @match #id(x): return sprintfa("%a",x);
    }
    error("Could not parse libname: %a\n",lib);
  }

  new_body = [];
  //new_locals is the set of local variables specific to this library.
  new_locals = [];

  foreach(@lambda(en) {
    @local s,fn,lname;
    //parse (fn, lib.fn) or (lib)
    switch(en) {
      @match #comma(x,y):
        fn = x;
        switch(fn) {
        @match #id(d): fn = d; break;
        default: error("Bad import entry: %a\n",en);
        };
        has_dot = nil;
        lname = mklibstr(y);
        if (has_dot != nil) {
          @local lfn;
          lfn = has_dot;
          check_and_load(lname);
          if (__library_exports[lname][lfn] == nil)
              error("Attempt to import non-exported symbol %a in %a",
                  lfn,lname );
          //store the id in the list of locals
          append(new_locals,#id(fn));
          s = #`{
            #,(#id(fn)) = __library_exports[#,(#val(lname))][#,(#val(lfn))];
          };
          //add these lazy function definitions to the body
          append(new_body,s);
        }
        break;
      default:
        lname = mklibstr(en);
        if (lname == nil)
          error("Could not parse imports at %a\n",en);
        check_and_load(lname);
        foreach(@lambda(lfn,_) {
          //store the id in the list of locals
          append(new_locals,#id(lfn));
          s = #`{
            #,(#id(lfn)) = __library_exports[#,(#val(lname))][#,(#val(lfn))];
            //hack to avoid variable defined but not referenced warnings
            #,(#id(lfn)) = #,(#id(lfn)); 
          };
          append(new_body,s);
        },__library_exports[lname]);
        break;
    }
  },Ztolist(imports));

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

  //we now 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))];
}

@defstx @dynamic_imports(args...) body {
  args = #list(args);
  return #`{
    { @local new_args; 
    new_args = map(@lambda(x) { 
      if (iscid(x)) return #id(x);
      if (isstring(x)) return parse(x+";")[0];
      error("bad library name: %a\n",x);
    },#,(args));
    compile(#mcall(#id('with_imports),apply(Zlist,new_args),#,(#val(body))))();
    }
  };
}

//this macro allows one to export some symbols as though they were part of
//a library with the provided name
@defstx @with_exports(name,exports...) body {
  @local libname, new_body, new_locals, new_postbody;

  @defloc mklibstr(lib) {
    switch(lib) {
      @match #div(x,y):
        x = mklibstr(x);
        y = mklibstr(y);
        return sprintfa("%s/%s",x,y);
      //should never export x.y
      //@match #dot(x,y): return mklibstr(x);
      @match #id(x): return sprintfa("%a",x);
    }
    error("Could not parse libname: %a\n",lib);
  }

  libname = mklibstr(name);

  //while loading this library, set it's __library_exports entry to 'loading
  if (__library_exports == nil) __library_exports = [:];
  __library_exports[libname] = 'loading;

  //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 __library_exports. 
  new_body = [ #`{
    __library_exports[#,(#val(libname))] = [:]; 
  } ];
  //new_postbody collects statements to be run after the main body of
  //this library. 
  new_postbody = [];
  //new_locals is the set of local variables specific to this library.
  new_locals = [];

  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 = #`{
      __library_exports[#,(#val(libname))] [#,(#val(en))] = #,(#id(en)); 
    };
    append(new_postbody,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);

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

  //and add the post body statments.
  new_body = concat(new_body,new_postbody);

  //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))] ;

}

//This macro is used to define a library -- it is not expected to be used
//by the user, but instead to be wrapped around the bodies of librarys before
//the libraries are compiled. 
@defstx @library(name) body {
  @local libname, export_params, import_params, locals, new_stmts, ret;

  @defloc mklibstr(lib) {
    switch(lib) {
      @match #div(x,y):
        x = mklibstr(x);
        y = mklibstr(y);
        return sprintfa("%s/%s",x,y);
      //should not have a library named x.y
      //@match #dot(x,y): return mklibstr(x);
      @match #id(x): return sprintfa("%a",x);
    }
    error("Could not parse libname: %a\n",lib);
  }

  libname = mklibstr(name);

  import_params = [];
  export_params = [];

  //while loading this library, set it's __library_exports entry to 'loading
  if (__library_exports == nil) {
    __library_exports = [:];
  }
  __library_exports[libname] = 'loading;

  new_stmts = [];
  switch(body) {
  @match #scope(#block(l, stmts)):
    locals = l;
    foreach(@lambda(s) {
      switch(s) {
      @match #mcall(#id('import), args):
        append(import_params,args);
        break;
      @match #mcall(#id('export), args):
        append(export_params,args);
        break;
      default: append(new_stmts,s);
      }
    },Ztolist(stmts));
    break;
  default: error("could not parse body: ",body);
  }

  new_stmts = apply(Zlist,new_stmts);

  ret = #scope(#block(locals, new_stmts));

  foreach(@lambda(args) {
    ret = #mcall(#id('with_imports),args,ret);
  },import_params);
  foreach(@lambda(args) {
    args = Zcons(name,args);
    ret = #mcall(#id('with_exports),args,ret);
  },export_params);
  compile(ret)();

  return #[];
}

}