mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 07:50:20 +02:00
Code Activity

finish deprecating eval closures

Browse source 
* libguile/deprecated.h:
* libguile/deprecated.c (scm_eval_closure_lookup)
  (scm_standard_eval_closure, scm_standard_interface_eval_closure)
  (scm_eval_closure_module): Deprecate these, as they are unused.

* libguile/modules.h:
* libguile/modules.c: Remove deprecated code.

* module/oop/goops/util.scm (top-level-env, top-level-env?): Deprecate.

* module/ice-9/deprecated.scm (set-system-module!): Deprecate.
  (module-eval-closure): Deprecate, by overriding the core definition to
  return a fresh eval closure.

* module/ice-9/boot-9.scm (make-module): Don't set an eval closure on
  the module.
  (the-root-module, the-scm-module): Don't call set-system-module!.
This commit is contained in:
Andy Wingo 2012-05-23 12:11:08 +02:00
parent 3f48638c8c
commit 2de74cb56e
7 changed files with 120 additions and 151 deletions
Download patch file Download diff file Expand all files Collapse all files

79
libguile/deprecated.c
View file

@ -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"
}

8
libguile/deprecated.h
View file

@ -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);

63
libguile/modules.c
View file

@ -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 ();
}

8
libguile/modules.h
View file

@ -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);

78
module/ice-9/boot-9.scm
View file

@ -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)

14
module/ice-9/deprecated.scm
View file

@ -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)))

21
module/oop/goops/util.scm
View file

@ -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"