Ilya Zakharevich on Wed, 01 Feb 2006 06:34:12 +0100


[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]

Re: [PATCH 2.2.11+] Support for packages: require()


> This is the second part of "package" support in GP/PARI (installing
> functionality via loaded library written in GP).  This patch enables
> new gp function require() documented in the first chunk.

Actually, one needs also support for versioning and export from the
module namespace.  Since a couple of things needed to be changed, the
following patch REPLACES the original patch.

The documentation is in the first chunk of the patch.  The described
semantic allows an easy distribution and/or update of GP/PARI
functionality by scripts written in GP.  E.g., a script string.gp
could define functions string::substring(), string::index(),
string::rindex() etc, and after

  require(string, [1,0,4]);	\\ version 1.0.3 had a bug...

one could have these functions available as substring(), index(),
rindex() etc.

Writing modules can be made slightly more convenient, by defining "a
current namespace prefix" (with default being "" - but changable to
e.g. "thisNamespace::").  However, this requires CHANGES to GP/PARI
internals; this patch gives no changes, all it does is an increase in
functionality.  In particular, the chance that this patch breaks
something is practically vanishing...

The test suite is contained in ilyaz.org/software/tmp/gp2211_test_require.zip

Enjoy,
Ilya

--- ./doc/usersch3.tex-ppre	Tue Jan 31 21:02:40 2006
+++ ./doc/usersch3.tex	Tue Jan 31 21:04:02 2006
@@ -8745,6 +8745,46 @@ example, if the existing order is \kbd{[
 to output, will be \kbd{[z,y,x]}. The internal representation is unaffected.
 \label{se:reorder}
 
+\subsubsecidx{require}$(\var{modulename},\{\var{version}\},\{\var{features}\})$:
+loads the module \var{modulename}, checks its version against \var{version}
+(unless \var{version} is negative---the default), and imports \var{features}
+from the module (unless \var{features} is 0).  The default for \var{features}
+is 1.
+
+A module is a GP file inside a directory on GP load path (or inside a directory
+in subdirectory \kbd{lib} of PARI data directory).  Module name should be a
+PARI identifier.  If a module name contains \kbd{::}, it is replaced by \kbd{/}
+in the corresponding file name.  The file should return a non-zero value.
+PARI maintains a list of modules which are already loaded; if 
+\var{modulename} is already loaded, it will not be reloaded.
+
+There are two way for a module to describe its version: either defining a
+function \kbd{modulename::HANDLE_VERSION}, or assigning the version to
+the variable \kbd{modulename::VERSION}.  In the former case, the argument
+\var{version} becomes the only argument to this function; the function
+is assumed to call \kbd{error} if the version of the module is not high enough.
+In the latter case, the value of argument \var{version} is compared with
+the value of variable \kbd{modulename::VERSION}; if the versions are of
+different types, or \var{version} is higher, the error condition is raised.
+
+The module can control export of its features either by defining a function
+\kbd{modulename::HANDLE_EXPORT}, or by assigning to variables
+\kbd{modulename::EXPORT} and/or \kbd{modulename::EXPORT_DEFAULT}.
+In the former case the meaning of "export" is fully controlled by the module
+itself (unless \var{features} is 0); the argument \var{features} is passed
+to this function {\it as is}; the second argument given to this function
+is an empty string (in future this may be changed to the default namespace
+of the caller).
+
+If \kbd{modulename::HANDLE_EXPORT} is not defined, then \var{features} should
+be either 1 (the default), or a list of functions to alias from the namespace
+\kbd{modulename::} to the root namespace.  (If the value is 1, it is replaced
+by the value of variable \kbd{modulename::EXPORT_DEFAULT}, or
+\kbd{modulename::EXPORT} if the former is not defined.)  If variable
+\kbd{modulename::EXPORT} is defined, the elements of the list \var{features}
+are checked to be contained in the array \kbd{modulename::EXPORT} before
+aliasing.
+
 \subsubsecidx{setrand}$(n)$: reseeds the random number generator to the value
 $n$. The initial seed is $n=1$.
 
--- ./src/functions/programming/require-ppre	Wed Jan 18 20:01:44 2006
+++ ./src/functions/programming/require	Tue Jan 31 20:08:42 2006
@@ -0,0 +1,18 @@
+Function: require
+Class: highlevel
+Section: programming
+C-Name: gp_handle_require
+Prototype: rD-1,G,D1,G,
+Help: require(name, {version}, {features}): ensure that a file with
+ 'name' and extension .gp is loaded from GP load path (or from "lib"
+ subdirectory in PARI datadir), and that the version
+ of this file is not older than 'version'; arrange for 'features' to
+ be imported from the file.
+ (A record is kept of already loaded 'name's; if the 'name' is already loaded,
+ skips loading.)
+ If 'version' is negative (default), skips version check.
+ If 'features' is 0, do not import; the default is 1.
+ In general, the semantic of import may be overriden by the required file;
+ for the default semantic, 'features' should be the vector of function names
+ to alias from namespace 'name::', or 1 to import the default list.
+
--- ./src/headers/paridecl.h-ppre	Tue Nov 15 10:01:50 2005
+++ ./src/headers/paridecl.h	Thu Jan 19 10:12:04 2006
@@ -929,6 +929,8 @@ GEN     gp_read_file(char *s);
 GEN     gp_read_stream(FILE *f);
 GEN     gp_readvec_file(char *s);
 GEN     gp_readvec_stream(FILE *f);
+void    gp_require_file(char *s);
+GEN     gp_handle_require(char *name, GEN version, GEN features);
 void    killallfiles(int check);
 int     killfile(pariFILE *f);
 void    matbrute(GEN g, char format, long dec);
--- ./src/language/es.c-ppre	Wed Jan 18 17:47:24 2006
+++ ./src/language/es.c	Tue Jan 31 19:36:18 2006
@@ -186,6 +186,8 @@ init_filtre(filtre_t *F, Buffer *buf)
 /**                        INPUT METHODS                           **/
 /**                                                                **/
 /********************************************************************/
+static void switchin2(const char *name0, int on_path);
+
 /* create */
 Buffer *
 new_buffer(void)
@@ -233,11 +235,11 @@ gp_read_stream(FILE *fi)
   delete_buffer(b); return x;
 }
 
-GEN
-gp_read_file(char *s)
+static GEN
+gp_read_file2(char *s, int on_path)
 {
   GEN x = gnil;
-  switchin(s);
+  switchin2(s, on_path);
   if (file_is_binary(infile))
     x = readbin(s,infile);
   else {
@@ -253,6 +255,12 @@ gp_read_file(char *s)
 }
 
 GEN
+gp_read_file(char *s)
+{
+    return gp_read_file2(s, 0);
+}
+
+GEN
 gp_readvec_stream(FILE *fi)
 {
   pari_sp ltop = avma;
@@ -3128,8 +3136,8 @@ try_name(char *name)
 }
 
 /* If name = "", re-read last file */
-void
-switchin(const char *name0)
+static void
+switchin2(const char *name0, int on_path)
 {
   char *s, *name;
 
@@ -3143,21 +3151,38 @@ switchin(const char *name0)
     name = pari_strdup(name0);
   }
   /* if name contains '/',  don't use dir_list */
-  s=name; while (*s && *s != '/' && *s != '\\') s++;
-  if (*s) { if (try_name(name)) return; }
+  s=name;
+  if (!on_path)
+      while (*s && *s != '/' && *s != '\\') s++;
+  if (!on_path && *s) { if (try_name(name)) return; }
   else
   {
     char **tmp = GP_DATA->path->dirs;
+    char *t[2] = {(char*)NULL, (char*)NULL};
+    char *lib = "";
+
+   again:
     for ( ; *tmp; tmp++)
     { /* make room for '/' and '\0', try_name frees it */
       s = gpmalloc(2 + strlen(*tmp) + strlen(name));
-      sprintf(s,"%s/%s",*tmp,name);
+      sprintf(s,"%s/%s%s",*tmp,lib,name);
       if (try_name(s)) return;
     }
+    if (on_path && !t[0] && pari_datadir) {
+	t[0] = pari_datadir;
+	lib = "lib/";
+	goto again;
+    }
   }
   err(openfiler,"input",name0);
 }
 
+void
+switchin(const char *name0)
+{
+    switchin2(name0, 0);
+}
+
 static int is_magic_ok(FILE *f);
 
 void
@@ -3645,3 +3670,196 @@ pari_unique_filename(char *s)
   }
   return buf;
 }
+
+void
+gp_require_file(char *name)
+{
+    char buf[1024], *s = name, *t = buf;
+    entree *ep;
+    GEN res;
+
+    if (!is_identifier(name))
+	err(talker, "required name (%s) is not an identifier", name);
+    if (strlen(name) >= sizeof(buf) - 2)
+	err(talker, "required name (%s) too long", name);
+    sprintf(buf, "%s::", name);
+    ep = is_entry(buf);
+    if (ep) {
+	if (EpVALENCE(ep) != EpVAR)
+	    err(talker, "panic: corrupted hash of loaded packages");
+	if (!gcmp0(ep->value))
+	    return;			/* loaded already */
+    }
+
+    while (*s) {
+	if (s[0] == ':' && s[1] == ':') {
+	    *t++ = '/';
+	    s += 2;
+	} else *t++ = *s++;
+    }
+    *t = 0;
+    res = gp_read_file2(buf, 1);	/* on path */
+    if (gcmp0(res))
+	err(talker, "required file (%s) did not return true", name);
+    sprintf(buf, "%s::", name);
+    ep = fetch_named_var(buf);		/* Create value */
+    changevalue(ep, gen_1);
+    return;
+}
+
+/* req: if 0, always succeed, immediately return 0;
+        if 1, req is replaced by the default value: EXPORT_DEFAULT or
+	EXPORT var in the namespace;
+	if HANDLE_EXPORT() is defined, req is given as an argument;
+	otherwise req should contain the list of function name to import;
+	they are imported from the namespace (subject to restriction
+	given by variable EXPORT: if present and not 1, it should
+	contain the list of functions allowed for export).
+
+*/
+
+static GEN
+gp_do_import(char *name, GEN req)
+{
+    char buf[1024];
+    entree *ep, *eptmp;
+    GEN res, list = 0;
+    int all = 0, i = 1, l = strlen(name), ll;
+
+    if (l >= sizeof(buf) - 60)
+	err(talker, "required name (%s) too long", name);
+    if (gcmp0(req)) return gen_0;		/* ignore import */
+
+    sprintf(buf, "%s::HANDLE_EXPORT", name);
+    ep = is_entry(buf);
+    if (ep) {				/* Let the module handle exporting */
+	if (EpVALENCE(ep) != EpUSER && EpVALENCE(ep) != EpINSTALL)
+	    err(talker, "%s should be a function", buf);
+	eptmp = fetch_named_var("core__::tmp");
+	changevalue(eptmp, req);
+	sprintf(buf + strlen(buf), "(core__::tmp,\"\")");
+	res = lisexpr(buf);
+	kill0(eptmp);			/* XXXX What if lisexpr() longjmp()? */
+	return res;
+    }
+
+    /* Default exporting logic: */
+    sprintf(buf + l + 2, "EXPORT");
+    ep = is_entry(buf);
+
+    if (gcmp1(req)) {			/* Use default value */
+	entree *ep1;
+
+	sprintf(buf + l + 2, "EXPORT_DEFAULT");
+	ep1 = is_entry(buf);
+	if (!ep1) {
+	    ep1 = ep;
+	    buf[l + 2 + 6] = 0;		/* Used in error messages */
+	}
+	
+	if (!ep1) return gen_0;		/* Nothing to export by default */
+
+	if (EpVALENCE(ep1) != EpVAR)
+	    err(talker, "EXPORT should be a variable");
+	req = ep1->value;
+	if (gcmp1(req))		/* Allows everything, but only explicit */
+	    return gen_0;
+	all = 1;
+	buf[l + 2 + 6] = 0;		/* Used in error messages */
+    }
+
+    if (ep) {
+	if (EpVALENCE(ep) != EpVAR)
+	    err(talker, "%s should be a variable", buf);
+	list = ep->value;
+	if (gcmp1(list)) all = 1;
+	else if (typ(list) != t_VEC)
+	    err(talker, "%s should contain a list", buf);
+    } else if (all == 1)		/* nothing to export */
+	return gen_0;
+    else
+	all = 1;			/* Allow export of all */
+
+    if (typ(req) != t_VEC)
+	err(talker, "list of features not a vector");
+    ll = lg(req);
+    for (i=1; i < ll; i++) {
+	char *s;
+
+	if (typ(req[i]) != t_STR)
+	    err(talker, "a feature should be a string");
+	s = GSTR(req[i]);
+	if (!all && !setsearch(list, (GEN)req[i], 0))
+	    err(talker, "feature \"%s\" not in EXPORT", s);
+	if (l + 2 + strlen(s) >= sizeof(buf))
+	    err(talker, "feature name \"%s\" too long", s);
+	sprintf(buf + l + 2, "%s", s);
+	ep = is_entry(s);
+	if (ep)
+	    kill0(ep);			/* alias() won't overwrite */
+	alias0(s, buf);
+    }
+    return ll > 1 ? gen_1 : gen_0;
+}
+
+/* err()s with suitable error message if req is larger than the
+   VERSION of the namespace; if HANDLE_ERROR of the namespace is
+   defined, delegates the checking to it.  Vector versions are
+   considered higher than non-vectored.
+ */
+static void
+gp_check_version(char *name, GEN req)
+{
+    char buf[1024];
+    entree *ep, *eptmp;
+    GEN res, version = 0;
+    int l = strlen(name);
+
+    if (l >= sizeof(buf) - 60)
+	err(talker, "required name (%s) too long", name);
+    if (typ(req) == t_INT && signe(req) < 0)
+	return;		/* negative version req always satisfied */
+
+    sprintf(buf, "%s::HANDLE_VERSION", name);
+    ep = is_entry(buf);
+    if (ep) {				/* Let the module handle checking */
+	if (EpVALENCE(ep) != EpUSER && EpVALENCE(ep) != EpINSTALL)
+	    err(talker, "%s should be a function", buf);
+	eptmp = fetch_named_var("core__::tmp");
+	changevalue(eptmp, req);
+	sprintf(buf + strlen(buf), "(core__::tmp)");
+	res = lisexpr(buf);
+	kill0(eptmp);			/* XXXX What if lisexpr() longjmp()? */
+	return;
+    }
+
+    /* Default version checking logic: */
+    sprintf(buf + l + 2, "VERSION");
+    ep = is_entry(buf);
+    if (!ep)
+	err(talker, "%s is not defined", buf);
+    if (EpVALENCE(ep) != EpVAR)
+	err(talker, "%s should be a variable", buf);
+    version = ep->value;
+    if ( typ(req) != typ(version) ) {
+	GEN g1 = GENtoGENstr(req), g2 = GENtoGENstr(version);
+	err(talker, 
+	    "Version of %s (%s) incompatible with the requested version (%s)",
+	    name, GSTR(g2), GSTR(g1));
+    }
+    if ( lexcmp(req, version) > 0 ) {
+	GEN g1 = GENtoGENstr(req), g2 = GENtoGENstr(version);
+	err(talker, 
+	    "Version of %s (%s) less than the requested version (%s)",
+	    name, GSTR(g2), GSTR(g1));
+    }
+}
+
+GEN
+gp_handle_require(char *name, GEN version, GEN features)
+{
+    gp_require_file(name);
+    gp_check_version(name, version);
+    return gp_do_import(name, features);
+}
+