Another extending patch from Christian Lynbech. This one adds some extra abilities to the load mechanism, as follows: scm_primitive_load can now take either a file name or a port scm_search_path has been renamed to scm_primitive_search_path. This allows us to override the search path function to do whatever we like, including looking inside of archive files, which is apparently the main motivation here (so, you could have a search-path function that will look inside of tar files given in the path list for the file, and return a port which can be passed to the modified load, which allows you to load a file from inside a tar archive). This is pretty flexible, though it would be nice to see this reworked around an object system (when we actually have one). == Original text== Here is a patch that provides a sneaky extension of the load mechanism. It provides hooks to allow loading to work also on suboptimal filesystems such as it frequently is the case with embedded filesystems. The patch has two parts. First it extends `scm_primitive_load' to also accept a port argument, and second it allows the default search mechanism to be overridden. This is done by renaming `scm_search_path' to `scm_primitive_search_path' and letting `scm_search_path' be a variable that can be overridden. This can be used to allow tar files as distribution units. A specialized search routine will check the directory of the tar file to for the file in question, and return a soft port that will deliver the characters of the relevant part of the tar file. In changelog form, the summary of the patch is as follows: * guile-core/libguile/load.c (scm_primitive_load): Allow `filename' to be a port. (scm_primitive_search_path): Renamed from `scm_search_path'. (search_path): New static variable. (scm_search_path): New function. The original functionality has been renamed to `scm_primitive_search_path'. (scm_init_load): Initialize `search_path' to point to `scm_primitive_search_path'. Index: guile-core/libguile/load.c =================================================================== RCS file: /nmc/Repository/tools/guile/guile-core/libguile/load.c,v retrieving revision 1.1.1.5 diff -u -r1.1.1.5 load.c --- guile-core/libguile/load.c 1998/10/20 03:33:52 1.1.1.5 +++ guile-core/libguile/load.c 1998/12/20 12:30:13 @@ -98,8 +98,9 @@ SCM filename; { SCM hook = *scm_loc_load_hook; - SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, - SCM_ARG1, s_primitive_load); + SCM_ASSERT (SCM_NIMP (filename) && + (SCM_ROSTRINGP (filename) || SCM_OPINPORTP (filename)), + filename, SCM_ARG1, s_primitive_load); SCM_ASSERT (hook == SCM_BOOL_F || (scm_procedure_p (hook) == SCM_BOOL_T), hook, "value of %load-hook is neither a procedure nor #f", @@ -110,8 +111,13 @@ { SCM port, save_port; - port = scm_open_file (filename, - scm_makfromstr ("r", (scm_sizet) sizeof (char), 0)); + + if (SCM_ROSTRINGP (filename)) + port = scm_open_file (filename, + scm_makfromstr ("r", (scm_sizet) sizeof(char), 0)); + else + port = filename; + save_port = port; scm_internal_dynamic_wind (swap_port, load, @@ -226,9 +232,9 @@ The file must be readable, and not a directory. If we find one, return its full filename; otherwise, return #f. If FILENAME is absolute, return it unchanged. */ -SCM_PROC(s_search_path, "search-path", 2, 1, 0, scm_search_path); +SCM_PROC(s_primitive_search_path, "primitive-search-path", 2, 1, 0, scm_primitive_search_path); SCM -scm_search_path (path, filename, extensions) +scm_primitive_search_path (path, filename, extensions) SCM path; SCM filename; SCM extensions; @@ -238,14 +244,15 @@ size_t max_path_len; size_t max_ext_len; - SCM_ASSERT (scm_ilength (path) >= 0, path, SCM_ARG1, s_search_path); + SCM_ASSERT (scm_ilength (path) >= 0, path, + SCM_ARG1, s_primitive_search_path); SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, - SCM_ARG2, s_search_path); + SCM_ARG2, s_primitive_search_path); if (SCM_UNBNDP (extensions)) extensions = scm_listofnullstr; else SCM_ASSERT (scm_ilength (extensions) >= 0, extensions, - SCM_ARG3, s_search_path); + SCM_ARG3, s_primitive_search_path); filename_len = SCM_ROLENGTH (filename); /* If FILENAME is absolute, return it unchanged. */ @@ -263,7 +270,7 @@ SCM elt = SCM_CAR (walk); SCM_ASSERT (SCM_NIMP (elt) && SCM_ROSTRINGP (elt), elt, "path is not a list of strings", - s_search_path); + s_primitive_search_path); if (SCM_LENGTH (elt) > max_path_len) max_path_len = SCM_LENGTH (elt); } @@ -280,7 +287,7 @@ SCM elt = SCM_CAR (walk); SCM_ASSERT (SCM_NIMP (elt) && SCM_ROSTRINGP (elt), elt, "extension list is not a list of strings", - s_search_path); + s_primitive_search_path); if (SCM_LENGTH (elt) > max_ext_len) max_ext_len = SCM_LENGTH (elt); } @@ -289,7 +296,7 @@ SCM_DEFER_INTS; buf = scm_must_malloc (max_path_len + 1 + filename_len + max_ext_len + 1, - s_search_path); + s_primitive_search_path); /* Try every path element. At this point, we know it's a proper list of strings. */ @@ -360,6 +367,20 @@ exts); } +static SCM search_path; + +SCM_PROC(s_search_path, "search-path", 2, 1, 0, scm_search_path); + +SCM +scm_search_path (path, filename, extensions) + SCM path; + SCM filename; + SCM extensions; +{ + return scm_apply (SCM_CDR (search_path), + SCM_LIST3 (path, filename, extensions), + SCM_EOL); +} SCM_PROC(s_primitive_load_path, "primitive-load-path", 1, 0, 0, scm_primitive_load_path); SCM @@ -438,7 +459,15 @@ SCM_UNDEFINED))); scm_loc_load_hook = SCM_CDRLOC (scm_sysintern ("%load-hook", SCM_BOOL_F)); + search_path = scm_intern0 ("search-path"); + init_build_info (); #include "load.x" + + { + SCM primitive_search_path = scm_intern0 (s_primitive_search_path); + /* make search_path point to scm_primitive_search_path */ + SCM_SETCDR(search_path, SCM_CDR(primitive_search_path)); + } }