[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] Implement `the-environment' and `local-eval' in evaluator
From: |
Mark H Weaver |
Subject: |
[PATCH] Implement `the-environment' and `local-eval' in evaluator |
Date: |
Fri, 16 Dec 2011 04:21:23 -0500 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.0.92 (gnu/linux) |
Here's an improved version of the preliminary evaluator-only
implementation of `the-environment' and `local-eval'. I renamed the
primitives to the Guile 1.8 names, fixed the expansion within
`local-eval' to use `expand' instead of `expand-top-sequence', made the
module handling more robust, and various other minor improvements.
I plan to fully support these primitives in the compiler as well, in a
future version of this patch.
This is still a _preliminary_ patch. In particular:
* The compiler currently fails ungracefully if it encounters
(the-environment).
* The lexical environment object is currently non-opaque list structure.
* I still wouldn't be surprised if `local-eval' does the wrong thing if
(current-module) is different from what it was when the associated
`primitive-eval' was called.
* I manually removed the psyntax-pp.scm patch from the output of
git-format-patch (though the header change summary still mentions it),
since it was so huge. I guess you'll need to manually regenerate that
file yourself, since the Makefiles don't do it automatically:
cd guile/module; make ice-9/psyntax-pp.scm.gen
Here's an example session:
mhw:~/guile$ meta/guile
GNU Guile 2.0.3.72-c6748
Copyright (C) 1995-2011 Free Software Foundation, Inc.
Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.
Enter `,help' for help.
scheme@(guile-user)> (define env1 (primitive-eval '(let-syntax ((foo
(syntax-rules () ((foo x) (quote x))))) (let ((x 1) (y 2)) (the-environment)))))
scheme@(guile-user)> (local-eval 'x env1)
$1 = 1
scheme@(guile-user)> (local-eval 'y env1)
$2 = 2
scheme@(guile-user)> (local-eval '(foo (1 2)) env1)
$3 = (1 2)
scheme@(guile-user)> (define env2 (local-eval '(let-syntax ((bar
(syntax-rules () ((bar x) (foo x))))) (let ((x 1) (z 3)) (the-environment)))
env1))
scheme@(guile-user)> (local-eval 'x env2)
$4 = 1
scheme@(guile-user)> (local-eval '(bar (1 2)) env2)
$5 = (1 2)
scheme@(guile-user)> (local-eval '(foo (1 2)) env2)
$6 = (1 2)
scheme@(guile-user)> (local-eval 'z env2)
$7 = 3
scheme@(guile-user)> (local-eval '(set! x (+ x 10)) env2)
$8 = 11
scheme@(guile-user)> (local-eval 'x env1)
$9 = 1
Mark
>From c6748349a833cd61b380259ca8b9d81d7f14128f Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Wed, 14 Dec 2011 03:12:43 -0500
Subject: [PATCH] Implement `the-environment' and `local-eval' in evaluator
PRELIMINARY WORK, not ready for commit.
---
libguile/expand.c | 5 +
libguile/expand.h | 13 +
libguile/memoize.c | 18 +
libguile/memoize.h | 5 +-
module/ice-9/eval.scm | 31 +
module/ice-9/psyntax-pp.scm |23299 ++++++++++++++++++++++---------------------
module/ice-9/psyntax.scm | 26 +-
module/language/tree-il.scm | 8 +
8 files changed, 12095 insertions(+), 11310 deletions(-)
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index c0fa64c..7d6e6c1 100644
--- a/module/ice-9/eval.scm
+++ b/module/ice-9/eval.scm
@@ -213,6 +213,8 @@
;;; `eval' in this order, to put the most frequent cases first.
;;;
+(define local-eval #f) ;; This is set! from within the primitive-eval block
+
(define primitive-eval
(let ()
;; We pre-generate procedures with fixed arities, up to some number of
@@ -357,6 +359,14 @@
;; Finally, eval the body.
(eval body env)))))))))))))))
+ ;; FIXME: make this opaque!!
+ (define (make-lexical-environment module eval-env memoizer-env
expander-env)
+ (list '<lexical-environment> module eval-env memoizer-env expander-env))
+ (define lexical-environment:module cadr)
+ (define lexical-environment:eval-env caddr)
+ (define lexical-environment:memoizer-env cadddr)
+ (define (lexical-environment:expander-env env) (car (cddddr env)))
+
;; The "engine". EXP is a memoized expression.
(define (eval exp env)
(memoized-expression-case exp
@@ -459,6 +469,12 @@
(eval exp env)
(eval handler env)))
+ (('the-environment (memoizer-env . expander-env))
+ (let ((module (capture-env (if (pair? env)
+ (cdr (last-pair env))
+ env))))
+ (make-lexical-environment module env memoizer-env expander-env)))
+
(('call/cc proc)
(call/cc (eval proc env)))
@@ -468,6 +484,21 @@
var-or-spec
(memoize-variable-access! exp #f))
(eval x env)))))
+
+ (set! local-eval
+ (lambda (exp env)
+ "Evaluate @var{exp} within the lexical environment @var{env}."
+ (let ((module (lexical-environment:module env))
+ (eval-env (lexical-environment:eval-env env))
+ (memoizer-env (lexical-environment:memoizer-env env))
+ (expander-env (lexical-environment:expander-env env)))
+ (eval (memoize-local-expression
+ (if (macroexpanded? exp)
+ exp
+ ((module-transformer module)
+ exp #:env expander-env))
+ memoizer-env)
+ eval-env))))
;; primitive-eval
(lambda (exp)
diff --git a/libguile/memoize.h b/libguile/memoize.h
index 26bd5b1..f012d3a 100644
--- a/libguile/memoize.h
+++ b/libguile/memoize.h
@@ -44,6 +44,7 @@ SCM_API SCM scm_sym_quote;
SCM_API SCM scm_sym_quasiquote;
SCM_API SCM scm_sym_unquote;
SCM_API SCM scm_sym_uq_splicing;
+SCM_API SCM scm_sym_the_environment;
SCM_API SCM scm_sym_with_fluids;
SCM_API SCM scm_sym_at;
@@ -90,13 +91,15 @@ enum
SCM_M_TOPLEVEL_SET,
SCM_M_MODULE_REF,
SCM_M_MODULE_SET,
- SCM_M_PROMPT
+ SCM_M_PROMPT,
+ SCM_M_THE_ENVIRONMENT
};
SCM_INTERNAL SCM scm_memoize_expression (SCM exp);
+SCM_INTERNAL SCM scm_memoize_local_expression (SCM exp, SCM memoizer_env);
SCM_INTERNAL SCM scm_unmemoize_expression (SCM memoized);
SCM_INTERNAL SCM scm_memoized_expression_typecode (SCM memoized);
SCM_INTERNAL SCM scm_memoized_expression_data (SCM memoized);
diff --git a/libguile/memoize.c b/libguile/memoize.c
index 911d972..f7be46e 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -112,6 +112,8 @@ scm_t_bits scm_tc16_memoized;
MAKMEMO (SCM_M_MODULE_SET, scm_cons (val, scm_cons (mod, scm_cons (var,
public))))
#define MAKMEMO_PROMPT(tag, exp, handler) \
MAKMEMO (SCM_M_PROMPT, scm_cons (tag, scm_cons (exp, handler)))
+#define MAKMEMO_THE_ENVIRONMENT(memoizer_env, expander_env) \
+ MAKMEMO (SCM_M_THE_ENVIRONMENT, scm_cons(memoizer_env, expander_env))
/* Primitives for the evaluator */
@@ -143,6 +145,7 @@ static const char *const memoized_tags[] =
"module-ref",
"module-set!",
"prompt",
+ "the-environment",
};
static int
@@ -426,6 +429,9 @@ memoize (SCM exp, SCM env)
memoize_exps (REF (exp, DYNLET, VALS), env),
memoize (REF (exp, DYNLET, BODY), env));
+ case SCM_EXPANDED_THE_ENVIRONMENT:
+ return MAKMEMO_THE_ENVIRONMENT (env, REF (exp, THE_ENVIRONMENT,
EXPANDER_ENV));
+
default:
abort ();
}
@@ -444,6 +450,16 @@ SCM_DEFINE (scm_memoize_expression, "memoize-expression",
1, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_memoize_local_expression, "memoize-local-expression", 2, 0, 0,
+ (SCM exp, SCM memoizer_env),
+ "Memoize the expression @var{exp} within @var{memoizer_env}.")
+#define FUNC_NAME s_scm_memoize_local_expression
+{
+ SCM_ASSERT_TYPE (SCM_EXPANDED_P (exp), exp, 1, FUNC_NAME, "expanded");
+ return memoize (exp, memoizer_env);
+}
+#undef FUNC_NAME
+
@@ -706,6 +722,8 @@ unmemoize (const SCM expr)
unmemoize (CAR (args)),
unmemoize (CADR (args)),
unmemoize (CDDR (args)));
+ case SCM_M_THE_ENVIRONMENT:
+ return scm_list_3 (scm_sym_the_environment, CAR (args), CDR (args));
default:
abort ();
}
diff --git a/libguile/expand.h b/libguile/expand.h
index 02e6e17..b150058 100644
--- a/libguile/expand.h
+++ b/libguile/expand.h
@@ -54,6 +54,7 @@ typedef enum
SCM_EXPANDED_LET,
SCM_EXPANDED_LETREC,
SCM_EXPANDED_DYNLET,
+ SCM_EXPANDED_THE_ENVIRONMENT,
SCM_NUM_EXPANDED_TYPES,
} scm_t_expanded_type;
@@ -330,6 +331,18 @@ enum
#define SCM_MAKE_EXPANDED_DYNLET(src, fluids, vals, body) \
scm_c_make_struct (exp_vtables[SCM_EXPANDED_DYNLET], 0,
SCM_NUM_EXPANDED_DYNLET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (fluids),
SCM_UNPACK (vals), SCM_UNPACK (body))
+#define SCM_EXPANDED_THE_ENVIRONMENT_TYPE_NAME "the-environment"
+#define SCM_EXPANDED_THE_ENVIRONMENT_FIELD_NAMES \
+ { "src", "expander-env", }
+enum
+ {
+ SCM_EXPANDED_THE_ENVIRONMENT_SRC,
+ SCM_EXPANDED_THE_ENVIRONMENT_EXPANDER_ENV,
+ SCM_NUM_EXPANDED_THE_ENVIRONMENT_FIELDS,
+ };
+#define SCM_MAKE_EXPANDED_THE_ENVIRONMENT(src, expander_env) \
+ scm_c_make_struct (exp_vtables[SCM_EXPANDED_THE_ENVIRONMENT], 0,
SCM_NUM_EXPANDED_THE_ENVIRONMENT_FIELDS, SCM_UNPACK (src), SCM_UNPACK
(expander_env))
+
#endif /* BUILDING_LIBGUILE */
diff --git a/libguile/expand.c b/libguile/expand.c
index bdecd80..18d9e40 100644
--- a/libguile/expand.c
+++ b/libguile/expand.c
@@ -85,6 +85,8 @@ static const char** exp_field_names[SCM_NUM_EXPANDED_TYPES];
SCM_MAKE_EXPANDED_LETREC(src, in_order_p, names, gensyms, vals, body)
#define DYNLET(src, fluids, vals, body) \
SCM_MAKE_EXPANDED_DYNLET(src, fluids, vals, body)
+#define THE_ENVIRONMENT(src, expander_env) \
+ SCM_MAKE_EXPANDED_THE_ENVIRONMENT(src, expander_env)
#define CAR(x) SCM_CAR(x)
#define CDR(x) SCM_CDR(x)
@@ -203,6 +205,8 @@ SCM_GLOBAL_SYMBOL (scm_sym_unquote, "unquote");
SCM_GLOBAL_SYMBOL (scm_sym_quasiquote, "quasiquote");
SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing, "unquote-splicing");
+SCM_GLOBAL_SYMBOL (scm_sym_the_environment, "the-environment");
+
SCM_KEYWORD (kw_allow_other_keys, "allow-other-keys");
SCM_KEYWORD (kw_optional, "optional");
SCM_KEYWORD (kw_key, "key");
@@ -1250,6 +1254,7 @@ scm_init_expand ()
DEFINE_NAMES (LET);
DEFINE_NAMES (LETREC);
DEFINE_NAMES (DYNLET);
+ DEFINE_NAMES (THE_ENVIRONMENT);
scm_exp_vtable_vtable =
scm_make_vtable (scm_from_locale_string (SCM_VTABLE_BASE_LAYOUT "pwuwpw"),
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index 1d391c4..907cc82 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -49,6 +49,7 @@
<dynlet> dynlet? make-dynlet dynlet-src dynlet-fluids dynlet-vals
dynlet-body
<dynref> dynref? make-dynref dynref-src dynref-fluid
<dynset> dynset? make-dynset dynset-src dynset-fluid dynset-exp
+ <the-environment> the-environment? make-the-environment
the-environment-src the-environment-expander-env
<prompt> prompt? make-prompt prompt-src prompt-tag prompt-body
prompt-handler
<abort> abort? make-abort abort-src abort-tag abort-args abort-tail
@@ -125,6 +126,7 @@
;; (<let> names gensyms vals body)
;; (<letrec> in-order? names gensyms vals body)
;; (<dynlet> fluids vals body)
+ ;; (<the-environment> expander-env)
(define-type (<tree-il> #:common-slots (src) #:printer print-tree-il)
(<fix> names gensyms vals body)
@@ -324,6 +326,9 @@
((<dynset> fluid exp)
`(dynset ,(unparse-tree-il fluid) ,(unparse-tree-il exp)))
+ ((<the-environment> expander-env)
+ `(the-environment ,expander-env))
+
((<prompt> tag body handler)
`(prompt ,(unparse-tree-il tag) ,(unparse-tree-il body) ,(unparse-tree-il
handler)))
@@ -470,6 +475,9 @@
((<dynset> fluid exp)
`(fluid-set! ,(tree-il->scheme fluid) ,(tree-il->scheme exp)))
+ ((<the-environment>)
+ '(the-environment))
+
((<prompt> tag body handler)
`(call-with-prompt
,(tree-il->scheme tag)
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index e522f54..292f932 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -307,6 +307,14 @@
(if (not (assq 'name meta))
(set-lambda-meta! val (acons 'name name meta))))))
+ ;; data type for exporting the compile-type environment
+ ;; FIXME: make this opaque!
+ (define (make-psyntax-env r w mod)
+ (list '<psyntax-env> r w mod))
+ (define psyntax-env:r cadr)
+ (define psyntax-env:w caddr)
+ (define psyntax-env:mod cadddr)
+
;; output constructors
(define build-void
(lambda (source)
@@ -410,6 +418,9 @@
(define (build-data src exp)
(make-const src exp))
+ (define (build-the-environment src expander-env)
+ (make-the-environment src expander-env))
+
(define build-sequence
(lambda (src exps)
(if (null? (cdr exps))
@@ -1786,6 +1797,13 @@
(_ (syntax-violation 'quote "bad syntax"
(source-wrap e w s mod))))))
+ (global-extend 'core 'the-environment
+ (lambda (e r w s mod)
+ (syntax-case e ()
+ ((_) (build-the-environment s (make-psyntax-env r w
mod)))
+ (_ (syntax-violation 'quote "bad syntax"
+ (source-wrap e w s mod))))))
+
(global-extend 'core 'syntax
(let ()
(define gen-syntax
@@ -2395,9 +2413,11 @@
;; expanded, and the expanded definitions are also residualized into
;; the object file if we are compiling a file.
(set! macroexpand
- (lambda* (x #:optional (m 'e) (esew '(eval)))
- (expand-top-sequence (list x) null-env top-wrap #f m esew
- (cons 'hygiene (module-name
(current-module))))))
+ (lambda* (x #:optional (m 'e) (esew '(eval)) #:key env)
+ (if env
+ (expand x (psyntax-env:r env) (psyntax-env:w env)
(psyntax-env:mod env))
+ (expand-top-sequence (list x) null-env top-wrap #f m esew
+ (cons 'hygiene (module-name
(current-module)))))))
(set! identifier?
(lambda (x)
--
1.7.5.4
- Re: Anything better for delayed lexical evaluation than (lambda () ...)?, (continued)
- Re: Anything better for delayed lexical evaluation than (lambda () ...)?, Noah Lavine, 2011/12/13
- Re: Anything better for delayed lexical evaluation than (lambda () ...)?, Noah Lavine, 2011/12/13
- Re: Anything better for delayed lexical evaluation than (lambda () ...)?, Mark H Weaver, 2011/12/13
- Re: Anything better for delayed lexical evaluation than (lambda () ...)?, Mark H Weaver, 2011/12/14
- [PATCH] Implement `capture-lexical-environment' in evaluator, Mark H Weaver, 2011/12/14
- Re: [PATCH] Implement `capture-lexical-environment' in evaluator, David Kastrup, 2011/12/14
- Re: [PATCH] Implement `capture-lexical-environment' in evaluator, Mark H Weaver, 2011/12/14
- [PATCH] Implement `the-environment' and `local-eval' in evaluator,
Mark H Weaver <=
- Re: [PATCH] Implement `the-environment' and `local-eval' in evaluator, David Kastrup, 2011/12/16
- Re: [PATCH] Implement `the-environment' and `local-eval' in evaluator, Peter TB Brett, 2011/12/16
- Re: [PATCH] Implement `the-environment' and `local-eval' in evaluator, David Kastrup, 2011/12/16
- Re: [PATCH] Implement `the-environment' and `local-eval' in evaluator, Mark H Weaver, 2011/12/16
- Re: [PATCH] Implement `the-environment' and `local-eval' in evaluator, Andy Wingo, 2011/12/16
- Re: [PATCH] Implement `the-environment' and `local-eval' in evaluator, Mark H Weaver, 2011/12/16
- Re: [PATCH] Implement `the-environment' and `local-eval' in evaluator, Mark H Weaver, 2011/12/16
- Re: [PATCH] Implement `the-environment' and `local-eval' in evaluator, Hans Aberg, 2011/12/16
- Re: Anything better for delayed lexical evaluation than (lambda () ...)?, Andy Wingo, 2011/12/14
- Re: Anything better for delayed lexical evaluation than (lambda () ...)?, David Kastrup, 2011/12/14