# Bazaar revision bundle v0.8 # # message: # 2006-10-05 Andy Wingo # # * guile/g-wrap/guile.scm (module-public-interface): Make sure that # using (g-wrap guile) also uses (g-wrap c-codegen), as it used to. # This fixes compilation of guile-gnome. # (generate-wrapset-scm): Reindent for spaces instead of tabs. If # this module had generics, make our public interface export the # generics as well. # # * guile/g-wrap/guile-runtime.c # (gw_guile_ensure_latent_generics_hash) # (gw_generics_module_binder_proc) # (gw_guile_ensure_generics_module) # (gw_guile_set_generics_module_x) # ("%gw:procedure-to-method-public!"): Rework so that we don't munge # the root module or the scm module. Instead our generics are # deposited into a module of the user's choosing, defaulting to a # submodule named %generics. # # * guile/g-wrap/guile-runtime.c # * guile/g-wrap/guile-runtime.h # (gw_guile_set_generics_module_x): New public # API. # # * ChangeLog: Finally started a changelog here. # # committer: Andy Wingo # date: Thu 2006-10-05 15:01:12.296999931 +0200 === modified file ChangeLog --- ChangeLog +++ ChangeLog @@ -1,1 +1,25 @@ -No ChangeLog yet. Use 'tla changelog' as temporary replacement. +2006-10-05 Andy Wingo + + * guile/g-wrap/guile.scm (module-public-interface): Make sure that + using (g-wrap guile) also uses (g-wrap c-codegen), as it used to. + This fixes compilation of guile-gnome. + (generate-wrapset-scm): Reindent for spaces instead of tabs. If + this module had generics, make our public interface export the + generics as well. + + * guile/g-wrap/guile-runtime.c + (gw_guile_ensure_latent_generics_hash) + (gw_generics_module_binder_proc) + (gw_guile_ensure_generics_module) + (gw_guile_set_generics_module_x) + ("%gw:procedure-to-method-public!"): Rework so that we don't munge + the root module or the scm module. Instead our generics are + deposited into a module of the user's choosing, defaulting to a + submodule named %generics. + + * guile/g-wrap/guile-runtime.c + * guile/g-wrap/guile-runtime.h + (gw_guile_set_generics_module_x): New public + API. + + * ChangeLog: Finally started a changelog here. === modified file guile/g-wrap/guile-runtime.c --- guile/g-wrap/guile-runtime.c +++ guile/g-wrap/guile-runtime.c @@ -42,9 +42,6 @@ static SCM latent_variables_hash_hash = SCM_BOOL_F; -static SCM latent_generics_hash = SCM_BOOL_F; -static SCM old_binder_proc = SCM_BOOL_F; - /* TODO: Use snarfer for kewords & symbols */ static SCM k_specializers = SCM_UNSPECIFIED; static SCM k_procedure = SCM_UNSPECIFIED; @@ -302,22 +299,34 @@ static SCM -gw_scm_module_binder_proc (SCM module, SCM sym, SCM definep) -{ - SCM proc_list, generic, var; - - /* We hack the scm module because it's the interface to the root module. The - * scm module and the root module share the same obarray. */ - +gw_guile_ensure_latent_generics_hash (SCM generics_module) +{ + SCM ret; + + ret = scm_hashq_ref (SCM_MODULE_OBARRAY (generics_module), + scm_from_locale_symbol ("%gw-latent-generics-hash"), + SCM_BOOL_F); + + if (SCM_FALSEP (ret)) { + ret = scm_make_variable (scm_c_make_hash_table (53)); + scm_hashq_set_x (SCM_MODULE_OBARRAY (generics_module), + scm_from_locale_symbol ("%gw-latent-generics-hash"), + ret); + } + + return SCM_VARIABLE_REF (ret); +} + +static SCM +gw_generics_module_binder_proc (SCM module, SCM sym, SCM definep) +{ + SCM latent_generics_hash, proc_list, generic, var; + + latent_generics_hash = gw_guile_ensure_latent_generics_hash (module); proc_list = scm_hashq_ref (latent_generics_hash, sym, SCM_BOOL_F); if (scm_is_false (proc_list)) - { - if (scm_is_false (old_binder_proc)) - return SCM_BOOL_F; - else - return scm_call_3 (old_binder_proc, module, sym, definep); - } + return SCM_BOOL_F; /* We need to make the generic now. Because the binder proc is * called, we know there's nothing else in the root module to @@ -354,23 +363,36 @@ return var; } -static void -ensure_scm_module_hacked (void) -{ - static int scm_module_hacked = 0; +void +gw_guile_set_generics_module_x (SCM module) +{ + SCM current_module = scm_current_module (); + + if (SCM_FALSEP (SCM_MODULE_BINDER (module))) + scm_struct_set_x (module, SCM_MAKINUM (scm_module_index_binder), + scm_c_make_gsubr ("%gw-generics-module-binder", 3, 0, + 0, gw_generics_module_binder_proc)); + + scm_c_module_define (current_module, "%generics", module); +} + +static SCM +gw_guile_ensure_generics_module (void) +{ + SCM existing_binding; + SCM current_module = scm_current_module (); + + existing_binding = + scm_hashq_ref (SCM_MODULE_OBARRAY (current_module), + scm_from_locale_symbol ("%generics"), + SCM_BOOL_F); - if (!scm_module_hacked) - { - scm_module_hacked = 1; - old_binder_proc = scm_permanent_object ( - SCM_MODULE_BINDER (the_scm_module)); - scm_struct_set_x (the_scm_module, SCM_I_MAKINUM (scm_module_index_binder), - scm_c_make_gsubr ("%gw-scm-module-binder", 3, 0, - 0, gw_scm_module_binder_proc)); + if (SCM_FALSEP (existing_binding)) { + gw_guile_set_generics_module_x (current_module); + return current_module; + } else { + return SCM_VARIABLE_REF (existing_binding); } - - if (scm_is_false (latent_generics_hash)) - latent_generics_hash = scm_permanent_object (scm_c_make_hash_table (53)); } /* no explicit returns in this function */ @@ -380,6 +402,8 @@ SCM n_req_args, SCM use_optional_args) #define FUNC_NAME "%gw:procedure-to-method-public!" { + SCM latent_generics_hash; + SCM generics; SCM existing_binding = SCM_BOOL_F; SCM existing_latents; @@ -389,18 +413,17 @@ SCM_VALIDATE_INUM (4, n_req_args); /* the fifth is a bool */ - ensure_scm_module_hacked (); - + generics = gw_guile_ensure_generics_module (); + latent_generics_hash = gw_guile_ensure_latent_generics_hash (generics); existing_latents = scm_hashq_ref (latent_generics_hash, generic_name, SCM_EOL); + if (scm_is_null (existing_latents)) - /* this means latent bindings for this variable have not been set up -- * - check now if there's an existing binding. use the root module to check -- - prevents unnecessarily running our hacked scm module binder proc */ + /* latent bindings for this variable have not been set up, check now if + there's an existing binding. use the obarray directly to avoid running + the module binder proc. */ existing_binding = - scm_sym2var (generic_name, - scm_module_lookup_closure (the_root_module), - SCM_BOOL_F); + scm_hashq_get_handle (SCM_MODULE_OBARRAY (generics), generic_name); if (!scm_is_null (existing_latents) || scm_is_false (existing_binding)) { @@ -408,7 +431,7 @@ list, knowing they will all be set up when the binding is forced. Otherwise, we're making the first latent binding, and there's nothing in - the root module that will conflict with our binding. */ + the generics module that will conflict with our binding. */ SCM entry = scm_c_make_vector (5, SCM_BOOL_F); /* entry := #(proc specializers module n_req_args use_optional_args) */ === modified file guile/g-wrap/guile-runtime.h --- guile/g-wrap/guile-runtime.h +++ guile/g-wrap/guile-runtime.h @@ -43,6 +43,7 @@ SCM scm_show_all_p); SCM gw_guile_enum_val2int(GWEnumPair enum_pairs[], SCM scm_val); +void gw_guile_set_generics_module_x (SCM module); void gw_guile_make_latent_variable (SCM sym, SCM proc, SCM arg); void gw_guile_procedure_to_method_public (SCM proc, SCM class_name, SCM generic_name, SCM n_req_args, === modified file guile/g-wrap/guile.scm --- guile/g-wrap/guile.scm +++ guile/g-wrap/guile.scm @@ -52,6 +52,8 @@ scm-var)) +(module-use! (module-public-interface (current-module)) + (resolve-interface '(g-wrap c-codegen))) ;;; @@ -886,31 +888,38 @@ (hashq-create-handle! gf-hash gf-name '()))) (set-cdr! handle (cons func (cdr handle))))))) #f wrapset) - (hash-fold - (lambda (gf funcs rest) - (for-each - (lambda (func) - (write - `(%gw:procedure->method-public - ,(name func) - ;; Specializers - ',(map (lambda (arg) - (let ((typespec (typespec arg))) - (and (not (memq 'unspecialized - (options typespec))) - (class-name (type typespec))))) - (filter visible? (arguments func))) - ',gf - ;; Required argument count - ,(- (input-argument-count func) - (optional-argument-count func)) - ;; Optional arguments? - ,(not (zero? (optional-argument-count func)))) - port) - (newline port)) - funcs) - (newline port)) - #f gf-hash)))) + (hash-fold + (lambda (gf funcs rest) + (for-each + (lambda (func) + (write + `(%gw:procedure->method-public + ,(name func) + ;; Specializers + ',(map (lambda (arg) + (let ((typespec (typespec arg))) + (and (not (memq 'unspecialized + (options typespec))) + (class-name (type typespec))))) + (filter visible? (arguments func))) + ',gf + ;; Required argument count + ,(- (input-argument-count func) + (optional-argument-count func)) + ;; Optional arguments? + ,(not (zero? (optional-argument-count func)))) + port) + (newline port)) + funcs) + (newline port)) + #f gf-hash) + (write + '(if (defined? '%generics) + (begin + (module-use! (module-public-interface (current-module)) + %generics))) + port) + (newline port)))) (define (make-header-def-sym filename) (string-append "__" # revision id: address@hidden # sha1: ce482d23b650612fcc99aaac00ff5f62f7000d8d # inventory sha1: 9c338989fa5359e552487d8c677e35353dded71f # parent ids: # address@hidden # base id: address@hidden # properties: # branch-nick: wingo