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

Add capture-env to evaluator

Browse source 
* libguile/eval.c (eval):
* libguile/memoize.c (memoized_tags, unmemoize):
* libguile/memoize.h (SCM_M_CAPTURE_ENV):
* module/ice-9/eval.scm (primitive-eval): Add capture-env memoized
  expression type.
This commit is contained in:
Andy Wingo 2014-12-06 19:43:24 +01:00
parent cfdc8416a2
commit 99fb07e19b
4 changed files with 40 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

22
libguile/eval.c
View file

@ -280,6 +280,28 @@ eval (SCM x, SCM env)
case SCM_M_LAMBDA:
RETURN_BOOT_CLOSURE (mx, env);
case SCM_M_CAPTURE_ENV:
{
SCM locs = CAR (mx);
SCM new_env;
int i;
new_env = make_env (VECTOR_LENGTH (locs), SCM_BOOL_F, env);
for (i = 0; i < VECTOR_LENGTH (locs); i++)
{
SCM loc = VECTOR_REF (locs, i);
int depth, width;
depth = SCM_I_INUM (CAR (loc));
width = SCM_I_INUM (CDR (loc));
env_set (new_env, 0, i, env_ref (env, depth, width));
}
env = new_env;
x = CDR (mx);
goto loop;
}
case SCM_M_QUOTE:
return mx;

5
libguile/memoize.c
View file

@ -165,6 +165,7 @@ static const char *const memoized_tags[] =
"seq",
"if",
"lambda",
"capture-env",
"let",
"quote",
"define",
@ -625,6 +626,10 @@ unmemoize (const SCM expr)
tail));
}
}
case SCM_M_CAPTURE_ENV:
return scm_list_3 (scm_from_latin1_symbol ("capture-env"),
CAR (args),
unmemoize (CDR (args)));
case SCM_M_LET:
return scm_list_3 (scm_sym_let,
unmemoize_bindings (CAR (args)),

3
libguile/memoize.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_MEMOIZE_H
#define SCM_MEMOIZE_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010,2011,2013
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010,2011,2013,2014
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@ -66,6 +66,7 @@ enum
SCM_M_SEQ,
SCM_M_IF,
SCM_M_LAMBDA,
SCM_M_CAPTURE_ENV,
SCM_M_LET,
SCM_M_QUOTE,
SCM_M_DEFINE,

11
module/ice-9/eval.scm
View file

@ -499,6 +499,17 @@
(lp (cdr meta))))
proc))
(('capture-env (locs . body))
(let* ((len (vector-length locs))
(new-env (make-env len #f (env-toplevel env))))
(let lp ((n 0))
(when (< n len)
(mx-bind
(vector-ref locs n) (depth . width)
(env-set! new-env 0 n (env-ref env depth width)))
(lp (1+ n))))
(eval body new-env)))
(('seq (head . tail))
(begin
(eval head env)