diff options
| -rw-r--r-- | libguile/deprecated.c | 79 | ||||
| -rw-r--r-- | libguile/deprecated.h | 8 | ||||
| -rw-r--r-- | libguile/modules.c | 63 | ||||
| -rw-r--r-- | libguile/modules.h | 8 | ||||
| -rw-r--r-- | module/ice-9/boot-9.scm | 78 | ||||
| -rw-r--r-- | module/ice-9/deprecated.scm | 14 | ||||
| -rw-r--r-- | module/oop/goops/util.scm | 21 |
7 files changed, 120 insertions, 151 deletions
diff --git a/libguile/deprecated.c b/libguile/deprecated.c index a41f45461..61fa8e271 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -2743,6 +2743,82 @@ scm_current_module_lookup_closure () return SCM_BOOL_F; } +scm_t_bits scm_tc16_eval_closure; + +#define SCM_F_EVAL_CLOSURE_INTERFACE (1<<0) +#define SCM_EVAL_CLOSURE_INTERFACE_P(e) \ + (SCM_SMOB_FLAGS (e) & SCM_F_EVAL_CLOSURE_INTERFACE) + +/* NOTE: This function may be called by a smob application + or from another C function directly. */ +SCM +scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep) +{ + SCM module = SCM_PACK (SCM_SMOB_DATA (eclo)); + + scm_c_issue_deprecation_warning + ("Eval closures are deprecated. See \"Accessing Modules From C\" in\n" + "the manual, for replacements."); + + if (scm_is_true (definep)) + { + if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo)) + return SCM_BOOL_F; + return scm_module_ensure_local_variable (module, sym); + } + else + return scm_module_variable (module, sym); +} + +SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0, + (SCM module), + "Return an eval closure for the module @var{module}.") +#define FUNC_NAME s_scm_standard_eval_closure +{ + scm_c_issue_deprecation_warning + ("Eval closures are deprecated. See \"Accessing Modules From C\" in\n" + "the manual, for replacements."); + + SCM_RETURN_NEWSMOB (scm_tc16_eval_closure, SCM_UNPACK (module)); +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_standard_interface_eval_closure, + "standard-interface-eval-closure", 1, 0, 0, + (SCM module), + "Return a interface eval closure for the module @var{module}. " + "Such a closure does not allow new bindings to be added.") +#define FUNC_NAME s_scm_standard_interface_eval_closure +{ + scm_c_issue_deprecation_warning + ("Eval closures are deprecated. See \"Accessing Modules From C\" in\n" + "the manual, for replacements."); + + SCM_RETURN_NEWSMOB (scm_tc16_eval_closure | (SCM_F_EVAL_CLOSURE_INTERFACE<<16), + SCM_UNPACK (module)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_eval_closure_module, + "eval-closure-module", 1, 0, 0, + (SCM eval_closure), + "Return the module associated with this eval closure.") +/* the idea is that eval closures are really not the way to do things, they're + superfluous given our module system. this function lets mmacros migrate away + from eval closures. */ +#define FUNC_NAME s_scm_eval_closure_module +{ + scm_c_issue_deprecation_warning + ("Eval closures are deprecated. See \"Accessing Modules From C\" in\n" + "the manual, for replacements."); + + SCM_MAKE_VALIDATE_MSG (SCM_ARG1, eval_closure, EVAL_CLOSURE_P, + "eval-closure"); + return SCM_SMOB_OBJECT (eval_closure); +} +#undef FUNC_NAME + @@ -2751,6 +2827,9 @@ scm_i_init_deprecated () { properties_whash = scm_make_weak_key_hash_table (SCM_UNDEFINED); scm_struct_table = scm_make_hash_table (SCM_UNDEFINED); + scm_tc16_eval_closure = scm_make_smob_type ("eval-closure", 0); + scm_set_smob_apply (scm_tc16_eval_closure, scm_eval_closure_lookup, 2, 0, 0); + #include "libguile/deprecated.x" } diff --git a/libguile/deprecated.h b/libguile/deprecated.h index e777d2f80..2970262b2 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -824,6 +824,14 @@ SCM_DEPRECATED SCM scm_lookup_closure_module (SCM proc); SCM_DEPRECATED SCM scm_module_lookup_closure (SCM module); SCM_DEPRECATED SCM scm_current_module_lookup_closure (void); +SCM_DEPRECATED scm_t_bits scm_tc16_eval_closure; + +#define SCM_EVAL_CLOSURE_P(x) SCM_TYP16_PREDICATE (scm_tc16_eval_closure, x) + +SCM_DEPRECATED SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep); +SCM_DEPRECATED SCM scm_standard_eval_closure (SCM module); +SCM_DEPRECATED SCM scm_standard_interface_eval_closure (SCM module); +SCM_DEPRECATED SCM scm_eval_closure_module (SCM eval_closure); diff --git a/libguile/modules.c b/libguile/modules.c index a7c0c0ce9..7b42a3d43 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -519,66 +519,6 @@ scm_module_ensure_local_variable (SCM module, SCM sym) } #undef FUNC_NAME -scm_t_bits scm_tc16_eval_closure; - -#define SCM_F_EVAL_CLOSURE_INTERFACE (1<<0) -#define SCM_EVAL_CLOSURE_INTERFACE_P(e) \ - (SCM_SMOB_FLAGS (e) & SCM_F_EVAL_CLOSURE_INTERFACE) - -/* NOTE: This function may be called by a smob application - or from another C function directly. */ -SCM -scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep) -{ - SCM module = SCM_PACK (SCM_SMOB_DATA (eclo)); - if (scm_is_true (definep)) - { - if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo)) - return SCM_BOOL_F; - return scm_call_2 (SCM_VARIABLE_REF (module_make_local_var_x_var), - module, sym); - } - else - return scm_module_variable (module, sym); -} - -SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0, - (SCM module), - "Return an eval closure for the module @var{module}.") -#define FUNC_NAME s_scm_standard_eval_closure -{ - SCM_RETURN_NEWSMOB (scm_tc16_eval_closure, SCM_UNPACK (module)); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_standard_interface_eval_closure, - "standard-interface-eval-closure", 1, 0, 0, - (SCM module), - "Return a interface eval closure for the module @var{module}. " - "Such a closure does not allow new bindings to be added.") -#define FUNC_NAME s_scm_standard_interface_eval_closure -{ - SCM_RETURN_NEWSMOB (scm_tc16_eval_closure | (SCM_F_EVAL_CLOSURE_INTERFACE<<16), - SCM_UNPACK (module)); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_eval_closure_module, - "eval-closure-module", 1, 0, 0, - (SCM eval_closure), - "Return the module associated with this eval closure.") -/* the idea is that eval closures are really not the way to do things, they're - superfluous given our module system. this function lets mmacros migrate away - from eval closures. */ -#define FUNC_NAME s_scm_eval_closure_module -{ - SCM_MAKE_VALIDATE_MSG (SCM_ARG1, eval_closure, EVAL_CLOSURE_P, - "eval-closure"); - return SCM_SMOB_OBJECT (eval_closure); -} -#undef FUNC_NAME - SCM_SYMBOL (sym_macroexpand, "macroexpand"); SCM_DEFINE (scm_module_transformer, "module-transformer", 1, 0, 0, @@ -936,9 +876,6 @@ scm_init_modules () #include "libguile/modules.x" module_make_local_var_x_var = scm_c_define ("module-make-local-var!", SCM_UNDEFINED); - scm_tc16_eval_closure = scm_make_smob_type ("eval-closure", 0); - scm_set_smob_apply (scm_tc16_eval_closure, scm_eval_closure_lookup, 2, 0, 0); - the_module = scm_make_fluid (); } diff --git a/libguile/modules.h b/libguile/modules.h index dee77ff92..28df6c6ea 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -64,10 +64,6 @@ SCM_API scm_t_bits scm_module_tag; #define SCM_MODULE_IMPORT_OBARRAY(module) \ SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_import_obarray]) -SCM_API scm_t_bits scm_tc16_eval_closure; - -#define SCM_EVAL_CLOSURE_P(x) SCM_TYP16_PREDICATE (scm_tc16_eval_closure, x) - SCM_API SCM scm_current_module (void); @@ -121,10 +117,6 @@ SCM_API SCM scm_module_public_interface (SCM module); SCM_API SCM scm_module_import_interface (SCM module, SCM sym); SCM_API SCM scm_module_transformer (SCM module); SCM_API SCM scm_current_module_transformer (void); -SCM_API SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep); -SCM_API SCM scm_standard_eval_closure (SCM module); -SCM_API SCM scm_standard_interface_eval_closure (SCM module); -SCM_API SCM scm_eval_closure_module (SCM eval_closure); /* deprecated already */ SCM_API SCM scm_get_pre_modules_obarray (void); SCM_INTERNAL void scm_modules_prehistory (void); diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index a13e92591..f4ed1df38 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -1524,55 +1524,7 @@ VALUE." ;;; Every module object is of the type 'module-type', which is a record ;;; consisting of the following members: ;;; -;;; - eval-closure: the function that defines for its module the strategy that -;;; shall be followed when looking up symbols in the module. -;;; -;;; An eval-closure is a function taking two arguments: the symbol to be -;;; looked up and a boolean value telling whether a binding for the symbol -;;; should be created if it does not exist yet. If the symbol lookup -;;; succeeded (either because an existing binding was found or because a new -;;; binding was created), a variable object representing the binding is -;;; returned. Otherwise, the value #f is returned. Note that the eval -;;; closure does not take the module to be searched as an argument: During -;;; construction of the eval-closure, the eval-closure has to store the -;;; module it belongs to in its environment. This means, that any -;;; eval-closure can belong to only one module. -;;; -;;; The eval-closure of a module can be defined arbitrarily. However, three -;;; special cases of eval-closures are to be distinguished: During startup -;;; the module system is not yet activated. In this phase, no modules are -;;; defined and all bindings are automatically stored by the system in the -;;; pre-modules-obarray. Since no eval-closures exist at this time, the -;;; functions which require an eval-closure as their argument need to be -;;; passed the value #f. -;;; -;;; The other two special cases of eval-closures are the -;;; standard-eval-closure and the standard-interface-eval-closure. Both -;;; behave equally for the case that no new binding is to be created. The -;;; difference between the two comes in, when the boolean argument to the -;;; eval-closure indicates that a new binding shall be created if it is not -;;; found. -;;; -;;; Given that no new binding shall be created, both standard eval-closures -;;; define the following standard strategy of searching bindings in the -;;; module: First, the module's obarray is searched for the symbol. Second, -;;; if no binding for the symbol was found in the module's obarray, the -;;; module's binder procedure is exececuted. If this procedure did not -;;; return a binding for the symbol, the modules referenced in the module's -;;; uses list are recursively searched for a binding of the symbol. If the -;;; binding can not be found in these modules also, the symbol lookup has -;;; failed. -;;; -;;; If a new binding shall be created, the standard-interface-eval-closure -;;; immediately returns indicating failure. That is, it does not even try -;;; to look up the symbol. In contrast, the standard-eval-closure would -;;; first search the obarray, and if no binding was found there, would -;;; create a new binding in the obarray, therefore not calling the binder -;;; procedure or searching the modules in the uses list. -;;; -;;; The explanation of the following members obarray, binder and uses -;;; assumes that the symbol lookup follows the strategy that is defined in -;;; the standard-eval-closure and the standard-interface-eval-closure. +;;; - eval-closure: A deprecated field, to be removed in Guile 2.2. ;;; ;;; - obarray: a hash table that maps symbols to variable objects. In this ;;; hash table, the definitions are found that are local to the module (that @@ -1780,7 +1732,6 @@ VALUE." ;; NOTE: If you change the set of fields or their order, you also need to ;; change the constants in libguile/modules.h. ;; - ;; NOTE: The getter `module-eval-closure' is used in libguile/modules.c. ;; NOTE: The getter `module-transfomer' is defined libguile/modules.c. ;; NOTE: The getter `module-name' is defined later, due to boot reasons. ;; NOTE: The getter `module-public-interface' is used in libguile/modules.c. @@ -1824,20 +1775,13 @@ VALUE." (error "Lazy-binder expected to be a procedure or #f." binder)) - (let ((module (module-constructor (make-hash-table size) - uses binder #f macroexpand - #f #f #f - (make-hash-table %default-import-size) - '() - (make-weak-key-hash-table 31) #f - (make-hash-table 7) #f #f #f))) - - ;; We can't pass this as an argument to module-constructor, - ;; because we need it to close over a pointer to the module - ;; itself. - (set-module-eval-closure! module (standard-eval-closure module)) - - module)) + (module-constructor (make-hash-table size) + uses binder #f macroexpand + #f #f #f + (make-hash-table %default-import-size) + '() + (make-weak-key-hash-table 31) #f + (make-hash-table 7) #f #f #f)) @@ -2431,9 +2375,6 @@ VALUE." ;;; better thought of as a root. ;;; -(define (set-system-module! m s) - (set-procedure-property! (module-eval-closure m) 'system-module s)) - ;; The root module uses the pre-modules-obarray as its obarray. This ;; special obarray accumulates all bindings that have been established ;; before the module system is fully booted. @@ -2445,7 +2386,6 @@ VALUE." (let ((m (make-module 0))) (set-module-obarray! m (%get-pre-modules-obarray)) (set-module-name! m '(guile)) - (set-system-module! m #t) m)) ;; The root interface is a module that uses the same obarray as the @@ -2454,10 +2394,8 @@ VALUE." (define the-scm-module (let ((m (make-module 0))) (set-module-obarray! m (%get-pre-modules-obarray)) - (set-module-eval-closure! m (standard-interface-eval-closure m)) (set-module-name! m '(guile)) (set-module-kind! m 'interface) - (set-system-module! m #t) ;; In Guile 1.8 and earlier M was its own public interface. (set-module-public-interface! m m) diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm index b631b5f42..9d80cfe65 100644 --- a/module/ice-9/deprecated.scm +++ b/module/ice-9/deprecated.scm @@ -69,7 +69,8 @@ turn-on-debugging read-hash-procedures process-define-module - fluid-let-syntax)) + fluid-let-syntax + set-system-module!)) ;;;; Deprecated definitions. @@ -884,3 +885,14 @@ it.") (issue-deprecation-warning "`close-io-port' is deprecated. Use `close-port' instead.") (close-port port)) + +(define (set-system-module! m s) + (issue-deprecation-warning + "`set-system-module!' is deprecated. There is no need to use it.") + (set-procedure-property! (module-eval-closure m) 'system-module s)) + +(set! module-eval-closure + (lambda (m) + (issue-deprecation-warning + "`module-eval-closure' is deprecated. Use module-variable or module-define! instead.") + (standard-eval-closure m))) diff --git a/module/oop/goops/util.scm b/module/oop/goops/util.scm index 69bb898bf..af72bc3f5 100644 --- a/module/oop/goops/util.scm +++ b/module/oop/goops/util.scm @@ -17,7 +17,7 @@ (define-module (oop goops util) - :export (mapappend find-duplicate top-level-env top-level-env? + :export (mapappend find-duplicate map* for-each* length* improper->proper) :use-module (srfi srfi-1) :re-export (any every) @@ -37,15 +37,18 @@ ((memv (car l) (cdr l)) (car l)) (else (find-duplicate (cdr l))))) -(define (top-level-env) - (let ((mod (current-module))) - (if mod - (module-eval-closure mod) - '()))) +(begin-deprecated + (define (top-level-env) + (let ((mod (current-module))) + (if mod + (module-eval-closure mod) + '()))) -(define (top-level-env? env) - (or (null? env) - (procedure? (car env)))) + (define (top-level-env? env) + (or (null? env) + (procedure? (car env)))) + + (export top-level-env? top-level-env)) (define (map* fn . l) ; A map which accepts dotted lists (arg lists (cond ; must be "isomorph" |